]> iEval git - www-search-torrentz.git/blob - Torrentz.pm
432badd210bce279f23c4172aed9ab13477a61c6
[www-search-torrentz.git] / 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 - [DEPRECATED] 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 This module is deprecated since L<https://torrentz.eu> was shut down
94 in August 2016.
95
96 WWW::Search::Torrentz is a subclass of WWW::Search that searches the
97 L<https://torrentz.eu> search aggregator.
98
99 To use this module, read the L<WWW::Search> documentation.
100
101 Search results are instances of the L<WWW::Search::Torrentz::Result> class.
102
103 Available optional L<WWW::Search> methods:
104
105 =over
106
107 =item B<gui_query>
108
109 Identical to B<native_query>.
110
111 =item B<approximate_result_count>
112
113 Returns the exact result count, as indicated by Torrentz.
114
115 =back
116
117 =head1 SEE ALSO
118
119 L<https://torrentz.eu/help>, L<WWW::Search>, L<WWW::Search::Torrentz::Result>
120
121 =head1 AUTHOR
122
123 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
124
125 =head1 COPYRIGHT AND LICENSE
126
127 Copyright (C) 2013 by Marius Gavrilescu
128
129 This library is free software; you can redistribute it and/or modify
130 it under the same terms as Perl itself, either Perl version 5.18.1 or,
131 at your option, any later version of Perl 5 you may have available.
132
133
134 =cut
This page took 0.052974 seconds and 3 git commands to generate.