From: Stevan Little Date: Thu, 11 May 2006 17:48:26 +0000 (+0000) Subject: foo X-Git-Tag: 0_29_02~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=195f5bf802be0d32838ddb6077866a5951c1d918;hp=fd662d66ae039fddacc0593f1bf732fb843c3a19;p=gitmo%2FClass-MOP.git foo --- diff --git a/Changes b/Changes index 8847997..1586ebc 100644 --- a/Changes +++ b/Changes @@ -4,6 +4,7 @@ Revision history for Perl extension Class-MOP. * Class::MOP::Class - anon-classes are now properly garbage collected - added tests for this + - improved method modifier wrapping * Class::MOP::Instance - added new instance protocol diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 111e20f..c66bb05 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -337,23 +337,22 @@ sub add_method { my $method = $self->get_method($method_name); # if we dont have local ... unless ($method) { - # make sure this method even exists ... - ($self->find_next_method_by_name($method_name)) + # try to find the next method + $method = $self->find_next_method_by_name($method_name); + # die if it does not exist + (defined $method) || confess "The method '$method_name' is not found in the inherience hierarchy for this class"; - # if so, then create a local which just - # calls the next applicable method ... - $self->add_method($method_name => sub { - $self->find_next_method_by_name($method_name)->(@_); - }); - $method = $self->get_method($method_name); - } - - # now make sure we wrap it properly - # (if it isnt already) - unless ($method->isa('Class::MOP::Method::Wrapped')) { + # and now make sure to wrap it + # even if it is already wrapped + # because we need a new sub ref $method = Class::MOP::Method::Wrapped->wrap($method); - $self->add_method($method_name => $method); - } + } + else { + # now make sure we wrap it properly + $method = Class::MOP::Method::Wrapped->wrap($method) + unless $method->isa('Class::MOP::Method::Wrapped'); + } + $self->add_method($method_name => $method); return $method; }; diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index 8b3c2b4..c07895d 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -141,6 +141,12 @@ sub wrap { $method; } +sub get_original_method { + my $code = shift; + $MODIFIERS{$code}->{orig} + if exists $MODIFIERS{$code}; +} + sub add_before_modifier { my $code = shift; my $modifier = shift; @@ -269,6 +275,8 @@ This simply blesses the C<&code> reference passed to it. This simply blesses the C<&code> reference passed to it. +=item B + =back =head2 Modifiers diff --git a/t/017_add_method_modifier.t b/t/017_add_method_modifier.t index 7ac25f6..646c396 100644 --- a/t/017_add_method_modifier.t +++ b/t/017_add_method_modifier.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 17; +use Test::More tests => 20; use Test::Exception; BEGIN { @@ -63,6 +63,8 @@ BEGIN { }); ::ok(CheckingAccount->meta->has_method('withdraw'), '... checking account now has a withdraw method'); + ::isa_ok(CheckingAccount->meta->get_method('withdraw'), 'Class::MOP::Method::Wrapped'); + ::isa_ok(BankAccount->meta->get_method('withdraw'), 'Class::MOP::Method'); } @@ -74,6 +76,10 @@ lives_ok { $savings_account->withdraw(50); } '... withdrew from savings successfully'; is($savings_account->balance, 200, '... got the right savings balance after withdrawl'); +dies_ok { + $savings_account->withdraw(250); +} '... could not withdraw from savings successfully'; + $savings_account->deposit(150); is($savings_account->balance, 350, '... got the right savings balance after deposit');