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