]> iEval git - www-search-torrentz.git/blob - lib/WWW/Search/Torrentz.pm
Add some extra dependencies to Makefile.PL
[www-search-torrentz.git] / 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.001001';
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
This page took 0.053971 seconds and 4 git commands to generate.