binge

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://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 */

binge.xdefaults

! vim: syntax=xdefaults
!
! Colors to go with binge

binge.font:            terminus-16
binge.italicFont:      terminus-16
binge.boldFont:        terminus-bold-16
binge.boldItalicFont:  terminus-bold-16

binge.internalBorder:  20
binge.geometry:        95x12
binge.letterSpace:     2
binge.lineSpace:       4

!  background color everywhere
binge.background:           gray9

!!  0 black, 1 red, 2 green, 3 yellow, 4 blue, 5 magenta, 6 cyan, 7 white

! black - background color
binge.color0:               gray9
binge.color8:               gray9

! red   - color of labels in statusbar
binge.color1:               #E6A52E
binge.color9:               #E6A52E

! green - torrent status == stopped
binge.color2:               gray50
binge.color10:              gray50

! blue  - torrent status == seeding
binge.color4:               #569CBF
binge.color12:              #569CBF

! cyan  - torrent status == downloading
binge.color6:               #AADAF2
binge.color14:              #AADAF2

! yellow - text values in statusbar
binge.color3:               gray85
binge.color11:              gray85

! magenta - vline and hline dividers
binge.color5:               gray40
binge.color13:              gray40