If you don't put your update calls into that callback, it will still block Tk until the get returns. And if the get() hangs, your Tk program could be hung forever, unless you set timers on it.#!/usr/bin/perl -w use strict; use LWP::UserAgent; # don't buffer the prints to make the status update $| = 1; my $ua = LWP::UserAgent->new(); my $received_size = 0; my $url = 'http://www.cpan.org/authors/id/J/JG/JGOFF/parrot-0_0_7.tgz' +; print "Fetching $url\n"; my $request_time = time; my $last_update = 0; my $response = $ua->get($url, ':content_cb' => \&callback, ':read_size_hint' => 8192, ); print "\n"; sub callback { my ($data, $response, $protocol) = @_; my $total_size = $response->header('Content-Length') || 0; $received_size += length $data; my $time_now = time; # this to make the status only update once per second. return unless $time_now > $last_update or $received_size == $total_s +ize; $last_update = $time_now; print "\rReceived $received_size bytes"; printf " (%i%%)", (100/$total_size)*$received_size if $total_size; printf " %6.1f/bps", $received_size/(($time_now-$request_time)||1) if $received_size; }
But it really is easier just to use a thread. :-)
In reply to Re^5: Perl Tk freezes when command button is clicked !
by zentara
in thread Perl Tk freezes when command button is clicked !
by muralidharan
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |