in reply to Re^6: Perl Tk , MainLoop, destroy function problem
in thread Perl Tk , MainLoop, destroy function problem

Hi, first the easy problem, making the timer variable. You can do this by making your timer a 1 shot timer which reinstalls itself at the end of each clear_data run. To use a -textvariable as a control, you have to watch out that the user dosn't change the $sec to 0, which would mess up the timer and cause an error. So I set it that $sec cannot go below 1000. It might be good to use a Spinbox to allow the user to set $sec only to allowed values.

Here is the code.

#!/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); open_report(); $mw->after( $sec, \&clear_data); MainLoop; sub clear_data{ #print "Inside clear data \n"; read_file(); my $path = 0; for my $locationkey (sort keys %{$hash->{$user}}){ print "clear_data $locationkey\n"; _refreshData($path,$locationkey); $path++; } # make a lower bound for timer # in case your user sets $sec to 0 if( $sec < 1000){ $sec = 1000 } # reinstall 1 shot timer for another run $mw->after( $sec, \&clear_data); } sub _refreshData{ my $path = shift; my $location = shift; print "Inside refreshdata $path | $location \n"; my $availbl = $hash->{$user}->{$location}->{age}; my $chk = $hash->{$user}->{$location}->{phone}; if($hl->itemExists($path,0)){ #if($hl->info(exists, $path)){ print "itemexists ...\n"; $hl->itemConfigure($path,0,-text=> $hash->{$user}->{$location}->{l +ocation}); $hl->itemConfigure($path,1,-text=> $hash->{$user}->{$location}->{a +ge}); $hl->itemConfigure($path,2,-text=> $hash->{$user}->{$location}->{p +hone}); } else { print "Inside else ....\n"; $hl->add($path); $hl->itemCreate($path,0,-text=> $hash->{$user}->{$location}->{loca +tion}); $hl->itemCreate($path,1,-text=> $hash->{$user}->{$location}->{age} +); $hl->itemCreate($path,2,-text=> $hash->{$user}->{$location}->{phon +e}); } } sub read_file { print "Inside read file \n"; open(FP, "< info.txt"); while(<FP>){ if(/location (\w+) age (\d+) phone (\d+)/){ ($location,$age,$use) = ($1,$2,$3); print "$1 $2 $3\n"; } if (/^$user\s*/){ $hash->{$user}->{$location}->{location} = $location; $hash->{$user}->{$location}->{age} = $age; $hash->{$user}->{$location}->{phone} = $use; } } close(FP); } sub open_report{ read_file(); my $path = 0; for my $locationkey (sort keys %{$hash->{$user}}){ _insertData($path,$locationkey); $path++; } } sub _insertData { print "Inside insertdata\n"; my $path = shift; my $location = shift; print "Inside insertdata $path | $location \n"; $hl->add($path); $hl->itemCreate($path,0,-text=> $hash->{$user}->{$location}->{loca +tion}); $hl->itemCreate($path,1,-text=> $hash->{$user}->{$location}->{age} +); $hl->itemCreate($path,2,-text=> $hash->{$user}->{$location}->{phon +e}); }
Your logic problem is not quite so easy, and since you are not paying for this, I feel like it isn't my responsibility to sort out your logic, I prefer to let my mind rest on Saturday. :-) But, I will point out where and what your problem is. Here is the debug output I get after following your instructions about swapping in the new info.txt.
$$ ./1020153.pl Inside read file usa 22 201 Inside insertdata Inside insertdata 0 | usa Inside read file usa 22 201 clear_data usa Inside refreshdata 0 | usa itemexists ... Inside read file usa 22 201 clear_data usa Inside refreshdata 0 | usa itemexists ... Inside read file usa 22 201 germany 22 202 france 23 101 clear_data germany Inside refreshdata 0 | germany itemexists ... clear_data usa Inside refreshdata 1 | usa XS_Tk__Callback_Call error:Entry "1" not found at /usr/lib/perl5/site_ +perl/5.14.1/x86_64-linux-thread-multi/Tk.pm line 251. Tk::Error: Entry "1" not found at /usr/lib/perl5/site_perl/5.14.1/x86_ +64-linux-thread-multi/Tk.pm line 251. Tk callback for .frame1.frame.hlist Tk::After::repeat at /usr/lib/perl5/site_perl/5.14.1/x86_64-linux-thr +ead-multi/Tk/After.pm line 80 [repeat,[{},after#13,5000,repeat,[\&main::clear_data]]] ("after" script) ^C
As you can see if you closely look at it, when it starts it clears_data for usa fine, but after I switch in the full file, indicated by the lines
Inside read file usa 22 201 germany 22 202 france 23 101 clear_data germany Inside refreshdata 0 | germany itemexists ... clear_data usa Inside refreshdata 1 | usa XS_Tk__Callback_Call error:Entry "1" not found at /usr/lib/perl5/site_ +perl/5.14.1/x86_64-linux-thread-multi/Tk.pm line 251.
After the full file is read, you clear_data for germany instead of usa, which what would be expected.

Like I said, it strains my mind to try to figure out someone else's spaghetti logic. Either I can spend all Saturday trying to debug that glitch, or you can, and guess what, I'm going to take a nap. :-)

If you really want to learn, you can run the code thru the ptkdb Tk debugger. There are many tutorials on ptkdb, just google for them. Good luck.


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