File Coverage

blib/lib/Net/RTorrent.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#$Id: RTorrent.pm 938 2011-04-05 07:12:53Z zag $

package Net::RTorrent;

use strict;
use warnings;
use RPC::XML;
use RPC::XML::Client;
use Net::RTorrent::Downloads;
use Net::RTorrent::Socket;
use Collection;
our @ISA     = ();
use Carp;
use 5.005;

=head1 NAME

Net::RTorrent - Perl interface to rtorrent via XML-RPC.

=head1 SYNOPSIS

  #from http scgi gate
  my $obj =  new Net::RTorrent:: 'http://10.100.0.1:8080/scgitest';
  #from network address
  my $obj =  new Net::RTorrent:: '10.100.0.1:5000';
  #from UNIX socket
  my $obj =  new Net::RTorrent:: '/tmp/rtorrent.sock';

  #get completed torrents list
  my $dloads = $obj->get_downloads('complete');
  #get all torrents list
  my $dloads = $obj->get_downloads();
  #get stopped torrents list
  my $dloads = $obj->get_downloads('stopped');

  #fetch all items
  $dloads->fetch()
  #or by hash_info
  $dloads->fetch_one('02DE69B09364A355F71279FC8825ADB0AC8C3A29')
  #list oll hash_info
  my $keys = $dloads->list_ids;
  #upload remotely
  $obj->create( $torrent_raw );
  $obj->create( $data, 0 );

=head1 ABSTRACT

Perl interface to rtorrent via XML-RPC

=head1 DESCRIPTION

Net::RTorrent - short way to create tools for rtorrent.

=cut

use constant {
    #info atributes for system info
    S_ATTRIBUTES => [
        'get_download_rate'    => 'download_rate',    #in my version dosn't work
        'get_memory_usage'     => 'memory_usage',
        'get_max_memory_usage' => 'max_memory_usage',
        'get_name'             => 'name',
        'get_safe_free_diskspace' => 'safe_free_diskspace',
        'get_upload_rate'         => 'upload_rate',
        'system.client_version'   => 'client_version',
        'system.hostname'         => 'hostname',
        'system.library_version'  => 'library_version',
        'system.pid'              => 'pid',
    ],
};

our $VERSION = '0.11';
my $attrs = {
    _cli       => undef,
};
### install get/set accessors for this object.
for my $key ( keys %$attrs ) {
    no strict 'refs';
    *{ __PACKAGE__ . "::$key" } = sub {
        my $self = shift;
        $self->{$key} = $_[0] if @_;
        return $self->{$key};
      }
}

=head1 METHODS

=cut

=head2 new URL

Creates a new client object that will route its requests to the URL provided.

=cut

sub new {
    my $class = shift;
    $class = ref $class if ref $class;
    my $self = bless( {}, $class );
    if (@_) {
        my $rpc_url = shift;
        my $cli_class  = $rpc_url =~m%\w+://% ? 'RPC::XML::Client': 'Net::RTorrent::Socket';
        $self->_cli( $cli_class->new($rpc_url) );

    }
    else {
        carp "need xmlrpc server URL";
        return;
    }
    return $self;
}

=head2 create \$raw_data || new IO::File , [ start_now=>1||0 ],[ tag=>]

Load torrent from file descriptor or scalar ref.

Params:

=over 2

=item start_now  - start torent now

1 - start download now (default)

0 - not start download

=item tag - save  to rtorrent

For read tag value use:

    $ditem->tag

=back

=cut

sub create {
    my $self = shift;
    my $res = $self->load_raw(@_);
    return $res
}


sub load_raw {
    my $self = shift;
    my ( $raw, %flg ) = @_;
    $flg{start_now} = 1 unless defined $flg{start_now};
    my $command = $flg{start_now} ? 'load_raw_start' : 'load_raw';
    my @add =();
    push @add, "d.set_custom2=$flg{tag}" if exists $flg{tag};
    return $self->_cli->send_request( $command, RPC::XML::base64->new($raw), @add );
}


=head2 delete ([,  ... ])

Call d.erase on I.

return {  =>  }

=cut

sub _delete {
    my $self = shift;
    my (@ids) = map { ref($_) ? $_->{id} : $_ } @_;
    my %res = ();
    for (@ids) {
        my $resp = $self->_cli->send_request( 'd.erase', $_ );
        if ( ref $resp ) {
            $res{$_} = $resp->value;
        }
    }
    return \%res;
}



=head2 list_ids ( [  ])

Return list of rtorrent I for I.
An empty string for I equals "default".

To get list of views names :

    xmlrpc http://10.100.0.1:8080/scgitest view_list

  'main'
  'default'
  'name'
  'started'
  'stopped'
  'complete'
  'incomplete'
  'hashing'
  'seeding'
  'scheduler'

=cut

sub list_ids {
    my $self = shift;
    my $cli  = $self->_cli;
    my $resp = $cli->send_request('download_list',shift ||"default");
    return ref($resp) ? $resp->value : [];
}


=head2 get_downloads [  || 'default']

Return collection of downloads (L< Net::RTorrent::Downloads>).

To get list of view:

    xmlrpc http://10.100.0.1:8080/scgitest view_list

  'main'
  'default'
  'name'
  'started'
  'stopped'
  'complete'
  'incomplete'
  'hashing'
  'seeding'
  'scheduler'

=cut

sub get_downloads {
    my $self = shift;
    my $view = shift;
    return new Net::RTorrent::Downloads:: $self->_cli, $view;
}

=head2 system_stat

Return system stat.

For example:

    print Dumper $obj->system_stat;

Return:

        {
           'library_version' => '0.11.9',
           'max_memory_usage' => '-858993460', #  at my amd64
           'upload_rate' => '0',
           'name' => 'gate.home.zg:1378',
           'memory_usage' => '115867648',
           'download_rate' => '0',
           'hostname' => 'gate.home.zg',
           'pid' => '1378',
           'client_version' => '0.7.9',
           'safe_free_diskspace' => '652738560'
         };

=cut

sub system_stat {
    my $self  = shift;
    my $comms = S_ATTRIBUTES;
    my @list  = @{$comms};
    my ( @res_pull, @cmd_pull ) = ();
    while ( my ( $mname, $aname ) = splice( @list, 0, 2 ) ) {
        push @res_pull, $aname;
        push @cmd_pull, $mname => [];
    }
    my $call_res = $self->do_sys_mutlicall(@cmd_pull);
    my %res      = ();
    while ( my $tmp_res = shift @$call_res ) {
        my $attr_name = shift @res_pull;
        $res{$attr_name} = defined $tmp_res->[1] ? $tmp_res : $tmp_res->[0];
    }
    return \%res

}

=head2 do_sys_mutlicall 'method1' =>[ , .. ], ...

Do XML::RPC I. Return ref to ARRAY of results

For sample.

 print Dumper $obj->do_sys_mutlicall('system.pid'=>[], 'system.hostname'=>[]);

Will return:

    [
           [
             '1378'
           ],
           [
             'gate.home.zg'
          ]
    ];

=cut

sub do_sys_mutlicall {
    my $self    = shift;
    my $res     = [];
    my @methods = ();
    while ( my ( $method, $param ) = splice( @_, 0, 2 ) ) {
        push @methods, { methodName => $method, params => $param },;
    }
    if (@methods) {
        my $resp =
          $self->_cli->send_request(
            new RPC::XML::request::( 'system.multicall', \@methods ) );
        $res = $resp->value;
    }
    return $res;
}

1;
__END__