composition and the role model are now decoupled
Stevan Little [Sun, 30 Dec 2007 20:16:01 +0000 (20:16 +0000)]
lib/Moose/Meta/Role.pm
lib/Moose/Meta/Role/Application.pm
lib/Moose/Meta/Role/Application/ToClass.pm
lib/Moose/Meta/Role/Application/ToInstance.pm
lib/Moose/Meta/Role/Application/ToRole.pm
t/030_roles/021_role_composite_exlcusion.t

index 60a9727..ef60f78 100644 (file)
@@ -349,56 +349,28 @@ sub alias_method {
     $self->add_package_symbol("&${method_name}" => $body);
 }
 
-sub reset_package_cache_flag  { () }
-sub update_package_cache_flag { () }
+#sub reset_package_cache_flag  { () }
+#sub update_package_cache_flag { () }
 
 ## ------------------------------------------------------------------
 ## role construction
 ## ------------------------------------------------------------------
 
-my $anon_counter = 0;
-
 sub apply {
     my ($self, $other) = @_;
-
-    unless ($other->isa('Moose::Meta::Class') || $other->isa('Moose::Meta::Role')) {
-
-        # Runtime Role mixins
-
-        # FIXME:
-        # We really should do this better, and
-        # cache the results of our efforts so
-        # that we don't need to repeat them.
-
-        my $pkg_name = __PACKAGE__ . "::__RUNTIME_ROLE_ANON_CLASS__::" . $anon_counter++;
-        eval "package " . $pkg_name . "; our \$VERSION = '0.00';";
-        die $@ if $@;
-
-        my $object = $other;
-
-        $other = Moose::Meta::Class->initialize($pkg_name);
-        $other->superclasses(blessed($object));
-
-        bless $object => $pkg_name;
-    }
-
-    $self->_check_excluded_roles($other);
-    $self->_check_required_methods($other);
-
-    $self->_apply_attributes($other);
-    $self->_apply_methods($other);
-
-    # NOTE:
-    # we need a clear cache flag too ...
-    $other->reset_package_cache_flag;
-
-    $self->_apply_override_method_modifiers($other);
     
-    $self->_apply_before_method_modifiers($other);
-    $self->_apply_around_method_modifiers($other);
-    $self->_apply_after_method_modifiers($other);
-
-    $other->add_role($self);
+    if ($other->isa('Moose::Meta::Role')) {
+        require Moose::Meta::Role::Application::ToRole;
+        return Moose::Meta::Role::Application::ToRole->new->apply($self, $other);
+    }
+    elsif ($other->isa('Moose::Meta::Class')) {
+        require Moose::Meta::Role::Application::ToClass;
+        return Moose::Meta::Role::Application::ToClass->new->apply($self, $other);
+    }  
+    else {
+        require Moose::Meta::Role::Application::ToInstance;
+        return Moose::Meta::Role::Application::ToInstance->new->apply($self, $other);        
+    }  
 }
 
 sub combine {
@@ -412,224 +384,6 @@ sub combine {
     return $c;
 }
 
-## ------------------------------------------------------------------
-
-## applying a role to a class ...
-
-sub _check_excluded_roles {
-    my ($self, $other) = @_;
-    if ($other->excludes_role($self->name)) {
-        confess "Conflict detected: " . $other->name . " excludes role '" . $self->name . "'";
-    }
-    foreach my $excluded_role_name ($self->get_excluded_roles_list) {
-        if ($other->does_role($excluded_role_name)) {
-            confess "The class " . $other->name . " does the excluded role '$excluded_role_name'";
-        }
-        else {
-            if ($other->isa('Moose::Meta::Role')) {
-                $other->add_excluded_roles($excluded_role_name);
-            }
-            # else -> ignore it :)
-        }
-    }
-}
-
-sub _check_required_methods {
-    my ($self, $other) = @_;
-    # NOTE:
-    # we might need to move this down below the
-    # the attributes so that we can require any
-    # attribute accessors. However I am thinking
-    # that maybe those are somehow exempt from
-    # the require methods stuff.
-    foreach my $required_method_name ($self->get_required_method_list) {
-
-        unless ($other->find_method_by_name($required_method_name)) {
-            if ($other->isa('Moose::Meta::Role')) {
-                $other->add_required_methods($required_method_name);
-            }
-            else {
-                confess "'" . $self->name . "' requires the method '$required_method_name' " .
-                        "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->find_method_by_name($required_method_name);
-
-            # check if it is a generated accessor ...
-            (!$method->isa('Class::MOP::Method::Accessor'))
-                || confess "'" . $self->name . "' requires the method '$required_method_name' " .
-                           "to be implemented by '" . $other->name . "', the method is only an attribute accessor";
-
-            # NOTE:
-            # All other tests here have been removed, they were tests
-            # for overriden methods and before/after/around modifiers.
-            # But we realized that for classes any overriden or modified
-            # methods would be backed by a real method of that name
-            # (and therefore meet the requirement). And for roles, the
-            # overriden and modified methods are "in statis" and so would
-            # not show up in this test anyway (and as a side-effect they
-            # would not fufill the requirement, which is exactly what we
-            # want them to do anyway).
-            # - SL
-        }
-    }
-}
-
-sub _apply_attributes {
-    my ($self, $other) = @_;
-    foreach my $attribute_name ($self->get_attribute_list) {
-        # it if it has one already
-        if ($other->has_attribute($attribute_name) &&
-            # make sure we haven't seen this one already too
-            $other->get_attribute($attribute_name) != $self->get_attribute($attribute_name)) {
-            # see if we are being composed
-            # into a role or not
-            if ($other->isa('Moose::Meta::Role')) {
-                # all attribute conflicts between roles
-                # result in an immediate fatal error
-                confess "Role '" . $self->name . "' has encountered an attribute conflict " .
-                        "during composition. This is fatal error and cannot be disambiguated.";
-            }
-            else {
-                # but if this is a class, we
-                # can safely skip adding the
-                # attribute to the class
-                next;
-            }
-        }
-        else {
-            # NOTE:
-            # this is kinda ugly ...
-            if ($other->isa('Moose::Meta::Class')) {
-                $other->_process_attribute(
-                    $attribute_name,
-                    %{$self->get_attribute($attribute_name)}
-                );
-            }
-            else {
-                $other->add_attribute(
-                    $attribute_name,
-                    $self->get_attribute($attribute_name)
-                );
-            }
-        }
-    }
-}
-
-sub _apply_methods {
-    my ($self, $other) = @_;
-    foreach my $method_name ($self->get_method_list) {
-        # it if it has one already
-        if ($other->has_method($method_name) &&
-            # and if they are not the same thing ...
-            $other->get_method($method_name)->body != $self->get_method($method_name)->body) {
-            # see if we are composing into a role
-            if ($other->isa('Moose::Meta::Role')) {
-                # method conflicts between roles result
-                # in the method becoming a requirement
-                $other->add_required_methods($method_name);
-                # NOTE:
-                # we have to remove the method from our
-                # role, if this is being called from combine()
-                # which means the meta is an anon class
-                # this *may* cause problems later, but it
-                # is probably fairly safe to assume that
-                # anon classes will only be used internally
-                # or by people who know what they are doing
-                $other->Moose::Meta::Class::remove_method($method_name)
-                    if $other->name =~ /__COMPOSITE_ROLE_SANDBOX__/;
-            }
-            else {
-                next;
-            }
-        }
-        else {
-            # add it, although it could be overriden
-            $other->alias_method(
-                $method_name,
-                $self->get_method($method_name)
-            );
-        }
-    }
-}
-
-sub _apply_override_method_modifiers {
-    my ($self, $other) = @_;
-    foreach my $method_name ($self->get_method_modifier_list('override')) {
-        # it if it has one already then ...
-        if ($other->has_method($method_name)) {
-            # if it is being composed into another role
-            # we have a conflict here, because you cannot
-            # combine an overriden method with a locally
-            # defined one
-            if ($other->isa('Moose::Meta::Role')) {
-                confess "Role '" . $self->name . "' has encountered an 'override' method conflict " .
-                        "during composition (A local method of the same name as been found). This " .
-                        "is fatal error.";
-            }
-            else {
-                # if it is a class, then we
-                # just ignore this here ...
-                next;
-            }
-        }
-        else {
-            # if no local method is found, then we
-            # must check if we are a role or class
-            if ($other->isa('Moose::Meta::Role')) {
-                # 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) &&
-                    $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 {
-                    # 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)
-                    );
-                }
-            }
-            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) = Class::MOP::get_code_info($method);
-                # if it is a class, we just add it
-                $other->add_override_method_modifier($method_name, $method, $package);
-            }
-        }
-    }
-}
-
-sub _apply_method_modifiers {
-    my ($self, $modifier_type, $other) = @_;
-    my $add = "add_${modifier_type}_method_modifier";
-    my $get = "get_${modifier_type}_method_modifiers";
-    foreach my $method_name ($self->get_method_modifier_list($modifier_type)) {
-        $other->$add(
-            $method_name,
-            $_
-        ) foreach $self->$get($method_name);
-    }
-}
-
-sub _apply_before_method_modifiers { (shift)->_apply_method_modifiers('before' => @_) }
-sub _apply_around_method_modifiers { (shift)->_apply_method_modifiers('around' => @_) }
-sub _apply_after_method_modifiers  { (shift)->_apply_method_modifiers('after'  => @_) }
-
 #####################################################################
 ## NOTE:
 ## This is Moose::Meta::Role as defined by Moose (plus the use of 
