From: gfx <gfuji@cpan.org>
Date: Sun, 4 Oct 2009 07:23:45 +0000 (+0900)
Subject: Implement augment/inner
X-Git-Tag: 0.37_02~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=768804c030095d21c5f83cdb63756a3275c242a9;p=gitmo%2FMouse.git

Implement augment/inner
---

diff --git a/lib/Mouse.pm b/lib/Mouse.pm
index 68808b8..f213eae 100644
--- a/lib/Mouse.pm
+++ b/lib/Mouse.pm
@@ -96,8 +96,26 @@ sub override {
     Mouse::Meta::Class->initialize(scalar caller)->add_override_method_modifier(@_);
 }
 
-sub inner  { not_supported }
-sub augment{ not_supported }
+our %INNER_BODY;
+our %INNER_ARGS;
+
+sub inner {
+    my $pkg = caller();
+    if ( my $body = $INNER_BODY{$pkg} ) {
+        my $args = $INNER_ARGS{$pkg};
+        local $INNER_ARGS{$pkg};
+        local $INNER_BODY{$pkg};
+        return $body->(@{$args});
+    }
+    else {
+        return;
+    }
+}
+
+sub augment {
+    #my($name, $method) = @_;
+    Mouse::Meta::Class->initialize(scalar caller)->add_augment_method_modifier(@_);
+}
 
 sub init_meta {
     shift;
@@ -466,3 +484,4 @@ under the same terms as Perl itself.
 
 =cut
 
+                
\ No newline at end of file
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) = @_;