What is the cleanest way to duplicate base/parent.pm's functionality for non-object perl modules?
I'm not thinking too clearly right now and possibly overlooking something simple. I've been thinking about this for a while and been searching, but can't really think of any sensible search queries anymore that would lead me to what i seek.
In short, I'm wondering how to do module inheritance, in the way base.pm/parent.pm do it for object-oriented modules; only for Exporter-based modules.
A hypothetical example of what i mean:
Here's our script. It originally loaded Foo.pm and called baz() from it, but baz() has a terrible bug (as we'll soon see), so we're using Local/Patched/Foo.pm now which should fix the bug. We're doing this, because in this hypothetical case we cannot change Foo (it is a cpan module under active development, you see), and it is huge (seriously).
#!/usr/bin/perl
# use Foo qw( baz [... 100 more functions here ...] );
use Local::Patched::Foo qw( baz [... 100 more functions here ...] );
baz();
Here's Foo.pm. As you can see, it exports baz(), which calls qux, which has a terrible bug, causing things to crash. We want to keep baz and the rest of Foo.pm though, without doing a ton of copy-paste, especially since they might change later on, due to Foo still being in development.
package Foo;
use parent 'Exporter';
our @EXPORT = qw( baz [... 100 more functions here ...] );
sub baz { qux(); }
sub qux { print 1/0; } # !!!!!!!!!!!!!
[... 100 more functions here ...]
1;
Lastly, since Fo开发者_如何学运维o.pm is used in MANY places, we do not want to use Sub::Exporter, as that would mean copy-pasting a bandaid fix to all those many places. Instead we're trying to create a new module that acts and looks like Foo.pm, and indeed loads 99% of its functionality still from Foo.pm and just replaces the ugly qux sub with a better one.
What follows is what such a thing would look like if Foo.pm was object-oriented:
package Local::Patched::Foo;
use parent 'Foo';
sub qux { print 2; }
1;
Now this obviously will not work in our current case, since parent.pm just doesn't do this kinda thing.
Is there a clean and simple method to write Local/Patched/Foo.pm (using any applicable CPAN modules) in a way that would work, short of copying Foo.pm's function namespace manually?
If it's one subroutine you want to override, you can do some monkey patching:
*Foo::qux = \&fixed_qux;
I'm not sure if this is the cleanest or best solution, but for a temporary stopgap until upstream fixes the bug in qux
, it should do.
Just adding in yet another way to monkey-patch Foo
's qux
function, this one without any manual typeglob manipulation.
package Local::Patched::Foo;
use Foo (); # load but import nothing
sub Foo::qux {
print "good qux";
}
This works because Perl's packages are always mutable, and so long as the above code appears after loading Foo.pm
, it will override the existing baz
routine. You might also need no warnings 'redefine';
to silence any warnings.
Then to use it:
use Local::Patched::Foo;
use Foo qw( baz );
baz(); # calls the patched qux() routine
You could do away with the two use
lines by writing a custom import method in Local::Patched::Foo
as follows:
# in the Local::Patched::Foo package:
sub import {
return unless @_; # return if no imports
splice @_, 0, 1, 'Foo'; # change 'Local::Patched::Foo' to 'Foo'
goto &{ Foo->can('import') }; # jump to Foo's import method
}
And then it is just:
use Local::Patched::Foo qw( baz );
baz(); # calls the patched qux()
Rather than hijacking Alexandr's answer (which was correct, but incomplete), here's a solution under separate copy:
package Foo;
use Exporter 'import';
our @EXPORT = qw(foo bar baz qux);
our %EXPORT_TAGS = (
'all' => [ qw(foo bar baz qux) ],
'all_without_qux' => [ qw(foo bar baz) ],
);
sub foo { 'foo' }
sub bar { 'bar' }
sub baz { 'baz' }
sub qux { 'qux' }
1;
package Foo::Patched;
use Foo qw(:all_without_qux);
use Exporter 'import';
our @EXPORT = qw( foo bar baz qux );
sub qux { 'patched qux' }
1;
package main;
use Foo::Patched;
print qux();
You can also use Foo;
in your program, as long as you use it before Foo::Patched
, or you will overwrite the patched qux with the original broken version.
There are a few morals here (at least they are IMHO):
- don't export into the caller's namespace without being explicitly told to (i.e. keep
@EXPORT
empty, and use@EXPORT_OK
and%EXPORT_TAGS
to allow the caller to specify exactly what they want. Or alternatively, don't export at all, and use fully-qualified names for all library functions. - Write your libraries so that the functions are called OO-style:
Foo->function
rather thanFoo::function
. This makes it much easier to override a function by using the standarduse base
syntax we all know and love, without having to mess around with monkeypatching symbol tables or manipulating exporter lists.
One approach is to simply replace the sub reference. if you can install it, use the Sub::Override CPAN module. Absent that, this will do:
package Local::Patched::Foo;
use Exporter;
sub baz { print "GOOD baz!\n" };
sub import() {
*Foo::baz = \&Local::Patched::Foo::baz;
}
1;
package Local::Patched::Foo;
use Foo qw/:all_without_qux/; #see Exporter docs for tags or just list all functions
use Exporter 'import'; #modern way
our @EXPORT = qw( baz [... 100 more functions here ...] qux);
sub qux { print 2; }
1;
I would suggest that you replace the offending file.
mkdir Something
cp Something.pm Something/Legacy.pm # ( or /Old.pm or /Bad.pm )
And then go in to that file and edit the package line:
package Something::Legacy;
Then you have a place to step in front of the legacy code. Create a new Something.pm and get all it's exports:
use Something::Legacy qw<:all>;
our @EXPORT = @Something::Legacy::EXPORT;
our @EXPORT_OK = @Something::Legacy::EXPORT_OK;
our %EXPORT_TAGS = %Something::Legacy::EXPORT_TAGS;
After you have all that in your current package, just re-implement the sub.
sub bad_thing { ... }
Anything your legacy code that calls Something::do_something
will be calling the old code via the new module. Any legacy code calling Something::bad_thing
will be calling the new code.
As well, you can manipulate *Something::Legacy
in other ways. If your code does not uses a local call, you're going to have to clobber &Something::Legacy::bad_thing
.
my $old_bad_thing = \&Something::Legacy::bad_thing;
*Something::Legacy::bad_thing = \&bad_thing;
Thus bad_thing
is still allowed to use that behavior, if desired:
sub bad_thing {
...
eval {
$old_bad_thing->( @_ );
};
unless ( $EVAL_ERROR =~ /$hinky_message/ ) {
...
}
...
}
精彩评论