lib/WebService/Strike.pm

   1 package WebService::Strike;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 use parent qw/Exporter/;
   7
   8 our @EXPORT    = qw/strike strike_search/; ## no critic (ProhibitAutomaticExportation)
   9 our @EXPORT_OK = qw/strike_query strike strike_search/;
  10 our $VERSION = '0.002';
  11 our $BASE_URL = 'http://getstrike.net/api/v2/torrents';
  12
  13 use JSON::MaybeXS qw/decode_json/;
  14 use HTTP::Tiny;
  15 use Sort::ByExample qw/sbe/;
  16 use WebService::Strike::Torrent;
  17
  18 sub _ht { HTTP::Tiny->new(agent => "WebService-Strike/$VERSION") }
  19
  20 sub _query {
  21         my ($url) = @_;
  22
  23         my $ht = _ht;
  24         my $response = $ht->get($url);
  25         die $response unless $response->{success}; ## no critic (RequireCarping)
  26         $response = decode_json $response->{content};
  27
  28         map { WebService::Strike::Torrent->new($_) } @{$response->{torrents}};
  29 }
  30
  31 sub strike_query {
  32         my (@hashes) = @_;
  33         my $url = "$BASE_URL/info/?hashes=" . join ',', map { uc } @hashes;
  34
  35         my $sorter = sbe(\@hashes, {xform => sub { $_[0]->hash }});
  36         my @torrents = $sorter->(_query $url);
  37         wantarray ? @torrents : $torrents[0]
  38 }
  39
  40 sub strike_search {
  41         my ($query, $full, %args) = @_;
  42         $args{phrase} = $query;
  43         my $url = "$BASE_URL/search/?" . HTTP::Tiny->www_form_urlencode(\%args);
  44
  45         my @torrents = _query $url;
  46         @torrents = $torrents[0] unless wantarray;
  47         @torrents = strike_query map { $_->hash } @torrents if $full;
  48         wantarray ? @torrents : $torrents[0]
  49 }
  50
  51 BEGIN { *strike = \&strike_query }
  52
  53 1;
  54 __END__
  55
  56 =encoding utf-8
  57
  58 =head1 NAME
  59
  60 WebService::Strike - Get torrent info from getstrike.net API
  61
  62 =head1 SYNOPSIS
  63
  64   use WebService::Strike;
  65   my $t = strike 'B425907E5755031BDA4A8D1B6DCCACA97DA14C04';
  66   say $t->title;               # Arch Linux 2015.01.01 (x86\/x64)
  67   say $t->magnet;              # Returns a magnet link
  68   my $torrent = $t->torrent;   # Returns the torrent file
  69   $t->torrent('file.torrent'); # Downloads the torrent file to 'file.torrent'
  70
  71   my @debian = strike_search 'Debian';
  72   say 'Found ' . @debian . ' torrents matching "Debian"';
  73   say 'First torrent has info hash ' . $debian[0]->hash;
  74
  75   my $mp = strike_search 'Modern perl', 1, category => 'Books';
  76   say 'Torrent has ' . $mp->count . ' files. They are:';
  77   say join ' ', @{$mp->file_names};
  78
  79 =head1 DESCRIPTION
  80
  81 Strike API is a service for getting information about a torrent given
  82 its info hash. WebService::Strike is a wrapper for this service.
  83
  84 =over
  85
  86 =item B<strike>(I<@info_hashes>)
  87
  88 Returns a list of L<WebService::Strike::Torrent> objects in list
  89 context or the first such object in scalar context. Dies in case of
  90 error.
  91
  92 =item B<strike_query>
  93
  94 Alias for B<strike>. Not exported by default.
  95
  96 =item B<strike_search>(I<$phrase>, [I<$full>, [ key => value ... ]])
  97
  98 Searches for torrents given a phrase. Returns a list of
  99 L<WebService::Strike::Torrent> objects in list context or the first
 100 such object in scalar context.
 101
 102 If I<$full> is false (default), the returned objects will be
 103 incomplete: their B<file_names> and B<file_lengths> accessors will
 104 return undef.
 105
 106 If I<$full> is true, B<strike> will be called with the info hashes of
 107 the found torrents, thus obtaining complete objects.
 108
 109 You can filter the search by appending key => value pairs to the call.
 110 For example:
 111
 112   strike_search 'windows', 0, category => 'Applications', sub_category => 'Windows';
 113
 114 =back
 115
 116 =head1 SEE ALSO
 117
 118 L<WebService::Strike::Torrent>, L<http://getstrike.net/api/>, L<WWW::Search::Torrentz>
 119
 120 =head1 AUTHOR
 121
 122 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 123
 124 =head1 COPYRIGHT AND LICENSE
 125
 126 Copyright (C) 2015 by Marius Gavrilescu
 127
 128 This library is free software; you can redistribute it and/or modify
 129 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 130 at your option, any later version of Perl 5 you may have available.
 131
 132
 133 =cut