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 | |
by zentara (Cardinal) on Oct 21, 2009 at 16:46 UTC | |
by lextre (Initiate) on Oct 22, 2009 at 09:32 UTC | |
by zentara (Cardinal) on Oct 23, 2009 at 12:25 UTC | |
by lextre (Initiate) on Oct 26, 2009 at 16:23 UTC | |
| |
by Anonymous Monk on Oct 22, 2009 at 10:02 UTC |