index 27bddba..7274f70 100644 (file)
@@ -8,22 +8,22 @@ our $VERSION   = '0.01';
 our $AUTHORITY = 'cpan:STEVAN';
 
 # no need to get fancy here ...
-sub new { bless {} => shift }
+sub new { bless {} => (shift) }
 
 sub apply {
-    my ($self, $other) = @_;
+    my $self = shift;
 
-    $self->check_role_exclusions($other);
-    $self->check_required_methods($other);
+    $self->check_role_exclusions(@_);
+    $self->check_required_methods(@_);
     
-    $self->apply_attributes($other);
-    $self->apply_methods($other);    
+    $self->apply_attributes(@_);
+    $self->apply_methods(@_);    
     
-    $self->apply_override_method_modifiers($other);
+    $self->apply_override_method_modifiers(@_);
     
-    $self->apply_before_method_modifiers($other);
-    $self->apply_around_method_modifiers($other);
-    $self->apply_after_method_modifiers($other);
+    $self->apply_before_method_modifiers(@_);
+    $self->apply_around_method_modifiers(@_);
+    $self->apply_after_method_modifiers(@_);
 }
 
 sub check_role_exclusions           { die "Abstract Method" }
index 5877811..a30c49f 100644 (file)
@@ -14,6 +14,152 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Role::Application';
 
