Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

download progress with gtk

by zentara (Archbishop)
on Nov 23, 2002 at 15:39 UTC ( #215430=snippet: print w/replies, xml ) Need Help??
Description:
This is just a little demonstration program to show how to
use LWP to download a file, with a gtk toolkit progress indicator. 
It likes full url's , but will try to save index.html
files with the saved filename being the stripped url name.
#!/usr/bin/perl -w
use strict;
use Gtk;
use LWP::UserAgent;
set_locale Gtk;
init Gtk;

my $true = 1;
my $false = 0;

my ($window,$button,$vbox,$hbox,$label,$label1,
     $entry,$adj,$pbar,$URL,$filename);

# Create the window. 
$window = new Gtk::Window( 'toplevel' );
$window->signal_connect( 'delete_event', sub { Gtk->exit( 0 ); } );
$window->border_width(10);

$vbox = new Gtk::VBox( $false, 0 );
$hbox = new Gtk::HBox($false,0);
$window->add($vbox);

# Label to let the user know what is going on. 
$label = new Gtk::Label("--------------------Gtk downloader-----------
+---------");
$vbox->pack_start( $label, $false, $false, 10 );
$label->show();

# Label to display URL to retreive. 
$label1 = new Gtk::Label( "file to retrieve\n" );
$vbox->pack_start( $label1, $false, $false, 10 );
$label1->show();

# Create the Entry  
$entry = new Gtk::Entry(100);
$entry->signal_connect( "activate",\&get_entry);
$entry->set_text( "Enter" );
$entry->append_text( "Url" );
$entry->select_region( 0, length( $entry->get_text() ) );
$vbox->pack_start( $entry, $true, $true, 0 );
$entry->show();

# Set up the progress bar 
$adj = new Gtk::Adjustment( 0, 1, 100, 0, 0, 0 );
$pbar = new_with_adjustment Gtk::ProgressBar( $adj );
$vbox->pack_start( $pbar, $false, $false, 10 );
$pbar->set_format_string("%p%%");
$pbar->set_show_text(1);
$pbar->set_value(1);
$pbar->show();

#Create start button 
$button = new Gtk::Button( "Start" );
$button->signal_connect( "clicked", \&get_file);
$hbox->pack_start($button, $true, $false,0);
$button->show();

# Create the close button 
$button = new Gtk::Button( "Close" );
$button->signal_connect( 'clicked', sub { Gtk->exit( 0 ); } );
$hbox->pack_start( $button, $true, $false,0);
$button->show();

$vbox->add($hbox);
$hbox->show();
$vbox->show();
$window->show();

main Gtk;
exit( 0 );
################################################################ 

sub get_file{
get_entry();
my $ua  = LWP::UserAgent->new;
open(IN,">$filename");
my $value = 0;
my $expected_length;
my $bytes_received = 0;
my $res = $ua->request(HTTP::Request->new(GET => $URL),
    sub {
        my ( $chunk, $res ) = @_;
        $bytes_received += length($chunk);
        unless ( defined $expected_length ) {
            $expected_length = $res->content_length || 0;
            $label1->set_text( "Getting $filename\n$expected_length by
+tes" );
           }if($expected_length){
                  $value= int (100 * $bytes_received / $expected_lengt
+h) || 0;
                   }
        # write to the file 
        print IN $chunk;

   $pbar->set_value( ++$value ) if ($value =~ /^[0-9]+$/);

 # Run the main loop as long as events are pending 
 Gtk->main_iteration while ( Gtk->events_pending );
});
close IN;
# Download is done, inform the user. 

if(-s $filename eq 0){
        $label1->set_text( "file contained no data\nCheck URL" );
        unlink $filename;
  }else{
        $label1->set_text( "$filename saved\n Download Complete" );
        $pbar->set_value(101);
  }
  
return;
}

sub get_entry{
$URL = $entry->get_text();
$pbar->set_value(0);
$filename = substr("$URL", rindex("$URL", "/" )+1);
$filename =~ s/~//g;
$filename = $filename || $URL;
$filename =~ s/[~\/]//g;
$label1->set_text("$filename\n");
return;
}
Replies are listed 'Best First'.
Re: download progress with gtk
by Aristotle (Chancellor) on Nov 27, 2002 at 07:59 UTC
    See, that is what made me invent multiple method calls against the same object (f.ex GUI programming). :) Including some addition cleanups, it ends up looking like this:
    #!/usr/bin/perl -w use strict; use Gtk; use LWP::UserAgent; use URI; sub configure_object { # see id://208407 my $object = shift; while(@_) { my ($meth, $param) = splice @_, 0, 2; my $obj = $object; until((not defined $param) or ref $param) { $obj = $obj->$meth; ($meth, $param) = ($param, shift); } $obj->$meth(@{ $param || [] }); } return $object; } Gtk->set_locale; Gtk->init; use constant TRUE => 1; use constant FALSE => 0; my ($entry, $label, $pbar); my $window = configure_object( Gtk::Window->new('toplevel'), border_width => [ 10 ], set_title => [ 'Gtk Downloader' ], signal_connect => [ delete_event => sub { Gtk->exit(0) } ], add => [ configure_object( Gtk::VBox->new(FALSE, 0), pack_start => [ $label = configure_object( Gtk::Label->new("File to retrieve\n"), show => undef, ), FALSE, FALSE, 10 ], pack_start => [ configure_object( $entry = Gtk::Entry->new(100), signal_connect => [ activate => \&get_entry ], set_text => [ "Enter URL:" ], select_region => [ 0, 0 ], show => undef, ), TRUE, TRUE, 0 ], pack_start => [ $pbar = configure_object( Gtk::ProgressBar->new_with_adjustment( Gtk::Adjustment->new(0, 1, 100, 0, 0, 0) ), set_format_string => [ "%p%%" ], set_show_text => [ 1 ], set_value => [ 1 ], show => undef, ), FALSE, FALSE, 10 ], add => [ configure_object( Gtk::HBox->new(FALSE, 0), pack_start => [ configure_object( Gtk::Button->new("Start"), signal_connect => [ clicked => \&get_file ], show => undef, ), TRUE, FALSE, 0 ], pack_start => [ configure_object( Gtk::Button->new("Close"), signal_connect => [ clicked => sub { Gtk->exit(0) } ], show => undef, ), TRUE, FALSE, 0 ], show => undef, )], show => undef, )], show => undef, ); Gtk->main; exit 0; sub get_file{ my $uri = URI->new($entry->get_text()); my $filename = $uri->path(); $filename =~ s!^.*/!!g; unless($filename) { $filename = $uri->as_string; $filename =~ tr[/][-]; } $label->set_text("$filename\n"); my $ua = LWP::UserAgent->new; open(my($fh), ">", $filename) or return; # FIXME notify the user h +ere my ($expected_length, $bytes_received, $first_call) = (0,0,1); my $res = $ua->request( HTTP::Request->new(GET => $uri->as_string), sub { my ($chunk, $res) = @_; $bytes_received += length($chunk); if($first_call) { $expected_length = $res->content_length || 0; $label->set_text("Getting $filename\n$expected_length +bytes"); $pbar->set_value(0); undef $first_call; } $pbar->set_value(1 + int(100 * $bytes_received / $expected +_length)) if $expected_length; print $fh $chunk; Gtk->main_iteration while Gtk->events_pending; }, ); close $fh; if($res->is_success) { $label->set_text("$filename saved."); $pbar->set_value(101); } else{ $label->set_text("Download failed, check URL."); unlink $filename unless -s $filename; } }

    Makeshifts last the longest.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (1)
As of 2021-04-18 00:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?