Someone on the perl.beginners maillist asked about putting a progress meter on an rsync transfer running thru cgi. I told him it was not practical, but it could easily be done with a real gui. Here is the basic idea using Tk.

This is just a proof-of-concept example, and is not intended to be a "all purpose solution", and may not run on MSWindows.

This one increments on each file sent, without using the --progress option of rsync. It is simpler that way, but it's drawback is if you have really big files, the percentage done can be misleading. You can change it to "total bytes transferred" if you use the --progress option in your $cmd, and regex for the bytes sent for each file, then change your percent computation.

This script also just moves directories on your local machine, I havn't tested it on a network transfer. In the interest of simplicity, I do a dry run to get the total files to be transferred before starting the gui, so you may want to put that in a sub, so the gui starts first.

The killchd sub is needed for cancelling the transfer, because rsync will fork off many clones to do the transfers, and all child processes must be killed. 

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::ProgressBar;
use IPC::Open3;
use Proc::Killfam;
$| = 1;

my $srcdir = '/home/zentara/testdir_in';
my $dstdir = '/home/zentara/testdir_out';

my $cmd = "rsync -r -v  $srcdir $dstdir";

#my $cmd = "rsync -r -v --bwlimit=10 $srcdir $dstdir"; 
#my $cmd = "rsync -r --dry-run  --progress  $srcdir $dstdir"; 

my $pid = open3( \*IN, \*OUT, 0, '/bin/sh' );

############################################################# 
#get a count of the files rysnc will transfer for progressbar 
my $count   = 0;
my $counter = 0;
my $percent = 0;
my $last;
my $pid1 = open( DR, " $cmd --dry-run |" ) or warn "$!\n";
while (<DR>) { $last = $_; print; $count++ }
close DR;
my ($totsize) = $last =~ /^total size is (\d+)/;
print "$count\t$totsize\n";

############################################################# 
my $mw = tkinit;

my $reader = $mw->fileevent( \*OUT, 'readable', \&get_out );

my $text = $mw->Scrolled(
    'Text',
    -bg     => 'black',
    -fg     => 'lightsteelblue',
    -width  => 80,
    -height => 5,
    -wrap   => 'none'
)->pack;

my $frame = $mw->Frame( -background => 'grey40' )
                  ->pack( -fill => 'x' );
my $butgo;
$butgo = $frame->Button(
    -text    => 'Start',
    -command => sub {
        $butgo->configure( -state => 'disabled' );
        print IN "$cmd\n";
    }
)->pack( -side => 'left', -padx => 20 );

my $butstop = $frame->Button(
    -text    => 'Cancel',
    -command => sub {
        close OUT;
        &killchd( $pid, 9 );
    }
)->pack( -side => 'left', -padx => 20 );

my $butexit = $frame->Button(
    -text    => 'Exit',
    -command => sub {
        exit;
    }
)->pack( -side => 'left', -padx => 20 );

my $l1 = $frame->Label(
    -text => '%',
    -bg   => 'black',
    -fg   => 'green',
)->pack( -side => 'right' );

my $l2 = $frame->Label(
    -textvariable => \$percent,
    -bg           => 'black',
    -fg           => 'green',
    -width        => 3,
)->pack( -side => 'right' );

my $pb = $frame->ProgressBar(
    -troughcolor => 'lightsteelblue',
    -fg          => 'hotpink',
    -blocks      => $count,
    -width       => 20,
    -length      => 200,
    -from        => 0,
    -to          => $count,
    -variable    => \$counter,
)->pack( -side => 'right', -padx => 20 );

MainLoop;
############################################################ 
sub get_out {
    my $texout = (<OUT>);
    $text->insert( 'end', "$texout" );
    $text->see('end');
    $text->update;
    $counter++;
    $percent = sprintf( '%2d', ( ( $counter / $count ) * 100 ) );
}
############################################################## 
sub killchd ($;$) {
    require Proc::ProcessTable;
    my $sig    = ( $_[1] =~ /^\-?\d+$/ ) ? $_[1] : 0;
    my $proc   = Proc::ProcessTable->new;
    my %fields = map { $_ => 1 } $proc->fields;
    return undef unless exists $fields{'ppid'};
    foreach ( @{ $proc->table } ) {
        kill $sig, $_->pid if ( $_->ppid == $_[0] );
    }
    kill $sig, $_[0];
}

__END__

[download]

In reply to rsync with tk progressbar by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.