Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on

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

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


In reply to Perl Tk , MainLoop, destroy function problem by ghosh123

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?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2024-04-24 23:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found