——————————————————# ex:ts=4:sw=4:sts=4:et
package
Transmission::Client;
=head1 NAME
Transmission::Client - Interface to Transmission
=head1 VERSION
0.0802
=head1 DESCRIPTION
L<Transmission::Client> is the main module in a collection of modules to
communicate with Transmission. Transmission is:
Transmission is a cross-platform BitTorrent client that is:
* Easy
* Lean
* Native
* Powerful
* Free
If you want to communicate with "transmission-daemon", this is a module
which can help you with that.
The documentation is half copy/paste from the Transmission RPC spec:
This module differs from L<P2P::Transmission> in (at least) two ways:
This one use L<Moose> and it won't die. The latter is especially
annoying in the constructor.
=head1 SYNOPSIS
use Transmission::Client;
my $client = Transmission::Client->new;
my $torrent_id = 2;
my $data = base64_encoded_data();
$client->add(metainfo => $data) or confess $client->error;
$client->remove($torrent_id) or confess $client->error;
for my $torrent (@{ $client->torrents }) {
print $torrent->name, "\n";
for my $file (@{ $torrent->files }) {
print "> ", $file->name, "\n";
}
}
print $client->session->download_dir, "\n";
=head1 FAULT HANDLING
In C<0.06> L<Transmission::Client> can be constructed with "autodie" set
to true, to make this object confess instead of just setting L</error>.
Example:
my $client = Transmission::Client->new(autodie => 1);
eval {
$self->add(filename => 'foo.torrent');
} or do {
# add() failed...
};
=head1 SEE ALSO
L<Transmission::AttributeRole>
L<Transmission::Session>
L<Transmission::Torrent>
L<Transmission::Utils>
=cut
use
Moose;
use
DateTime;
use
DateTime::Duration;
use
JSON::Any;
use
LWP::UserAgent;
use
MIME::Base64;
our
$VERSION
=
'0.0802'
;
our
$SESSION_ID_HEADER_NAME
=
'X-Transmission-Session-Id'
;
my
$JSON
= JSON::Any->new;
=head1 ATTRIBUTES
=head2 url
$str = $self->url;
Returns an URL to where the Transmission rpc api is.
Default value is "http://localhost:9091/transmission/rpc";
=cut
has
url
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
);
# this is subject for change!
has
_url
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
lazy_build
=> 1,
);
sub
_build__url {
my
$self
=
shift
;
my
$url
=
$self
->url;
if
(
$self
->username or
$self
->password) {
my
$auth
=
join
':'
,
$self
->username,
$self
->password;
$url
=~ s,://,://
$auth
@,;
}
return
$url
;
}
=head2 error
$str = $self->error;
Returns the last error known to the object. All methods can return
empty list in addition to what specified. Check this attribute if so happens.
Like L</autodie>? Create your object with C<autodie> set to true and this
module will throw exceptions in addition to setting this variable.
=cut
has
error
=> (
is
=>
'rw'
,
isa
=>
'Str'
,
default
=>
''
,
clearer
=>
'_clear_error'
,
trigger
=>
sub
{
$_
[0]->_autodie and confess
$_
[1] },
);
has
_autodie
=> (
is
=>
'ro'
,
init_arg
=>
'autodie'
,
isa
=>
'Bool'
,
default
=> 0,
);
=head2 username
$str = $self->username;
Used to authenticate against Transmission.
=cut
has
username
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
default
=>
''
,
);
=head2 password
$str = $self->password;
Used to authenticate against Transmission.
=cut
has
password
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
default
=>
''
,
);
=head2 timeout
$int = $self->timeout;
Number of seconds to wait for RPC response.
=cut
has
_ua
=> (
is
=>
'rw'
,
isa
=>
'LWP::UserAgent'
,
lazy
=> 1,
handles
=> [
qw/timeout/
],
default
=>
sub
{
LWP::UserAgent->new(
agent
=>
'Transmission-Client'
);
},
);
=head2 session
$session_obj = $self->session;
$stats_obj = $self->stats;
Returns an instance of L<Transmission::Session>.
C<stats()> is a proxy method on L</session>.
=cut
has
session
=> (
is
=>
'ro'
,
lazy
=> 1,
predicate
=>
'has_session'
,
handles
=> [
qw/stats/
],
default
=>
sub
{
Transmission::Session->new(
client
=>
$_
[0] );
},
);
=head2 torrents
$array_ref = $self->torrents;
$self->clear_torrents;
Returns an array-ref of L<Transmission::Torrent> objects. Default value
is a full list of all known torrents, with as little data as possible read
from Transmission. This means that each request on a attribute on an object
will require a new request to Transmission. See L</read_torrents> for more
information.
=cut
has
torrents
=> (
is
=>
'rw'
,
traits
=> [
'Array'
],
lazy
=> 1,
clearer
=>
"clear_torrents"
,
builder
=>
"read_torrents"
,
predicate
=>
'has_torrents'
,
handles
=> {
torrent_list
=>
'elements'
,
},
);
=head2 version
$str = $self->version;
Get Transmission version.
=cut
has
version
=> (
is
=>
'ro'
,
isa
=>
'Str'
,
lazy_build
=> 1,
);
sub
_build_version {
my
$self
=
shift
;
if
(
my
$data
=
$self
->rpc(
'session-get'
)) {
return
$data
->{
'version'
} ||
q()
;
}
return
q()
;
}
=head2 session_id
$self->session_id($str);
$str = $self->session_id;
The session ID used to communicate with Transmission.
=cut
has
session_id
=> (
is
=>
'rw'
,
isa
=>
'Str'
,
default
=>
''
,
trigger
=>
sub
{
$_
[0]->_ua->default_header(
$SESSION_ID_HEADER_NAME
=>
$_
[1]);
},
);
=head1 METHODS
=head2 add
$bool = $self->add(%args);
key | value type & description
-----------------+-------------------------------------------------
download_dir | string path to download the torrent to
filename | string filename or URL of the .torrent file
metainfo | string torrent content
paused | boolean if true, don't start the torrent
peer_limit | number maximum number of peers
Either "filename" or "metainfo" MUST be included. All other arguments are
optional.
See "3.4 Adding a torrent" from
=cut
sub
add {
my
$self
=
shift
;
my
%args
=
@_
;
if
(
$args
{
'filename'
} and
$args
{
'metainfo'
}) {
$self
->error(
"Filename and metainfo argument crash"
);
return
;
}
elsif
(
$args
{
'filename'
}) {
return
$self
->rpc(
'torrent-add'
,
%args
);
}
elsif
(
$args
{
'metainfo'
}) {
$args
{
'metainfo'
} = encode_base64(
$args
{
'metainfo'
});
return
$self
->rpc(
'torrent-add'
,
%args
);
}
else
{
$self
->error(
"Need either filename or metainfo argument"
);
return
;
}
}
=head2 remove
$bool = $self->remove(%args);
key | value type & description
-------------------+-------------------------------------------------
ids | array torrent list, as described in 3.1
delete_local_data | boolean delete local data. (default: false)
C<ids> can also be the string "all". C<ids> is required.
See "3.4 Removing a torrent" from
=cut
sub
remove {
my
$self
=
shift
;
if
(
$self
->_do_ids_action(
'torrent-remove'
=>
@_
)) {
$self
->clear_torrents;
# torrent list might be out of sync
return
1;
}
else
{
return
0;
}
}
=head2 move
$bool = $self->move(%args);
string | value type & description
------------+-------------------------------------------------
ids | array torrent list, as described in 3.1
location | string the new torrent location
move | boolean if true, move from previous location.
| otherwise, search "location" for files
C<ids> can also be the string "all". C<ids> and C<location> is required.
See "3.5 moving a torrent" from
=cut
sub
move {
my
$self
=
shift
;
my
%args
=
@_
;
if
(!
defined
$args
{
'location'
}) {
$self
->error(
"location argument is required"
);
return
;
}
return
$self
->_do_ids_action(
'torrent-set-location'
=>
%args
);
}
=head2 start
$bool = $self->start($ids);
Will start one or more torrents.
C<$ids> can be a single int, an array of ints or the string "all".
=head2 stop
$bool = $self->stop($ids);
Will stop one or more torrents.
C<$ids> can be a single int, an array of ints or the string "all".
=head2 verify
$bool = $self->stop($ids);
Will verify one or more torrents.
C<$ids> can be a single int, an array of ints or the string "all".
=cut
sub
start {
return
shift
->_do_ids_action(
'torrent-start'
=>
@_
);
}
sub
stop {
return
shift
->_do_ids_action(
'torrent-stop'
=>
@_
);
}
sub
verify {
return
shift
->_do_ids_action(
'torrent-verify'
=>
@_
);
}
sub
_do_ids_action {
my
$self
=
shift
;
my
$method
=
shift
;
my
%args
=
@_
== 1 ? (
ids
=>
$_
[0]) :
@_
;
my
$ids
;
unless
(
defined
$args
{
'ids'
}) {
$self
->error(
'ids is required as argument'
);
return
;
}
unless
(
ref
$args
{
'ids'
} eq
'ARRAY'
) {
if
(
$args
{
'ids'
} eq
'all'
) {
delete
$args
{
'ids'
};
}
else
{
$args
{
'ids'
} = [
$args
{
'ids'
}];
}
}
return
$self
->rpc(
$method
,
%args
) ? 1 : 0;
}
=head2 read_torrents
@list = $self->read_torrents(%args);
$array_ref = $self->read_torrents(%args);
key | value type & description
------------+-------------------------------------------------
ids | array torrent list, as described in 3.1
| this is optional
lazy_read | will create objects with as little data as possible.
=over 4
=item List context
Returns a list of L<Transmission::Torrent> objects and sets the L</torrents>
attribute.
=item Scalar context
Returns an array-ref of L<Transmission::Torrent>.
=back
=cut
sub
read_torrents {
my
$self
=
shift
;
my
%args
=
@_
== 1 ? (
ids
=>
$_
[0]) :
@_
;
my
$list
;
# set fields...
if
(
exists
$args
{
'fields'
}) {
# ... based on user input
# We should always request id
push
@{
$args
{
'fields'
}},
'id'
unless
grep
{
'id'
eq
$_
} @{
$args
{
'fields'
}};
}
elsif
(
$args
{
'lazy_read'
}) {
# ... as few fields as possible
$args
{
'fields'
} = [
'id'
];
}
else
{
# ... all fields
$args
{
'fields'
} = [
keys
%Transmission::Torrent::READ
,
keys
%Transmission::Torrent::BOTH
,
];
}
# set ids
if
(
$args
{
'ids'
}) {
if
(
$args
{
'ids'
} eq
'all'
) {
delete
$args
{
'ids'
};
}
elsif
(
ref
$args
{
'ids'
} eq
""
) {
$args
{
'ids'
} = [
$args
{
'ids'
} ];
}
}
if
(
my
$data
=
$self
->rpc(
'torrent-get'
=>
%args
)) {
$list
=
$data
->{
'torrents'
};
}
else
{
$list
= [];
}
for
my
$torrent
(
@$list
) {
$torrent
= Transmission::Torrent->new(
client
=>
$self
,
id
=>
$torrent
->{
'id'
},
%$torrent
,
);
}
if
(
wantarray
) {
$self
->torrents(
$list
);
return
@$list
;
}
else
{
return
$list
;
}
}
=head2 rpc
$any = $self->rpc($method, %args);
Communicate with backend. This methods is meant for internal use.
=cut
sub
rpc {
my
$self
=
shift
;
my
$method
=
shift
or
return
;
my
%args
=
@_
;
my
$nested
=
delete
$args
{
'_nested'
};
# internal flag
my
(
$tag
,
$res
,
$post
);
$method
=
$self
->_normal2Camel(
$method
);
# The keys need to be dashes as well
# _normal2Camel modifies a hashref in places
$self
->_normal2Camel( \
%args
);
# make sure ids are numeric
if
(
ref
$args
{
'ids'
} eq
'ARRAY'
) {
for
my
$id
(@{
$args
{
'ids'
} }) {
# Need to convert string integer to "real" integer
# FLAGS = (IOK,POK,pIOK,pPOK)
# IV = 42
# ...to...
# FLAGS = (PADTMP,IOK,pIOK)
# IV = 42
$id
+= 0
if
(
$id
=~ /^\d+$/);
}
}
$tag
=
int
rand
2*16 - 1;
$post
=
$JSON
->encode({
method
=>
$method
,
tag
=>
$tag
,
arguments
=> \
%args
,
});
$res
=
$self
->_ua->post(
$self
->_url,
Content
=>
$post
);
if
(RPC_DEBUG) {
"post: $post\n"
;
"status_line: "
,
$res
->status_line,
"\n"
;
}
unless
(
$res
->is_success) {
if
(
$res
->code == 409 and !
$nested
) {
$self
->session_id(
$res
->header(
$SESSION_ID_HEADER_NAME
));
return
$self
->rpc(
$method
=>
%args
,
_nested
=> 1);
}
else
{
$self
->error(
$res
->status_line);
return
;
}
}
$res
=
$JSON
->decode(
$res
->content);
unless
(
$res
->{
'tag'
} ==
$tag
) {
$self
->error(
"Tag mismatch"
);
return
;
}
unless
(
$res
->{
'result'
} eq
'success'
) {
$self
->error(
$res
->{
'result'
});
return
;
}
$self
->_clear_error;
return
$res
->{
'arguments'
};
}
=head2 read_all
1 == $self->read_all;
This method will try to populate ALL torrent, session and stats information,
using three requests.
=cut
sub
read_all {
my
$self
=
shift
;
$self
->session->read_all;
$self
->stats->read_all;
() =
$self
->read_torrents;
return
1;
}
=head1 LICENSE
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 AUTHOR
Jan Henning Thorsen - C<jhthorsen@cpan.org>
Current maintainer: Olof Johansson - C<olof@cpan.org>
=cut
no
MIME::Base64;
no
Moose;
1;