Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Redefine the sub of a subref?

by aplonis (Pilgrim)
on Feb 04, 2017 at 14:01 UTC ( #1181091=perlquestion: print w/replies, xml ) Need Help??

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

Suppose I have a sub...

sub foo { print 'Foo!' )

...which I embed into some other sub as a ref...

\&foo

How might I manage to later redefine the action of &foo, such that when &foo gets called via its original ref, the new action is done, not the old?

The reason is that I have two actions to alternate between, depending upon something else. And whether or not this is the best way, I'd still like to know how to do it this way. That is, if it can be done at all. TIA

Replies are listed 'Best First'.
Re: Redefine the sub of a subref?
by Corion (Pope) on Feb 04, 2017 at 14:08 UTC

    Don't "embed" the subroutine in the first place, but make it a parameter (or a global variable if you must).

    I assume you have something like this:

    sub foo { print 'Foo!' }; sub bar { my( $output ) = @_; $output->(); }; bar( \&foo );

    If you want to change what bar() does, change its calling site:

    sub foo1 { print 'Foo! One' }; sub foo2 { print 'Foo! Two' }; bar( \&foo1 ); bar( \&foo2 );

    If you really, really want the action at a distance, use a global variable:

    sub foo1 { print 'Foo! One' }; sub foo2 { print 'Foo! Two' }; use vars '$output'; sub bar { $output->(); }; local $output = \&foo1; bar(); local $output = \&foo2; bar();

    If you really, really, really feel that what you want to do is to override foo on a completely global level, you can do the following, but know that I consider this a practice last resort which might be incredibly useful but if you control the source code of foo and bar, while cute this practice will lead to hard to understand control flow:

    sub foo { print 'Foo!' }; sub bar { foo(); }; bar(); { local *foo = sub { print 'Foo! reloaded!'; }; bar(); }
Re: Redefine the sub of a subref?
by haukex (Chancellor) on Feb 04, 2017 at 14:13 UTC

    Hi aplonis,

    Sounds like this might be a case for coderefs:

    my $foo = sub { print "Foo\n"; }; my $bar = sub { print "Bar\n"; }; my $x = $foo; $x->(); # prints "Foo" $x = $bar; $x->(); # prints "Bar"

    Or, perhaps the same with a dispatch table:

    my %code = ( foo => sub { print "Foo\n"; }, bar => sub { print "Bar\n"; }, ); $code{foo}(); # prints "Foo" $code{bar}(); # prints "Bar"

    Update: Combining that with Corion's excellent post:

    sub bar { my( $output ) = @_; $output->(); } my $foo1 = sub { print "Foo\n"; }; my $foo2 = sub { print "Bar\n"; }; bar( $foo1 ); # prints "Foo" bar( $foo2 ); # prints "Bar"

    Hope this helps,
    -- Hauke D

      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 Tk::EasyGUI.pm 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?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1181091]
Approved by haukex
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (9)
As of 2019-07-19 12:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?