+sub apply {
+    my ($self, $role, $class) = @_;
+    $self->SUPER::apply($role, $class);
+    $class->add_role($role);    
+}
+
+sub check_role_exclusions {
+    my ($self, $role, $class) = @_;
+    if ($class->excludes_role($role->name)) {
+        confess "Conflict detected: " . $class->name . " excludes role '" . $role->name . "'";
+    }
+    foreach my $excluded_role_name ($role->get_excluded_roles_list) {
+        if ($class->does_role($excluded_role_name)) {
+            confess "The class " . $class->name . " does the excluded role '$excluded_role_name'";
+        }
+    }
+}
+
+sub check_required_methods {
+    my ($self, $role, $class) = @_;
+    # NOTE:
+    # we might need to move this down below the
+    # the attributes so that we can require any
+    # attribute accessors. However I am thinking
+    # that maybe those are somehow exempt from
+    # the require methods stuff.
+    foreach my $required_method_name ($role->get_required_method_list) {
+
+        unless ($class->find_method_by_name($required_method_name)) {
+            confess "'" . $role->name . "' requires the method '$required_method_name' " .
+                    "to be implemented by '" . $class->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 = $class->find_method_by_name($required_method_name);
+
+            # check if it is a generated accessor ...
+            (!$method->isa('Class::MOP::Method::Accessor'))
+                || confess "'" . $role->name . "' requires the method '$required_method_name' " .
+                           "to be implemented by '" . $class->name . "', the method is only an attribute accessor";
+
+            # NOTE:
+            # All other tests here have been removed, they were tests
+            # for overriden methods and before/after/around modifiers.
+            # But we realized that for classes any overriden or modified
+            # methods would be backed by a real method of that name
+            # (and therefore meet the requirement). And for roles, the
+            # overriden and modified methods are "in statis" and so would
+            # not show up in this test anyway (and as a side-effect they
+            # would not fufill the requirement, which is exactly what we
+            # want them to do anyway).
+            # - SL
+        }
+    }
+}
+
+sub apply_attributes {
+    my ($self, $role, $class) = @_;
+    foreach my $attribute_name ($role->get_attribute_list) {
+        # it if it has one already
+        if ($class->has_attribute($attribute_name) &&
+            # make sure we haven't seen this one already too
+            $class->get_attribute($attribute_name) != $role->get_attribute($attribute_name)) {
+            next;
+        }
+        else {
+            # NOTE:
+            # this is kinda ugly ...
+            if ($class->isa('Moose::Meta::Class')) {
+                $class->_process_attribute(
+                    $attribute_name,
+                    %{$role->get_attribute($attribute_name)}
+                );
+            }
+            else {
+                $class->add_attribute(
+                    $attribute_name,
+                    $role->get_attribute($attribute_name)
+                );
+            }
+        }
+    }
+}
+
+sub apply_methods {
+    my ($self, $role, $class) = @_;
+    foreach my $method_name ($role->get_method_list) {
+        # it if it has one already
+        if ($class->has_method($method_name) &&
+            # and if they are not the same thing ...
+            $class->get_method($method_name)->body != $role->get_method($method_name)->body) {
+            next;
+        }
+        else {
+            # add it, although it could be overriden
+            $class->alias_method(
+                $method_name,
+                $role->get_method($method_name)
+            );
+        }
+    }
+    # we must reset the cache here since
+    # we are just aliasing methods, otherwise
+    # the modifiers go wonky.
+    $class->reset_package_cache_flag;        
+}
+
+sub apply_override_method_modifiers {
+    my ($self, $role, $class) = @_;
+    foreach my $method_name ($role->get_method_modifier_list('override')) {
+        # it if it has one already then ...
+        if ($class->has_method($method_name)) {
+            next;
+        }
+        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 = $role->get_override_method_modifier($method_name);
+            my ($package) = Class::MOP::get_code_info($method);
+            # if it is a class, we just add it
+            $class->add_override_method_modifier($method_name, $method, $package);
+        }
+    }
+}
+
+sub apply_method_modifiers {
+    my ($self, $modifier_type, $role, $class) = @_;
+    my $add = "add_${modifier_type}_method_modifier";
+    my $get = "get_${modifier_type}_method_modifiers";
+    foreach my $method_name ($role->get_method_modifier_list($modifier_type)) {
+        $class->$add(
+            $method_name,
+            $_
+        ) foreach $role->$get($method_name);
+    }
+}
+
+sub apply_before_method_modifiers { (shift)->apply_method_modifiers('before' => @_) }
+sub apply_around_method_modifiers { (shift)->apply_method_modifiers('around' => @_) }
+sub apply_after_method_modifiers  { (shift)->apply_method_modifiers('after'  => @_) }
+
 1;
 
 __END__
