Yep. This is truly an amazing feature of Perl.

I once did a similar thing with an IRC robot. It had various handlers that were triggered based on regexps matching things passing in a channel.

Without taking down the bot, I could edit the code of a particular handler on the server, and then connect to the channel, send a sekret™ private message to the bot, which would instruct it to reload the handler code, save the old code onto an array of coderefs attached to the trigger regexp, and install the new code in its place.

If the code failed to evaluate, it wouldn't get installed. If the new code ran for a while and I didn't like what it did, I could send another message to tell the bot to throw away the new version of the code and reinstate the version N-1.

I thought it was incredibly cool to be able to undo code changes, and have always kept it in the back of my mind hoping I'd be able to put it to use in Real Life sometime.

That is exactly what our code does. The ruby guys in my office were going on about how this is such a well covered tactic in their world. I wasn't out to prove them wrong, I just needed the equivalent functionality. I'm glad I found it.

This looks pretty slick.

I'd probably put some more abstraction into the interface of the loader function. Also, you shouldn't need two steps to create a backup and install a new sub.

#!/usr/bin/perl

package test_package;

use strict;
use warnings;

sub new { return bless {}; }

sub test_function { print "Original test_function! $_[1]\n"; }

sub loader {
    my $self         = shift;
    my $override     = shift; # Name of function to override.
    my $new_function = shift; # code ref to install

    my $backup; # keep a code ref of the original here.

    local @_;
    eval {
        no strict 'refs';
        no warnings 'redefine';

        die "Can't override non-existant function $override\n"
            unless exists &{$override};
        
        $backup = \&{$override};
        *{$override} = $new_function;
    };
    
    if ( $@ ) {
        warn "ERROR: $@\n" if ( $@ );
        $backup = undef;
    }

    return $backup;
}

package main;

use strict;
use warnings;

my $counter = 0;

my $f = new test_package();

$f->test_function($counter++); # 1

my $newsub =  sub { print "New output! $_[1]+\n"; 1 };

# Replace function, get backup in return.
my $backup = $f->loader( 'test_package::test_function', $newsub );

$f->test_function($counter++);

# Restore function.
$f->loader( "test_package::test_function", $backup);
$f->test_function($counter++);

my $faked =$f->loader( "test_package::fake_function", $newsub );
warn "Unable to override function" unless $faked;


#$f->fake_function( 'Fake');  # program will die
[download]

If you specifically want to focus on overriding and restoring functions, you could actually use your object to store the names of overridden functions and their original code refs. Then your code could look like this:

$f->override( 'test::function', sub { print 'foo' } );
# Do your testing;
$f->restore( 'test::function' );
[download]

Update: You might also want to look at Sub::Installer.