download progress with gtk

[zentara]

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;
}

[Aristotle]

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.