#!/usr/bin/perl

use warnings;
use strict;

use utf8;
use open qw(:std :utf8);

package RTPG;
use base qw(RPC::XML::Client);

use Carp;
use RPC::XML;
use RPC::XML::Client;
my $SIZE_BY_CHUNKS_LIMIT=1024**3;

our $ERROR;
=head1 SYNOPSIS

 use RTPG;
 my $h = new RTPG(url=>'http://localhost/RPC2');

 die $RTPG::ERROR unless defined $h;

 my $tlist=$h->torrents_list; # arrayref (died version)
 my ($tlist, $error)=$h->torrents_list; # arrayref

 my $list_methods=$h->rpc_command('system.listMethods');
 my ($list_methods, $error)=$h->rpc_command('system.listMethods');

 for (@$tlist)
 {
 	 my $file_list=$h->file_list($_->{hash});
 	 ..
 }

 my $hashref=$h->system_information;
 my ($hashref, $error)=$h->system_information;

=head1 METHODS

=cut

sub new
{
    my ($class, %opts)=@_;
    croak 'XMLRPC url must be defined' unless exists $opts{url};
    my $self=$class->SUPER::new($opts{url});
    if (ref $self)
    {
        $self->{rtorrent_ctl_url}=$opts{url};
        return $self;
    }

    $ERROR="Error connect to XMLRPC-server: $self\n";
    return undef;
}

=head2 rpc_command(CMD[,ARGS])

If method failed and wantarray==true then method returns the list:
(undef, error_code)

If wantarray!=true, then method will throw die

 my ($list_methods, $error_code)=$h->rpc_command('system.listMethods');
 if (defined $listMethods)
 {
 	 doing...
 }
 else
 {
 	 processing error (with $error_code)
 }

 my $listMethods=eval { $h->rpc_command('system.listMethods') };

 if ($@)
 {
 	 processing error (with $@)
 }
 else
 {
 	 doing...
 }
=cut
sub rpc_command
{
	my $self=shift;
	my ($cmd, @args)=@_;

    my $resp=$self->send_request($cmd, @args);
    if (ref $resp)
    {
    	if ('RPC::XML::fault' eq ref $resp)
    	{
    	    my $err_str=sprintf 
    	        "Fault when execute command: %s\n" .
    	        "Fault code: %s\n" .
    	        "Fault text: %s\n",
    	        join(' ', $cmd, @args),
    	        $resp->value->{faultString},
    	        $resp->value->{faultCode};
    	    die $err_str unless wantarray;
    	    return (undef, $err_str);
    	}
    	return $resp->value unless wantarray;
    	return $resp->value, '';
    }
    my $err_str=sprintf 
    	"Fault when execute command: %s\n" .
    	"Fault text: %s\n",
    	join(' ', $cmd, @args),
    	$resp||'';
    die $err_str unless wantarray;
    return undef, $err_str;
}

=head2 torrents_list([VIEW])

returned torrent list and error text (if wantarray)

returned torrent list or die error (unless wantarray)

 my ($tlist, $err)=$h->torrents_list;
 my ($tlist, $err)=$h->torrents_list('started');

=head3 views variants

=over

=item default

=item name

=item stopped

=item started

=item complete

=item incomplete

