From: Yuval Kogman Date: Thu, 24 Apr 2008 20:07:55 +0000 (+0000) Subject: metaclass and traits interpolation moved to Meta::Attribute X-Git-Tag: 0_55~211 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5c30e5273a24e66bc3028d8a63e1e07aeaa2d58;p=gitmo%2FMoose.git metaclass and traits interpolation moved to Meta::Attribute --- diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 0c9d98a..0bd227a 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -13,6 +13,7 @@ our $VERSION = '0.22'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Accessor; +use Moose::Util (); use Moose::Util::TypeConstraints (); use base 'Class::MOP::Attribute'; @@ -65,6 +66,39 @@ sub new { return $class->SUPER::new($name, %options); } +sub interpolate_class_and_new { + my ($class, $name, @args) = @_; + + $class->interpolate_class(@args)->new($name, @args); +} + +sub interpolate_class { + my ($class, %options) = @_; + + if ( my $metaclass_name = $options{metaclass} ) { + $class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name ); + } + + if (my $traits = $options{traits}) { + my @traits = map { + Moose::Util::resolve_metatrait_alias( Attribute => $_ ) + or + $_ + } @$traits; + + my $anon_class = Moose::Meta::Class->create_anon_class( + superclasses => [ $class ], + roles => [ @traits ], + cache => 1, + ); + + return $anon_class->name; + } + else { + return $class; + } +} + sub clone_and_inherit_options { my ($self, %options) = @_; # you can change default, required, coerce, documentation, lazy, handles, builder, metaclass and traits @@ -609,6 +643,13 @@ creation and type coercion. =over 4 +=item B + +=item B + +When called as a class method causes interpretation of the C and +C options. + =item B This is to support the C feature, it clones an attribute diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 975ee8e..c591374 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -323,34 +323,8 @@ sub _process_attribute { sub _process_new_attribute { my ( $self, $name, @args ) = @_; - $self->_resolve_attribute_metaclass(@args)->new($name, @args); -} - -sub _resolve_attribute_metaclass { - my ( $self, %options ) = @_; - - my $attr_metaclass_name = $options{metaclass} - ? Moose::Util::resolve_metaclass_alias( Attribute => $options{metaclass} ) - : $self->attribute_metaclass; - - if (my $traits = $options{traits}) { - my @traits = map { - Moose::Util::resolve_metatrait_alias( Attribute => $_ ) - or - $_ - } @$traits; - my $class = Moose::Meta::Class->create_anon_class( - superclasses => [ $attr_metaclass_name ], - roles => [ @traits ], - cache => 1, - ); - - return $class->name; - } - else { - return $attr_metaclass_name; - } + $self->attribute_metaclass->interpolate_class_and_new($name, @args); } sub _process_inherited_attribute {