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