Subject: | build_subs() redefine "fix" breaks subclass method overriding |
The check for $self->can($field) in build_subs() breaks subclassing.
Consider...
package Business::OnlinePayment::Foo;
use base qw(Business::OnlinePayment);
sub test_transaction {
my $self = shift;
my $is_test = shift;
print "This is a test!\n" if $is_test;
$self->SUPER::test_transaction;
}
Because the subclass has already defined test_transaction() and because
build_subs() is called with an object of the subclass it will not
generate test_transaction() for BOP. It thinks it already exists.
This also reveals a bug/feature in build_subs(). It is called for each
subclass apparently with the intention of generating subroutines in the
subclass but it instead generates methods in BOP. Thus it only needs to
be called once when BOP loads and once again for each of the data accessors.
The attached patch...
* Tests that accessors can be overriden
* Calls build_subs() once when BOP is loaded with the default fields
rather than every time new() is called.
* Similarly does not call build_subs() with the default fields for each
FraudDetect instance
* Reimplements build_subs() using closures rather than eval. This is
easier to maintain and uses less memory (thus no temptation to use
AUTOLOAD).
A side effect of that last bit means that build_subs() will gladly make
a method called "-key". Contrary to what bop.t says, you can have
subroutines named pretty much anything if you jam it into the symbol
table yourself. Up to you if you want to keep this "feature". But it
does cause bop.t to fail.
$ perl -wle '*{"-foo"} = sub { 42 }; $meth = "-foo"; print main->$meth()'
42
Subject: | bop.patch |
=== OnlinePayment.pm
==================================================================
--- OnlinePayment.pm (revision 19625)
+++ OnlinePayment.pm (local)
@@ -10,6 +10,8 @@
$VERSION = '3.00_04';
$VERSION = eval $VERSION; # modperlstyle: convert the string into a number
+my $Class = __PACKAGE__;
+
my %fields = (
authorization => undef,
error_message => undef,
@@ -27,6 +29,7 @@
transaction_type => undef,
);
+$Class->build_subs(keys %fields);
sub new {
my($class,$processor,%data) = @_;
@@ -40,7 +43,6 @@
}
my $self = bless {processor => $processor}, $subclass;
- $self->build_subs(keys %fields);
if($self->can("set_defaults")) {
$self->set_defaults();
@@ -107,7 +109,6 @@
$@ =~ m/^Can\'t locate/;
} else {
my $risk_tx = bless ( { processor => $fraud_detection } , $subclass );
- $risk_tx->build_subs(keys %fields);
if ($risk_tx->can('set_defaults')) {
$risk_tx->set_defaults();
}
@@ -179,14 +180,23 @@
return $dump;
}
-# didnt use AUTOLOAD because Net::SSLeay::AUTOLOAD passes right to
-# AutoLoader::AUTOLOAD, instead of passing up the chain
+
sub build_subs {
my $self = shift;
- foreach(@_) {
- next if($self->can($_));
- eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }";
+ foreach my $method (@_) {
+ next if $Class->can($method);
+
+ my $code = sub {
+ my $self = shift;
+ if (@_) {
+ $self->{$method} = shift;
+ }
+ return $self->{$method};
+ };
+
+ no strict 'refs';
+ *{$Class . "::" . $method} = $code;
}
}
=== t/override.t
==================================================================
--- t/override.t (revision 19625)
+++ t/override.t (local)
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 2;
+
+{ # fake test driver (with submit method)
+
+ package Business::OnlinePayment::MOCK;
+ use strict;
+ use warnings;
+ use base qw(Business::OnlinePayment);
+ sub test_transaction {
+ my $self = shift;
+ return $self->SUPER::test_transaction(@_);
+ }
+}
+
+$INC{"Business/OnlinePayment/MOCK.pm"} = "testing";
+
+my $tx = Business::OnlinePayment->new("MOCK");
+is eval {
+ $tx->test_transaction(1);
+ $tx->test_transaction;
+}, 1;
+is $@, '';