| 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;
}
|
|
| comment on download progress with gtk Download Code | |
|---|---|
| Re: download progress with gtk by Aristotle on Nov 27, 2002 at 12:59 UTC | |
#!/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. | [reply] d/l code |