@@ -34,6 +180,26 @@ Moose::Meta::Role::Application::ToClass
 
 =item B<meta>
 
+=item B<apply>
+
+=item B<check_required_methods>
+
+=item B<check_role_exclusions>
+
+=item B<apply_attributes>
+
+=item B<apply_methods>
+
+=item B<apply_method_modifiers>
+
+=item B<apply_before_method_modifiers>
+
+=item B<apply_after_method_modifiers>
+
+=item B<apply_around_method_modifiers>
+
+=item B<apply_override_method_modifiers>
+
 =back
 
 =head1 BUGS
index 8a15962..c0ee0e1 100644 (file)
@@ -12,7 +12,29 @@ use Data::Dumper;
 our $VERSION   = '0.01';
 our $AUTHORITY = 'cpan:STEVAN';
 
-use base 'Moose::Meta::Role::Application';
+use base 'Moose::Meta::Role::Application::ToClass';
+
+my $anon_counter = 0;
+
+sub apply {
+    my ($self, $role, $object) = @_;
+
+    # FIXME:
+    # We really should do this better, and
+    # cache the results of our efforts so
+    # that we don't need to repeat them.
+
+    my $pkg_name = __PACKAGE__ . "::__RUNTIME_ROLE_ANON_CLASS__::" . $anon_counter++;
+    eval "package " . $pkg_name . "; our \$VERSION = '0.00';";
+    die $@ if $@;
+
+    my $class = Moose::Meta::Class->initialize($pkg_name);
+    $class->superclasses(blessed($object));
+
+    bless $object => $class->name;   
+    
+    $self->SUPER::apply($role, $class); 
+}
 
 1;
 
@@ -34,6 +56,8 @@ Moose::Meta::Role::Application::ToInstance
 
 =item B<meta>
 
+=item B<apply>
+
 =back
 
 =head1 BUGS
index 8768b08..399bc72 100644 (file)
@@ -14,6 +14,123 @@ our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Role::Application';
 
