sub add_override_method_modifier {
my ($self, $name, $method, $_super_package) = @_;
+
(!$self->has_method($name))
|| confess "Cannot add an override method if a local method is already present";
- # need this for roles ...
- $_super_package ||= $self->name;
- my $super = $self->find_next_method_by_name($name);
- (defined $super)
- || confess "You cannot override '$name' because it has no super method";
- $self->add_method($name => Moose::Meta::Method::Overriden->wrap(sub {
- my @args = @_;
- no warnings 'redefine';
- if ($Moose::SUPER_SLOT{$_super_package}) {
- local *{$Moose::SUPER_SLOT{$_super_package}} = sub { $super->body->(@args) };
- return $method->(@args);
- } else {
- confess "Trying to call override modifier'd method without super()";
- }
- }));
+
+ $self->add_method($name => Moose::Meta::Method::Overriden->new(
+ override => $method,
+ class => $self,
+ package => $_super_package, # need this for roles
+ name => $name,
+ ));
}
sub add_augment_method_modifier {
use base 'Moose::Meta::Method';
+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 $_super_package = $args{package} || $args{class}->name;
+
+ my $name = $args{name};
+
+ my $super = $args{class}->find_next_method_by_name($name);
+
+ (defined $super)
+ || confess "You cannot override '$name' because it has no super method";
+
+ my $super_body = $super->body;
+
+ my $method = $args{override};
+
+ 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()";
+ }
+ };
+
+ # FIXME store additional attrs
+ $class->wrap($body);
+}
+
1;
__END__
=head1 DESCRIPTION
-This is primarily used to tag methods created with the C<override> keyword. It
-is currently just a subclass of L<Moose::Meta::Method>.
+This class implements method overriding logic for the L<Moose> C<override> keyword.
+
+This involves setting up C<super> for the overriding body, and dispatching to
+the correct parent method upon its invocation.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new>
-Later releases will likely encapsulate the C<super> behavior of overriden methods,
-rather than that being the responsibility of the class. But this is low priority
-for now.
+=back
=head1 BUGS
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=cut
\ No newline at end of file
+=cut