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
-
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.