http://qs321.pair.com?node_id=244634

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

Monks of honor: I've come to realize that Tk does have some limitations that I need to know how to get around. I have a button that leads to a command:
my $button_submit = $lf->Button( -text => 'Search', -command => \&get_data )->pack(qw//);


This works perfectly to build a button but once I'm in the subroutine, I no longer can use the Tk command configure to update other fields. This is necessary. My program works so that it takes the information from a field when you click the button, searches a database for a match and returns the matching row. (to make a long story short)

What I really need to do is find out some way to use the configure command for Tk inside that subroutine or know how to make a button in which I can save a varriable (like below but note: this does not work.
my @info; my $button_submit = $lf->Button( -text => 'Search', -command => \@info = \&get_data )->pack(qw//);


In case anyone is wondering, below is posted the error I get when I try to run the command. (inside the subroutine)
$varname->configure(-textvariable => 'helloo');


The Error Message:
Tk::Error: Can't call method "configure" on an undefined value at disp +atch.pl li ne 158. [\&main::__ANON__] Tk callback for .frame.button Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 228 Tk::Button::butUp at C:/Perl/site/lib/Tk/Button.pm line 111 (command bound to event)

Replies are listed 'Best First'.
Re: Tk/Perl Command
by pg (Canon) on Mar 20, 2003 at 18:13 UTC
    Tk has limitations, but not this one;-).

    In this case, you have to pass the widget into your sub. For example:
    #!/usr/bin/perl use Tk; use strict; use constant BUTTON_WIDTH => 20; my $mw = new MainWindow(title => "demo"); my $button = $mw->Button(text => "color", width => BUTTON_WIDTH) ->pack; $mw->Button(text => "red", width => BUTTON_WIDTH, command => sub {change_color($button, "red")}) ->pack; $mw->Button(text => "green", width => BUTTON_WIDTH, command => sub {change_color($button, "green")}) ->pack; MainLoop; sub change_color { my ($widget, $color) = @_; $widget->configure(background => $color); }
      I agree with "pg", pass the references of your widgets to subroutines...in fact, that's how tk programs become more modular, so you're not playing around with global vars everywhere. You only need to pass the reference of a widget and a subroutine has access (via configure) to all of its' properties and methods. Chris
      That's what I was looking for, I still have some problems as I shouldn't be using textvarriable I now see and I had my button too high up in my script to be catching the code. Thanks again!
Re: Tk/Perl Command
by hiseldl (Priest) on Mar 20, 2003 at 18:02 UTC

    Try passing your array as a ref to your sub:

    my @info; my $button_submit = $lf->Button( -text => 'Search', -command => [\&get_data, \@info], )->pack(qw//);
    ...this should pass the \@info ref into your get_data sub. You can also add your Tk widget as another parameter and call configure on that ref.
    my @info; my $button_submit = $lf->Button( -text => 'Search', -command => [\&get_data, \@info, $TkWidget], )->pack(qw//); ... sub get_data { my ($info_ref, $tkwidget_ref) = @_; # add/delete/modify elements of $info_ref # call configure on the widget $tkwidget_ref->configure(...); }

    This is the method I use when I want to modify a data structure using a callback.

    --
    hiseldl
    What time is it? It's Camel Time!

Re: Tk/Perl Command
by Courage (Parson) on Mar 20, 2003 at 17:10 UTC
    Looks like you confused a bit.
    Actually what you 'retrying to do should certainly work, but you did some small mistakes in your code and in your understanding.

    Look at some samples of codes.

    Also it looks like you should do

    $button_submit->configure(-text => 'helloo');
    Your "$varname" is really not defined, as Perl explains to you.

    Also remember that you have a method $widget->update; to redraw your GUI at a moment to reflect your current changes.

    Courage, the Cowardly Dog

      In think you misunderstood me. I don't want the text on the button to change but I actually have a whole hash of Entry Boxes that need to have their information updated. Second, the varname was just an example. posted below is my current code (w/o the extra subroutines to save space)
      se strict; use Tk 800.00; use Mysql; require Tk::Frame; require Tk::TextUndo; require Tk::Text; require Tk::Scrollbar; require Tk::Menu; require Tk::Menubutton; require Tk::Adjuster; require Tk::DialogBox; # Main Window my $mw = new MainWindow; $mw->geometry('800x600'); # Frames Setup my $lf = $mw->Frame->pack(qw/-side left -fill y/); my $rf = $mw->Frame->pack(qw/-side right -fill y/); # Menu Bar Setup my $mb = $mw->Menu(-menuitems => &menubar_menuitems() ); $mw->configure(-menu => $mb); $mw->title("INSCO Inventory Control"); #Set Up Serial Query Information my $label_input = $lf->Label(-text=>'Serial Number: ',)->pack(qw/-si +de top/); my $tf_serial = $lf->Entry(-width=>30)->pack(qw/-side top/); my $label_space = $lf->Label(-text=>'',)->pack(qw/-side top/); my $returned = "";
      Right here is where I'm working.
      ##Set up query button my @info; my $button_submit = $lf->Button( -text => 'Search', -command => my \@info = \&get_data )->pack(qw//); print $info[1]; #Set Up Client Information my %field; my @names = (qw/tf_po tf_client tf_contact tf_phone tf_email tf_addres +s tf_city tf_state tf_zip tf_id tf_model/); my @sizes = ( 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30); my @labls = ("PO:", "Client:", "Contact:", "Contact Phone Number:", "C +ontact Email Address:", "Contact Post Address:", "", "" , "", "Client + Specified ID", "Model"); my @pos = (1,2,3,4,5,6,7,8,9,10,11); foreach (@names) { my $position = shift(@pos); $field{$_}{txvar} = ''; $field{$_}{label} = $rf->Label( -text => shift( @labls )) ->grid(-row => '$position', -col => '0', ); $field{$_}{entry} = $rf->Entry( -width => shift( @sizes ), -textvariable => '', )->grid(-row => '$position', -col => '2', ); } # Start the main event loop MainLoop; sub get_data { my $entered = $tf_serial->get; my $dbh = Mysql->connect("host", "database", "username", "******** +") or die("Could Not Connect To Server"); my $query = qq~SELECT * FROM inventory WHERE serial='$entered'~; my $sth = $dbh->query($query); my @arr = $sth->fetchrow; return(@arr); }