File Coverage

lib/Transmission/Client.pm
Criterion Covered Total %
statement 120 137 87.5
branch 42 56 75.0
condition 6 11 54.5
subroutine 23 23 100.0
pod 9 9 100.0
total 200 236 84.7


line stmt bran cond sub pod time code
1             # ex:ts=4:sw=4:sts=4:et
2             package Transmission::Client;
3             # Copyright 2009-2013, Jan Henning Thorsen <jhthorsen@cpan.org>
4             # and contributors
5             #
6             # All rights reserved.
7             #
8             # This program is free software; you can redistribute it and/or
9             # modify it under the same terms as Perl itself.
10              
11             =head1 NAME
12              
13             Transmission::Client - Interface to Transmission
14              
15             =head1 VERSION
16              
17             0.0806
18              
19             =head1 DESCRIPTION
20              
21             L<Transmission::Client> is the main module in a collection of modules
22             to communicate with Transmission. Transmission is a cross-platform
23             BitTorrent client that is:
24              
25             =over
26              
27             =item * Easy
28              
29             =item * Lean
30              
31             =item * Native
32              
33             =item * Powerful
34              
35             =item * Free
36              
37             =back
38              
39             If you want to communicate with "transmission-daemon", this is a module
40             which can help you with that.
41              
42             The documentation is half copy/paste from the Transmission RPC spec:
43             L<https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt>
44              
45             This module differs from L<P2P::Transmission> in (at least) two ways:
46             This one use L<Moose> and it won't die. The latter is especially
47             annoying in the constructor.
48              
49             =head1 SYNOPSIS
50              
51             use Transmission::Client;
52              
53             my $client = Transmission::Client->new;
54             my $torrent_id = 2;
55             my $data = base64_encoded_data();
56              
57             $client->add(metainfo => $data) or confess $client->error;
58             $client->remove($torrent_id) or confess $client->error;
59              
60             for my $torrent (@{ $client->torrents }) {
61             print $torrent->name, "\n";
62             for my $file (@{ $torrent->files }) {
63             print "> ", $file->name, "\n";
64             }
65             }
66              
67             print $client->session->download_dir, "\n";
68              
69             =head1 FAULT HANDLING
70              
71             In C<0.06> L<Transmission::Client> can be constructed with "autodie" set
72             to true, to make this object confess instead of just setting L</error>.
73             Example:
74              
75             my $client = Transmission::Client->new(autodie => 1);
76              
77             eval {
78             $self->add(filename => 'foo.torrent');
79             } or do {
80             # add() failed...
81             };
82              
83             =head1 SEE ALSO
84              
85             L<Transmission::AttributeRole>
86             L<Transmission::Session>
87             L<Transmission::Torrent>
88             L<Transmission::Utils>
89              
90             =cut
91              
92 4     4   103857 use Moose;
  4         934369  
  4         27  
93 4     4   34460 use DateTime;
  4         1928947  
  4         208  
94 4     4   40 use DateTime::Duration;
  4         9  
  4         93  
95 4     4   1813 use JSON::MaybeXS;
  4         17618  
  4         265  
96 4     4   3070 use LWP::UserAgent;
  4         162662  
  4         155  
97 4     4   2030 use MIME::Base64;
  4         2777  
  4         255  
98 4     4   1348 use Transmission::Torrent;
  4         25  
  4         173  
99 4     4   2296 use Transmission::Session;
  4         14  
  4         242  
100 4     4   80 use constant RPC_DEBUG => $ENV{'TC_RPC_DEBUG'};
  4         9  
  4         7463  
