From: Stevan Little Date: Sun, 30 Dec 2007 20:16:01 +0000 (+0000) Subject: composition and the role model are now decoupled X-Git-Tag: 0_35~43 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c9db35c77752fc918e23bee1613dc6567087dc5;hp=fb1e11d526a7d3608132ba484525980e9fafcc4f;p=gitmo%2FMoose.git composition and the role model are now decoupled --- diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index 60a9727..ef60f78 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -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 diff --git a/lib/Moose/Meta/Role/Application.pm b/lib/Moose/Meta/Role/Application.pm index 27bddba..7274f70 100644 --- a/lib/Moose/Meta/Role/Application.pm +++ b/lib/Moose/Meta/Role/Application.pm @@ -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" } diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm index 5877811..a30c49f 100644 --- a/lib/Moose/Meta/Role/Application/ToClass.pm +++ b/lib/Moose/Meta/Role/Application/ToClass.pm @@ -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 +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + =back =head1 BUGS diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm index 8a15962..c0ee0e1 100644 --- a/lib/Moose/Meta/Role/Application/ToInstance.pm +++ b/lib/Moose/Meta/Role/Application/ToInstance.pm @@ -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 +=item B + =back =head1 BUGS diff --git a/lib/Moose/Meta/Role/Application/ToRole.pm b/lib/Moose/Meta/Role/Application/ToRole.pm index 8768b08..399bc72 100644 --- a/lib/Moose/Meta/Role/Application/ToRole.pm +++ b/lib/Moose/Meta/Role/Application/ToRole.pm @@ -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 +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + =back =head1 BUGS diff --git a/t/030_roles/021_role_composite_exlcusion.t b/t/030_roles/021_role_composite_exlcusion.t index 85cad57..7866b5e 100644 --- a/t/030_roles/021_role_composite_exlcusion.t +++ b/t/030_roles/021_role_composite_exlcusion.t @@ -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(