Re^4: Perl Tk , MainLoop, destroy function problem

[ghosh123]

Hi

Thank you for your reply !
But still one more thing is not working, though I am following the cpan doc for HList. I have tried using both itemExists($entrypath,$col) and info(exists, $entrypath), but of no use.
The scenario is like :
The gui always has two columns , no issue on that. But first time the gui has one row, so entrypath 0 is added and I used itemCreate() to populate values.
Next time due to updation of the input file the gui should have some 3 rows with entirely new data. This time for entrypath 0 , the if(itemExists) returns true and I am using itemConfigure inside the if block. All fine so far. But next iteration for entrypath 1, itemExists should fail and I should be able to go to the else block to add() and itemCreate(), but I am not able to.
I am getting following error :

XS_Tk__Callback_Call error:Entry "1" not found at /user/perl_5.8.8/lib/Tk.pm line 250.
Tk::Error: Entry "1" not found at /opt/perl_5.8.8/lib/Tk.pm line 250.
Tk::Error:: Too many arguments.
Tk callback for .frame1.frame.hlist
Tk::After::repeat at /opt/perl_5.8.8/lib/Tk/After.pm line 79
[repeat,[{},after#12,5000,repeat,\&main::clear_data]]
[repeat,[{},after#12,5000,repeat,&main::clear_data]]: No match.
Here is the code snipppet which is not working

if($hl->itemExists($path,0)){
#if($hl->info(exists, $path)){ # tried both info and itemExist alterna
+tely, but :(
        print "itemexists ...\n";
    $hl->itemConfigure($path,0,-text=> $hash->{$user}->{$tool}->{tool}
+);
    $hl->itemConfigure($path,1,-text=> $hash->{$user}->{$tool}->{issue
+d})
;
    $hl->itemConfigure($path,2,-text=> $hash->{$user}->{$tool}->{inuse
+});

       $hl->itemConfigure($path,3,-text=> $hash->{$user}->{$tool}->{in
+use},
-style => $color);

        }
        else
        {
        print "Inside else ....\n";
        $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});

    $hl->itemCreate($path,3,-text=> $hash->{$user}->{$tool}->{inuse},
-style => $color);




        }

[zentara]

You didn't provide a complete code snippet which demonstrates your problem, but from your code it looks like you have the right concept. However, from the error message you provided, it says you have "too many arguments", and just from my intuition, I think the problem is that you say you have just 2 columns, yet you are trying to itemCreate 4 in your add($path).

Related to that, and I'm not sure about it, but if you know that you have 4 columns in your subsequent data, but only 1 initially, you may want to create that first row with 4 columns with the last 3 empty, thereby making available for itemConfigure. Otherwise, you will need to figure out how to change that entry from a 1 column to a 4 column path. I hope that makes sense.

Another possible problem is that you may be running into conflicts with your 2 timers. Where 1 timer is clearing out data while another is trying to write, but we don't see what your code is actually doing. Can you make a small running example with some fake data, that demonstrates your problem?

[ghosh123]

Hi
To explain you better, I am copy/pasting the entire snippet run on a small input file (info.txt). The info.txt content is following :

location usa age 22 phone 201
alex
location germany age 22 phone 202
alex
location france age 23 phone 101
martin

Above info.txt is having 3 sets of data (2 for alex and 1 for martin). To test the application , you have to first keep only one set of data for alex only, then you replace the file by the above one to see the "Entry '1' not found Error"

One apology, the regular expression is working fine for me. If it does not work for you, please correct it. I have kept the file content as simple as possible. Pardon me please on this.
One more thing is, I have kept an entry box above to let the user to set the frequency of refreshing the gui. How can I put that Entry box textvariable to the repeat function so that it picks it up. Default should be 5000.

Following is the code


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;
#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)->pa
+ck(-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();
my $timer1 = $mw->repeat(5000, \&clear_data);

MainLoop;

sub clear_data{
 print "Inside clear data \n";
 read_file();
my $path = 0;

for my $locationkey (sort keys %{$hash->{$user}}){
  _refreshData($path,$locationkey);
  $path++;
  }



  }


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});



}

[zentara]

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.