TK subroutine status

K_M_McMahon has asked for the wisdom of the Perl Monks concerning the following question:

Hello fellow monks,

I love TK. The ease with which a gui can be built with Perl and TK is incredible.... but I digress from my problem.

I know there must be a simple solution, but as usual I am probably just overlooking the forest for the trees. Several of the scripts that I have created for use at work have to parse through many files and/or transfer files to and from remote workstations. This can take from 1 minute to 30 minutes depending on the script.

The precise problem that I am having is that I want the subruotine to be able to update the mainwindow (or toplevel window as appropriate) as to what it is doing. I have tried putting a label into the main window and having the subroutine configure->Label("This is what I am doing now"); but until the subroutine completes, none of these updates are actually executed by the window.
Example:

#!/usr/bin/perl -w
use strict;
use Tk;
use LWP::Simple;
my($label);
my $w=new MainWindow;
my $root='http://www.billwfriend.com/outdoors/hiking/ricketts_glen';
my @pics=('DSC00005.JPG','DSC00006.JPG','DSC00007.JPG','DSC00008.JPG',
+'DSC00009.JPG','DSC00011.JPG','DSC00012.JPG','DSC00014.JPG','DSC00072
+.JPG');
$w->title("TK Sample");
my $test=$w->Button(-text=> 'Test',
    -command => sub{&test})->pack();
my $quit=$w->Button(-text=> 'Quit',
    -command => sub{exit})->pack();
    
    
&MainLoop;

sub test
    {
    $label=$w->Label(-text=>"Starting to get files.")->pack();
    foreach my $file (@pics)
        {
        &get_url($file);
        }
    }
sub    get_url
    {
    my $file=shift;

    $label->configure(-text=>"Starting to get $file");
    my $test=get("$root/$file");
    open(TEST, ">$file") || die"can't open $file\n";
    binmode TEST;  # for MSDOS derivations.
    print TEST $test;
    close TEST;
    $label->configure(-text=>"Got $file.");
    }
[download]

I know this code example could be made much cleaner, I just threw this together to illustrate my problem, the actual scripts I am speaking of are much larger.

In the above example, the Got $file does not get put into the MainWindow until the last file in @pics is processed.

How do I get the Perl/TK to execute the configure command immediately instead of waiting for the subroutine to complete? Or is there a better method altogether?

Thanks in advance for all your help.

-Kevin

my $a='62696c6c77667269656e6440676d61696c2e636f6d';
while ($a=~m/(^.{2})/s)
{print unpack('A',pack('H*',"$1"));$a=~s/^.{2}//s;}
[download]

Comment on TK subroutine status Select or Download Code

Replies are listed 'Best First'.
Re: TK subroutine status by zentara (Cardinal) on Feb 16, 2005 at 14:10 UTC
You are running into the "blocking the gui" problem, where the program's execution point is such that you can't add a "$label->update" statement. In your code above, the only place you can inject an update, is after each file is retreived `foreach my $file (@pics) { &get_url($file); $label->configure(-text => "$file finished"); $label->update; }` [download] However, now that you are getting into GUI programming, you will start to become aware of the "better methods" for doing the tasks. The "get" method of LWP is easy for commandline use, but dig into the docs, and you will find something which gives more control, for gui progress tracking. For instance: #!/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; # FIXME: write the $data to a filehandle or whatever should happen # with it here. 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; } [download] Now you can feed info to a progressbar, or whatever. Other libs have similar features. CURL and libCURL are similar to LWP, and also have the more detailed ways of watching the "chunks of data" as they come in. I'm not really a human, but I play one on earth. flash japh	[reply] [d/l] [select]
Re: TK subroutine status by g0n (Priest) on Feb 16, 2005 at 12:15 UTC
You should be able to just call the $label->update method to refresh the label object. Update: First time I had a requirement to do that, it took ages to find in the documentation. Tk uses inheritance heavily, when looking for documentation of something you want to do, its important to look at the 'this widget also inherits all the methods in tk::xyz' section at the bottom of the perldoc, as you may well find what you're looking for in the docs for a widget class further up the inheritance chain VGhpcyBtZXNzYWdlIGludGVudGlvbmFsbHkgcG9pbnRsZXNz	[reply]
Re^2: TK subroutine status by K_M_McMahon (Hermit) on Feb 16, 2005 at 13:03 UTC
Although update does not work, it did point me in the right direction. I was using the wrong search terms on here... using TK and Update I have now found several relevant articles....Thanx for the help. Tk, LWP, and blocking? Tk and socket question Update Text Widget during FTP in Perl/Tk Just for starters. -Kevin `my $a='62696c6c77667269656e6440676d61696c2e636f6d'; while ($a=~m/(^.{2})/s) {print unpack('A',pack('H*',"$1"));$a=~s/^.{2}//s;}` [download]	[reply] [d/l]