From: Stevan Little Date: Sat, 19 Jan 2008 15:54:02 +0000 (+0000) Subject: just some more cleanup X-Git-Tag: 0_35~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7d8a8c72f249e02b2d9b213e099f9f2aa4307f6;p=gitmo%2FMoose.git just some more cleanup --- diff --git a/Changes b/Changes index 3c90491..c45f051 100644 --- a/Changes +++ b/Changes @@ -27,6 +27,18 @@ Revision history for Perl extension Moose - methods can now be aliased to another name (and still retain the original as well) + * Moose + Moose::Role + - now uses the Moose::Util::apply_all_roles to deal + with role application + + * Moose::Util + - added the &apply_all_roles function + + * Moose::Meta::Class + - fixed the &_process_attribute method to be called + by &add_attribute, so that the API is now correct + * Moose::Meta::Method::Accessor - fixed bug when passing a list of values to an accessor would get (incorrectly) ignored. diff --git a/lib/Moose.pm b/lib/Moose.pm index 8b6f610..0b09568 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -13,7 +13,7 @@ use Sub::Name 'subname'; use Sub::Exporter; -use Class::MOP 0.49; +use Class::MOP 0.51; use Moose::Meta::Class; use Moose::Meta::TypeConstraint; @@ -26,6 +26,7 @@ use Moose::Meta::Role; use Moose::Object; use Moose::Util::TypeConstraints; +use Moose::Util (); { my $CALLER; @@ -63,7 +64,6 @@ use Moose::Util::TypeConstraints; $meta = $metaclass->initialize($class); $meta->add_method( 'meta' => sub { - # re-initialize so it inherits properly $metaclass->initialize( blessed( $_[0] ) || $_[0] ); } @@ -92,33 +92,7 @@ use Moose::Util::TypeConstraints; with => sub { my $class = $CALLER; return subname 'Moose::with' => sub (@) { - my (@args) = @_; - confess "Must specify at least one role" unless @args; - - my $roles = Data::OptList::mkopt(\@args); - - #use Data::Dumper; - #warn Dumper $roles; - - Class::MOP::load_class($_->[0]) for @$roles; - - ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role')) - || confess "You can only consume roles, " . $_->[0] . " is not a Moose role" - foreach @$roles; - - my $meta = $class->meta; - - if (scalar @$roles == 1) { - my ($role, $params) = @{$roles->[0]}; - $role->meta->apply($meta, (defined $params ? %$params : ())); - } - else { - Moose::Meta::Role->combine( - @$roles - )->apply($meta); - } - - #$class->meta->_apply_all_roles(@roles); + Moose::Util::apply_all_roles($class->meta, @_) }; }, has => sub { @@ -126,7 +100,7 @@ use Moose::Util::TypeConstraints; return subname 'Moose::has' => sub ($;%) { my ( $name, %options ) = @_; my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ]; - $class->meta->_process_attribute( $_, %options ) for @$attrs; + $class->meta->add_attribute( $_, %options ) for @$attrs; }; }, before => sub { diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 2e1759b..ebc3528 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -164,11 +164,11 @@ sub add_attribute { # if it is a HASH ref, we de-ref it. # this will usually mean that it is # coming from a role - $self->SUPER::add_attribute($name => %{$_[0]}); + $self->SUPER::add_attribute($self->_process_attribute($name => %{$_[0]})); } else { # otherwise we just pass the args - $self->SUPER::add_attribute($name => @_); + $self->SUPER::add_attribute($self->_process_attribute($name => @_)); } } @@ -278,30 +278,16 @@ sub _fix_metaclass_incompatability { return $self; } -sub _apply_all_roles { - my ($self, @roles) = @_; - ($_->can('meta') && $_->meta->isa('Moose::Meta::Role')) - || confess "You can only consume roles, $_ is not a Moose role" - foreach @roles; - if (scalar @roles == 1) { - $roles[0]->meta->apply($self); - } - else { - # FIXME - # we should make a Moose::Meta::Role::Composite - # which is a smaller version of Moose::Meta::Role - # which does not use any package stuff - Moose::Meta::Role->combine( - map { $_->meta } @roles - )->apply($self); - } -} +# NOTE: +# this was crap anyway, see +# Moose::Util::apply_all_roles +# instead +sub _apply_all_roles { die "DEPRECATED" } sub _process_attribute { my ($self, $name, %options) = @_; if ($name =~ /^\+(.*)/) { - my $new_attr = $self->_process_inherited_attribute($1, %options); - $self->add_attribute($new_attr); + return $self->_process_inherited_attribute($1, %options); } else { if ($options{metaclass}) { @@ -316,10 +302,10 @@ sub _process_attribute { if ($@) { Class::MOP::load_class($metaclass_name); } - $self->add_attribute($metaclass_name->new($name, %options)); + return $metaclass_name->new($name, %options); } else { - $self->add_attribute($name, %options); + return $self->attribute_metaclass->new($name, %options); } } } @@ -329,18 +315,14 @@ sub _process_inherited_attribute { my $inherited_attr = $self->find_attribute_by_name($attr_name); (defined $inherited_attr) || confess "Could not find an attribute by the name of '$attr_name' to inherit from"; - my $new_attr; if ($inherited_attr->isa('Moose::Meta::Attribute')) { - $new_attr = $inherited_attr->clone_and_inherit_options(%options); + return $inherited_attr->clone_and_inherit_options(%options); } else { # NOTE: # kind of a kludge to handle Class::MOP::Attributes - $new_attr = Moose::Meta::Attribute::clone_and_inherit_options( - $inherited_attr, %options - ); + return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options); } - return $new_attr; } ## ------------------------------------------------- diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm index 51fb16a..05d0661 100644 --- a/lib/Moose/Meta/Role/Application/ToClass.pm +++ b/lib/Moose/Meta/Role/Application/ToClass.pm @@ -90,20 +90,10 @@ sub apply_attributes { 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) - ); - } + $class->add_attribute( + $attribute_name, + $role->get_attribute($attribute_name) + ); } } } diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index e4289ce..6f314b7 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -14,7 +14,8 @@ use Sub::Exporter; our $VERSION = '0.07'; our $AUTHORITY = 'cpan:STEVAN'; -use Moose (); +use Moose (); +use Moose::Util (); use Moose::Meta::Role; use Moose::Util::TypeConstraints; @@ -59,29 +60,7 @@ use Moose::Util::TypeConstraints; with => sub { my $meta = _find_meta(); return subname 'Moose::Role::with' => sub (@) { - my (@args) = @_; - confess "Must specify at least one role" unless @args; - - my $roles = Data::OptList::mkopt(\@args); - - #use Data::Dumper; - #warn Dumper $roles; - - Class::MOP::load_class($_->[0]) for @$roles; - - ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role')) - || confess "You can only consume roles, " . $_->[0] . " is not a Moose role" - foreach @$roles; - - if (scalar @$roles == 1) { - my ($role, $params) = @{$roles->[0]}; - $role->meta->apply($meta, (defined $params ? %$params : ())); - } - else { - Moose::Meta::Role->combine( - @$roles - )->apply($meta); - } + Moose::Util::apply_all_roles($meta, @_) }; }, requires => sub { diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index c13067b..f4bc473 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -4,16 +4,18 @@ use strict; use warnings; use Sub::Exporter; -use Scalar::Util (); +use Scalar::Util 'blessed'; +use Carp 'confess'; use Class::MOP (); -our $VERSION = '0.01'; +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; my @exports = qw[ find_meta does_role search_class_by_role + apply_all_roles ]; Sub::Exporter::setup_exporter({ @@ -25,7 +27,7 @@ Sub::Exporter::setup_exporter({ sub find_meta { return unless $_[0]; - return Class::MOP::get_metaclass_by_name(ref($_[0]) || $_[0]); + return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]); } ## the functions ... @@ -62,6 +64,43 @@ sub search_class_by_role { return; } +sub apply_all_roles { + my $applicant = shift; + + confess "Must specify at least one role to apply to $applicant" unless @_; + + my $roles = Data::OptList::mkopt([ @_ ]); + + #use Data::Dumper; + #warn Dumper $roles; + + my $meta; + if (blessed $applicant && + ($applicant->isa('Class::MOP::Class') || + $applicant->isa('Moose::Meta::Role')) ){ + $meta = $applicant; + } + else { + $meta = find_meta($applicant); + } + + Class::MOP::load_class($_->[0]) for @$roles; + + ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role')) + || confess "You can only consume roles, " . $_->[0] . " is not a Moose role" + foreach @$roles; + + if (scalar @$roles == 1) { + my ($role, $params) = @{$roles->[0]}; + $role->meta->apply($meta, (defined $params ? %$params : ())); + } + else { + Moose::Meta::Role->combine( + @$roles + )->apply($meta); + } +} + 1; __END__ @@ -110,6 +149,13 @@ Returns true if C<$class_or_obj> can do the role C<$role_name>. Returns first class in precedence list that consumed C<$role_name>. +=item B + +Given an C<$applicant> (which can somehow be turned into either a +metaclass or a metarole) and a list of C<@roles> this will do the +right thing to apply the C<@roles> to the C<$applicant>. This is +actually used internally by both L and L. + =back =head1 TODO