From: Yuval Kogman <nothingmuch@woobling.org>
Date: Thu, 24 Apr 2008 19:25:01 +0000 (+0000)
Subject: Move the short name resolution magic of metaclass/traits params into Moose::Util... 
X-Git-Tag: 0_55~213
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3738e5b694e89eb03672de763214bf156421101;p=gitmo%2FMoose.git

Move the short name resolution magic of metaclass/traits params into Moose::Util::resolve_metaclass_alias
---

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index f15c8e1..c5730ae 100644
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -309,54 +309,30 @@ sub _apply_all_roles {
 }
 
 sub _process_attribute {
-    my $self    = shift;
-    my $name    = shift;
-    my %options = ((scalar @_ == 1 && ref($_[0]) eq 'HASH') ? %{$_[0]} : @_);
+    my ( $self, $name, @args ) = @_;
+    my %options = ((scalar @args == 1 && ref($args[0]) eq 'HASH') ? %{$args[0]} : @args);
 
     if ($name =~ /^\+(.*)/) {
         return $self->_process_inherited_attribute($1, %options);
     }
     else {
-        my $attr_metaclass_name;
-        if ($options{metaclass}) {
-            my $metaclass_name = $options{metaclass};
-            eval {
-                my $possible_full_name = 'Moose::Meta::Attribute::Custom::' . $metaclass_name;
-                Class::MOP::load_class($possible_full_name);
-                $metaclass_name = $possible_full_name->can('register_implementation')
-                    ? $possible_full_name->register_implementation
-                    : $possible_full_name;
-            };
-            if ($@) {
-                Class::MOP::load_class($metaclass_name);
-            }
-            $attr_metaclass_name = $metaclass_name;
-        }
-        else {
-            $attr_metaclass_name = $self->attribute_metaclass;
-        }
+        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;
 
-        if ($options{traits}) {
-            my @traits;
-            foreach my $trait (@{$options{traits}}) {
-                eval {
-                    my $possible_full_name = 'Moose::Meta::Attribute::Custom::Trait::' . $trait;
-                    Class::MOP::load_class($possible_full_name);
-                    push @traits => $possible_full_name->can('register_implementation')
-                      ? $possible_full_name->register_implementation
-                        : $possible_full_name;
-                };
-                if ($@) {
-                    push @traits => $trait;
-                }
-            }
-            
             my $class = Moose::Meta::Class->create_anon_class(
                 superclasses => [ $attr_metaclass_name ],
                 roles        => [ @traits ],
                 cache        => 1,
             );
-            
+
             $attr_metaclass_name = $class->name;
         }
         
diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 32cf5a9..46b57f6 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -118,6 +118,29 @@ sub get_all_init_args {
     };
 }
 
+sub resolve_metatrait_alias {
+    resolve_metaclass_alias( @_, trait => 1 );
+}
+
+sub resolve_metaclass_alias {
+    my ( $type, $metaclass_name, %options ) = @_;
+
+    if ( my $resolved = eval {
+        my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
+
+        Class::MOP::load_class($possible_full_name);
+
+        $possible_full_name->can('register_implementation')
+            ? $possible_full_name->register_implementation
+            : $possible_full_name;
+    } ) {
+        return $resolved;
+    } else {
+        Class::MOP::load_class($metaclass_name);
+        return $metaclass_name;
+    }
+}
+
 
 1;
 
@@ -189,6 +212,18 @@ Returns a hash reference where the keys are all the attributes' C<init_arg>s
 and the values are the instance's fields. Attributes without an C<init_arg>
 will be skipped.
 
+=item B<resolve_metaclass_alias($category, $name, %options)>
+
+=item B<resolve_metatrait_alias($category, $name, %options)>
+
+Resolve a short name like in e.g.
+
+    has foo => (
+        metaclass => "Bar",
+    );
+
+to a full class name.
+
 =back
 
 =head1 TODO