Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

tk bind and widgets stored in array

by glenn (Scribe)
on Jun 29, 2011 at 17:50 UTC ( [id://912002]=perlquestion: print w/replies, xml ) Need Help??

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

I have been making some changes to an in house test program. This new page presents the user with the ability to select a license option and to set the serial number of the unit as well as identify the unit by blinking it. I am having problems with:
1. When the blink button is pressed i want the serial number of that unit to get focus.
2. When the bar code scanner (USB) enters values into the labentry I want to cut the trailing /n and give focus to the next serial number box.
3. Lastly once it attempts to continue i want to validate that each serial is 15 char's long then write it to a file on the server.
sub createLicenseWindow { my $mins = int(8); #waittime in minutes my $waittime = int($mins * 60); #wait in seconds my @serailset; my $mainwindow = MainWindow->new(); $mainwindow->title("License Units"); $mainwindow->configure(-background=> 'wheat'); my $center = $mainwindow->Frame->grid(); $center->configure(-background=> 'wheat'); $center->Label(-text=>"Select license option to set on unit. New f +eature.\n\nWill automatticly continue after $mins minutes.", -backgro +und=>'tan', -foreground=>'green', -font=>['courier', '14', 'bold'])-> +grid(-row=>0, -column=>0, -columnspan=>2, -sticky=>'ew'); my $lic_frame = $center->Scrolled('Frame', -scrollbars=>'e', -heig +ht=>'300')->grid(-row=>1, -column=>0, -columnspan=>2); my $lic_grid = $lic_frame->grid(); $lic_grid->configure(-background=> 'wheat'); my @serailEnt; for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[0]->{sys +tem}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$count] +; my $serail = \$serialEnt[$count]; my $bgcolor; if ($count % 2 == 0) { $bgcolor="LemonChiffon"; } else { $bgcolor="cornsilk"; } $lic_grid->Label(-text=>"IP: ".$system->{ip}->[0], -background +=>$bgcolor."1")->grid(-row=>$count, -column=>0); $serail = $lic_grid->LabEntry(-label=>"Serial: ", -background= +>$bgcolor."2", -textvariable=>\$system->{serial}->[0], -labelPack=>[- +side=>'left', -anchor=>'w'])->grid(-row=>$count, -column=>1); $lic_grid->BrowseEntry(-label=>"Set License: ", -background=>$ +bgcolor."3", -variable=>\$system->{license}->[0], -choices=>\@lic_opt +ions)->grid(-row=>$count, -column=>2); my $blink = $lic_grid->Button(-text=>"Blink Unit", -background +=>$bgcolor."4", -command=>sub { if ($system->{raidtype}->[0] =~ m/software/i or $system->{ +raidtype}->[0] =~ m/unknown/i) { qx"wincuri 2 $system->{ip}->[0] \"/usr/AmiNas/cli blin +k -t ld -l /dev/md255 raid\""; } if ($system->{raidtype}->[0] =~ m/hardware/i or $system->{ +raidtype}->[0] =~ m/unknown/i) { qx"wincuri 2 $system->{ip}->[0] \"/usr/AmiNas/cli blin +k -t ld -l /dev/sda raid\""; } $serail->focus; })->grid(-row=>$count, -column=>3); if ($system->{raidtype}->[0] =~ m/none/i) { $blink->enabled = 0; } } for (my $count = 0; $count < @serailEnt; $count++) { my $serail = \$serialEnt[$count]; $serail->bind('<KeyPress>' => sub{ print "Key pressed for serial $count\n"; my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$co +unt]; my $nextserail = \$serialEnt[$count+1]; $system->{serial}->[0] =~ s/\n//g; if (length($system->{serial}->[0]) >= 15) { $nextserail->focus; } }); } $center->Button(-text=>"Continue", -background=>'tan', -command=>s +ub { my $allset = 2; my $message = ""; for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[0]-> +{system}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$co +unt]; if ($system->{serial}->[0] eq "") { $allset = 0; } elsif (length($system->{serial}->[0]) ne 15) { $message .= "Serial number ".$system->{serial}->[0]." +is ".length($system->{serial}->[0])." charaters\n"; $allset = 1; } elsif (length($system->{serial}->[0]) eq 15) { my $set = 1; foreach my $alreadydone (@serailset) { if ($system->{ip}->[0] eq $alreadydone) { $set = 0; } } if ($set == 1) { qx"wincuri 2 ".$system->{ip}->[0]." \"echo '".$sys +tem->{serial}->[0]."' > /etc/itxserial\""; push(@serialset, $system->{ip}->[0]); } } } if ($allset == 1) { $mainwindow->messageBox(-message=>"Serial numbers must be +15 charaters long\n\n$message", -title=>"Invalid Input"); } elsif ($allset == 2) { $waittime = -1; $mainwindow->destroy; } })->grid(-row=>2, -column=>0, -columnspan=>2, -sticky=>'ew'); $center->LabEntry(-label=>"Auto Continue in: ", -background=>'tan' +, -textvariable=>\$waittime, -labelPack=>[-side=>'left', -anchor=>'w' +])->grid(-row=>3, -column=>0); $center->Button(-text=>"Stop Timer", -background=>'tan', -command= +>sub {$waittime = -1;})->grid(-row=>3, -column=>1); my $timer = $mainwindow->repeat(1000, sub{ if ($waittime == 0) { my $allset = 1; for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[0]-> +{system}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$co +unt]; if ($system->{serial}->[0] eq "" or length($system->{seria +l}->[0]) ne 15) { $allset = 0; } elsif (length($system->{serial}->[0]) eq 15) { my $set = 1; foreach my $alreadydone (@serailset) { if ($system->{ip}->[0] eq $alreadydone) { $set = 0; } } if ($set == 1) { qx"wincuri 2 ".$system->{ip}->[0]." \"echo '".$sys +tem->{serial}->[0]."' > /etc/itxserial\""; push(@serialset, $system->{ip}->[0]); } } } if ($allset == 1) { $waittime = -1; $mainwindow->destroy; } else { $waittime = -1; licenseEmail(); } } elsif ($waittime > 0) { $waittime--; } }); }

Replies are listed 'Best First'.
Re: tk bind and widgets stored in array
by zentara (Archbishop) on Jun 30, 2011 at 11:47 UTC
    You don't give a complete running example, and your code is full of alot of distractions, which makes it hard to see what is happening. Can you make a simplified example, to separate the focus problem from the entry validation?

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
Re: tk bind and widgets stored in array
by glenn (Scribe) on Jun 29, 2011 at 17:53 UTC
    Currently when values are entered into the labentry for the serial (even by keyboard) the sub in the bind does not run, i have a print just to see if it worked. When the blink button is pressed, the unit blinks but the focus does not change. If the serial number is not eq to 15 chars then the message box works, if it is eq it does not set the license...
Re: tk bind and widgets stored in array
by glenn (Scribe) on Jun 30, 2011 at 20:48 UTC
    Thank you for looking at it, i got it working; i know there is a lot but i was posting it quickly and all the parts work together and i would have had to go line by line to remove the simple mundane items. There was an id10t error with the bind, it was my first time using bind. The bind sub is not like a sub in the -command part of a widget, so i was trying to use variables in the sub that were declared in the surrounding for loop; i had to create a real sub and pass the values. In case anybody wants it here is the working code:
    use XML::Simple; use Tk; use Tk::DialogBox; use Term::ANSIColor; use Tk::ColorEditor; use Tk::BrowseEntry; use Tk::LabEntry; use Tk::Pane; my $SYSTEMJOB; my @lic_options = ("none","opt1","opt2"); #license window vars; do not edit my $mainwindow; my $win2; my $allserial = 0; my $systemxml = "<systemlist>"; for (my $i = 0; $i < @ip; $i++) { $tempip++; my $serial = $confHlpr->getSerialNumber($itxip[$i]); #returns seri +al or X my $createtime = time; $systemxml .= "<system> <ip>$itxip[$i]</ip> <ip>192.168.0.$tempip</ip> <nodenumber>$i</nodenumber> <status>proceed</status> <serial>$serial</serial> <createtime>$createtime</createtime> <filename>unknown</filename> <mac>unknown</mac> <mac>unknown</mac> <reasonforfailure>unknown</reasonforfailure> <password>password</password> <license>none</license> <license>unknown</license> <raidtype>unknown</raidtype> </system>"; } $systemxml .= "</systemlist>"; my $xs = new XML::Simple(keeproot=>1, forcearray=>1); $SYSTEMJOB = $xs->XMLin($systemxml); #Set License createLicenseWindow(); MainLoop(); sub createLicenseWindow { my $mins = int(8); #waittime in minutes my $waittime = int($mins * 60); #wait in seconds $mainwindow = MainWindow->new(); $mainwindow->title("License Units"); $mainwindow->configure(-background=> 'wheat'); $mainwindow->protocol('WM_DELETE_WINDOW',sub{$mainwindow->messageB +ox(-message=>"Window cannot be closed this way.", -title=>"Disabled") +;return;}); my $center = $mainwindow->Frame->grid(); $center->configure(-background=> 'wheat'); $center->Label(-text=>"Select license option to set on unit. New f +eature.\n\nWill automatticly continue after $mins minutes.", -backgro +und=>'tan', -foreground=>'darkgreen', -font=>['courier', '14', 'bold' +])->grid(-row=>0, -column=>0, -columnspan=>2, -sticky=>'ew'); my $lic_frame = $center->Scrolled('Frame', -scrollbars=>'e', -heig +ht=>'300')->grid(-row=>1, -column=>0, -columnspan=>2); my $lic_grid = $lic_frame->grid(); $lic_grid->configure(-background=> 'wheat'); my @serialEnt; for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[0]->{sys +tem}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$count] +; if ($system->{serial}->[0] =~ m/X/) { $system->{serial}->[0] = ""; } my $bgcolor; if ($count % 2 == 0) { $bgcolor="LemonChiffon"; } else { $bgcolor="cornsilk"; } $lic_grid->Label(-text=>"IP: ".$system->{ip}->[0], -background +=>$bgcolor."1")->grid(-row=>$count, -column=>0); $serialEnt[$count] = $lic_grid->LabEntry(-label=>"Serial: ", - +background=>$bgcolor."2", -textvariable=>\$system->{serial}->[0], -la +belPack=>[-side=>'left', -anchor=>'w'])->grid(-row=>$count, -column=> +1); $lic_grid->BrowseEntry(-label=>"Set License: ", -background=>$ +bgcolor."3", -variable=>\$system->{license}->[0], -choices=>\@lic_opt +ions)->grid(-row=>$count, -column=>2); my $blink = $lic_grid->Button(-text=>"Blink Unit", -background +=>$bgcolor."4", -command=>sub { if ($system->{raidtype}->[0] =~ m/software/i or $system->{ +raidtype}->[0] =~ m/unknown/i) { qx"wincuri 2 $system->{ip}->[0] \"/usr/AmiNas/cli blin +k -t ld -l /dev/md255 raid\""; } if ($system->{raidtype}->[0] =~ m/hardware/i or $system->{ +raidtype}->[0] =~ m/unknown/i) { qx"wincuri 2 $system->{ip}->[0] \"/usr/AmiNas/cli blin +k -t ld -l /dev/sda raid\""; } $serialEnt[$count]->focus; })->grid(-row=>$count, -column=>3); if ($system->{raidtype}->[0] =~ m/none/i) { $blink->enabled = 0; } } for (my $count = 0; $count < @serialEnt; $count++) { #give the first system with no serail focus my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$count] +; if ($system->{serial}->[0] eq "") { $serialEnt[$count]->focus; last; } } for (my $count = 0; $count < @serialEnt; $count++) { my $serialRef = \@serialEnt; $serialEnt[$count]->bind('<KeyPress>' => [\&Linputcheck, $coun +t, $serialRef]); } $center->Button(-text=>"Continue", -background=>'tan', -command=>s +ub { my $allset = 2; my $message = ""; for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[0]-> +{system}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$co +unt]; if ($system->{serial}->[0] eq "") { $allset = 0; } elsif (length($system->{serial}->[0]) ne 15) { $message .= "Serial number ".$system->{serial}->[0]." +is ".length($system->{serial}->[0])." charaters\n"; $allset = 1; } } if ($allset == 1) { $mainwindow->messageBox(-message=>"Serial numbers must be +15 charaters long\n\n$message", -title=>"Invalid Input"); } elsif ($allset == 2) { $waittime = -1; &setSerailNumbers; $mainwindow->destroy; } })->grid(-row=>2, -column=>0, -columnspan=>2, -sticky=>'ew'); $center->LabEntry(-label=>"Auto Continue in: ", -background=>'tan' +, -textvariable=>\$waittime, -labelPack=>[-side=>'left', -anchor=>'w' +])->grid(-row=>3, -column=>0); $center->Button(-text=>"Stop Auto Continue", -background=>'tan', - +command=>sub {$waittime = -1;})->grid(-row=>3, -column=>1); my $timer = $mainwindow->repeat(1000, sub{ if ($waittime == 0) { my $allset = 1; $waittime = -1; for (my $c = 0; $c < @{$SYSTEMJOB->{systemlist}->[0]->{sys +tem}}; $c++) { if (length($SYSTEMJOB->{systemlist}->[0]->{system}->[$ +c]->{serial}->[0]) ne 15) { $allset = 0; } } if ($allset == 1) { &setSerailNumbers; $mainwindow->destroy; } else { licenseEmail(); } } elsif ($waittime > 0) { $waittime--; } }); } sub Linputcheck { my ($widget, $count, $serialRef) = @_; my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$count]; $system->{serial}->[0] =~ s/\s//g; print "My serail number for unit $count is [".$system->{serial}->[ +0]."]\n"; if (length($system->{serial}->[0]) eq 15) { if ($count + 1 eq @$serialRef) { print "All serail numbers have been entered, correctly\n"; my $cnt = 30; if ($allserial == 0) { $allserial = 1; #only popup once $win2 = $mainwindow->Toplevel(); #$win2->update; $win2->raise(); $win2->protocol('WM_DELETE_WINDOW',sub{$win2->messageB +ox(-message=>"Window cannot be closed this way.", -title=>"Disabled") +;return;}); $win2->title("Ready to continue?"); $win2->Label(-text=>"Are you ready to continue or do\n + you need to change the license settings?")->pack(-side => 'top'); $win2->Button(-text=>"Contine", -command=>sub{&setSera +ilNumbers; $mainwindow->destroy;})->pack(-side => 'left'); $win2->Button(-text=>"Change License", -command=>sub{$ +win2->destroy;})->pack(-side => 'right'); $win2->LabEntry(-label=>"Auto Continue in: ", -textvar +iable=>\$cnt, -labelPack=>[-side=>'left', -anchor=>'w'])->pack(-side +=> 'bottom'); my $timer2 = $win2->repeat(1000, sub{ $cnt--; if ($cnt == 0) { &setSerailNumbers; $mainwindow->destroy; } }); } } else { print "There are more serial numbers to be entered\n"; @$serialRef[$count+1]->focus; } } return; } sub setSerailNumbers { for (my $count = 0; $count < @{$SYSTEMJOB->{systemlist}->[0]->{sys +tem}}; $count++) { my $system = $SYSTEMJOB->{systemlist}->[0]->{system}->[$count] +; system("plink ".$system->{ip}->[0]." \"echo '".$system->{seria +l}->[0]."' > /etc/itxserial\""); } return; }

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2024-03-29 08:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found