X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FRole.pm;h=5066f0630f9366bc4124bca62946ed279160dfa7;hb=342ac8377d73e337ec979f1cb9452860c7c992bd;hp=485ac55905fb0d4a415b05dffb46c555b0c573c3;hpb=a2eec5e74dfb56aad14be204396be4ee7409b06c;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index 485ac55..5066f06 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -11,16 +11,11 @@ use B 'svref_2object'; use Moose::Meta::Class; -our $VERSION = '0.03'; +our $VERSION = '0.04'; -## Attributes - -## the meta for the role package +use base 'Class::MOP::Module'; -__PACKAGE__->meta->add_attribute('_role_meta' => ( - reader => '_role_meta', - init_arg => ':role_meta' -)); +## Attributes ## roles @@ -74,17 +69,7 @@ __PACKAGE__->meta->add_attribute('override_method_modifiers' => ( ## Methods -sub new { - my $class = shift; - my %options = @_; - $options{':role_meta'} = Moose::Meta::Class->initialize( - $options{role_name}, - ':method_metaclass' => 'Moose::Meta::Role::Method' - ) unless defined $options{':role_meta'} && - $options{':role_meta'}->isa('Moose::Meta::Class'); - my $self = $class->meta->new_object(%options); - return $self; -} +sub method_metaclass { 'Moose::Meta::Role::Method' } ## subroles @@ -95,6 +80,12 @@ sub add_role { push @{$self->get_roles} => $role; } +sub calculate_all_roles { + my $self = shift; + my %seen; + grep { !$seen{$_->name}++ } $self, map { $_->calculate_all_roles } @{ $self->get_roles }; +} + sub does_role { my ($self, $role_name) = @_; (defined $role_name) @@ -157,30 +148,30 @@ sub _clean_up_required_methods { ## methods -# NOTE: -# we delegate to some role_meta methods for convience here -# the Moose::Meta::Role is meant to be a read-only interface -# to the underlying role package, if you want to manipulate -# that, just use ->role_meta - -sub name { (shift)->_role_meta->name } -sub version { (shift)->_role_meta->version } +# FIXME: +# this is an UGLY hack +sub get_method_map { + my $self = shift; + $self->{'%:methods'} ||= {}; + $self->Moose::Meta::Class::get_method_map() +} -sub get_method { (shift)->_role_meta->get_method(@_) } -sub has_method { (shift)->_role_meta->has_method(@_) } -sub alias_method { (shift)->_role_meta->alias_method(@_) } -sub get_method_list { - my ($self) = @_; - grep { - # NOTE: - # this is a kludge for now,... these functions - # should not be showing up in the list at all, - # but they do, so we need to switch Moose::Role - # and Moose to use Sub::Exporter to prevent this - !/^(meta|has|extends|blessed|confess|augment|inner|override|super|before|after|around|with|requires)$/ - } $self->_role_meta->get_method_list; +# FIXME: +# Yes, this is a really really UGLY hack +# but it works, and until I can figure +# out a better way, this is gonna be it. + +sub get_method { (shift)->Moose::Meta::Class::get_method(@_) } +sub has_method { (shift)->Moose::Meta::Class::has_method(@_) } +sub alias_method { (shift)->Moose::Meta::Class::alias_method(@_) } +sub get_method_list { + grep { + !/^meta$/ + } (shift)->Moose::Meta::Class::get_method_list(@_) } +sub find_method_by_name { (shift)->has_method(@_) } + # ... however the items in statis (attributes & method modifiers) # can be removed and added to through this API @@ -244,6 +235,9 @@ sub _add_method_modifier { 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; } @@ -314,7 +308,8 @@ sub _check_required_methods { # that maybe those are somehow exempt from # the require methods stuff. foreach my $required_method_name ($self->get_required_method_list) { - unless ($other->has_method($required_method_name)) { + + unless ($other->find_method_by_name($required_method_name)) { if ($other->isa('Moose::Meta::Role')) { $other->add_required_methods($required_method_name); } @@ -343,7 +338,7 @@ sub _check_required_methods { || confess "'" . $self->name . "' requires the method '$required_method_name' " . "to be implemented by '" . $other->name . "', the method is only a method modifier"; } - } + } } } @@ -384,7 +379,7 @@ sub _apply_methods { # 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) != $self->get_method($method_name)) { + $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 @@ -398,8 +393,8 @@ sub _apply_methods { # is probably fairly safe to assume that # anon classes will only be used internally # or by people who know what they are doing - $other->_role_meta->remove_method($method_name) - if $other->_role_meta->name =~ /__ANON__/; + $other->Moose::Meta::Class::remove_method($method_name) + if $other->name =~ /__COMPOSITE_ROLE_SANDBOX__/; } else { next; @@ -487,29 +482,54 @@ 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_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); - + $self->_apply_after_method_modifiers($other); + $other->add_role($self); } sub combine { my ($class, @roles) = @_; - my $combined = $class->new( - ':role_meta' => Moose::Meta::Class->create_anon_class() - ); + 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); @@ -590,10 +610,16 @@ probably not that much really). =item B +=item B + =back =over 4 +=item B + +=item B + =item B =item B @@ -602,6 +628,8 @@ probably not that much really). =item B +=item B + =back =over 4 @@ -703,4 +731,4 @@ L 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