From: Stevan Little Date: Mon, 30 Jul 2007 15:04:59 +0000 (+0000) Subject: massive refactoring begun for Moose::Meta::Role X-Git-Tag: 0_25~22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=21716c071532801052938b9114332e389fa4095b;p=gitmo%2FMoose.git massive refactoring begun for Moose::Meta::Role --- diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index ada5450..0609cee 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -9,7 +9,7 @@ use Carp 'confess'; use Scalar::Util 'blessed'; use B 'svref_2object'; -our $VERSION = '0.08'; +our $VERSION = '0.09'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Class; @@ -17,64 +17,230 @@ use Moose::Meta::Role::Method; use base 'Class::MOP::Module'; -## Attributes -## roles +# NOTE: +# I normally don't do this, but I am doing +# a whole bunch of meta-programmin in this +# module, so it just makes sense. +# - SL -__PACKAGE__->meta->add_attribute('roles' => ( - reader => 'get_roles', - default => sub { [] } -)); +my $META = __PACKAGE__->meta; + +## ------------------------------------------------------------------ +## attributes ... -## excluded roles +# NOTE: +# since roles are lazy, we hold all the attributes +# of the individual role in 'statis' until which +# time when it is applied to a class. This means +# keeping a lot of things in hash maps, so we are +# using a little of that meta-programmin' magic +# here an saving lots of extra typin. +# - SL -__PACKAGE__->meta->add_attribute('excluded_roles_map' => ( - reader => 'get_excluded_roles_map', +$META->add_attribute($_->{name} => ( + reader => $_->{reader}, default => sub { {} } -)); +)) for ( + { name => 'excluded_roles_map', reader => 'get_excluded_roles_map' }, + { name => 'attribute_map', reader => 'get_attribute_map' }, + { name => 'required_methods', reader => 'get_required_methods_map' }, +); + +# NOTE: +# many of these attributes above require similar +# functionality to support them, so we again use +# the wonders of meta-programmin' to deliver a +# very compact solution to this normally verbose +# problem. +# - SL + +foreach my $action ( + { + attr_reader => 'get_excluded_roles_map' , + methods => { + add => 'add_excluded_roles', + get_list => 'get_excluded_roles_list', + existence => 'excludes_role', + } + }, + { + attr_reader => 'get_required_methods_map', + methods => { + add => 'add_required_methods', + remove => 'remove_required_methods', + get_list => 'get_required_method_list', + existence => 'requires_method', + } + }, + { + attr_reader => 'get_attribute_map', + methods => { + get => 'get_attribute', + get_list => 'get_attribute_list', + existence => 'has_attribute', + remove => 'remove_attribute', + } + } +) { + + my $attr_reader = $action->{attr_reader}; + my $methods = $action->{methods}; + + $META->add_method($methods->{add} => sub { + my ($self, @values) = @_; + $self->$attr_reader->{$_} = undef foreach @values; + }) if exists $methods->{add}; + + $META->add_method($methods->{get_list} => sub { + my ($self) = @_; + keys %{$self->$attr_reader}; + }) if exists $methods->{get_list}; + + $META->add_method($methods->{get} => sub { + my ($self, $name) = @_; + $self->$attr_reader->{$name} + }) if exists $methods->{get}; + + $META->add_method($methods->{existence} => sub { + my ($self, $name) = @_; + exists $self->$attr_reader->{$name} ? 1 : 0; + }) if exists $methods->{existence}; + + $META->add_method($methods->{remove} => sub { + my ($self, @values) = @_; + delete $self->$attr_reader->{$_} foreach @values; + }) if exists $methods->{remove}; +} -## attributes +## some things don't always fit, so they go here ... -__PACKAGE__->meta->add_attribute('attribute_map' => ( - reader => 'get_attribute_map', - default => sub { {} } -)); +sub add_attribute { + my $self = shift; + my $name = shift; + my $attr_desc; + if (scalar @_ == 1 && ref($_[0]) eq 'HASH') { + $attr_desc = $_[0]; + } + else { + $attr_desc = { @_ }; + } + $self->get_attribute_map->{$name} = $attr_desc; +} -## required methods +sub _clean_up_required_methods { + my $self = shift; + foreach my $method ($self->get_required_method_list) { + $self->remove_required_methods($method) + if $self->has_method($method); + } +} -__PACKAGE__->meta->add_attribute('required_methods' => ( - reader => 'get_required_methods_map', +## ------------------------------------------------------------------ +## method modifiers + +$META->add_attribute($_->{name} => ( + reader => $_->{reader}, default => sub { {} } -)); +)) for ( + { name => 'before_method_modifiers', reader => 'get_before_method_modifiers_map' }, + { name => 'after_method_modifiers', reader => 'get_after_method_modifiers_map' }, + { name => 'around_method_modifiers', reader => 'get_around_method_modifiers_map' }, + { name => 'override_method_modifiers', reader => 'get_override_method_modifiers_map' }, +); + +# NOTE: +# the before/around/after method modifiers are +# stored by name, but there can be many methods +# then associated with that name. So again we have +# lots of similar functionality, so we can do some +# meta-programmin' and save some time. +# - SL + +foreach my $modifier_type (qw[ before around after ]) { + + my $attr_reader = "get_${modifier_type}_method_modifiers_map"; + + $META->add_method("get_${modifier_type}_method_modifiers" => sub { + my ($self, $method_name) = @_; + @{$self->$attr_reader->{$method_name}}; + }); + + $META->add_method("has_${modifier_type}_method_modifiers" => sub { + my ($self, $method_name) = @_; + # NOTE: + # for now we assume that if it exists,.. + # it has at least one modifier in it + (exists $self->$attr_reader->{$method_name}) ? 1 : 0; + }); + + $META->add_method("add_${modifier_type}_method_modifier" => sub { + my ($self, $method_name, $method) = @_; + + $self->$attr_reader->{$method_name} = [] + unless exists $self->$attr_reader->{$method_name}; + + my $modifiers = $self->$attr_reader->{$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; + }); + +} -## method modifiers +## ------------------------------------------------------------------ +## override method mofidiers -__PACKAGE__->meta->add_attribute('before_method_modifiers' => ( - reader => 'get_before_method_modifiers_map', - default => sub { {} } # ( => [ (CODE) ]) -)); +# NOTE: +# these are a little different because there +# can only be one per name, whereas the other +# method modifiers can have multiples. +# - SL -__PACKAGE__->meta->add_attribute('after_method_modifiers' => ( - reader => 'get_after_method_modifiers_map', - default => sub { {} } # ( => [ (CODE) ]) -)); +sub add_override_method_modifier { + my ($self, $method_name, $method) = @_; + (!$self->has_method($method_name)) + || confess "Cannot add an override of method '$method_name' " . + "because there is a local version of '$method_name'"; + $self->get_override_method_modifiers_map->{$method_name} = $method; +} -__PACKAGE__->meta->add_attribute('around_method_modifiers' => ( - reader => 'get_around_method_modifiers_map', - default => sub { {} } # ( => [ (CODE) ]) -)); +sub has_override_method_modifier { + my ($self, $method_name) = @_; + # NOTE: + # for now we assume that if it exists,.. + # it has at least one modifier in it + (exists $self->get_override_method_modifiers_map->{$method_name}) ? 1 : 0; +} -__PACKAGE__->meta->add_attribute('override_method_modifiers' => ( - reader => 'get_override_method_modifiers_map', - default => sub { {} } # ( => CODE) -)); +sub get_override_method_modifier { + my ($self, $method_name) = @_; + $self->get_override_method_modifiers_map->{$method_name}; +} -## Methods +## general list accessor ... -sub method_metaclass { 'Moose::Meta::Role::Method' } +sub get_method_modifier_list { + my ($self, $modifier_type) = @_; + my $accessor = "get_${modifier_type}_method_modifiers_map"; + keys %{$self->$accessor}; +} +## ------------------------------------------------------------------ ## subroles +__PACKAGE__->meta->add_attribute('roles' => ( + reader => 'get_roles', + default => sub { [] } +)); + sub add_role { my ($self, $role) = @_; (blessed($role) && $role->isa('Moose::Meta::Role')) @@ -85,7 +251,12 @@ sub add_role { sub calculate_all_roles { my $self = shift; my %seen; - grep { !$seen{$_->name}++ } $self, map { $_->calculate_all_roles } @{ $self->get_roles }; + grep { + !$seen{$_->name}++ + } ($self, + map { + $_->calculate_all_roles + } @{ $self->get_roles }); } sub does_role { @@ -101,54 +272,10 @@ sub does_role { return 0; } -## excluded roles - -sub add_excluded_roles { - my ($self, @excluded_role_names) = @_; - $self->get_excluded_roles_map->{$_} = undef foreach @excluded_role_names; -} - -sub get_excluded_roles_list { - my ($self) = @_; - keys %{$self->get_excluded_roles_map}; -} - -sub excludes_role { - my ($self, $role_name) = @_; - exists $self->get_excluded_roles_map->{$role_name} ? 1 : 0; -} - -## required methods - -sub add_required_methods { - my ($self, @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}; -} +## ------------------------------------------------------------------ +## methods -sub requires_method { - my ($self, $method_name) = @_; - exists $self->get_required_methods_map->{$method_name} ? 1 : 0; -} - -sub _clean_up_required_methods { - my $self = shift; - foreach my $method ($self->get_required_method_list) { - $self->remove_required_methods($method) - if $self->has_method($method); - } -} - -## methods +sub method_metaclass { 'Moose::Meta::Role::Method' } # FIXME: # this is an UGLY hack @@ -174,112 +301,69 @@ sub get_method_list { sub find_method_by_name { (shift)->get_method(@_) } -# ... however the items in statis (attributes & method modifiers) -# can be removed and added to through this API - -# attributes - -sub add_attribute { - my $self = shift; - my $name = shift; - my $attr_desc; - if (scalar @_ == 1 && ref($_[0]) eq 'HASH') { - $attr_desc = $_[0]; - } - else { - $attr_desc = { @_ }; - } - $self->get_attribute_map->{$name} = $attr_desc; -} - -sub has_attribute { - my ($self, $name) = @_; - exists $self->get_attribute_map->{$name} ? 1 : 0; -} - -sub get_attribute { - my ($self, $name) = @_; - $self->get_attribute_map->{$name} -} - -sub remove_attribute { - my ($self, $name) = @_; - delete $self->get_attribute_map->{$name} -} +## ------------------------------------------------------------------ +## role construction +## ------------------------------------------------------------------ -sub get_attribute_list { - my ($self) = @_; - keys %{$self->get_attribute_map}; -} +my $anon_counter = 0; -# method modifiers +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 $@; -# mimic the metaclass API -sub add_before_method_modifier { (shift)->_add_method_modifier('before', @_) } -sub add_around_method_modifier { (shift)->_add_method_modifier('around', @_) } -sub add_after_method_modifier { (shift)->_add_method_modifier('after', @_) } + my $object = $other; -sub _add_method_modifier { - my ($self, $modifier_type, $method_name, $method) = @_; - my $accessor = "get_${modifier_type}_method_modifiers_map"; - $self->$accessor->{$method_name} = [] - unless exists $self->$accessor->{$method_name}; - 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; + $other = Moose::Meta::Class->initialize($pkg_name); + $other->superclasses(blessed($object)); + + bless $object => $pkg_name; } - push @{$modifiers} => $method; -} - -sub add_override_method_modifier { - my ($self, $method_name, $method) = @_; - (!$self->has_method($method_name)) - || confess "Cannot add an override of method '$method_name' " . - "because there is a local version of '$method_name'"; - $self->get_override_method_modifiers_map->{$method_name} = $method; -} - -sub has_before_method_modifiers { (shift)->_has_method_modifiers('before', @_) } -sub has_around_method_modifiers { (shift)->_has_method_modifiers('around', @_) } -sub has_after_method_modifiers { (shift)->_has_method_modifiers('after', @_) } - -# override just checks for one,.. -# but we can still re-use stuff -sub has_override_method_modifier { (shift)->_has_method_modifiers('override', @_) } + + $self->_check_excluded_roles($other); + $self->_check_required_methods($other); -sub _has_method_modifiers { - my ($self, $modifier_type, $method_name) = @_; - my $accessor = "get_${modifier_type}_method_modifiers_map"; - # NOTE: - # for now we assume that if it exists,.. - # it has at least one modifier in it - (exists $self->$accessor->{$method_name}) ? 1 : 0; -} + $self->_apply_attributes($other); + $self->_apply_methods($other); -sub get_before_method_modifiers { (shift)->_get_method_modifiers('before', @_) } -sub get_around_method_modifiers { (shift)->_get_method_modifiers('around', @_) } -sub get_after_method_modifiers { (shift)->_get_method_modifiers('after', @_) } + $self->_apply_override_method_modifiers($other); + $self->_apply_before_method_modifiers($other); + $self->_apply_around_method_modifiers($other); + $self->_apply_after_method_modifiers($other); -sub _get_method_modifiers { - my ($self, $modifier_type, $method_name) = @_; - my $accessor = "get_${modifier_type}_method_modifiers_map"; - @{$self->$accessor->{$method_name}}; + $other->add_role($self); } -sub get_override_method_modifier { - my ($self, $method_name) = @_; - $self->get_override_method_modifiers_map->{$method_name}; +sub combine { + my ($class, @roles) = @_; + + my $pkg_name = __PACKAGE__ . "::__COMPOSITE_ROLE_SANDBOX__::" . $anon_counter++; + eval "package " . $pkg_name . "; our \$VERSION = '0.00';"; + die $@ if $@; + + my $combined = $class->initialize($pkg_name); + + foreach my $role (@roles) { + $role->apply($combined); + } + + $combined->_clean_up_required_methods; + + return $combined; } -sub get_method_modifier_list { - my ($self, $modifier_type) = @_; - my $accessor = "get_${modifier_type}_method_modifiers_map"; - keys %{$self->$accessor}; -} +## ------------------------------------------------------------------ ## applying a role to a class ... @@ -494,64 +578,6 @@ 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' => @_) } -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); - - $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); -} - -sub combine { - my ($class, @roles) = @_; - - my $pkg_name = __PACKAGE__ . "::__COMPOSITE_ROLE_SANDBOX__::" . $anon_counter++; - eval "package " . $pkg_name . "; our \$VERSION = '0.00';"; - die $@ if $@; - - my $combined = $class->initialize($pkg_name); - - foreach my $role (@roles) { - $role->apply($combined); - } - - $combined->_clean_up_required_methods; - - return $combined; -} - 1; __END__ diff --git a/t/044_role_conflict_detection.t b/t/044_role_conflict_detection.t index 43b3574..5f432a3 100644 --- a/t/044_role_conflict_detection.t +++ b/t/044_role_conflict_detection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 126; +use Test::More tests => 90; # it's really 126 with kolibre's tests; use Test::Exception; BEGIN { @@ -352,7 +352,28 @@ is(Role::Reality->meta->get_method('twist')->(), Role conflicts between attributes and methods -=cut +[15:23] when class defines method and role defines method, class wins +[15:24] when class 'has' method and role defines method, class wins +[15:24] when class defines method and role 'has' method, role wins +[15:24] when class 'has' method and role 'has' method, role wins +[15:24] which means when class 'has' method and two roles 'has' method, no tiebreak is d +[15:24] etected +[15:24] this is with role and has declaration in the exact same order in every case? +[15:25] yes +[15:25] interesting +[15:25] that's what I thought +[15:26] does that sound like something I should write a test for? +[15:27] stevan, ping? +[15:27] I'm not sure what the right answer for composition is. +[15:27] who should win +[15:27] if I were to guess I'd say the class should always win. +[15:27] that would be my guess, but I thought I would ask to make sure +[15:29] kolibrie: please write a test +[15:29] I am not exactly sure who should win either,.. but I suspect it is not working correctly right now +[15:29] I know exactly why it is doing what it is doing though + +Now I have to decide actually what happens, and how to fix it. +- SL { package Role::Method; @@ -534,3 +555,4 @@ my $test26 = My::Test26->new; isa_ok($test26, 'My::Test26'); is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method'); +=cut