Tk::Error that I do not understand.

rbc has asked for the wisdom of the Perl Monks concerning the following question:

Oh most wise Monks I am a cursed with this problem.

I am creating tags in a Tk::Text widget.
I create tags for phone numbers and tag
for dates. When the user clicks on a
tagged phone number, the phone number gets
added to the 1st column of a table.
When the user clicks on a tagged date a menu
pops up and the user can choose to insert the
the date to the 2nd column or the 3rd column.

I have a sub routine, addToTable, that inserts the
phone numbers and dates into the table.

The problem is that when the user clicks
on a date and chooses 2nd or 3rd I get this message ...

Tk::Error: Not an ARRAY reference at ./tagMenu.pl line 32, <DATA> chun
+k 20.
 [\&main::addToTable,10/10/2002,1,[[(790)555-5555,,],[,,],[,,],[,,],[,
+,],[,,],[,,],[,,],[,,],[,,]],{}]
 (menu invoke)
[download]

... It is really strange because I don't get that message
when I click on the phone number !?!?!?!?

I suspect I am doing something wrong.
Please take a look at my code and help me out ... please :)

#!/cygdrive/c/PERL/BIN/perl -w

use strict;
use Tk;
use Tk::ROText;
use Tk::Table;
use constant COLS => 3;


my @TAGS = ();
my @tableArray = (
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
    \( 1..COLS ),
);

