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