=back
=cut
sub torrents_list
{
	my ($self, $view)=@_;
	$view||='default';

	my @iary=eval {
        grep { $_ ne 'd.get_mode' }
        grep /^d\.(get_|is_)/, $self->_get_list_methods;
    };

    if ($@)
    {
    	return undef, "$@" if wantarray;
    	die $@;
    }
    my ($list, $error) =
        $self->rpc_command('d.multicall', $view, map { "$_=" } @iary);

    unless (defined $list)
    {
        die $error unless wantarray;
        return undef, $error;
    }

    for (@$list)
    {
    	my %info;
        for my $i (0 .. $#iary)
        {
        	my $name=$iary[$i];
        	$name =~ s/^..(?:get_)?//;
        	$info{$name}=$_->[$i];
        }
        $_ = _normalize_one_torrent_info(\%info);
    }
    return $list unless wantarray;
    return $list, '';
}

=head2 torrent_info(TorrentId)

get hash-info about one torrent

=cut
sub torrent_info
{
	my ($self, $id)=@_;
	my @iary=eval {
        grep { $_ ne 'd.get_mode' }
        grep /^d\.(get_|is_)/, $self->_get_list_methods;
    };
    if ($@)
    {
    	return undef, "$@" if wantarray;
    	die $@;
    }

    my $info={};

    eval
    {
        for my $cmd (@iary)
        {
    	    my $name=$cmd;
    	    $name=~s/^..(?:get_)?//;
    	    $info->{$name}=$self->rpc_command($cmd, $id);
        }
    };
    if ($@)
    {
    	return undef, "$@" if wantarray;
    	die $@;
    }
    return _normalize_one_torrent_info($info), '' if wantarray;
    return _normalize_one_torrent_info($info);
}

=head2 file_list(ID)

return file list of torrent (by ID)

 my $tlist = $h->torrents_list;
 for (@$tlist)
 {
 	 my $file_list=$h->file_list($_->{hash});
 	 ..
 }

=cut

sub file_list
{
	my ($self, $id)=@_;
	croak "TorrentID must be defined!\n" unless $id;
	my @iary=eval {
        grep /^f\.(get|is)/, $self->_get_list_methods;
    };

    if ($@)
    {
    	return undef, "$@" if wantarray;
    	die $@;
    }
    
    my ($chunk_size, $error)=$self->rpc_command('d.get_chunk_size', $id);
    unless (defined $chunk_size)
    {
    	die $error unless wantarray;
    	return undef, $error;
    }

    my $list;

    ($list, $error) =
        $self->rpc_command('f.multicall', $id, '', map { "$_=" } @iary);
    unless (defined $list)
    {
    	die $error unless wantarray;
    	return undef, $error;
    }

    for (@$list)
    {
    	my %info;
        for my $i (0 .. $#iary)
        {
        	my $name=$iary[$i];
        	$name =~ s/^..(?:get_)?//;
        	$info{$name}=$_->[$i];
        }
        $_ =  \%info;
        my $size_bytes=1.0*$chunk_size*$_->{size_chunks};
        $_->{size_bytes}=$size_bytes if $size_bytes > $SIZE_BY_CHUNKS_LIMIT;
        $_->{human_size}=_human_size($_->{size_bytes});
        $_->{percent}=_get_percent_string(
            $_->{completed_chunks},
            $_->{size_chunks}
        );
    }
    return $list, '' if wantarray;
    return $list;
}

=head2 system_information

returned hash with system information

=cut
sub system_information
{
	my $self=shift;

    my $lv;
	my ($rv, $err)=$self->rpc_command('system.client_version');
	($lv, $err)=$self->rpc_command('system.library_version') if defined $rv;

	unless (defined $lv)
	{
		return undef, $err if wantarray;
		die $err;
	}
	
	my $res=
	{
		client_version      => $rv,
		library_version     => $lv,
	};

	return $res, '' if wantarray;
	return $res;
}

=head1 PRIVATE METHODS

=head2 _get_list_methods

return list of rtorrent commands

=cut

sub _get_list_methods
{
	my $self=shift;
	return @{ $self->{listMethods} } if $self->{listMethods};
	my $list = $self->rpc_command('system.listMethods');
	return @$list;
}

=head2 _get_percent_string(PART_OF_VALUE,VALUE)

count percent by pair values
=cut
sub _get_percent_string($$)
{
	my ($part, $full)=@_;
	return undef unless $full;
	return undef unless defined $part;
	return undef if $part<0;
	return undef if $full<0;
	return undef if $part>$full;
	my $percent=$part*100/$full;
	if ($percent<10)
	{
		$percent=sprintf '%1.2f', $percent;
	}
	else
	{
		$percent=sprintf '%1.1f', $percent;
	}
	s/(?<=\.\d)0$//, s/\.00?$// for $percent;
	return "$percent%";
}

=head2 _human_size(NUM)

convert big numbers to small 1024 = 1K, 1024**2 == 1M, etc
=cut
sub _human_size($)
{
	my ($size, $sign)=(shift, 1);
	if ($size<0) { return '>2G'; }
	return 0 unless $size;
	my @suffixes=('', 'K', 'M', 'G', 'T', 'P', 'E');
	my ($limit, $div)=(1024, 1);
    for (@suffixes)
    {
    	if ($size<$limit || $_ eq $suffixes[-1])
    	{
            $size = $sign*$size/$div;
            if ($size<10)
            {
            	$size=sprintf "%1.2f", $size;
            }
            elsif ($size<50)
            {
            	$size=sprintf "%1.1f", $size;
            }
            else
            {
            	$size=int($size);
            }
            s/(?<=\.\d)0$//, s/\.00?$// for $size;
            return "$size$_";
    	}
        $div = $limit;
        $limit *= 1024;
    }
}

=head2 _normalize_one_torrent_info(HASHREF)


=over

=item count:

percents, ratio, human_size, human_done,
human_up_total, human_up_rate, human_down_rate

=item fixed 32bit overflow in libxmlrpc-c3 version < 1.07

=back

=cut

sub _normalize_one_torrent_info($)
{
	my ($info)=@_;

	for ($info)
	{
        $_->{percent} = _get_percent_string(
            $_->{completed_chunks},
            $_->{size_chunks}
        );

        my ($bytes_done, $size_bytes)=
        (
            1.0*$_->{completed_chunks}*$_->{chunk_size},
            1.0*$_->{size_chunks}*$_->{chunk_size}
        );
        $_->{size_bytes}=$size_bytes if $size_bytes>$SIZE_BY_CHUNKS_LIMIT;
        $_->{bytes_done}=$bytes_done if $bytes_done>$SIZE_BY_CHUNKS_LIMIT;
        $_->{up_total}=1.0*$_->{bytes_done}*($_->{ratio}/1000);


        $_->{ratio}=sprintf '%1.2f', $_->{ratio}/1000;
        $_->{ratio}=~s/((\.00)|0)$//;

        $_->{human_size} = _human_size($_->{size_bytes});
        $_->{human_done} = _human_size($_->{bytes_done});
        $_->{human_up_total} = _human_size($_->{up_total});
        $_->{human_up_rate} = _human_size($_->{up_rate});
        $_->{human_down_rate} = _human_size($_->{down_rate});

        for ($_->{human_up_rate}, $_->{human_down_rate})
        {
            next if $_ eq 0;
            $_ .= 'b/s';
        }
	}
	return $info;
}
1;