101              
102             our $VERSION = '0.0806';
103             our $SESSION_ID_HEADER_NAME = 'X-Transmission-Session-Id';
104             my $JSON = JSON::MaybeXS->new;
105              
106             with 'Transmission::AttributeRole';
107              
108             =head1 ATTRIBUTES
109              
110             =head2 url
111              
112             $str = $self->url;
113              
114             Returns an URL to where the Transmission rpc api is.
115             Default value is "http://localhost:9091/transmission/rpc";
116              
117             =cut
118              
119             has url => (
120             is => 'ro',
121             isa => 'Str',
122             default => 'http://localhost:9091/transmission/rpc',
123             );
124              
125             # this is subject for change!
126             has _url => (
127             is => 'ro',
128             isa => 'Str',
129             lazy_build => 1,
130             );
131              
132             sub _build__url {
133 1     1   2 my $self = shift;
134 1         20 my $url = $self->url;
135              
136 1 50 33     21 if($self->username or $self->password) {
137 0         0 my $auth = join ':', $self->username, $self->password;
138 0         0 $url =~ s,://,://$auth@,;
139             }
140              
141 1         19 return $url;
142             }
143              
144             =head2 error
145              
146             $str = $self->error;
147            
148             Returns the last error known to the object. All methods can return
149             empty list in addition to what specified. Check this attribute if so happens.
150              
151             Like L</autodie>? Create your object with C<autodie> set to true and this
152             module will throw exceptions in addition to setting this variable.
153              
154             =cut
155              
156             has error => (
157             is => 'rw',
158             isa => 'Str',
159             default => '',
160             clearer => '_clear_error',
161             trigger => sub { $_[0]->_autodie and confess $_[1] },
162             );
163              
164             has _autodie => (
165             is => 'ro',
166             init_arg => 'autodie',
167             isa => 'Bool',
168             default => 0,
169             );
170              
171             =head2 username
172              
173             $str = $self->username;
174              
175             Used to authenticate against Transmission.
176              
177             =cut
178              
179             has username => (
180             is => 'ro',
181             isa => 'Str',
182             default => '',
183             );
184              
185             =head2 password
186              
187             $str = $self->password;
188              
189             Used to authenticate against Transmission.
190              
191             =cut
192              
193             has password => (
194             is => 'ro',
195             isa => 'Str',
196             default => '',
197             );
198              
199             =head2 timeout
200              
201             $int = $self->timeout;
202              
203             Number of seconds to wait for RPC response.
204              
205             =cut
206              
207             has _ua => (
208             is => 'rw',
209             isa => 'LWP::UserAgent',
210             lazy => 1,
211             handles => [qw/timeout/],
212             default => sub {
213             LWP::UserAgent->new( agent => 'Transmission-Client' );
214             },
215             );
216              
217             =head2 session
218              
219             $session_obj = $self->session;
220             $stats_obj = $self->stats;
221              
222             Returns an instance of L<Transmission::Session>.
223             C<stats()> is a proxy method on L</session>.
224              
225             =cut
226              
227             has session => (
228             is => 'ro',
229             lazy => 1,
230             predicate => 'has_session',
231             handles => [qw/stats/],
232             default => sub {
233             Transmission::Session->new( client => $_[0] );
234             },
235             );
236              
237             =head2 torrents
238              
239             $array_ref = $self->torrents;
240             $self->clear_torrents;
241              
242             Returns an array-ref of L<Transmission::Torrent> objects. Default value
243             is a full list of all known torrents, with as little data as possible read
244             from Transmission. This means that each request on a attribute on an object
245             will require a new request to Transmission. See L</read_torrents> for more
246             information.
247              
248             =cut
249              
250             has torrents => (
251             is => 'rw',
252             traits => ['Array'],
253             lazy => 1,
254             clearer => "clear_torrents",
255             builder => "read_torrents",
256             predicate => 'has_torrents',
257             handles => {
258             torrent_list => 'elements',
259             },
260             );
261              
262             =head2 version
263              
264             $str = $self->version;
265              
266             Get Transmission version.
267              
268             =cut
269              
270             has version => (
271             is => 'ro',
272             isa => 'Str',
273             lazy_build => 1,
274             );
275              
276             sub _build_version {
277 1     1   2 my $self = shift;
278              
279 1 50       3 if(my $data = $self->rpc('session-get')) {
280 1   50     23 return $data->{'version'} || q();
281             }
282              
283 0         0 return q();
284             }
285              
286             =head2 session_id
287              
288             $self->session_id($str);
289             $str = $self->session_id;
290              
291             The session ID used to communicate with Transmission.
292              
293             =cut
294              
295             has session_id => (
296             is => 'rw',
297             isa => 'Str',
298             default => '',
299             trigger => sub {
300             $_[0]->_ua->default_header($SESSION_ID_HEADER_NAME => $_[1]);
301             },
302             );
303              
304             =head1 METHODS
305              
306             =head2 add
307              
308             $bool = $self->add(%args);
309              
310             key | value type | description
311             -----------------+------------+------------------------------------
312             download_dir | string | path to download the torrent to
313             filename | string | filename or URL of the .torrent file
314             metainfo | string | torrent content
315             paused | boolean | if true, don't start the torrent
316             peer_limit | number | maximum number of peers
317              
318             Either "filename" or "metainfo" MUST be included. All other arguments are
319             optional.
320              
321             See "3.4 Adding a torrent" from
322             L<https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt>
323              
324             =cut
325              
326             sub add {
327 4     4 1 2134 my $self = shift;
328 4         12 my %args = @_;
329              
330 4 100 100     25 if($args{'filename'} and $args{'metainfo'}) {
    100          
    100          
331 1         29 $self->error("Filename and metainfo argument crash");
332 0         0 return;
333             }
334             elsif($args{'filename'}) {
335 1         20 return $self->rpc('torrent-add', %args);
336             }
337             elsif($args{'metainfo'}) {
338 1         9 $args{'metainfo'} = encode_base64($args{'metainfo'});
339 1         4 return $self->rpc('torrent-add', %args);
340             }
341             else {
342 1         30 $self->error("Need either filename or metainfo argument");
343 0         0 return;
344             }
345             }
346              
347             =head2 remove
348              
349             $bool = $self->remove(%args);
350              
351             key | value type | description
352             -------------------+------------+------------------------------------
353             ids | array | torrent list, as described in 3.1
354             delete_local_data | boolean | delete local data. (default: false)
355              
356             C<ids> can also be the string "all". C<ids> is required.
357              
358             See "3.4 Removing a torrent" from
359             L<https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt>
360              
361             =cut
362              
363             sub remove {
364 4     4 1 865 my $self = shift;
365              
366 4 50       11 if($self->_do_ids_action('torrent-remove' => @_)) {
367 3         108 $self->clear_torrents; # torrent list might be out of sync
368 3         15 return 1;
369             }
370             else {
371 0         0 return 0;
372             }
373             }
374              
375             =head2 move
376              
377             $bool = $self->move(%args);
378              
379              
380             string | value type | description
381             ------------+------------+------------------------------------
382             ids | array | torrent list, as described in 3.1
383             location | string | the new torrent location
384             move | boolean | if true, move from previous location.
385             | | otherwise, search "location" for files
386              
387             C<ids> can also be the string "all". C<ids> and C<location> is required.
388              
389             See "3.5 moving a torrent" from
390             L<https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt>
391              
392             =cut
393              
394             sub move {
395 2     2 1 724 my $self = shift;
396 2         7 my %args = @_;
397              
398 2 100       7 if(!defined $args{'location'}) {
399 1         29 $self->error("location argument is required");
400 0         0 return;
401             }
402              
403 1         5 return $self->_do_ids_action('torrent-set-location' => %args);
404             }
405              
406             =head2 start
407              
408             $bool = $self->start($ids);
409              
410             Will start one or more torrents.
411             C<$ids> can be a single int, an array of ints or the string "all".
412              
413             =head2 stop
414              
415             $bool = $self->stop($ids);
416              
417             Will stop one or more torrents.
418             C<$ids> can be a single int, an array of ints or the string "all".
419              
420             =head2 verify
421              
422             $bool = $self->stop($ids);
423              
424             Will verify one or more torrents.
425             C<$ids> can be a single int, an array of ints or the string "all".
426              
427             =cut
428              
429             sub start {
430 1     1 1 5 return shift->_do_ids_action('torrent-start' => @_);
431             }
432              
433             sub stop {
434 1     1 1 4 return shift->_do_ids_action('torrent-stop' => @_);
435             }
436              
437             sub verify {
438 1     1 1 5 return shift->_do_ids_action('torrent-verify' => @_);
439             }
440              
441             sub _do_ids_action {
442 8     8   9 my $self = shift;
443 8         16 my $method = shift;
444 8 50       27 my %args = @_ == 1 ? (ids => $_[0]) : @_;
445 8         11 my $ids;
446              
447 8 100       20 unless(defined $args{'ids'}) {
448 1         30 $self->error('ids is required as argument');
449 0         0 return;
450             }
451              
452 7 100       18 unless(ref $args{'ids'} eq 'ARRAY') {
453 6 100       15 if($args{'ids'} eq 'all') {
454 1         2 delete $args{'ids'};
455             }
456             else {
457 5         12 $args{'ids'} = [$args{'ids'}];
458             }
459             }
460              
461 7 50       22 return $self->rpc($method, %args) ? 1 : 0;
462             }
463              
464             =head2 read_torrents
465              
466             @list = $self->read_torrents(%args);
467             $array_ref = $self->read_torrents(%args);
468              
469             key | value type | description
470             ------------+------------+------------------------------------
471             ids | array | optional torrent list, as described in 3.1.
472             lazy_read | | will create objects with as little data as possible.
473              
474             =over 4
475              
476             =item List context
477              
478             Returns a list of L<Transmission::Torrent> objects and sets the L</torrents>
479             attribute.
480              
481             =item Scalar context
482              
483             Returns an array-ref of L<Transmission::Torrent>.
484              
485             =back
486              
487             =cut
488              
489             sub read_torrents {
490 6     6 1 13 my $self = shift;
491 6 50       20 my %args = @_ == 1 ? (ids => $_[0]) : @_;
492 6         8 my $list;
493              
494             # set fields...
495 6 100       15 if(exists $args{'fields'}) { # ... based on user input
    100          
496             # We should always request id
497 1         3 push @{$args{'fields'}}, 'id' unless
498 1 50       6 grep {'id' eq $_} @{$args{'fields'}};
  2         8  
  1         5  
499             }
500             elsif($args{'lazy_read'}) { # ... as few fields as possible
501 1         3 $args{'fields'} = ['id'];
502             }
503             else { # ... all fields
504 4         69 $args{'fields'} = [
505             keys %Transmission::Torrent::READ,
506             keys %Transmission::Torrent::BOTH,
507             ];
508             }
509              
510             # set ids
511 6 100       22 if($args{'ids'}) {
512 1 50       8 if($args{'ids'} eq 'all') {
    50          
513 0         0 delete $args{'ids'};
514             }
515             elsif(ref $args{'ids'} eq "") {
516 1         5 $args{'ids'} = [ $args{'ids'} ];
517             }
518             }
519              
520 6 50       18 if(my $data = $self->rpc('torrent-get' => %args)) {
521 6         11 $list = $data->{'torrents'};
522             }
523             else {
524 0         0 $list = [];
525             }
526              
527 6         14 for my $torrent (@$list) {
528             $torrent = Transmission::Torrent->new(
529             client => $self,
530 0         0 id => $torrent->{'id'},
531             %$torrent,
532             );
533             }
534              
535 6 100       12 if(wantarray) {
536 1         22 $self->torrents($list);
537 1         5 return @$list;
538             }
539             else {
540 5         46 return $list;
541             }
542             }
543              
544             =head2 rpc
545              
546             $any = $self->rpc($method, %args);
547              
548             Communicate with backend. This methods is meant for internal use.
549              
550             =cut
551              
552             sub rpc {
553 20     20 1 1147 my $self = shift;
554 20 50       44 my $method = shift or return;
555 20         42 my %args = @_;
556 20         35 my $nested = delete $args{'_nested'}; # internal flag
557 20         27 my($tag, $res, $post);
558              
559 20         56 $method = $self->_normal2Camel($method);
560              
561             # The keys need to be dashes as well
562             # _normal2Camel modifies a hashref in places
563 20         84 $self->_normal2Camel( \%args );
564              
565             # make sure ids are numeric
566 20 100       67 if(ref $args{'ids'} eq 'ARRAY') {
567 8         10 for my $id (@{ $args{'ids'} }) {
  8         18  
568             # Need to convert string integer to "real" integer
569             # FLAGS = (IOK,POK,pIOK,pPOK)
570             # IV = 42
571             # ...to...
572             # FLAGS = (PADTMP,IOK,pIOK)
573             # IV = 42
574 11 100       58 $id += 0 if($id =~ /^\d+$/);
575             }
576             }
577              
578 20         84 $tag = int rand 2*16 - 1;
579 20         198 $post = $JSON->encode({
580             method => $method,
581             tag => $tag,
582             arguments => \%args,
583             });
584              
585 20         550 $res = $self->_ua->post($self->_url, Content => $post);
586              
587 20         223 if(RPC_DEBUG) {
588             print "post: $post\n";
589             print "status_line: ", $res->status_line, "\n";
590             }
591              
592 20 100       91 unless($res->is_success) {
593 1 50 33     15 if($res->code == 409 and !$nested) {
594 1         20 $self->session_id($res->header($SESSION_ID_HEADER_NAME));
595 1         9 return $self->rpc($method => %args, _nested => 1);
596             }
597             else {
598 0         0 $self->error($res->status_line);
599 0         0 return;
600             }
601             }
602              
603 19         149 $res = $JSON->decode($res->content);
604              
605 19 50       362 unless($res->{'tag'} == $tag) {
606 0         0 $self->error("Tag mismatch");
607 0         0 return;
608             }
609 19 50       40 unless($res->{'result'} eq 'success') {
610 0         0 $self->error($res->{'result'});
611 0         0 return;
612             }
613              
614 19         475 $self->_clear_error;
615              
616 19         108 return $res->{'arguments'};
617             }
618              
619             =head2 read_all
620              
621             1 == $self->read_all;
622              
623             This method will try to populate ALL torrent, session and stats information,
624             using three requests.
625              
626             =cut
627              
628             sub read_all {
629 1     1 1 2 my $self = shift;
630              
631 1         31 $self->session->read_all;
632 1         8 $self->stats->read_all;
633 1         9 () = $self->read_torrents;
634              
635 1         4 return 1;
636             }
637              
638             =head1 LICENSE
639              
640             This library is free software; you can redistribute it and/or modify it under
641             the same terms as Perl itself.
642              
643             =head1 COPYRIGHT AND AUTHORS
644              
645             Copyright 2009-2019 by Transmission::Client contributors
646              
647             See C<git log --format="%aN E<lt>%aEE<gt>" | sort | uniq> in the git repository
648             for the reference list of contributors.
649              
650             =head2 CONTRIBUTORS
651              
652             =over
653              
654             =item * Jan Henning Thorsen (original author)
655              
656             =item * Olof Johansson (current maintainer)
657              
658             =item * Andrew Fresh
659              
660             =item * Yanick Champoux
661              
662             =back
663              
664             =cut
665              
666 4     4   37 no MIME::Base64;
  4         8  
  4         174  
667 4     4   194 no Moose;
  4         13  
  4         42  
668             1;