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 );
[download]

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 );
[download]

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();
[download]

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();
}
[download]

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"
[download]

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"
[download]

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"
[download]

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 ();
}
[download]