| Moose documentation | Contained in the Moose distribution. |
Moose::Meta::Method::Augmented - A Moose Method metaclass for augmented methods
This class implements method augmentation logic for the Moose
augment keyword.
The augmentation subroutine reference will be invoked explicitly using
the inner keyword from the parent class's method definition.
Moose::Meta::Method::Augmented is a subclass of Moose::Meta::Method.
This constructs a new object. It accepts the following options:
The metaclass object for the class in which the augmentation is being declared. This option is required.
The name of the method which we are augmenting. This method must exist in one of the class's superclasses. This option is required.
The subroutine reference which implements the augmentation. This option is required.
See BUGS in Moose for details on reporting bugs.
Yuval Kogman <nothingmuch@cpan.org>
Copyright 2006-2010 by Infinity Interactive, Inc.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Moose documentation | Contained in the Moose distribution. |
package Moose::Meta::Method::Augmented; use strict; use warnings; our $VERSION = '0.99'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method'; 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) || $meta->throw_error("You cannot augment '$name' because it has no super method", data => $name); my $_super_package = $super->package_name; # BUT!,... if this is an overridden method .... if ($super->isa('Moose::Meta::Method::Overridden')) { # 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, package_name => $meta->name, name => $name ); } 1; __END__