lib/WWW/Search/Torrentz.pm

   1 package WWW::Search::Torrentz;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 no if $] >= 5.018, warnings => 'experimental::smartmatch';
   7 use parent qw/WWW::Search/;
   8
   9 our $VERSION = '0.001002';
  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{
  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);
  24 }
  25
  26 sub fullint ($) { int (shift =~ y/0-9//cdr) }
  27
  28 sub _parse_tree{
  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.*//;
  36                 $self->approximate_result_count(fullint $result_count);
  37         }
  38
  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';
  53                                 $seeders = fullint $span->as_text when 'u';
  54                                 $leechers = fullint $span->as_text when 'd';
  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;
  70 }
  71
  72 1;
  73 __END__
  74
  75 =encoding utf-8
  76
  77 =head1 NAME
  78
  79 WWW::Search::Torrentz - search torrentz.eu with WWW::Search
  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