metaclass and traits interpolation moved to Meta::Attribute
Yuval Kogman [Thu, 24 Apr 2008 20:07:55 +0000 (20:07 +0000)]
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/Class.pm

index 0c9d98a..0bd227a 100644 (file)
@@ -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<interpolate_class_and_new>
+
+=item B<interpolate_class>
+
+When called as a class method causes interpretation of the C<metaclass> and
+C<traits> options.
+
 =item B<clone_and_inherit_options>
 
 This is to support the C<has '+foo'> feature, it clones an attribute
index 975ee8e..c591374 100644 (file)
@@ -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 {