From: Yuval Kogman <nothingmuch@woobling.org>
Date: Sun, 13 Apr 2008 13:45:24 +0000 (+0000)
Subject: Move the override logic into Method::Override
X-Git-Tag: 0_55~227
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=18c2ec0e78877a01cbaf330c44a5817fd790dc7d;p=gitmo%2FMoose.git

Move the override logic into Method::Override
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 68ffa24..6c34121 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -224,23 +224,16 @@ sub add_attribute {
 
 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 {
diff --git a/lib/Moose/Meta/Method/Overriden.pm b/lib/Moose/Meta/Method/Overriden.pm
index b99660e..ef831dd 100644
--- a/lib/Moose/Meta/Method/Overriden.pm
+++ b/lib/Moose/Meta/Method/Overriden.pm
@@ -8,6 +8,44 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 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__
@@ -20,12 +58,18 @@ Moose::Meta::Method::Overriden - A Moose Method metaclass for overriden methods
 
 =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
 
@@ -46,4 +90,4 @@ L<http://www.iinteractive.com>
 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