+sub apply {
+    my ($self, $role1, $role2) = @_;
+    $self->SUPER::apply($role1, $role2);
+    $role2->add_role($role1);    
+}
+
+sub check_role_exclusions {
+    my ($self, $role1, $role2) = @_;
+    confess "Conflict detected: " . $role2->name . " excludes role '" . $role1->name . "'"
+        if $role2->excludes_role($role1->name);
+    foreach my $excluded_role_name ($role1->get_excluded_roles_list) {
+        confess "The class " . $role2->name . " does the excluded role '$excluded_role_name'"
+            if $role2->does_role($excluded_role_name);
+        $role2->add_excluded_roles($excluded_role_name);
+    }
+}
+
+sub check_required_methods {
+    my ($self, $role1, $role2) = @_;
+    foreach my $required_method_name ($role1->get_required_method_list) {
+        $role2->add_required_methods($required_method_name)
+            unless $role2->find_method_by_name($required_method_name);
+    }
+}
+
+sub apply_attributes {
+    my ($self, $role1, $role2) = @_;
+    foreach my $attribute_name ($role1->get_attribute_list) {
+        # it if it has one already
+        if ($role2->has_attribute($attribute_name) &&
+            # make sure we haven't seen this one already too
+            $role2->get_attribute($attribute_name) != $role1->get_attribute($attribute_name)) {
+            confess "Role '" . $role1->name . "' has encountered an attribute conflict " .
+                    "during composition. This is fatal error and cannot be disambiguated.";
+        }
+        else {
+            $role2->add_attribute(
+                $attribute_name,
+                $role1->get_attribute($attribute_name)
+            );
+        }
+    }
+}
+
+sub apply_methods {
+    my ($self, $role1, $role2) = @_;
+    foreach my $method_name ($role1->get_method_list) {
+        # it if it has one already
+        if ($role2->has_method($method_name) &&
+            # and if they are not the same thing ...
+            $role2->get_method($method_name)->body != $role1->get_method($method_name)->body) {
+            # method conflicts between roles result
+            # in the method becoming a requirement
+            $role2->add_required_methods($method_name);
+        }
+        else {
+            # add it, although it could be overriden
+            $role2->alias_method(
+                $method_name,
+                $role1->get_method($method_name)
+            );
+        }
+    }
+}
+
+sub apply_override_method_modifiers {
+    my ($self, $role1, $role2) = @_;
+    foreach my $method_name ($role1->get_method_modifier_list('override')) {
+        # it if it has one already then ...
+        if ($role2->has_method($method_name)) {
+            # if it is being composed into another role
+            # we have a conflict here, because you cannot
+            # combine an overriden method with a locally
+            # defined one
+            confess "Role '" . $role1->name . "' has encountered an 'override' method conflict " .
+                    "during composition (A local method of the same name as been found). This " .
+                    "is fatal error.";
+        }
+        else {
+            # if we are a role, we need to make sure
+            # we dont have a conflict with the role
+            # we are composing into
+            if ($role2->has_override_method_modifier($method_name) &&
+                $role2->get_override_method_modifier($method_name) != $role2->get_override_method_modifier($method_name)) {
+                confess "Role '" . $role1->name . "' has encountered an 'override' method conflict " .
+                        "during composition (Two 'override' methods of the same name encountered). " .
+                        "This is fatal error.";
+            }
+            else {
+                # if there is no conflict,
+                # just add it to the role
+                $role2->add_override_method_modifier(
+                    $method_name,
+                    $role1->get_override_method_modifier($method_name)
+                );
+            }
+        }
+    }
+}
+
+sub apply_method_modifiers {
+    my ($self, $modifier_type, $role1, $role2) = @_;
+    my $add = "add_${modifier_type}_method_modifier";
+    my $get = "get_${modifier_type}_method_modifiers";
+    foreach my $method_name ($role1->get_method_modifier_list($modifier_type)) {
+        $role2->$add(
+            $method_name,
+            $_
+        ) foreach $role1->$get($method_name);
+    }
+}
+
+sub apply_before_method_modifiers { (shift)->apply_method_modifiers('before' => @_) }
+sub apply_around_method_modifiers { (shift)->apply_method_modifiers('around' => @_) }
+sub apply_after_method_modifiers  { (shift)->apply_method_modifiers('after'  => @_) }
+
+
 1;
 
 __END__
@@ -34,6 +151,26 @@ Moose::Meta::Role::Application::ToRole
 
 =item B<meta>
 
+=item B<apply>
+
+=item B<check_required_methods>
+
+=item B<check_role_exclusions>
+
+=item B<apply_attributes>
+
+=item B<apply_methods>
+
+=item B<apply_method_modifiers>
+
+=item B<apply_before_method_modifiers>
+
+=item B<apply_after_method_modifiers>
+
+=item B<apply_around_method_modifiers>
+
+=item B<apply_override_method_modifiers>
+
 =back
 
 =head1 BUGS
index 85cad57..7866b5e 100644 (file)
@@ -32,6 +32,9 @@ BEGIN {
     with 'Role::Foo';    
 }
 
+ok(Role::ExcludesFoo->meta->excludes_role('Role::Foo'), '... got the right exclusions');
+ok(Role::DoesExcludesFoo->meta->excludes_role('Role::Foo'), '... got the right exclusions');
+
 # test simple exclusion
 dies_ok {
     Moose::Meta::Role::Application::RoleSummation->new->apply(