Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Perl Tk , MainLoop, destroy function problem

by ghosh123 (Monk)
on Feb 19, 2013 at 12:05 UTC ( [id://1019534]=perlquestion: print w/replies, xml ) Need Help??

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

    It is very bad to use a while loop and/or sleep() in any GUI program, as it interferes with the GUI's event loop. That is why you get a window only when you comment the outer while loop.

    Your code is seriously messed up, and needs a pretty major rewrite to get it working. As a start, you need to remove your while loops and use timers to get your 1 second and 5 second intervals to work with the GUI.

    Finally, the Hlist has an internal path counter, and instead of destroying the existing Hlist for the next update, you should reconfigure the existing Hlist paths. Your idea to destroy and recreate the Hlist for updates will almost certainly lead to unwanted memory gains in the process.

    So, without me wasting all fff'ing morning on this, here is a general guide as to setup your program. I left out the rebuilding of the HList for now, until you can load your data successfully.... as you can see from the $1 $2 $3 printouts, your regex is broken.

    See ztkdb for how to handle an Hlist.

    #!/usr/bin/perl use Tk; use Tk::HList; use Tk::ItemStyle; use Data::Dumper; my $user = $ARGV[0] || 'alex'; 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); $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'); open_report(); my $timer = $mw->repeat(1000, \&open_report); # my $timer1 = $mw->repeat(5000, \&clear_data); MainLoop; sub clear_data{ # fix your loading data problem first, before # worrying about clearing out the Hlist # you will probably get a memory gain unless you # reuse the Hlist, so don't try to destroy the Hlist # but just reconfigure the existing paths } sub open_report{ open(FP, "< 1report"); while(<FP>){ if(/^Users of (\w+):\s+\(Total of ([0-9]+) licenses issued;\s+Total +of ([0-9]+) (licenses|license) in use/) { ($tool,$issued,$use) = ($1,$2,$3); print "$1 $2 $3\n"; } if (/^\s+$user(.*)/){ $hash->{$user}->{$tool}->{tool} = $tool; $hash->{$user}->{$tool}->{issued} = $issued; $hash->{$user}->{$tool}->{inuse} = $use; print "2\n"; } } print "3\n"; close(FP); print Dumper($hash); my $path = 0; for my $toolkey (sort keys %{$hash->{$user}}){ _insertData($path,$toolkey); $path++; } # sleep 5; #not working # NEVER USE SLEEP IN A GUI !!!!!! # $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); }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      Thanks a lot for replying. I will try with that clear_data() and get back to you.

      Hi zentara,

      I need a help regarding configuring this hlist.
      The _insertData() is working for the first time, but next
      time when it gets invoked thru repeat(),
      I am getting the following error :
      XS_Tk__Callback_Call error:element "0" already exists at /opt/perl_5.8.8/lib/Tk.pm line 250.

      I ma stuck here, please help. Not able to figure ou from the tar files you sent me.

        Hi, Yes I know the problem and it is why I mentioned to you the fact that Hlist maintains an internal counter that can't ( as far as I know ) be changed. In essence what it means is that once you itemCreate a path 0 ( or 1,2,3 etc) it is always maintained inside the Hlist. So if you delete path 0 ( or which ever path you please ) you cannot itemCreate it again, you can only itemConfigure it. You can get the number of paths in the Hlist by using my @entries = $h->info('children');

        Here is a simple example which shows all the methods fairly clearly.

        #!/usr/bin/perl use strict; use Tk; use Tk::HList; my $mw = MainWindow->new(); #create some sample data my %data; foreach (0..100) { $data{$_}{'name'} = 'name'.$_; $data{$_}{'id'} = rand(time); } #get random list of keys my @keys = keys %data; ################# my $h = $mw->Scrolled( 'HList', -header => 1, -columns => 2, -width => 30, -height => 60, -takefocus => 1, -background => 'steelblue', -foreground =>'snow', -selectmode => 'single', -selectforeground => 'pink', -selectbackground => 'black', # -browsecmd => \&browseThis, )->pack(-side => "left", -anchor => "n"); my $nameh = $h->header('create', 0, -text => ' Name ', -borderwidth => 3, -headerbackground => 'steelblue', -relief => 'raised'); my $idh = $h->header('create', 1, -text => ' ID ', -borderwidth => 3, -headerbackground => 'lightsteelblue', -relief => 'raised'); foreach (@keys) { my $e = $h->addchild(""); #will add at end $h->itemCreate ($e, 0, -itemtype => 'text', -text => $data{$_}{'name'}, ); $h->itemCreate($e, 1, -itemtype => 'text', -text => $data{$_}{'id'}, ); } my $button = $mw->Button(-text => 'exit', -command => sub{exit})->pack; my $sortid = $mw->Button(-text => 'Sort by Id', -command => [\&sort_me,1] )->pack; MainLoop; ######################################################### sub sort_me{ my $col = shift; my @entries = $h->info('children'); my @to_be_sorted =(); foreach my $entry(@entries){ push @to_be_sorted, [ $h->itemCget($entry,0,'text'), $h->itemCget($entry,1,'text') ]; } my @sorted = sort{ $a->[$col] cmp $b->[$col] } @to_be_sorted; my $entry = 0; foreach my $aref (@sorted){ # print $aref->[0],' ',$aref->[1],"\n"; $h->itemConfigure( $entry, 0, 'text' => $aref->[0] ); $h->itemConfigure( $entry, 1, 'text' => $aref->[1] ); $entry++; } $mw->update; }

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
Re: Perl Tk , MainLoop, destroy function problem
by zentara (Archbishop) on Feb 24, 2013 at 13:03 UTC
    Hi again, I realize you are a beginner at this gui business, so in lieu of trying to solve your logic problem with the code as you have written it, I would like to suggest to you an alternative program flow structure, which would be cleaner.

    You don't need 5 subs to do the refresh, where you have clear_data(), _refreshdata(), read_file(), open_report(), and finally _insertData().

    You can more easily do it in one sub called refresh(), which is called by the timer. Now in my code flow, refresh() will read the file, then just insert the data in its appropriate $path. You will need a few tests in there, requiring that if the $path already exists, you will reconfigure that path; and if the path dosn't exist, then an addpath is used. It should all be done in 1 sub for maintaining easy flow.

    Also 1 final point, you don't distinquish between users in the rows. You data seems to have multiple users, and I would have the user as the data in the first column, where you put it in a label above the Hlist. But it's your code, and you know what needs to be done.

    #!/usr/bin/perl use Tk; use Tk::HList; use Tk::ItemStyle; use Data::Dumper; my $user = $ARGV[0] || 'alex'; my $hash = {}; my ($location,$age,$use,$vendor,$feature); my $sec = 5000; #default value #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(-side => 'left', -anch +or => 'nw',-padx => 0); $userframe->Label(-text => "Set time")->pack(-side => 'left',-anchor = +> 'w',-padx => 0); my $frequency = $userframe->Entry(-width=>5,-textvariable=> \$sec) ->pack(-side => 'left',-anchor => 'nw',-padx => 0); my $hlistframe = $mw->Frame()->pack(-fill => 'both', -expand => 1); $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 => "location", -anchor => 'w'); $hl->headerCreate(0,-itemtype => 'window',-widget => $label1); my $label3 = $hl->Label(-text => "Age", -anchor => 'w'); $hl->headerCreate(1,-itemtype => 'window',-widget => $label3); my $label4 = $hl->Label(-text => "phone", -anchor => 'w'); $hl->headerCreate(2,-itemtype => 'window',-widget => $label4); refresh(); # called to start the first refresh # the timer is now at the end of the refresh() sub MainLoop; sub refresh { # 1 here you read the file # 2 do your regexes # 3 test to see how many paths you have thru info('children') # 4 reconfigure the existing paths with new data # 5 if new paths are needed add them, if you have too many # existing paths, hide them # finally call it again later # make a lower bound for timer # in case your user sets $sec to 0 if( $sec < 1000){ $sec = 1000 } $mw->after( $sec, \&refresh); }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2024-04-16 13:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found