[www-search-torrentz.git] / lib / WWW / Search / Torrentz.pm

package WWW::Search::Torrentz;

use 5.014000;
use strict;
use warnings;
no if $] >= 5.018, warnings => 'experimental::smartmatch';
use parent qw/WWW::Search/;

our $VERSION = '0.001002';
our $MAINTAINER = 'Marius Gavrilescu <marius@ieval.ro>';

use WWW::Search::Torrentz::Result;

sub gui_query{ shift->native_query(@_) }

sub _native_setup_search{
	my ($self, $native_query, $options) = @_;
	$self->agent_email('marius@ieval.ro');
	$options //= {};
	my $base_url = $options->{search_url} // 'https://torrentz.eu/search';
	$self->{search_debug} = $options->{search_debug};
	$self->{_next_url} = "$base_url?f=$native_query";
	$self->user_agent->delay(2/60);
}

sub fullint ($) { int (shift =~ y/0-9//cdr) }

sub _parse_tree{
	my ($self, $tree) = @_;
	my $found = 0;

	my @potential_results = $tree->find('dl');
	my $result_count = $tree->find('h2')->as_text;
	if (defined $result_count && $result_count ne 'No Torrents Found') {
		$result_count =~ s/orrents.*//;
		$self->approximate_result_count(fullint $result_count);
	}

	for my $node (@potential_results) {
		my $a = $node->find('a');
		next unless defined $a;

		my $infohash = substr $a->attr('href'), 1;
		next unless $infohash =~ m,^[a-f0-9]{40}$,;
		my $title = $a->as_text;
		my ($verified, $age, $size, $seeders, $leechers);
		$verified = 0;
		for my $span ($node->find('span')) {
			given($span->attr('class')){
				$verified = int ($span->as_text =~ m,^\d+,) when 'v';
				$age = $span->as_text when 'a';
				$size = $span->as_text when 's';
				$seeders = fullint $span->as_text when 'u';
				$leechers = fullint $span->as_text when 'd';
			}
		}

		push @{$self->{cache}}, WWW::Search::Torrentz::Result->new(infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers, ua => $self->user_agent);
		say STDERR "infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers" if $self->{search_debug};
		$found++;
	}

	my $url = $tree->look_down(rel => 'next');
	if (defined $url) {
		my $prev = $self->{_prev_url} =~ s,/[^/]+$,,r;
		$self->{_next_url} = $prev . $url->attr('href')
	}
	say STDERR "Found: $found" if $self->{search_debug};
	return $found;
}

1;
__END__

=encoding utf-8

=head1 NAME

WWW::Search::Torrentz - search torrentz.eu with WWW::Search

=head1 SYNOPSIS

  use WWW::Search;
  my $search = WWW::Search->new('Torrentz');
  $search->gui_query('query');
  say $_->title while $_ = $search->next_result;

=head1 DESCRIPTION

WWW::Search::Torrentz is a subclass of WWW::Search that searches the L<https://torrentz.eu> search aggregator.

To use this module, read the L<WWW::Search> documentation.

Search results are instances of the L<WWW::Search::Torrentz::Result> class.

Available optional L<WWW::Search> methods:

=over

=item B<gui_query>

Identical to B<native_query>.

=item B<approximate_result_count>

Returns the exact result count, as indicated by Torrentz.

=back

=head1 SEE ALSO

L<https://torrentz.eu/help>, L<WWW::Search>, L<WWW::Search::Torrentz::Result>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.18.1 or,
at your option, any later version of Perl 5 you may have available.


=cut
Commit	Line	Data
e605ae0f MG	1	package WWW::Search::Torrentz;
	2
	3	use 5.014000;
	4	use strict;
	5	use warnings;
d54e3343	6	no if $] >= 5.018, warnings => 'experimental::smartmatch';
e605ae0f MG	7	use parent qw/WWW::Search/;
e605ae0f MG	8
318ef587	9	our $VERSION = '0.001002';
e605ae0f MG	10	our $MAINTAINER = 'Marius Gavrilescu <marius@ieval.ro>';
	11
	12	use WWW::Search::Torrentz::Result;
	13
	14	sub gui_query{ shift->native_query(@_) }
	15
	16	sub _native_setup_search{
7dcf8cda MG	17	my ($self, $native_query, $options) = @_;
	18	$self->agent_email('marius@ieval.ro');
	19	$options //= {};
	20	my $base_url = $options->{search_url} // 'https://torrentz.eu/search';
	21	$self->{search_debug} = $options->{search_debug};
	22	$self->{_next_url} = "$base_url?f=$native_query";
	23	$self->user_agent->delay(2/60);
e605ae0f MG	24	}
e605ae0f MG	25
287bea8a MG	26	sub fullint ($) { int (shift =~ y/0-9//cdr) }
287bea8a MG	27
e605ae0f	28	sub _parse_tree{
7dcf8cda MG	29	my ($self, $tree) = @_;
	30	my $found = 0;
	31
	32	my @potential_results = $tree->find('dl');
	33	my $result_count = $tree->find('h2')->as_text;
	34	if (defined $result_count && $result_count ne 'No Torrents Found') {
	35	$result_count =~ s/orrents.*//;
287bea8a	36	$self->approximate_result_count(fullint $result_count);
e605ae0f MG	37	}
e605ae0f MG	38
7dcf8cda MG	39	for my $node (@potential_results) {
	40	my $a = $node->find('a');
	41	next unless defined $a;
	42
	43	my $infohash = substr $a->attr('href'), 1;
	44	next unless $infohash =~ m,^[a-f0-9]{40}$,;
	45	my $title = $a->as_text;
	46	my ($verified, $age, $size, $seeders, $leechers);
	47	$verified = 0;
	48	for my $span ($node->find('span')) {
	49	given($span->attr('class')){
	50	$verified = int ($span->as_text =~ m,^\d+,) when 'v';
	51	$age = $span->as_text when 'a';
	52	$size = $span->as_text when 's';
287bea8a MG	53	$seeders = fullint $span->as_text when 'u';
287bea8a MG	54	$leechers = fullint $span->as_text when 'd';
7dcf8cda MG	55	}
	56	}
	57
	58	push @{$self->{cache}}, WWW::Search::Torrentz::Result->new(infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers, ua => $self->user_agent);
	59	say STDERR "infohash => $infohash, title => $title, verified => $verified, age => $age, size => $size, seeders => $seeders, leechers => $leechers" if $self->{search_debug};
	60	$found++;
	61	}
	62
	63	my $url = $tree->look_down(rel => 'next');
	64	if (defined $url) {
	65	my $prev = $self->{_prev_url} =~ s,/[^/]+$,,r;
	66	$self->{_next_url} = $prev . $url->attr('href')
	67	}
	68	say STDERR "Found: $found" if $self->{search_debug};
	69	return $found;
e605ae0f MG	70	}
	71
	72	1;
	73	__END__
	74
	75	=encoding utf-8
	76
	77	=head1 NAME
	78
d54e3343	79	WWW::Search::Torrentz - search torrentz.eu with WWW::Search
e605ae0f MG	80
	81	=head1 SYNOPSIS
	82
	83	use WWW::Search;
	84	my $search = WWW::Search->new('Torrentz');
	85	$search->gui_query('query');
	86	say $_->title while $_ = $search->next_result;
	87
	88	=head1 DESCRIPTION
	89
	90	WWW::Search::Torrentz is a subclass of WWW::Search that searches the L<https://torrentz.eu> search aggregator.
	91
	92	To use this module, read the L<WWW::Search> documentation.
	93
	94	Search results are instances of the L<WWW::Search::Torrentz::Result> class.
	95
	96	Available optional L<WWW::Search> methods:
	97
	98	=over
	99
	100	=item B<gui_query>
	101
	102	Identical to B<native_query>.
	103
	104	=item B<approximate_result_count>
	105
	106	Returns the exact result count, as indicated by Torrentz.
	107
	108	=back
	109
	110	=head1 SEE ALSO
	111
	112	L<https://torrentz.eu/help>, L<WWW::Search>, L<WWW::Search::Torrentz::Result>
	113
	114	=head1 AUTHOR
	115
	116	Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
	117
	118	=head1 COPYRIGHT AND LICENSE
	119
	120	Copyright (C) 2013 by Marius Gavrilescu
	121
	122	This library is free software; you can redistribute it and/or modify
	123	it under the same terms as Perl itself, either Perl version 5.18.1 or,
	124	at your option, any later version of Perl 5 you may have available.
	125
	126
	127	=cut