ghosh123 has asked for the wisdom of the Perl Monks concerning the following question:
Hi Monk,
I am making an aplication gui using Tk::HList which will get updated every 5 secs. The application is reading a text file which is getting updated every second.
I am attaching the code (report.pl) here and also the text file. The code has two while loops. The inner while loop works fine, but the outer while loop which is responsible for reading the file every 5 secs is not working. After every 5 secs I am trying to destroy the Tk objects and re-constructing them again.
Please comment out the outer while loop (while($loop==1)) to see how it works and then comment it back to see the problem I am facing. Please help. Thanks.
I am running it as follows for a particular user :
report.pl alex
The code is below :
use Tk; use Tk::HList; use Tk::ItemStyle; my $user = $ARGV[0]; my $hash = {}; my ($tool,$issued,$use,$vendor,$feature); #gui variables my ($hl,$ok,$alert); # Making the Gui my $mw = new MainWindow; $mw->geometry("500x200"); my $userframe = $mw->Frame(-width=>5,-height=>10)->pack(-side=>'top',- +anchor=>'nw'); $userframe->Label(-text => "USER: $user")->pack(-anchor => 'nw',-padx +=> 0); my $hlistframe = $mw->Frame()->pack(-fill => 'both', -expand => 1); my $loop = 1; while ($loop == 1) { open(FP, "<file.txt"); while(<FP>){ if(/^Users of (\w+):\s+\(Total of ([0-9]+) licenses issued;\s+Tota +l of ([0-9]+) (licenses|license) in use/) { ($tool,$issued,$use) = ($1,$2,$3); } if (/^\s+$user(.*)/){ $hash->{$user}->{$tool}->{tool} = $tool; $hash->{$user}->{$tool}->{issued} = $issued; $hash->{$user}->{$tool}->{inuse} = $use; } } close(FP); #print Dumper($hash); $hl = $hlistframe->Scrolled('HList', -scrollbars => 'ose', -columns =>4 , -header => 1, -width => 100, -command => sub {print "AAA\n";}, -selectmode => 'browse', )->pack(-fill => 'both',-expand =>1 ); my $label1 = $hl->Label(-text => "Tool", -anchor => 'w'); $hl->headerCreate(0,-itemtype => 'window',-widget => $label1); my $label3 = $hl->Label(-text => "Available", -anchor => 'w'); $hl->headerCreate(1,-itemtype => 'window',-widget => $label3); my $label4 = $hl->Label(-text => "checkedout", -anchor => 'w'); $hl->headerCreate(2,-itemtype => 'window',-widget => $label4); my $label5 = $hl->Label(-text => "checkedout%", -anchor => 'w'); $hl->headerCreate(3,-itemtype => 'window',-widget => $label5); $ok = $hl->ItemStyle('text', -selectforeground =>'black', -anchor => +'center',-background =>'green'); $alert = $hl->ItemStyle('text', -selectforeground =>'black', -anchor + =>'center',-background =>'red'); my $path = 0; for my $toolkey (sort keys %{$hash->{$user}}) { _insertData($path,$toolkey); $path++; } sleep 5; #not working $hl->destroy; #not working } sub _insertData { my $path = shift; my $tool = shift; my $availbl = $hash->{$user}->{$tool}->{issued}; my $chk = $hash->{$user}->{$tool}->{inuse}; $hl->add($path); $hl->itemCreate($path,0,-text=> $hash->{$user}->{$tool}->{tool}); $hl->itemCreate($path,1,-text=> $hash->{$user}->{$tool}->{issued}) +; $hl->itemCreate($path,2,-text=> $hash->{$user}->{$tool}->{inuse}); my ($percent_lic_co,$color)= calculate_percent($availbl,$chk); $hl->itemCreate($path,3,-text=> $hash->{$user}->{$tool}->{inuse}, +-style => $color); } sub calculate_percent { my $avail = shift; my $co = shift; my $percent = ($co * 100)/$avail ; $percent = sprintf "%.2f", $percent; my $color; if($percent > 90) { $color = $alert; } else { $color = $ok; } return ($percent,$color); } MainLoop;
The text file (file.txt) is having following content :
Users of nspice_apl: (Total of 20 licenses issued; Total of 0 licenses in use)
Users of nspice_sv: (Total of 20 licenses issued; Total of 2 licenses in use)
"nspice_sv" v9999.99, vendor: apache
floating license
alex vihlc22 /dev/pts/12 (v2002.7) (xyz.com/330 312), start Wed 1/16 15:15
alex vihlc522 /dev/pts/12 (v2002.7) (yxz.com/330 312), start Wed 1/16 15:15
Users of redhawk: (Total of 3 licenses issued; Total of 3 licenses in use)
"redhawk" v9999.99, vendor: apache
floating license
martin sinlc112 /dev/pts/9 (v2002.7) (xyz.com/330 220), start Mon 1/14 12:26
martin vihlc522 /dev/pts/12 (v2002.7) (xyz/330 312), start Wed 1/16 15:15
alex vihlc008 /dev/pts/10 (v2002.7) (xyz.com/330 198), start Mon 2/4 18:23
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Perl Tk , MainLoop, destroy function problem
by zentara (Archbishop) on Feb 19, 2013 at 13:27 UTC | |
by ghosh123 (Monk) on Feb 19, 2013 at 14:15 UTC | |
by ghosh123 (Monk) on Feb 20, 2013 at 13:29 UTC | |
by zentara (Archbishop) on Feb 21, 2013 at 12:18 UTC | |
by ghosh123 (Monk) on Feb 22, 2013 at 07:18 UTC | |
by zentara (Archbishop) on Feb 22, 2013 at 11:07 UTC | |
| |
Re: Perl Tk , MainLoop, destroy function problem
by zentara (Archbishop) on Feb 24, 2013 at 13:03 UTC |