~/.local/bin/binge
#!/usr/bin/perl
##
## binge - curses torrent client with 'top' mode.
##
## keys - Press 'h' to show key bindings, then ESC.
##
## urxvt -name binge -n binge -T binge -e sh -c "exec binge 2>>/tmp/binge_$(date +%s).log"
##
## apt-install libcurses-perl libwww-perl libjson-maybexs-perl libjson-xs-perl libdata-dump-perl
## libmath-round-perl libtext-unidecode-perl transmission-daemon
##
## colors : ~/.fvwm-custom/themes/blue/Xresources.d/binge.xres
##
## https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt
## https://trac.transmissionbt.com/browser/trunk/libtransmission/transmission.h
## https://pythonhosted.org/transmissionrpc/reference/transmissionrpc.html
use v5.28 ;
use strictures ;
use warnings ;
use feature qw(signatures) ;
no warnings qw(experimental::signatures) ;
use Curses ;
use LWP::UserAgent ;
use JSON::MaybeXS ;
use List::Util qw( none any first ) ;
use Math::Round qw( round nearest_floor nearest ) ;
use Text::Unidecode qw( unidecode ) ;
use Data::Dump qw( dump ) ;
## Access tr-daemon via rpc
my $ua = LWP::UserAgent->new( agent => 'Transmission-Client' ) ;
my $url = 'http://madonna@localhost:9091/transmission/rpc' ;
my $trd_timeout = 10 ;
## Torrent data is obtained via the rpc interface.
my $si = get_session() ; ## session info
my $th = {} ; ## torrents info hash (KEEP)
my $ti = {} ; ## tracker info
my @tq ; ## torrents queue - array of hashrefs
my $tqf ; ## hashref for focused torrent
my $fid = -1 ; ## "id" for focused torrent
my $fpos = -1 ; ## queue position "pos" for focused torrent
my $update_cnt = 0 ; ## count of updates for the torrent data
my $stats_freq = 15 ; ## update trackerStats with this freq
my $tq_sort_freq = 10 ; ## sort torrent queue with this freq
my $alert = 0 ; ## highlight the current torrent in display
my $topmode = 1 ; ## sort active torrents to the top
my ($totalrx, $totaltx) = (0, 0) ; ## total rx/tx speed in bytes
initscr(); ## Initialize stdscr, and set $COLS + $LINES
noecho() ; ## Don't echo() while we do getchar
cbreak() ; ## line buffering disabled
keypad(1) ; ## we get f1, f2 etc...
curs_set(0) ; ## hide cursor
start_color() ;
## 0 black, 1 red, 2 green, 3 yellow, 4 blue, 5 magenta, 6 cyan, 7 white
init_pair 0, COLOR_BLACK, COLOR_BLACK ;
init_pair 1, COLOR_RED, COLOR_BLACK ;
init_pair 2, COLOR_GREEN, COLOR_BLACK ;
init_pair 3, COLOR_YELLOW, COLOR_BLACK ;
init_pair 4, COLOR_BLUE, COLOR_BLACK ;
init_pair 5, COLOR_MAGENTA, COLOR_BLACK ;
init_pair 6, COLOR_CYAN, COLOR_BLACK ;
init_pair 7, COLOR_BLACK, COLOR_WHITE ;
my ($BLACK, $RED, $GREEN, $YELLOW, $BLUE, $MAGENTA, $CYAN, $HILIGHT) = map { COLOR_PAIR($_) } 0..7 ;
update_torrents(1) ;
my $reload = 1 ; ## reload torrent data at next opportunity
#my $timeout = 2500 ;
while ( 1 ) {
## Update torrent/tracker data and sort.
if ($reload or not $alert) {
print STDERR $update_cnt % $stats_freq ? '.' : '_' ;
update_speeds() ;
topsort() if $topmode and not $update_cnt % $tq_sort_freq ;
update_torrents($update_cnt % $stats_freq ? 0 : 1) ;
$update_cnt++ ;
$reload = 0 ;
} ;
$tqf = $fpos != -1 ? $tq[$fpos] : undef ; ## hashref for the focused torrent
## update display
erase() ;
print_torrents() ;
print_statusbar() ;
refresh() ;
## wait for next keypress and act accordingly...
timeout($alert ? 900 : 3000) ;
my $ch = getchar() ;
if (defined $ch) {
if ($ch eq KEY_UP) { focus_prev()
} elsif ($ch eq "k") { focus_prev()
} elsif ($ch eq KEY_DOWN) { focus_next()
} elsif ($ch eq "j") { focus_next()
} elsif ($ch eq KEY_PPAGE) { key_page_up()
} elsif ($ch eq KEY_NPAGE) { key_page_down()
} elsif ($ch eq KEY_HOME) { key_home()
} elsif ($ch eq KEY_END) { key_end()
} elsif ($ch =~ /s/i) { start_topmode()
} elsif ($ch =~ /t/i) { start_topmode()
} elsif ($ch =~ /p/i) { toggle_pause()
} elsif ($ch =~ /u/i) { ch_upload_speed()
} elsif ($ch =~ /d/i) { ch_download_speed()
} elsif ($ch =~ /l/i) { ch_seeding_ratio_limit()
} elsif ($ch =~ /h/i) { widget_help()
} elsif ($ch eq "r") { remove_torrent()
} elsif ($ch eq "R") { remove_and_delete_torrent()
} elsif ($ch eq "Q") { last if widget_confirm(' Quit binge? y/n') ;
} else { next
}
$alert++ ; ## the current torrent highlighted after a keypress
} else { $alert = 0 ;
} ;
}
refresh() ;
endwin() ;
exit ;
#### SUBROUTINES
sub start_topmode {
print STDERR 'T' ;
$alert++ ;
$topmode++ ;
$update_cnt = 0 ;
widget_message(1, 22, 6, 'Top Mode') ;
}
sub key_home {
$alert++ ;
$topmode = 0 ;
$fpos = 0 ;
$fid = $tq[0]->{id} ;
}
sub key_end {
$alert++ ;
$topmode = 0 ;
$fpos = $#tq ;
$fid = $tq[$#tq]->{id} ;
}
sub key_page_down {
$alert++ ;
$topmode = 0 ;
return if $fpos == $#tq ;
$fpos += $LINES - 2 ;
$fpos = $#tq if $fpos > $#tq ;
$fid = $tq[$fpos]->{id} ;
}
sub key_page_up {
$alert++ ;
$topmode = 0 ;
return if $fpos == 0 ;
$fpos -= $LINES - 2 ;
$fpos = 0 if $fpos < 0 ;
$fid = $tq[$fpos]->{id} ;
}
sub focus_next {
$fpos++ if $fpos < $#tq ;
$fid = $fpos >= 0 ? $tq[$fpos]->{id} : -1 ;
$alert++ ;
$topmode = 0 ;
}
sub focus_prev {
$fpos-- if $fpos >= 0 ;
$fid = $fpos >= 0 ? $tq[$fpos]->{id} : -1 ;
$alert++ ;
$topmode = 0 ;
}
sub remove_torrent() {
return 0 unless widget_confirm('Remove torrent? y/n') ;
my %args = (ids => [ $fid ], ) ;
my $ret = rpc('torrent-remove', %args ) ;
say STDERR "\nremove_torrent : " . unidecode($tq[$fpos]->{name}) ;
dump $ret ;
$reload++ ;
$topmode = 0 ;
return 1 ;
}
sub remove_and_delete_torrent() {
return 0 unless widget_confirm('Remove and delete torrent? y/n') ;
my %args = (ids => [ $fid ], 'delete-local-data' => 1) ;
my $ret = rpc('torrent-remove', %args ) ;
say STDERR "\nremove_and_delete : " . unidecode($tq[$fpos]->{name}) ;
dump $ret ;
$reload++ ;
$topmode = 0 ;
return 1 ;
}
sub toggle_pause() {
return unless defined $tqf ;
if (defined $tqf) {
my $ret ;
if ($tqf->{status} == 0) {
warn "toggle_pause : start" ;
$ret = rpc('torrent-start', ids => $fid) ;
widget_message(1, 26, 6, 'Start Torrent') ;
# $ret = rpc('torrent-start', ids => $id) unless $ret ;
# $ret = rpc('torrent-start', ids => $id) unless $ret ;
} else {
warn "toggle_pause : stop" ;
$ret = rpc('torrent-stop', ids => $fid) ;
widget_message(1, 26, 6, 'Pause Torrent') ;
# $ret = rpc('torrent-stop', ids => $id) unless $ret ;
# $ret = rpc('torrent-stop', ids => $id) unless $ret ;
} ;
$reload++ ;
$topmode = 0 ;
return 1 ;
} else { return 0 ;
}
}
sub ch_upload_speed() {
return unless defined $tqf ;
foreach (qw( uploadLimit uploadLimited )) { return unless defined $tqf->{$_} } ;
my ($uploadLimit, $uploadLimited) = map {$tqf->{$_}} qw(uploadLimit uploadLimited) ;
my $oldrate = nearest_floor 100, $uploadLimit ;
$oldrate = 50 if $uploadLimit == 50 ;
$oldrate = -1 unless $uploadLimited ;
warn "ch_upload_speed old : $oldrate" ;
my $limit = $si->{'speed-limit-up'} ;
my @rates = map { $_ * 100 } 1..int($limit/100) ;
my $rate = widget_get_value("Upload speed: ", $oldrate, -1, 50, @rates) ;
warn "ch_upload_speed new : $rate" if defined $rate ;
my %args ;
if (not defined $rate) { return
} elsif ($rate == -1) {
%args = ( ids => [ $fid ], "uploadLimit" => $rate, "uploadLimited" => 0 )
} else {
%args = ( ids => [ $fid ], "uploadLimit" => $rate, "uploadLimited" => 1 )
} ;
rpc('torrent-set', %args) ;
$reload++ ;
$topmode = 0 ;
return 1 ;
}
sub ch_download_speed() {
return unless defined $tqf ;
return unless $tqf->{status} =~ /3|4/ ;
return unless defined $tqf->{downloadLimit} ;
return unless defined $tqf->{downloadLimited} ;
my $downloadLimit = $tqf->{downloadLimit} ;
my $downloadLimited = $tqf->{downloadLimited} ;
my $oldrate = nearest_floor 100, $downloadLimit ;
$oldrate = 50 if $downloadLimit == 50 ;
$oldrate = -1 unless $downloadLimited ;
warn "ch_download_speed old : $oldrate" ;
my $limit = $si->{'speed-limit-down'} ;
my @rates = map { $_ * 100 } 1..int($limit/100) ;
my $rate = widget_get_value("Download speed: ", $oldrate, -1, 50, @rates) ;
warn "ch_download_speed new : $rate" if defined $rate ;
my %args ;
if (not defined $rate) { return
} elsif ($rate == -1) { %args = ( ids => [ $fid ], "downloadLimited" => 0 )
} else { %args = ( ids => [ $fid ], "downloadLimit" => $rate, "downloadLimited" => 1 )
} ;
rpc('torrent-set', %args) ;
$reload++ ;
$topmode = 0 ;
return 1 ;
}
## seedRatioMode
## 0) follow the global settings
## 1) override the global settings, seeding until a certain ratio
## 2) override the global settings, seeding regardless of ratio
sub ch_seeding_ratio_limit() {
return if $fpos == -1 ;
return unless defined $tq[$fpos]->{seedRatioLimit} ;
return unless defined $tq[$fpos]->{seedRatioMode} ;
my $oldratio = int($tq[$fpos]->{seedRatioLimit}) ;
my $ratio = widget_get_value("Seeding Ratio Limit: ", $oldratio, -1, 1..30 ) ;
my %args = (
ids => [ $fid ],
seedRatioLimit => $ratio,
seedRatioMode => 1,
) ;
rpc('torrent-set', %args) ;
$reload++ ;
$topmode = 0 ;
return 1 ;
}
sub widget_message($secs,$width,$xpos,$text) {
my $win = newwin(5, $width, ($LINES - 5) / 2 , ($COLS - $width) / 2 ) ;
erase($win) ;
box($win, 0, 0) ;
addstring($win,2,$xpos,$text) ;
refresh($win) ;
sleep $secs if $secs ;
delwin($win) ;
return 1 ;
}
## FAIL : Drawing box in bold so far
sub widget_help {
my $win = newwin(8, 45, ($LINES - 9) / 2 , ($COLS - 45) / 2 ) ;
erase($win) ;
attrset($win,A_BOLD | $BLUE) ;
box($win, 0, 0) ;
attrset($win,A_BOLD | $CYAN) ;
addstring($win,1,5,' KEY BINDINGS ') ;
attrset($win,A_BOLD | $BLUE) ;
addstring($win,2,5,'navigate') ;
addstring($win,3,5,'remove torrent') ;
addstring($win,4,5,'remove w/data') ;
addstring($win,5,5,'top mode') ;
addstring($win,6,5,'quit') ;
attrset($win,A_BOLD | $GREEN) ;
addstring($win,2,23,'up|dwn|pgup|pgdwn') ;
addstring($win,3,39,'r') ;
addstring($win,4,39,'R') ;
addstring($win,5,37,'s/t') ;
addstring($win,6,39,'Q') ;
refresh($win) ;
while (1) {
my $ch = getchar() ;
last if defined $ch ;
}
delwin($win) ;
return 1 ;
}
#border($win,'a','b','c','d','e','f','g','h') ;
#border($win,ACS_VLINE | A_BOLD,ACS_VLINE,ACS_HLINE,ACS_HLINE,ACS_ULCORNER,ACS_URCORNER,ACS_LLCORNER,ACS_LRCORNER) ;
#my @chs = map { $_ | A_BOLD } (
# ACS_VLINE,ACS_VLINE,ACS_HLINE,ACS_HLINE,ACS_ULCORNER,ACS_URCORNER,ACS_LLCORNER,ACS_LRCORNER
#) ;
#border($win,@chs) ;
sub widget_confirm($title) {
my $win = newwin(5, 40, ($LINES - 5) / 2 , ($COLS - 40) / 2 ) ;
my $ret = undef ;
while (1) {
erase($win) ;
box($win, 0, 0) ;
addstring($win,2,5,$title) ;
refresh($win) ;
my $ch = getchar() ;
if (not defined $ch) { next ;
} elsif ($ch eq "y" or $ch eq "Y") { $ret = 1 ; last ;
} elsif ($ch eq "n" or $ch eq "N") { $ret = 0 ; last ;
} elsif ( any { $_ eq $ch } ("\e", "q", "Q")) { last ;
}
} ;
delwin($win) ;
return $ret ;
}
sub widget_get_value($title,$old,@values) {
my $idx = first { $values[$_] == $old } 0..$#values // undef ;
return unless defined $idx ;
my $win = newwin(5, 40, ($LINES - 5) / 2 , ($COLS - 40) / 2 ) ;
while (1) {
erase($win) ;
box($win, 0, 0) ;
addstring($win,2,5,"$title $values[$idx]") ;
refresh($win) ;
my $ch = getchar() ;
if (not defined $ch) { next ;
} elsif ($ch eq KEY_UP) { $idx++ if $idx < $#values ;
} elsif ($ch eq KEY_DOWN) { $idx-- if $idx > 0 ;
} elsif ( any { $_ eq $ch } ("\e", "q", "Q")) { return ;
} elsif ($ch eq "\n") { last ;
}
}
delwin($win) ;
return $values[$idx] ;
}
#### DISPLAY
## Print the statusline along bottom of display. It is comprised of multiple
## separate formatted fields that contain text and attributes.
sub print_statusbar {
my @x = (0, 18, 28, 38, 45) ; ## xpos for first 4 elements, width adjusted.
if ($COLS > 75) {
for (my $idx = 1, my $dif = $COLS - 75 ; $idx <= $#x ; $idx++) {
my $step = int($dif/($#x - $idx + 1)) ;
@x[$idx..$#x] = map { $_ + $step } @x[$idx..$#x] ;
$dif -= $step ;
}
}
my @line = map { @$_ } (
status_field_peers($x[0]),
status_field_uploadLimit($x[1]),
status_field_downloadLimit($x[2]),
status_field_eta($x[3]),
status_field_uprate_total(-4),
status_field_downrate_total(-12),
status_field_sizeWhenDone(-19),
status_field_seedRatioLimit(-26),
) ;
foreach (@line) {
my $xpos = $_->{xpos} >= 0 ? $_->{xpos} : $COLS + $_->{xpos} - 1 ;
attrset($_->{attr}) ;
addstring($LINES - 1, $xpos, $_->{text}) ;
standend() ;
}
}
#$_->{attr} //= A_NORMAL ;
## Print the visible torrent lines...
sub print_torrents {
## draw the vertical/horizontal dividers
my @xpos = (-28, -21, -14, -6) ;
attrset(A_NORMAL | $MAGENTA) ;
hline($LINES - 2, 0, ACS_HLINE, $COLS) ;
vline(0, ($COLS - 1 + $_), ACS_VLINE, $LINES) foreach @xpos ;
addch($LINES - 2, ($COLS + $_ - 1), ACS_PLUS) foreach @xpos ;
standend() ;
## print the visible torrent lines
my ($start, $end) = @{ calc_range() } ;
my @fields = @{ set_lines($start,$end) } ;
foreach my $ypos (0..$#fields) {
foreach (@{ $fields[$ypos] }) {
my $xpos = $_->{xpos} >= 0 ? $_->{xpos} : $COLS + $_->{xpos} - 1 ;
attrset($_->{attr}) ;
if ($_->{text} eq 'vline') { addch($ypos, $xpos, ACS_VLINE)
} else { addstring($ypos, $xpos, $_->{text}) ;
}
standend() ;
}
}
}
## Generates an array of torrent lines to be displayed. Each line contains multiple fields
## with text and attributes.
sub set_lines($start,$end) {
my @fields = () ;
my @linepos = (0, -28, -26, -21, -19, -14, -12, -6, -4) ;
my $width = $COLS - 30 ;
foreach my $idx ($start..$end) {
my $status = $tq[$idx]->{status} ;
my @line = map { @$_ } (
line_field_spaces(),
line_field_name($idx,$linepos[0],$width), line_field_vline($linepos[1]),
line_field_ratio($idx,$linepos[2]), line_field_vline($linepos[3]),
line_field_percent($idx,$linepos[4]), line_field_vline($linepos[5]),
line_field_downrate($idx,$linepos[6]), line_field_vline($linepos[7]),
line_field_uprate($idx,$linepos[8]),
) ;
for (@line) {
$_->{attr} //= [ $GREEN, $CYAN, $CYAN, $CYAN, $CYAN, $BLUE, $BLUE ]->[$status] ;
if ($idx == $fpos and $alert) {
$_->{attr} = $HILIGHT ;
$_->{attr} |= A_BOLD unless $_->{text} eq 'vline' ;
} elsif ($idx == $fpos and not $alert) {
$_->{attr} |= A_BOLD ;
}
}
push @fields, \@line ;
}
return \@fields ;
}
## A_UNDERLINE
## Calculates the range of torrent lines to be displayed.
sub calc_range {
my ($start, $end) ;
my $w_ymax = $LINES - 3 ;
if ($#tq <= $w_ymax) { ## if vis.window has more rows than @tq
($start, $end) = (0, $#tq) ;
} else {
my ($tq_start, $tq_end) ;
if ($fpos <= int($w_ymax/2)) { ## if focused entry is in the 1st half page
($start, $end) = (0, $w_ymax) ;
} elsif ($#tq - $fpos <= int($w_ymax/2)) { ## or in the last half page
($start, $end) = ($#tq-$w_ymax, $#tq) ;
} elsif ($#tq - $fpos > int($w_ymax/2)) { ## or else somewhere in between.
$start = $fpos - int($w_ymax/2) ;
$end = $fpos + ($w_ymax - int($w_ymax/2)) ;
}
}
return [ $start, $end ] ;
}
#### DISPLAY TEXT FIELDS
sub status_field_uprate_total($xpos) {
my %field = ( text => undef, attr => $YELLOW, xpos => $xpos) ;
if ($totaltx < 0) { $field{text} = " ";
} else { $field{text} = sprintf "%4s%s", format_number(-$totaltx) ;
}
return [ \%field ] ;
}
sub status_field_downrate_total($xpos) {
my %field = ( text => undef, attr => $YELLOW, xpos => $xpos) ;
if ($totalrx < 0) { $field{text} = " ";
} else { $field{text} = sprintf "%4s%s", format_number(+$totalrx) ;
}
return [ \%field ] ;
}
sub status_field_seedRatioLimit($xpos) {
my %field = ( text => undef, attr => $YELLOW, xpos => $xpos) ;
my @fmt = ( "%4.2f", "%4.1f", "%4.0f" ) ;
my $ratio = defined $tqf ? $tqf->{seedRatioLimit} : 0 ;
if ($ratio < 0) { $field{text} = " inf" ;
} elsif ($ratio < 10) { $field{text} = sprintf($fmt[0], $ratio) ;
} elsif ($ratio < 100) { $field{text} = sprintf($fmt[1], $ratio) ;
} else { $field{text} = sprintf($fmt[2], $ratio) ;
}
return [ \%field ] ;
}
sub status_field_sizeWhenDone($xpos) {
my %field = ( text => undef, attr => $YELLOW, xpos => $xpos ) ;
if (defined $tqf) {
my ($num, $unit) = format_number($tqf->{sizeWhenDone}) ;
$num =~ s/^[-+]// ;
$field{text} = sprintf "%3s%s", $num, $unit ;
} else { $field{text} = "" ;
}
return [ \%field ] ;
}
sub status_field_peers($xpos) {
sub abbrev_peers($num) {
if ($num == -1) { return 0 ;
} elsif ($num < 1000) { return sprintf "%d", $num ;
} else { return sprintf "%dK", round($num/1000) ;
} ;
}
my %field = ( text => "", attr => $YELLOW, xpos => $xpos + 3 ) ;
return [ \%field ] unless $tqf ;
my %label = ( text => 'P:', attr => $RED | A_BOLD, xpos => $xpos) ;
my ($seeds,$leeches,$peers) =
map { abbrev_peers($_) }
map { $tqf->{$_} } qw(seederCount leecherCount peersConnected) ;
$field{text} = "$seeds/$leeches ($peers)" ;
return [ \%label, \%field ] ;
}
## Part of the status line.
sub status_field_uploadLimit($xpos) {
my %field = ( text => "", attr => $YELLOW, xpos => $xpos + 2) ;
return [ \%field ] unless $tqf ;
my $limit = $tqf->{uploadLimit} * 1000 ;
$limit = $si->{'speed-limit-up'} * 1000 unless $tqf->{uploadLimited} ;
my %label = ( text => 'U:', attr => $RED | A_BOLD, xpos => $xpos ) ;
$field{text} = sprintf "%4s%s", format_number_unsigned($limit) ;
return [ \%label, \%field ] ;
}
sub status_field_downloadLimit($xpos) {
my %field = ( text => "", attr => $YELLOW, xpos => $xpos + 2) ;
return [ \%field ] unless defined $tqf ;
my $status = $tqf->{status} ;
return [ \%field ] if $status !~ /3|4/ ;
my $limit = $tqf->{downloadLimit} * 1000 ;
$limit = $si->{'speed-limit-down'} * 1000 unless $tqf->{downloadLimited} ;
my %label = ( text => 'D:', attr => $RED | A_BOLD, xpos => $xpos ) ;
$field{text} = sprintf "%4s%s", format_number_unsigned($limit) ;
return [ \%label, \%field ] ;
}
sub status_field_eta($xpos) {
my %field = ( text => undef, attr => $YELLOW, xpos => $xpos + 3 ) ;
return [ \%field ] unless defined $tqf ;
my %label = ( text => 'E:', attr => $RED | A_BOLD, xpos => $xpos ) ;
if ($tqf->{status} == 4) {
my $eta = $tqf->{eta} ;
if ($eta > 604800) { $field{text} = sprintf "%2d%s", round($eta/604800), "w" ;
} elsif ($eta > 86400) { $field{text} = sprintf "%2d%s", round($eta/86400), "d" ;
} elsif ($eta > 3600) { $field{text} = sprintf "%2d%s", round($eta/3600), "h" ;
} elsif ($eta > 600) { $field{text} = sprintf "%2d%s", round($eta/60), "m" ;
} elsif ($eta > 60) { $field{text} = sprintf "%2d%s", round($eta/60), "m" ;
} elsif ($eta > 0) { $field{text} = sprintf "%2d%s", $eta, "s" ;
}
}
return [ \%field ] unless defined $field{text} ;
return [ \%label, \%field ] ;
}
## Write spaces across the full width
sub line_field_spaces() {
my $xmax = $COLS - 1 ;
my $spaces = sprintf "%${xmax}s", " " ;
return [ { text => $spaces, attr => undef, xpos => 0 } ] ;
}
sub line_field_vline($xpos) { return [ { text => 'vline', attr => $MAGENTA, xpos => $xpos } ] } ;
sub line_field_name($qpos,$xpos,$width) {
my %field = ( text => undef, attr => undef, xpos => $xpos) ;
my $name = unidecode($tq[$qpos]->{name}) ;
$field{text} = sprintf( "%-${width}s", substr($name, 0, $width) ) ;
$field{attr} = $CYAN | A_UNDERLINE if
$tq[$qpos]->{status} == 4 and $tq[$qpos]->{sizeWhenDone} == 0 ;
return [ \%field ] ;
} ;
sub line_field_percent($qpos,$xpos) {
my %field = ( text => undef, attr => undef, xpos => $xpos) ;
my $perc = $tq[$qpos]->{percentDone} * 100 ;
$field{text} = sprintf "%3d%%", $perc ;
return [ \%field ] ;
}
sub line_field_ratio($qpos,$xpos) {
my %field = ( text => undef, attr => undef, xpos => $xpos ) ;
my $ratio = $tq[$qpos]->{uploadRatio} ;
my $fmt1 = "%4.2f" ; my $fmt2 = "%4.1f" ; my $fmt3 = "%4.0f" ;
$ratio = 0 if $ratio < 0 ;
if ($ratio < 1) {
$field{attr} = $RED ;
$field{text} = sprintf($fmt1, $ratio) ;
} elsif ($ratio < 10) { $field{text} = sprintf($fmt1, $ratio) ;
} elsif ($ratio < 100) { $field{text} = sprintf($fmt2, $ratio) ;
} else { $field{text} = sprintf($fmt3, $ratio) ;
} ;
return [ \%field ] ;
}
sub line_field_uprate($qpos,$xpos) {
my %field = ( text => undef, attr => undef, xpos => $xpos) ;
my $rate = $tq[$qpos]->{rateUpload} ;
$field{attr} = $RED if $rate > 512000 ;
if ($rate <= 0 or $tq[$qpos]->{status} !~ /4|6/) { $field{text} = " ";
} else { $field{text} = sprintf "%4s%s", format_number(-$rate) ;
}
return [ \%field ] ;
}
sub line_field_downrate($qpos,$xpos) {
my %field = ( text => undef, attr => undef, xpos => $xpos) ;
my $rate = $tq[$qpos]->{rateDownload} ;
$field{attr} = $RED if $rate > 512000 ;
if ($rate <= 0 or $tq[$qpos]->{status} !~ /4|6/) { $field{text} = " ";
} else { $field{text} = sprintf "%4s%s", format_number($rate) ;
}
return [ \%field ] ;
}
sub format_number($num) {
my $sign = $num < 0 ? '-' : '+' ;
$num = abs($num) ;
if ($num < 1000) { return "$sign$num" , "B" ;
} elsif ($num < 999000) { return $sign . int($num/1000) , "K" ;
} elsif ($num < 9800000) { return sprintf("%s%.1f", $sign, $num/1000000) , "M" ;
} elsif ($num < 999000000) { return $sign . int($num/1000000) , "M" ;
} elsif ($num < 9800000000) { return sprintf("%s%.1f", $sign, $num/1000000000) , "G" ;
} else { return $sign . int($num/1000000000) , "G" ;
}
}
sub format_number_unsigned($num) {
$num = abs($num) ;
if ($num < 1000) { return "$num" , "B" ;
} elsif ($num < 999000) { return int($num/1000) , "K" ;
} elsif ($num < 9800000) { return sprintf("%.1f", $num/1000000) , "M" ;
} elsif ($num < 999000000) { return int($num/1000000) , "M" ;
} elsif ($num < 9800000000) { return sprintf("%.1f", $num/1000000000) , "G" ;
} else { return int($num/1000000000) , "G" ;
}
}
#### UPDATE TRANSMISSION DATA
sub update_speeds {
my $data = rpc('session-stats', fields => [qw( downloadSpeed uploadSpeed )] ) ;
return unless $data ;
($totalrx, $totaltx) = map { $data->{$_} } qw( downloadSpeed uploadSpeed ) ;
return 1 ;
}
## If $all == 1 then also update the trackerStats.
sub update_torrents($all = 0) {
## Get torrent data from transmission-daemon via rpc.
my $data ;
my @fields = qw(
eta id name sizeWhenDone seedRatioLimit seedRatioMode queuePosition
uploadRatio rateUpload rateDownload percentDone peersConnected
uploadLimit uploadLimited downloadLimit downloadLimited status
) ;
push @fields, "trackerStats" if $all ;
$data = rpc('torrent-get', fields => \@fields ) ;
#widget_message(0, 35, 6, 'Data not found') unless ref $data and exists $data->{torrents}->[0] ;
until (ref $data and exists $data->{torrents}->[0]) {
print STDERR '?' ;
sleep 1 ;
$data = rpc('torrent-get', fields => \@fields ) ;
} ;
#dump $data ;
#print STDERR 'x' if $all ;
#return 0 unless $data ;
#widget_message(0, 35, 6, 'Data not found') unless exists $data->{torrents}->[0] ;
@tq = () ; $th = {} ;
@tq = sort { $a->{queuePosition} <=> $b->{queuePosition} } @{ $data->{torrents} } ;
## Scrape seeds/peers info from trackerStats, using the highest values found.
foreach my $t ( @tq ) {
my $id = $t->{id} ;
if (defined $t->{trackerStats}->[0]) {
my ($seeds, $leeches) = (-1) x 2 ;
foreach (@{ $t->{trackerStats} }) {
$seeds = $_->{seederCount} if $_->{seederCount} > $seeds ;
$leeches = $_->{leecherCount} if $_->{leecherCount} > $leeches ;
}
$ti->{$id}->{seederCount} = $seeds ;
$ti->{$id}->{leecherCount} = $leeches ;
} ;
## Write seeds/peers back into torrent queue (@tq). When undefined, default to -1.
foreach (qw( seederCount leecherCount )) {
$ti->{$id}->{$_} = -1 unless defined $ti->{$id}->{$_} ;
$t->{$_} = $ti->{$id}->{$_} ;
}
}
$th->{ $_->{id} } = $_ foreach @tq ; ## Generate the torrent hashref ($th)
if ($fid != -1 and defined $th->{$fid}) {
$fpos = $th->{$fid}->{queuePosition} ;
} elsif ($fpos != -1 and $fpos <= $#tq) { $fid = $tq[$fpos]->{id} ;
} else { ($fid, $fpos) = ( -1, -1 ) ;
}
#$fpos = $#tq if $fpos > $#tq ;
$tqf = $fpos != -1 ? $tq[$fpos] : undef ;
return 1 ;
}
sub get_session {
my $data = rpc('session-get') ;
until ( ref($data) and defined $data->{"speed-limit-up"} ) {
sleep 1 ;
$data = rpc('session-get') ;
} ;
my @fields = qw(
seed-queue-enabled seed-queue-size seedRatioLimit seedRatioLimited
speed-limit-down speed-limit-down-enabled speed-limit-up speed-limit-up-enabled
) ;
my %g = map { $_ => $data->{$_} } @fields ;
return \%g ;
} ;
## Torrent queue reorder. Send rpc commands to reorder the torrent queue nicely.
sub topsort {
print STDERR '+' ;
#warn 'topsort : A' ;
my @before = map { $_->{id} } @tq ;
## downloading + active
my @sorted = sort { $th->{$b}->{rateDownload} <=> $th->{$a}->{rateDownload} }
grep { $th->{$_}->{rateDownload} > 0 }
grep { $th->{$_}->{status} == 4 } keys %$th ;
## downloading + idle
push @sorted, sort { $th->{$b}->{percentDone} <=> $th->{$a}->{percentDone} }
grep { $th->{$_}->{rateDownload} == 0 }
grep { $th->{$_}->{status} == 4 } keys %$th ;
## stopped but incomplete
push @sorted, sort { $th->{$a}->{id} <=> $th->{$b}->{id} }
grep { $th->{$_}->{percentDone} < 1 }
grep { $th->{$_}->{status} == 0 } keys %$th ;
## queued to download
push @sorted, sort { $th->{$a}->{id} <=> $th->{$b}->{id} }
grep { $th->{$_}->{status} == 3 } keys %$th ;
## checking files
push @sorted, grep { my $foo = $th->{$_}->{status} ; any { $_ == $foo } (1, 2) } keys %$th ;
## seeding + active
push @sorted, sort { $th->{$b}->{rateUpload} <=> $th->{$a}->{rateUpload} }
grep { $th->{$_}->{rateUpload} > 0 }
grep { $th->{$_}->{status} == 6 } keys %$th ;
## seeding + idle
push @sorted, sort { $th->{$a}->{uploadRatio} <=> $th->{$b}->{uploadRatio} }
grep { $th->{$_}->{rateUpload} == 0 }
grep { $th->{$_}->{status} == 6 } keys %$th ;
## queued to seed
push @sorted, sort { $th->{$a}->{id} <=> $th->{$b}->{id} }
grep { $th->{$_}->{status} == 5 } keys %$th ;
## stopped and complete
push @sorted, sort { $th->{$a}->{uploadRatio} <=> $th->{$b}->{uploadRatio} }
grep { $th->{$_}->{percentDone} == 1 }
grep { $th->{$_}->{status} == 0 } keys %$th ;
my @diff = grep { $before[$_] != $sorted[$_] } 0 .. $#before ;
if (@diff) {
#dump @diff ;
foreach (0 .. $#sorted) {
my %args = ( ids => [ $sorted[$_] ], queuePosition => $_ ) ;
rpc('torrent-set', %args) ;
}
#warn 'topsort : B' ;
$reload++ ;
}
($fid, $fpos) = ( -1, 0 ) ;
}
## Partially cribbed from Transmission::Curses.
## https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt
## https://trac.transmissionbt.com/browser/trunk/libtransmission/transmission.h
## https://pythonhosted.org/transmissionrpc/reference/transmissionrpc.html
sub rpc {
my $method = shift or return ;
my %args = @_ ;
my $nested = delete $args{_nested} ; # internal flag
my($tag, $res, $post) ;
if (ref $args{ids} eq 'ARRAY') {
for my $id (@{ $args{ids} }) { $id += 0 if $id =~ /^\d+$/ ; }
}
$tag = int rand 2*16 - 1;
$post = JSON::MaybeXS->new->encode({
method => $method, tag => $tag, arguments => \%args,
}) ;
$res = $ua->post( $url, Content => $post ) ;
unless ( $res->is_success ) {
if ($res->code == 409 and ! $nested) {
my $sid = $res->header('X-Transmission-Session-Id') ;
$ua->default_header('X-Transmission-Session-Id' => $sid) ;
return rpc($method => %args, _nested => 1) ;
} else {
return 0 ;
} ;
}
$res = JSON::MaybeXS->new->decode( $res->content ) ;
return 0 unless $res->{tag} = $tag ;
return 0 if $res->{result} ne 'success' ;
return $res->{'arguments'} ;
}
## https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt
## https://trac.transmissionbt.com/browser/trunk/libtransmission/transmission.h
## https://pythonhosted.org/transmissionrpc/reference/transmissionrpc.html
## STATUS
##
## TR_STATUS_STOPPED = 0, /* Torrent is stopped */
## TR_STATUS_CHECK_WAIT = 1, /* Queued to check files */
## TR_STATUS_CHECK = 2, /* Checking files */
## TR_STATUS_DOWNLOAD_WAIT = 3, /* Queued to download */
## TR_STATUS_DOWNLOAD = 4, /* Downloading */
## TR_STATUS_SEED_WAIT = 5, /* Queued to seed */
## TR_STATUS_SEED = 6 /* Seeding */