}
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;
}
};
}
+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;
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