more-roles

[gitmo/Moose.git] / lib / Moose / Meta / Role.pm

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 3eb9ef3..3b938cd 100644 (file)
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -7,6 +7,7 @@ use metaclass;
 
 use Carp         'confess';
 use Scalar::Util 'blessed';
+use B            'svref_2object';
 
 use Moose::Meta::Class;
 
@@ -131,6 +132,11 @@ sub add_required_methods {
     $self->get_required_methods_map->{$_} = undef foreach @methods;
 }
 
+sub remove_required_methods {
+    my ($self, @methods) = @_;
+    delete $self->get_required_methods_map->{$_} foreach @methods;
+}
+
 sub get_required_method_list {
     my ($self) = @_;
     keys %{$self->get_required_methods_map};
@@ -144,7 +150,7 @@ sub requires_method {
 sub _clean_up_required_methods {
     my $self = shift;
     foreach my $method ($self->get_required_method_list) {
-        delete $self->get_required_methods_map->{$method}
+        $self->remove_required_methods($method)
             if $self->has_method($method);
     } 
 }
@@ -217,7 +223,15 @@ sub _add_method_modifier {
     my $accessor = "get_${modifier_type}_method_modifiers_map";
     $self->$accessor->{$method_name} = [] 
         unless exists $self->$accessor->{$method_name};
-    push @{$self->$accessor->{$method_name}} => $method;
+    my $modifiers = $self->$accessor->{$method_name};
+    # NOTE:
+    # check to see that we aren't adding the 
+    # same code twice. We err in favor of the 
+    # first on here, this may not be as expected
+    foreach my $modifier (@{$modifiers}) {
+        return if $modifier == $method;
+    }
+    push @{$modifiers} => $method;
 }
 
 sub add_override_method_modifier {
@@ -275,7 +289,7 @@ sub apply {
 #    warn "... Checking " . $self->name . " for excluded methods";
     foreach my $excluded_role_name ($self->get_excluded_roles_list) {
 #        warn "... Checking if '$excluded_role_name' is done by " . $other->name . " for " . $self->name;
-        if ($other->does_role($excluded_role_name)) { # || $self->does_role($excluded_role_name) 
+        if ($other->does_role($excluded_role_name)) { 
             confess "The class " . $other->name . " does the excluded role '$excluded_role_name'";
         }
         else {
@@ -306,6 +320,27 @@ sub apply {
                         "to be implemented by '" . $other->name . "'";
             }
         }
+        else {
+            # NOTE:
+            # we need to make sure that the method is 
+            # not a method modifier, because those do 
+            # not satisfy the requirements ...
+            my $method = $other->get_method($required_method_name);
+            # check if it is an override or a generated accessor ..
+            (!$method->isa('Moose::Meta::Method::Overriden') &&
+             !$method->isa('Class::MOP::Attribute::Accessor'))
+                || confess "'" . $self->name . "' requires the method '$required_method_name' " . 
+                           "to be implemented by '" . $other->name . "', the method is only a method modifier";
+            # before/after/around methods are a little trickier
+            # since we wrap the original local method (if applicable)
+            # so we need to check if the original wrapped method is 
+            # from the same package, and not a wrap of the super method 
+            if ($method->isa('Class::MOP::Method::Wrapped')) {
+                ($method->get_original_method->package_name eq $other->name)
+                    || confess "'" . $self->name . "' requires the method '$required_method_name' " . 
+                               "to be implemented by '" . $other->name . "', the method is only a method modifier";            
+            }
+        }
     }       
     
     foreach my $attribute_name ($self->get_attribute_list) {
@@ -344,7 +379,9 @@ sub apply {
     
     foreach my $method_name ($self->get_method_list) {
         # it if it has one already
-        if ($other->has_method($method_name)) {
+        if ($other->has_method($method_name) &&
+            # and if they are not the same thing ...
+            $other->get_method($method_name) != $self->get_method($method_name)) {
             # see if we are composing into a role
             if ($other->isa('Moose::Meta::Role')) { 
                 # method conflicts between roles result 
@@ -399,26 +436,30 @@ sub apply {
                 # if we are a role, we need to make sure 
                 # we dont have a conflict with the role 
                 # we are composing into
-                if ($other->has_override_method_modifier($method_name)) {
+                if ($other->has_override_method_modifier($method_name) &&
+                    $other->get_override_method_modifier($method_name) != $self->get_override_method_modifier($method_name)) {
                     confess "Role '" . $self->name . "' has encountered an 'override' method conflict " . 
                             "during composition (Two 'override' methods of the same name encountered). " . 
                             "This is fatal error.";
                 }
-                else {
+                else {   
+                    # if there is no conflict,
+                    # just add it to the role  
                     $other->add_override_method_modifier(
-                        $method_name,
-                        $self->get_override_method_modifier($method_name),
-                        $self->name
+                        $method_name, 
+                        $self->get_override_method_modifier($method_name)
                     );                    
                 }
             }
             else {
+                # if this is not a role, then we need to 
+                # find the original package of the method
+                # so that we can tell the class were to 
+                # find the right super() method
+                my $method = $self->get_override_method_modifier($method_name);
+                my $package = svref_2object($method)->GV->STASH->NAME;
                 # if it is a class, we just add it
-                $other->add_override_method_modifier(
-                    $method_name,
-                    $self->get_override_method_modifier($method_name),
-                    $self->name
-                );
+                $other->add_override_method_modifier($method_name, $method, $package);
             }
         }
     }    
@@ -567,6 +608,8 @@ probably not that much really).
 
 =item B<add_required_methods>
 
+=item B<remove_required_methods>
+
 =item B<get_required_method_list>
 
 =item B<get_required_methods_map>