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