X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=dfbce2402b9831e2db78fdf2fae4f3a86fcf11bb;hb=768804c030095d21c5f83cdb63756a3275c242a9;hp=bfcbaa0ae85e67c01fa00c713b8d325389fbb6d8;hpb=85bd3f44fbee036b39fedb1e2ca2b566c1a6d08f;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index bfcbaa0..dfbce24 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -397,8 +397,8 @@ sub add_after_method_modifier { sub add_override_method_modifier { my ($self, $name, $code) = @_; - if($self->has_method($name)){ - $self->throw_error("Cannot add an override method if a local method is already present"); + if($self->has_method($name)){ + $self->throw_error("Cannot add an override method if a local method is already present"); } my $package = $self->name; @@ -416,6 +416,26 @@ sub add_override_method_modifier { return; } +sub add_augment_method_modifier { + my ($self, $name, $code) = @_; + if($self->has_method($name)){ + $self->throw_error("Cannot add an augment method if a local method is already present"); + } + + my $super = $self->find_method_by_name($name) + or $self->throw_error("You cannot augment '$name' because it has no super method"); + + my $super_package = $super->package_name; + my $super_body = $super->body; + + $self->add_method($name => sub{ + local $Mouse::INNER_BODY{$super_package} = $code; + local $Mouse::INNER_ARGS{$super_package} = [@_]; + $super_body->(@_); + }); + return; +} + sub does_role { my ($self, $role_name) = @_;