our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
+use Moose::Util ();
use Moose::Util::TypeConstraints ();
use base 'Class::MOP::Attribute';
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
=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
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 {