Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Re^2: Redefine the sub of a subref?

by aplonis (Pilgrim)
on Feb 05, 2017 at 03:34 UTC ( #1181120=note: print w/replies, xml ) Need Help??

in reply to Re: Redefine the sub of a subref?
in thread Redefine the sub of a subref?

Thank you both for those. I sure wouldn't have thought of either of those. I'll check them out later. Meanwhile, I also stubmled on this. It too seems to work.

What the whole thing's about is that I have a DBI script with a Tk GUI. And that GUI... Well, it's one that auto-self-builds from a non-CPAN module named which I wrote myself ten years ago. Meanwhile, I've done almost no Perl. And so, while I could still use it, and the GUI itself still worked great, I just couldn't seem to figure out what, quite exactly, was window/frame/sub-frame/pane/label/button reference to redefine -bind on. Which I needed to do so as to re-purpose a pair of buttons to each do two different things, depending on context. Hours I spent scratching my head, and then gave up. So then I decided, how much simpler it would be if only I could just redefine, dending on context, the subref which was the original callback for -bind on the auto-self-built GUI. Hence my call to gurus for help. And I do thank you. I'll try those out. Meanwhile, though, I managed to cobble this bit together, and thought maybe it might be worth adding into the thread.

So my Tk has two buttons, X and Y. Normally they call DBI searches on date (X) or keyword (Y). But having called a search on keyword by pressing Y, I wanted the buttons for X to select, and Y to scroll to next. And to do it only while in a search on keyword, since that is the only one which can give plural rows. This is how, I made them do that (at least for now). Your other ways given are likely better, but this works for now.

my $sql = "SELECT this, that, the_other FROM table WHERE foo = $bar"; my @rows; my $sth; my $ratchet_counter = 1; if ( $sth = $dbh->prepare($sql) ) { $sth->execute(); while ( @rows = $sth->fetchrow_array() ) { # Load in new values from current row. ( $this, $that, $the_other) = @rows; # Redefine button subs temporarily. local *callback_X = sub { ++$ratchet_counter; }; # User wan +ting next row. local *callback_Y = sub { $ratchet_counter = 0; }; # User cho +osing current row. $mw->waitVariable(\$ratchet_counter); # User mak +ing choice of show-next or keep-this. last if 0 == $rows_ratchet_index; # User made choice. } } else { $wgt->{'frame'}->{'entry'} = qq|Oops! $DBI::errstr!|; return (); }

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1181120]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (7)
As of 2019-07-24 08:47 GMT
Find Nodes?
    Voting Booth?
    If you were the first to set foot on the Moon, what would be your epigram?

    Results (32 votes). Check out past polls.