Skip Menu |

This queue is for tickets about the Business-OnlinePayment CPAN distribution.

Report information
The Basics
Id: 22073
Status: resolved
Priority: 0/
Queue: Business-OnlinePayment

People
Owner: ivan-pause [...] 420.am
Requestors: mschwern [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: (no value)
Fixed in:
  • 3.03
  • 3.03_02



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 $@, '';
pushed to git, will be in 3.03