Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

TK subroutine status

by K_M_McMahon (Hermit)
on Feb 16, 2005 at 11:58 UTC ( [id://431533]=perlquestion: print w/replies, xml ) Need Help??

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."); }
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;}

Replies are listed 'Best First'.
Re: TK subroutine status
by zentara (Archbishop) 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; }
    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; }
    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
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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://431533]
Approved by Old_Gray_Bear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2024-04-19 17:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found