added auth using TR_AUTH env variable
[cloudstore.git] / 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 ( $username, $password ) = split(/:/, $ENV{TR_AUTH} );
28
29 my $tc = Transmission::Client->new(
30         autodie => 1,
31         username => $username,
32         password => $password,
33 );
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 else {
70     _help();
71 }
72
73 print "\n";
74
75 #==============================================================================
76 sub _peers {
77     my $n = shift;
78
79     if($n < 0) {
80         return 'na';
81     }
82     elsif($n < 9999) {
83         return $n;
84     }
85     else {
86         return '++';
87     }
88 }
89 sub _rate {
90     my $kbps = shift;
91
92     if($kbps < 0) {
93         return '0';
94     }
95     elsif($kbps < 1000) {
96         return $kbps;
97     }
98     elsif($kbps < 1e6) {
99         return int($kbps / 1e3) . 'k';
100     }
101     elsif($kbps < 1e6) {
102         return int($kbps / 1e6) . 'M';
103     }
104     else {
105         return '++';
106     }
107 }
108
109 sub _eta {
110     my $sec = shift;
111
112     if($sec < 0) {
113         return 'inf';
114     }
115     elsif($sec < 60) {
116         return $sec . "s";
117     }
118     elsif($sec < 3600) {
119         return int($sec / 6) / 10 . "m";
120     }
121     elsif($sec < 86400) {
122         return int($sec / 360) / 10 . "h";
123     }
124     else {
125         return '>1d';
126     }
127 }
128
129 sub _help {
130     exec perldoc => -tT => $0;
131 }
132
133 =head1 LICENSE
134
135 This library is free software; you can redistribute it and/or modify it under
136 the same terms as Perl itself.
137
138 =head1 AUTHOR
139
140 Jan Henning Thorsen
141
142 =cut
143
144 exit;