Re: download progress with gtk

[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.