Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

perl tk MainLoop hangs

by zemplen (Novice)
on Apr 30, 2013 at 14:29 UTC ( #1031416=perlquestion: print w/ replies, xml ) Need Help??
zemplen has asked for the wisdom of the Perl Monks concerning the following question:

I created a Perl/tk script to act as a front end to an existing Perl script. This was cloned from a existing (working) script, which I used as a template.

The new script was working and displaying correctly. I was tidying things up and updated the clone to use strict;. After correcting the errors and any problems indicated by Perl -wc the MainLoop hangs. The script runs without error upto the MaonLoop

I tried the following to resolve the issue without success

print "@ main loop\n"; #MainLoop; while (MainWindow->Count) { print MainWindow->Count,"\n"; DoOneEvent(ALL_EVENTS); #$MainWindow->update(); }

Console Output:
$perl zip_tk.pl
@ main loop
1

	
$perl -v

This is perl 5, version 16, subversion 0 (v5.16.0) built for MSWin32-x86-multi-thread (with 1 registered patch, see perl -V for more detail)

Copyright 1987-2012, Larry Wall

Binary build 1600 295879 provided by ActiveState http://www.ActiveState.com
Built Jun 11 2012 12:43:38

MainLoop hangs ie: no widgets are displayed.

#!/usr/local/bin/perl use Tk; use Tk::ROText; use Tk::Text; use Tk::Balloon; use Tk::Listbox; use Tk ':eventtypes'; use strict; use lib "."; use lib 'J:\\myWebPage\\WPMC\\files\\DB\\'; use walk_locations; my %walkLoc = walk_locations->new(); use vars qw($inFile $outFile $formHandler); my $main = MainWindow->new(); $main->configure (-title=>'WPMC Walk List'); my $topFrame = $main->Frame (-relief=>'sunken', -borderwidth=>1); my $lftFrame = $main->Frame (-relief=>'sunken', -borderwidth=>1); my $midFrame = $main->Frame (-relief=>'sunken', -borderwidth=>1); my $rgtFrame = $main->Frame (-relief=>'sunken', -borderwidth=>1); my $botFrame = $main->Frame (-relief=>'sunken', -borderwidth=>1); my $butFrame = $botFrame->Frame (-label=>'', -relief=>'raised', -borde +rwidth=>1); $topFrame->pack(-side=>'top', -anchor=>'w', -fill=>'both'); $lftFrame->pack(-side=>'top', -anchor=>'e', -fill=>'both'); $midFrame->pack(-side=>'top', -anchor=>'center', -fill=>'both'); $rgtFrame->pack(-side=>'top', -anchor=>'w', -fill=>'both'); $botFrame->pack(-side=>'bottom', -anchor=>'w', -fill=>'both'); $butFrame->pack(-side=>'left', -anchor=>'w', -fill=>'both'); ### # submit/exit buttons ### my @button; $button[0] = $butFrame->Button(-text=>'Submit', -command=>\&submit, -f +g=>"darkgreen", -background=>"ivory", -activebackground=>'lightgreen' +); $button[1] = $butFrame->Button(-text=>'Exit', -command=>sub{exit}, -fg +=>"darkred", -background=>"ivory", -activebackground=>"indianred"); $button[2] = $butFrame->Button(-text=>'Help', -command=>[\&help], -fg= +>"orange", -activebackground=>"wheat", -background=>"ivory"); $button[0]->pack(-side=>'right', -anchor=>'e', -fill=>'none'); $button[1]->pack(-side=>'right', -anchor=>'e', -fill=>'none'); $button[2]->pack(-side=>'right', -anchor=>'e', -fill=>'none'); # Create the balloon widget my $b = $butFrame->Balloon(-statusbar => my $status); $b->attach($button[0], -msg => 'Create e-mail list'); $b->attach($button[1], -msg => 'Exit This Program'); $b->attach($button[2], -msg => 'General Help Screen'); # Listbox my $label1 = $midFrame->Label(-text => "By Location", -anchor => 'e')- +>pack(-side=>'left' ); my $listbox = $midFrame->Listbox(-fg=>"darkblue", -background=>"ivory" +, -height=>-1)->pack(-side=>'left'); getList (my @list); $listbox->insert('end', @list ); $listbox->selectionSet(1); #$listbox->curselection my $label2 = $topFrame->Label(-text => "Distance")->pack(); my $distance = $topFrame->Entry(-fg=>"darkblue", -background=>"ivory") +->pack(); my $label6 = $topFrame->Label(-text => "City")->pack(); my $city = $topFrame->Entry(-fg=>"darkblue", -background=>"ivory")->pa +ck(); my $label7 = $topFrame->Label(-text => "State", -anchor => 'center')-> +pack(); my $state = $topFrame->Entry(-fg=>"darkblue", -background=>"ivory")->p +ack(); my $label3 = $topFrame->Label(-text => "Zip Code", -anchor => 'center' +)->pack(); my $zipCode = $topFrame->Entry(-fg=>"darkblue", -background=>"ivory")- +>pack(); my $label4 = $topFrame->Label(-text => "Latitude", -anchor => 'center' +)->pack(); my $latitude = $topFrame->Entry(-fg=>"darkblue", -background=>"ivory") +->pack(); my $label5 = $topFrame->Label(-text => "Longitude", -anchor => 'center +')->pack( ); my $longitude = $topFrame->Entry(-fg=>"darkblue", -background=>"ivory" +)->pack(); #defauts $distance->insert('end', '15'); #Geometry Management $label2 -> grid(-row=>1,-column=>1); $distance -> grid(-row=>1,-column=>2,-sticky=>"ns"); $zipCode -> grid(-row=>2,-column=>6,-sticky=>"ns"); $longitude -> grid(-row=>3,-column=>4,-sticky=>"ns"); print "@ main loop\n"; #MainLoop; while (MainWindow->Count) { print MainWindow->Count,"\n"; DoOneEvent(ALL_EVENTS); #$MainWindow->update(); } sub submit () { my %args; my $hash; my $key; my $value; my $argv; $args{distance}{value} = $distance->get(); $args{city}{value} = $city->get(); $args{state}{value} = $state->get(); $args{zipCode}{value} = $zipCode->get(); $args{latitude}{value} = $latitude->get(); $args{longitude}{value} = $longitude->get(); $args{distance}{argv} = "-distance="; $args{city}{argv} = "-city="; $args{state}{argv} = "-state="; $args{zipCode}{argv} = "-zip="; $args{latitude}{argv} = "-latitude="; $args{longitude}{argv} = "-longitude="; print "--------------------------------------\n$args{distance}{valu +e}\n"; my $argString = ""; while ( ($key, $hash) = each %args ) { print "-->{$key}: \n"; while ( ($argv, $value) = each %$hash ) { print "inside $argv\n"; if ($value=~/\s*/==1) { print "true value = ".$value."\t". $value=~/\s*/==1,"\ +n";} elsif ($value=~/\s*/!=1) { print "false value = ".$value."\t". $value=~/\s*/==1, +"\n";} else { print "fail all\n";} } print "\n"; } #print 'perl.exe "J:\myWebPage\WPMC\files\DB\zip.pl" '.$argString; } sub help () { ; } sub getList (@) { ### # Walk locations ### my $key; my $value; while (($key, $value) = each(%walkLoc)) { push (@list, $key);} }
package walk_locations; use strict; use warnings; BEGIN { require Exporter; # set the version for version checking our $VERSION = 0.01; # Inherit from Exporter to export functions and variables our @ISA = qw(Exporter); # Functions and variables which are exported by default our @EXPORT = qw(new); # Functions and variables which can be optionally exported our @EXPORT_OK = qw(); } # exported package globals go here ## # Walk locations ### my %walkLoc = ( # $degrees + ($minutes/60) + ($seconds/3600) Mingo => { lat => '40.2041666666667)', lon => '-80.0272222222222',}, Hartwood => { lat => '40.5553', lon => '-79.9094',}, DeerLakes => { lat => '40.62118209953078)', lon => '-79.82713968655357',}, NorthPark => { lat => '40.6036', lon => '-80.0169',}, CoopersRocks => { lat => '39.65556', lon => '-79.78806',}, BradysRun => { lat => '40.76', lon => '-80.32',}, FallRun => { lat => '40.534', lon => '-79.9471',}, Shawnee => { lat => '40.03', lon => '-78.64',}, SouthPark => { lat => '40.30', lon => '-80.00',}, Moraine => { lat => '40.966', lon => '-80.1308',}, BlueKnob => { lat => '40.27861', lon => '-78.58139',}, Emmerling => { lat => '40.581390', lon => '-79.861670',}, Jennings => { lat => '41.0071', lon => '-80.0079',}, Hampton => { lat => '40.5886', lon => '-79.937',}, OhioPyle => { lat => '39.872', lon => '-79.492',}, DockHollow => { lat => '40.69861', lon => '-79.66944',}, FrickPark => { lat => '40.4323', lon => '-79.9049',}, TwinLakes => { lat => '40.3217356', lon => '-79.4772611',}, test => { lat => '40.0', lon => '-80',}, ); sub new2 { my $package = shift; return bless({}, $package); } sub new1 { my ( $class, %args ) = @_; my $self = {}; bless( $self, $class ); return $self; } sub new() { return %walkLoc; } END {;} # module clean-up code here (global destructor) 1; # don't forget to return a true value from the file

Comment on perl tk MainLoop hangs
Select or Download Code
Re: perl tk MainLoop hangs
by Anonymous Monk on Apr 30, 2013 at 14:40 UTC

    The script runs without error upto the MaonLoop

    Yes, MainLoop is supposed to hang, that's what MainLoop does

Re: perl tk MainLoop hangs
by hdb (Prior) on Apr 30, 2013 at 14:48 UTC

    MainLoop waits for something to happen but in your example nothing will ever happen. If you add a button, you can see that the script is still responsive.

    use strict; use warnings; use Tk; my $mw = new MainWindow(-background=>'Gray'); my $btn = $mw->Button( -text => "Exit", -command => sub { print "Button pressed\n"; } )->pack(); MainLoop;

    UPDATE: In other words, you need to completely set up your application, GUI and response functions and then call MainLoop. MainLoop will watch the GUI and react to any user interaction by executing the provided callback functions.

    If you knew this all already, then there must be a bug in your program elsewhere.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (11)
As of 2014-09-23 10:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (219 votes), past polls