sub addToTable {
    my $rotext     = shift;
    my $data    = shift;
    my $col        = shift;
    my $tArrRef     = shift;
    my $tWidget     = shift;

    for( my $row=0; $row<10; $row++ ) {
        my $v = $tArrRef->[$row][$col];
        if( length( $v ) == 0 ) {
            $tArrRef->[$row][$col] = $data;
            $tWidget->get($row, $col)->configure( -background => 'yell
+ow' );
            last;
        }
    }
}

### build GUI
my $top     = MainWindow->new();
my $rotext     = $top->ROText()->pack();
my $table     = $top->Scrolled( "Table",  
                -scrollbars     => 'e',    
                -columns     => COLS, 
                -rows         => 3)->pack();

for( my $row=0; $row<10; $row++ ) {
    for( my $col=0; $col<COLS; $col++ ) {
        my $widget = $table->Entry( -textvar => \$tableArray[$row][$co
+l]);
        $table->put( $row, $col, $widget );
        $tableArray[$row][$col] = '';
    }
}
### End build GUI

### read data and put in tags
my $Lines = 1;
while(<DATA>) {
    my @dates = ( /\d\d\/\d\d\/\d\d\d\d/g );
    if( $#dates > -1 ) {
        foreach my $date ( @dates ) {
            my $d = quotemeta( $date );
            my (@notPh) = split /$d/;
            for ( my $i=0; $i<$#dates+1; $i++ ) {
                my $notph = $notPh[$i];
                my $rec = {};
                my $s = length( $notph );
                my $e = length( $date );
                $rec->{'start'} = $Lines . "." . $s;
                $rec->{'end'}   = $Lines . "." . ($s + $e);
                $rec->{'name'} = $d;
                $rec->{'column'} = 0;
                my $menu = $rotext->Menu();
                $menu->add( 'command', -label => "2nd col",
            -command => [\&addToTable, $date, 1, \@tableArray, $table 
+]);
                $menu->add( 'command', -label => "3rd col",
            -command => [\&addToTable, $date, 2, \@tableArray, $table 
+]);
$rec->{'script'} = [sub { shift; shift->Post(@_);}, $menu, Ev('X'), Ev
+('Y')];
                push( @TAGS, $rec );
            }
        }
    }

    my @phNumbers = ( /\(\d\d\d\)\d\d\d-\d\d\d\d/g );
    if( $#phNumbers > -1 ) {
        foreach my $ph ( @phNumbers ) {
            my $p = quotemeta( $ph );
            my (@notPh) = split /$p/;
            for ( my $i=0; $i<$#phNumbers+1; $i++ ) {
                my $notph = $notPh[$i];
                my $rec = {};
                my $s = length( $notph );
                my $e = length( $ph );
                $rec->{'start'} = $Lines . "." . $s;
                $rec->{'end'}   = $Lines . "." . ($s + $e);
                $rec->{'name'} = $ph;
                $rec->{'column'} = 0;
                $rec->{'script'} = [\&addToTable, $ph, 0, \@tableArray
+, $table ];
                push( @TAGS, $rec );
            }
            
        }
    }

    $rotext->insert( 'end', $_ );
    $Lines++;
}

foreach my $tag( @TAGS ) {
    print "$tag->{'start'} $tag->{'end'} $tag->{'name'}\n";

    $rotext->tagAdd($tag->{'name'}, $tag->{'start'}, $tag->{'end'});
    $rotext->tagBind($tag->{'name'}, '<ButtonRelease-1>', $tag->{'scri
+pt'} );
    $rotext->tagConfigure( $tag->{'name'}, -underline => 1 );
}
MainLoop;

__DATA__
Blah blah blah balh balh
Blah 10/10/2002 blah balh balh
Blah blah blah balh balh
Blah blah blah balh balh
Blah blah blah balh balh
Blah blah blah balh balh
Blah blah blah balh balh
Blah blah ummmm .... blah balh balh
stinky dinky 10/12/1999 poo
kdsjflkjf saklfjadlkfj sdkfjaslf askfjsalf
Blah blah blah balh balh
Blah 10/10/2002 blah balh balh
Blah blah blah balh balh
Blah blah blah balh balh
Blah (790)555-5555 blah blah balh balh
Blah blah blah balh balh
Blah blah blah balh balh
Blah blah ummmm .... blah balh balh
stinky dinky 10/12/1999 poo
kdsjflkjf saklfjadlkfj sdkfjaslf askfjsalf
[download]

Comment on Tk::Error that I do not understand. Select or Download Code

Replies are listed 'Best First'.
Re: Tk::Error that I do not understand. by gellyfish (Monsignor) on Feb 17, 2002 at 09:48 UTC
my @tableArray = ( \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), \( 1..COLS ), ); Surely you meant : `my @tableArray = ( [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], );` [download] /J\	[reply] [d/l]
Re: Re: Tk::Error that I do not understand. by IlyaM (Parson) on Feb 17, 2002 at 10:29 UTC
Slightly shorter version of this code `my @tableArray = ( map [ 1..COLS ], 1 .. 10 );` [download] -- Ilya Martynov (http://martynov.org/)	[reply] [d/l]
Re: Re: Tk::Error that I do not understand. by rbc (Curate) on Feb 17, 2002 at 23:27 UTC
Surely you missed the point of my post. Why am I get the Tk::Error? But your stylistic critique is appreciated :)	[reply]
Re: Tk::Error that I do not understand. by BeernuT (Pilgrim) on Feb 18, 2002 at 03:03 UTC
ok. I want you to add this to your code. at the top add `use diagnostics;` [download] you probably ment to have this instead `my @tableArray = ( [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ], [ 1..COLS ] );` [download] so go ahead and change that also. Now were going to add a few lines of debugging code. `sub addToTable { foreach (@_) { print "$_\n"; } print "elements passed " . scaler(@_) ."\n";` [download] Now go ahead and run your script. This should then show you that when you click on a phone number it is passing 5 elements to the sub. And when you click on the date it will tell you that you only passed 4. Because your sub is setup to take the correct amount of args when you click on the phone number it is causing your data to be one element off when clicking on the phone number. I'm not sure what exactly is causing it, but I'll keep playing with it. But this should give you a good idea on where to start since its your code :) -bn	[reply] [d/l] [select]
Re: Re: Tk::Error that I do not understand. by rbc (Curate) on Feb 18, 2002 at 17:31 UTC
Thanks BeernuT! That helps. I changed my code like so ... `$menu->add( 'command', -label => "2nd col", -command => [\&addToTable,'filler',$date, 1, \@tableArray, +$table]); $menu->add( 'command', -label => "3rd col", -command => [\&addToTable,'filler',$date, 2, \@tableArray, +$table ]);` [download] ... I don't really understand why I have to put in the extra parameter ('filler'), but what the heck it works! Thanks again!	[reply] [d/l]