Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

rsync with Gtk2 progressbar

by zentara (Archbishop)
on May 24, 2005 at 20:33 UTC ( [id://460158]=CUFP: print w/replies, xml ) Need Help??

I'm trying to pick up Gtk2-perl, which is superior (although harder to use) than Tk. So here is a Gtk2 version of rsync with tk progressbar.

This one has better response and features than the Tk version, and it demonstrates quite a few tricks for basic Gtk2-perl use.

Once again, I'm just doing local file transfers, so you can experiment with more complex $cmd's.

Also you may notice that there are no color or font specifications in Gtk2. That is because it is usually left for your default gtk theme, to decorate it to your preferences. Google for .gtkrc-2.0 for examples. A cool one, with rounded boxes, etc. is Bumblebee

#!/usr/bin/perl use warnings; use strict; use Glib qw/TRUE FALSE/; use Gtk2 '-init'; $| = 1; my $srcdir = '/home/zentara/testdirout'; my $dstdir = '/home/zentara/testdirin'; my $cmd = "rsync -r -v $srcdir $dstdir"; #my $cmd = "rsync -r -v --bwlimit=500 $srcdir $dstdir"; my $pid; ############################################################# ############################################################# my $window = Gtk2::Window->new('toplevel'); $window->set_title('Rsync-progressbar'); $window->signal_connect( 'destroy' => \&delete_event ); $window->set_border_width(10); $window->set_size_request( 600, 300 ); my $vbox = Gtk2::VBox->new( FALSE, 6 ); $window->add($vbox); $vbox->set_border_width(2); my $hbox = Gtk2::HBox->new( FALSE, 6 ); $vbox->pack_end( $hbox, FALSE, FALSE, 0 ); $hbox->set_border_width(2); $vbox->pack_end( Gtk2::HSeparator->new, FALSE, FALSE, 0 ); my $qbutton = Gtk2::Button->new_from_stock('gtk-quit'); $hbox->pack_end( $qbutton, FALSE, FALSE, 0 ); $qbutton->signal_connect( clicked => \&delete_event ); my $sbutton = Gtk2::Button->new('Start'); $hbox->pack_end( $sbutton, FALSE, FALSE, 0 ); $sbutton->signal_connect( clicked => \&start ); my $cbutton = Gtk2::Button->new('Cancel'); $hbox->pack_end( $cbutton, FALSE, FALSE, 0 ); $cbutton->signal_connect( clicked => sub {&killchd( $pid, 9 ) } ); my $scroll = Gtk2::ScrolledWindow->new; my $textview = Gtk2::TextView->new; $scroll->add($textview); $vbox->pack_start( $scroll, TRUE, TRUE, 0 ); my $buffer = $textview->get_buffer; my $end_mark = $buffer->create_mark( 'end', $buffer->get_end_iter, FAL +SE ); # every time we insert text, scroll to that mark. $buffer->signal_connect( insert_text => sub { $textview->scroll_to_mark( $end_mark, 0.0, TRUE, 0.0, 0.0 ); } ); my $pbar = new Gtk2::ProgressBar; $pbar->set_fraction(0); $pbar->set_text("Ready to Start"); $hbox->pack_start( $pbar, TRUE, TRUE, 0 ); $window->show_all(); Gtk2->main; ##################################### sub delete_event { Gtk2->main_quit; return FALSE; } ################################### sub init { $pbar->set_text('Initializing file count'); #get a count of the files rysnc will transfer for progressbar my ( $last, $count ); $pid = open( DR, " $cmd --dry-run |" ) or warn "$!\n"; while (<DR>) { $last = $_; $buffer->insert( $buffer->get_end_iter, $_ ); #gtk2 way of forcing update Gtk2->main_iteration while Gtk2->events_pending; $count++; } close DR; my ($totsize) = $last =~ /^total size is (\d+)/; $buffer->insert( $buffer->get_end_iter, "filecount->$count\ttotal_bytes->$totsize\n" ); $pbar->set_text("$count files -- 0%"); my $confirm = &getconfirmation( $count, $totsize ); if($confirm eq 'ok'){ return ( $count, $totsize ) } else{ return(0,0)} } ###################################### sub start { $sbutton->set_sensitive(FALSE); my ( $count, $totsize ) = &init; if($count == 0){return} my ( $counter, $percent ); $pid = open( RR, " $cmd |" ) or warn "$!\n"; while (<RR>) { $buffer->insert( $buffer->get_end_iter, $_ ); $counter++; $percent = ( $counter / $count ); $pbar->set_fraction($percent); my $text = "$count files -- " . sprintf( '%2d', $percent * 100 + ) . '%'; $pbar->set_text($text); Gtk2->main_iteration while Gtk2->events_pending; } close RR; } ############################################################## sub killchd ($;$) { $cbutton->set_sensitive(FALSE); 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]; } ############################################################# sub getconfirmation { my ( $count, $totsize ) = @_; my $dialog = Gtk2::Dialog->new( 'Confirm Transfer', undef, 'modal', 'gtk-ok' => 'ok', # response ids may be one of the built-i +n enums... '_Cancel' => 2, # or any positive integer. ); # put an hbox with a label and entry into the dialog's vbox area. my $hboxd = Gtk2::HBox->new( FALSE, 6 ); $hboxd->pack_start( Gtk2::Label->new( "Continue Real Transfer?\n$count files -- $totsize bytes "), TRUE, TRUE, 0 ); $hboxd->show_all; $dialog->vbox->pack_start( $hboxd, TRUE, TRUE, 0 ); # Set which response is the default: $dialog->set_default_response('ok'); $dialog->set_position('center'); my $response = $dialog->run; $dialog->destroy; Gtk2->main_iteration while Gtk2->events_pending; return $response; } __END__

Replies are listed 'Best First'.
Re: rsync with Gtk2 progressbar
by Anonymous Monk on Oct 16, 2009 at 13:43 UTC
    Hello, I realise this article is over four years old but would you be able to help me change the script to remove the confirmation dialog so that the script runs without an option to start/confirm/cancel? Basically I would just like this to show an overall progress of the rsync process in a progress bar. Actually, even better than that would be if individual file trasnfers could be shown with a progress bar. Is that possible? Sorry but my programming skills are non-existent! Any help you could offer would be very much appreciated. thanks
      hi, i've been out of commission for a bit, but if you still need help, answer this, and I'll show you how.... it's easy..... it would help if you had a real perlmonks user account

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku
        Hi, Thanks for the reply. I would really appreciate your help on how to modify the script but I don't know where to start!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://460158]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (7)
As of 2024-04-16 08:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found