Oh, you were so close! But I see now what I did wrong.
Bringing the function refs from Orig into Repl is only part of the solution. But that still fails if one of the original functions calls another. Say orig() calls repl(). Even though orig() reference has been copied into package Repl and gets called from Repl, the orig() code still belongs to package Orig. When it executes, it will call Orig::repl() not the new Repl::repl() we just worked so hard to replace. I discovered this problem in my original post (after I posted of course).
The other part of the solution is to replace the references in package Orig for any replaced functions in package Repl to ensure that when they get called, they execute the replaced function, not the original.
# note: adjusted @EXPORT_OK in place of @EXPORT
package Orig;
use Exporter;
use vars qw( @ISA @EXPORT_OK );
@ISA = qw(Exporter);
@EXPORT_OK = qw( orig repl );
sub orig {
print "&Orig::orig runs\n";
repl(); # this will not call the replaced repl() without help
}
sub repl { print "&Orig::repl runs (O No!)\n" }
1;
package Repl;
use warnings;
use strict;
# don't run in BEGIN blocks or we won't know what functions
# we have defined
use Orig;
use Exporter;
use vars qw( @ISA @EXPORT_OK);
@ISA = qw(Exporter);
for ( @Orig::EXPORT_OK) {
no strict 'refs';
# check if we redefine this function
# maybe it might not hurt to check for a function ref?
if (${"Repl::"}{$_}) {
# yes, save a SUPER:: copy so we can call it later
*{"SUPER::" . $_} = \&{"Orig::". $_};
# now replace the original function with our new one
no warnings 'redefine';
*{"Orig::" . $_} = \&$_;
}
else {
#
*{$_} = \&{"Orig::". $_};
}
}
@EXPORT_OK = ( qw( newfunc ), @Orig::EXPORT_OK );
# no warnings 'redefine' - not required here as we didn't import it;
sub repl {
print "&Repl::repl runs $/";
# finish with our original
SUPER::repl();
}
sub newfunc { print "&Repl::newfunc runs $/"; }
1;
|