torrent/transmission-client.pl

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 transmission-client.pl - Alternative to transmission-remote
   6
   7 =head1 SYNOPSIS
   8
   9  transmission-client.pl list;
  10  transmission-client.pl session;
  11  transmission-client.pl session $key $value;
  12  transmission-client.pl stats;
  13
  14 =head1 DESCRIPTION
  15
  16 This is an example application for L<Transmission::Client>
  17
  18 =cut
  19
  20 use strict;
  21 use warnings;
  22 use lib qw(lib);
  23 use Transmission::Client;
  24
  25 my $action = shift @ARGV or _help();
  26
  27 my %a = ( autodie => 1 );
  28 @a{ qw(username password) } = split(/:/, $ENV{TR_AUTH}) if $ENV{TR_AUTH};
  29 print %a;
  30
  31 my $tc = Transmission::Client->new( %a );
  32
  33 if($action eq 'list') {
  34     printf "%3s %-34s %4s %4s %5s %5s\n", 'id', 'name', 'lcrs', 'sdrs', 'rate', 'eta';
  35     print "-" x 79, "\n";
  36     for my $torrent ($tc->read_torrents) {
  37         printf "%3i %-34s %4s %4s %5s %5s\n",
  38             $torrent->id,
  39             substr($torrent->name, 0, 34),
  40             _peers($torrent->leechers),
  41             _peers($torrent->seeders),
  42             _rate($torrent->rate_download),
  43             _eta($torrent->eta),
  44             ;
  45     }
  46 }
  47 elsif($action eq 'session') {
  48     if(my $set = shift @ARGV) {
  49         $tc->session->$set(shift @ARGV);
  50         $tc->session->${ \"clear_$set" };
  51         printf "%s: %s\n", $set, $tc->session->$set;
  52         print $tc->error;
  53     }
  54     else {
  55         my $res = $tc->session->read_all;
  56         for my $key (sort keys %$res) {
  57             printf "%-30s %s\n", $key, $res->{$key};
  58         }
  59     }
  60 }
  61 elsif($action eq 'stats') {
  62     my $res = $tc->session->stats->read_all;
  63     for my $key (sort keys %$res) {
  64         printf "%-30s %s\n", $key, $res->{$key};
  65     }
  66 }
  67
  68 elsif($action eq 'add') {
  69         $tc->add(
  70                 filename => $ARGV[0],
  71                 download_dir => '/rsync1/s1/torrent/download',
  72         );
  73 }
  74
  75 elsif($action eq 'remove') {
  76         $tc->remove(
  77                 ids => @ARGV
  78         );
  79 }
  80
  81 else {
  82     _help();
  83 }
  84
  85 print "\n";
  86
  87 #==============================================================================
  88 sub _peers {
  89     my $n = shift;
  90
  91     if($n < 0) {
  92         return 'na';
  93     }
  94     elsif($n < 9999) {
  95         return $n;
  96     }
  97     else {
  98         return '++';
  99     }
 100 }
 101 sub _rate {
 102     my $kbps = shift;
 103
 104     if($kbps < 0) {
 105         return '0';
 106     }
 107     elsif($kbps < 1000) {
 108         return $kbps;
 109     }
 110     elsif($kbps < 1e6) {
 111         return int($kbps / 1e3) . 'k';
 112     }
 113     elsif($kbps < 1e6) {
 114         return int($kbps / 1e6) . 'M';
 115     }
 116     else {
 117         return '++';
 118     }
 119 }
 120
 121 sub _eta {
 122     my $sec = shift;
 123
 124     if($sec < 0) {
 125         return 'inf';
 126     }
 127     elsif($sec < 60) {
 128         return $sec . "s";
 129     }
 130     elsif($sec < 3600) {
 131         return int($sec / 6) / 10 . "m";
 132     }
 133     elsif($sec < 86400) {
 134         return int($sec / 360) / 10 . "h";
 135     }
 136     else {
 137         return '>1d';
 138     }
 139 }
 140
 141 sub _help {
 142     exec perldoc => -tT => $0;
 143 }
 144
 145 =head1 LICENSE
 146
 147 This library is free software; you can redistribute it and/or modify it under
 148 the same terms as Perl itself.
 149
 150 =head1 AUTHOR
 151
 152 Jan Henning Thorsen
 153
 154 =cut
 155
 156 exit;