From: Yuval Kogman Date: Wed, 16 Apr 2008 00:54:37 +0000 (+0000) Subject: inner() and super() no longer increment sub_generation under 5.8. Refactored Moose... X-Git-Tag: 0_55~221 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3f9e4b0a1ec1bd784d87282849b3d1e27e9be283;p=gitmo%2FMoose.git inner() and super() no longer increment sub_generation under 5.8. Refactored Moose::Meta::Method::Augmented out of Moose::Meta::Class --- diff --git a/lib/Moose.pm b/lib/Moose.pm index f1a3708..75fa8bb 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -13,6 +13,7 @@ use Sub::Name 'subname'; use Sub::Exporter; +use MRO::Compat; use Class::MOP; use Moose::Meta::Class; @@ -135,13 +136,12 @@ use Moose::Util (); }; }, super => sub { - { - our %SUPER_SLOT; - no strict 'refs'; - $SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"}; - } - return subname 'Moose::super' => sub { }; + # FIXME can be made into goto, might break caller() for existing code + return subname 'Moose::super' => sub { return unless our $SUPER_BODY; $SUPER_BODY->(our @SUPER_ARGS) } }, + #next => sub { + # return subname 'Moose::next' => sub { @_ = our @SUPER_ARGS; goto \&next::method }; + #}, override => sub { my $class = $CALLER; return subname 'Moose::override' => sub ($&) { @@ -150,12 +150,19 @@ use Moose::Util (); }; }, inner => sub { - { - our %INNER_SLOT; - no strict 'refs'; - $INNER_SLOT{$CALLER} = \*{"${CALLER}::inner"}; - } - return subname 'Moose::inner' => sub { }; + return subname 'Moose::inner' => sub { + my $pkg = caller(); + our ( %INNER_BODY, %INNER_ARGS ); + + if ( my $body = $INNER_BODY{$pkg} ) { + my @args = @{ $INNER_ARGS{$pkg} }; + local $INNER_ARGS{$pkg}; + local $INNER_BODY{$pkg}; + return $body->(@args); + } else { + return; + } + }; }, augment => sub { my $class = $CALLER; diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 6c34121..f15c8e1 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -13,6 +13,7 @@ our $VERSION = '0.21'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; +use Moose::Meta::Method::Augmented; use base 'Class::MOP::Class'; @@ -229,10 +230,10 @@ sub add_override_method_modifier { || confess "Cannot add an override method if a local method is already present"; $self->add_method($name => Moose::Meta::Method::Overriden->new( - override => $method, - class => $self, - package => $_super_package, # need this for roles - name => $name, + method => $method, + class => $self, + package => $_super_package, # need this for roles + name => $name, )); } @@ -240,34 +241,12 @@ sub add_augment_method_modifier { my ($self, $name, $method) = @_; (!$self->has_method($name)) || confess "Cannot add an augment method if a local method is already present"; - my $super = $self->find_next_method_by_name($name); - (defined $super) - || confess "You cannot augment '$name' because it has no super method"; - my $_super_package = $super->package_name; - # BUT!,... if this is an overriden method .... - if ($super->isa('Moose::Meta::Method::Overriden')) { - # we need to be sure that we actually - # find the next method, which is not - # an 'override' method, the reason is - # that an 'override' method will not - # be the one calling inner() - my $real_super = $self->_find_next_method_by_name_which_is_not_overridden($name); - $_super_package = $real_super->package_name; - } - $self->add_method($name => sub { - my @args = @_; - no warnings 'redefine'; - if ($Moose::INNER_SLOT{$_super_package}) { - local *{$Moose::INNER_SLOT{$_super_package}} = sub { - local *{$Moose::INNER_SLOT{$_super_package}} = sub {}; - $method->(@args); - }; - return $super->body->(@args); - } - else { - return $super->body->(@args); - } - }); + + $self->add_method($name => Moose::Meta::Method::Augmented->new( + method => $method, + class => $self, + name => $name, + )); } ## Private Utility methods ... diff --git a/lib/Moose/Meta/Method/Augmented.pm b/lib/Moose/Meta/Method/Augmented.pm new file mode 100644 index 0000000..18e43ef --- /dev/null +++ b/lib/Moose/Meta/Method/Augmented.pm @@ -0,0 +1,103 @@ +package Moose::Meta::Method::Augmented; + +use strict; +use warnings; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +use base 'Moose::Meta::Method'; + +use Sub::Name; + +use Carp qw(confess); + +sub new { + my ( $class, %args ) = @_; + + # the package can be overridden by roles + # it is really more like body's compilation stash + # this is where we need to override the definition of super() so that the + # body of the code can call the right overridden version + my $name = $args{name}; + my $meta = $args{class}; + + my $super = $meta->find_next_method_by_name($name); + + (defined $super) + || confess "You cannot augment '$name' because it has no super method"; + + my $_super_package = $super->package_name; + # BUT!,... if this is an overriden method .... + if ($super->isa('Moose::Meta::Method::Overriden')) { + # we need to be sure that we actually + # find the next method, which is not + # an 'override' method, the reason is + # that an 'override' method will not + # be the one calling inner() + my $real_super = $meta->_find_next_method_by_name_which_is_not_overridden($name); + $_super_package = $real_super->package_name; + } + + my $super_body = $super->body; + + my $method = $args{method}; + + my $body = sub { + local $Moose::INNER_ARGS{$_super_package} = [ @_ ]; + local $Moose::INNER_BODY{$_super_package} = $method; + $super_body->(@_); + }; + + # FIXME store additional attrs + $class->wrap($body); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Moose::Meta::Method::Augmented - A Moose Method metaclass for augmented methods + +=head1 DESCRIPTION + +This class implements method augmenting logic for the L C keyword. + +This involves setting up C for the superclass body, and dispatching to +the superclass from the normal body. + +The subclass definition (the augmentation itself) will be invoked explicitly +using the C keyword from the parent class's method definition. + +=head1 METHODS + +=over 4 + +=item B + +=back + +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Stevan Little Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/Moose/Meta/Method/Overriden.pm b/lib/Moose/Meta/Method/Overriden.pm index ef831dd..12bae38 100644 --- a/lib/Moose/Meta/Method/Overriden.pm +++ b/lib/Moose/Meta/Method/Overriden.pm @@ -8,6 +8,8 @@ our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method'; +use Sub::Name; + use Carp qw(confess); sub new { @@ -28,20 +30,17 @@ sub new { my $super_body = $super->body; - my $method = $args{override}; + my $method = $args{method}; my $body = sub { - my @args = @_; - if ($Moose::SUPER_SLOT{$_super_package}) { - no warnings 'redefine'; - # FIXME goto() to prevent additional stack frame? - local *{$Moose::SUPER_SLOT{$_super_package}} = sub { $super_body->(@args) }; - return $method->(@args); - } else { - confess "Trying to call override modifier'd method without super()"; - } + local @Moose::SUPER_ARGS = @_; + local $Moose::SUPER_BODY = $super_body; + return $method->(@_); }; + # FIXME do we need this make sure this works for next::method? + # subname "${_super_package}::${name}", $method; + # FIXME store additional attrs $class->wrap($body); } diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 6908b76..062de31 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -101,14 +101,13 @@ use Moose::Util::TypeConstraints; $meta->add_around_method_modifier($_, $code) for @_; }; }, + # see Moose.pm for discussion super => sub { - { - no strict 'refs'; - $Moose::SUPER_SLOT{$CALLER} = \*{"${CALLER}::super"}; - } - my $meta = _find_meta(); - return subname 'Moose::Role::super' => sub {}; + return subname 'Moose::Role::super' => sub { return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS) } }, + #next => sub { + # return subname 'Moose::Role::next' => sub { @_ = @Moose::SUPER_ARGS; goto \&next::method }; + #}, override => sub { my $meta = _find_meta(); return subname 'Moose::Role::override' => sub ($&) {