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
In reply to perl tk MainLoop hangs by zemplen
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |