Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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();
}

[download]

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

[download]
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

[download]

In reply to perl tk MainLoop hangs by zemplen

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others taking refuge in the Monastery: (5)
As of 2024-04-19 07:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found