2 package Moose::Meta::Attribute;
9 use Scalar::Util 'blessed', 'weaken';
10 use List::MoreUtils 'any';
14 use Moose::Deprecated;
15 use Moose::Meta::Method::Accessor;
16 use Moose::Meta::Method::Delegation;
18 use Moose::Util::TypeConstraints ();
19 use Class::MOP::MiniTrait;
21 use base 'Class::MOP::Attribute', 'Moose::Meta::Mixin::AttributeCore';
23 Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
25 __PACKAGE__->meta->add_attribute('traits' => (
26 reader => 'applied_traits',
27 predicate => 'has_applied_traits',
30 # we need to have a ->does method in here to
31 # more easily support traits, and the introspection
32 # of those traits. We extend the does check to look
33 # for metatrait aliases.
35 my ($self, $role_name) = @_;
37 Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
39 return 0 if !defined($name); # failed to load class
40 return $self->Moose::Object::does($name);
45 require Moose::Meta::Class;
46 ( ref $self && $self->associated_class ) || "Moose::Meta::Class";
51 my $inv = $self->_error_thrower;
52 unshift @_, "message" if @_ % 2 == 1;
53 unshift @_, attr => $self if ref $self;
55 my $handler = $inv->can("throw_error"); # to avoid incrementing depth by 1
59 sub _inline_throw_error {
60 my ( $self, $msg, $args ) = @_;
62 my $inv = $self->_error_thrower;
64 $inv = 'Moose::Meta::Class' unless $inv->can('_inline_throw_error');
67 my $class = $self->associated_class;
69 my $class_name = B::perlstring($class->name);
70 my $attr_name = B::perlstring($self->name);
71 $args = 'attr => Class::MOP::class_of(' . $class_name . ')'
72 . '->find_attribute_by_name(' . $attr_name . '), '
73 . (defined $args ? $args : '');
76 return $inv->_inline_throw_error($msg, $args)
80 my ($class, $name, %options) = @_;
81 $class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
83 delete $options{__hack_no_process_options};
88 map { $_->init_arg() }
89 $class->meta()->get_all_attributes()
92 my @bad = sort grep { ! $attrs{$_} } keys %options;
96 Carp::cluck "Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad";
99 return $class->SUPER::new($name, %options);
102 sub interpolate_class_and_new {
103 my ($class, $name, %args) = @_;
105 my ( $new_class, @traits ) = $class->interpolate_class(\%args);
107 $new_class->new($name, %args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
110 sub interpolate_class {
111 my ($class, $options) = @_;
113 $class = ref($class) || $class;
115 if ( my $metaclass_name = delete $options->{metaclass} ) {
116 my $new_class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
118 if ( $class ne $new_class ) {
119 if ( $new_class->can("interpolate_class") ) {
120 return $new_class->interpolate_class($options);
129 if (my $traits = $options->{traits}) {
131 while ($i < @$traits) {
132 my $trait = $traits->[$i++];
133 next if ref($trait); # options to a trait we discarded
135 $trait = Moose::Util::resolve_metatrait_alias(Attribute => $trait)
138 next if $class->does($trait);
140 push @traits, $trait;
143 push @traits, $traits->[$i++]
144 if $traits->[$i] && ref($traits->[$i]);
148 my $anon_class = Moose::Meta::Class->create_anon_class(
149 superclasses => [ $class ],
150 roles => [ @traits ],
154 $class = $anon_class->name;
158 return ( wantarray ? ( $class, @traits ) : $class );
163 # method-generating options shouldn't be overridden
164 sub illegal_options_for_inheritance {
165 qw(reader writer accessor clearer predicate)
169 # This method *must* be able to handle
170 # Class::MOP::Attribute instances as
171 # well. Yes, I know that is wrong, but
172 # apparently we didn't realize it was
173 # doing that and now we have some code
174 # which is dependent on it. The real
175 # solution of course is to push this
176 # feature back up into Class::MOP::Attribute
177 # but I not right now, I am too lazy.
178 # However if you are reading this and
179 # looking for something to do,.. please
182 sub clone_and_inherit_options {
183 my ($self, %options) = @_;
186 # we may want to extends a Class::MOP::Attribute
187 # in which case we need to be able to use the
188 # core set of legal options that have always
189 # been here. But we allows Moose::Meta::Attribute
190 # instances to changes them.
192 my @illegal_options = $self->can('illegal_options_for_inheritance')
193 ? $self->illegal_options_for_inheritance
196 my @found_illegal_options = grep { exists $options{$_} && exists $self->{$_} ? $_ : undef } @illegal_options;
197 (scalar @found_illegal_options == 0)
198 || $self->throw_error("Illegal inherited options => (" . (join ', ' => @found_illegal_options) . ")", data => \%options);
202 if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
203 $type_constraint = $options{isa};
206 $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa});
207 (defined $type_constraint)
208 || $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa});
211 $options{type_constraint} = $type_constraint;
214 if ($options{does}) {
216 if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) {
217 $type_constraint = $options{does};
220 $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does});
221 (defined $type_constraint)
222 || $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does});
225 $options{type_constraint} = $type_constraint;
229 # this doesn't apply to Class::MOP::Attributes,
230 # so we can ignore it for them.
232 if ($self->can('interpolate_class')) {
233 ( $options{metaclass}, my @traits ) = $self->interpolate_class(\%options);
236 my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits;
237 $options{traits} = \@all_traits if @all_traits;
240 # This method can be called on a CMOP::Attribute object, so we need to
241 # make sure we can call this method.
242 $self->_process_lazy_build_option( $self->name, \%options )
243 if $self->can('_process_lazy_build_option');
245 $self->clone(%options);
249 my ( $self, %params ) = @_;
251 my $class = delete $params{metaclass} || ref $self;
253 my ( @init, @non_init );
255 foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) {
256 push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
259 my %new_params = ( ( map { $_->init_arg => $_->get_value($self) } @init ), %params );
261 my $name = delete $new_params{name};
263 my $clone = $class->new($name, %new_params, __hack_no_process_options => 1 );
265 foreach my $attr ( @non_init ) {
266 $attr->set_value($clone, $attr->get_value($self));
272 sub _process_options {
273 my ( $class, $name, $options ) = @_;
275 $class->_process_is_option( $name, $options );
276 $class->_process_isa_option( $name, $options );
277 $class->_process_does_option( $name, $options );
278 $class->_process_coerce_option( $name, $options );
279 $class->_process_trigger_option( $name, $options );
280 $class->_process_auto_deref_option( $name, $options );
281 $class->_process_lazy_build_option( $name, $options );
282 $class->_process_lazy_option( $name, $options );
283 $class->_process_required_option( $name, $options );
286 sub _process_is_option {
287 my ( $class, $name, $options ) = @_;
289 return unless $options->{is};
291 ### -------------------------
292 ## is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
293 ## is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
294 ## is => rw, accessor => _foo # turns into (accessor => _foo)
295 ## is => ro, accessor => _foo # error, accesor is rw
296 ### -------------------------
298 if ( $options->{is} eq 'ro' ) {
300 "Cannot define an accessor name on a read-only attribute, accessors are read/write",
302 if exists $options->{accessor};
303 $options->{reader} ||= $name;
305 elsif ( $options->{is} eq 'rw' ) {
306 if ( $options->{writer} ) {
307 $options->{reader} ||= $name;
310 $options->{accessor} ||= $name;
313 elsif ( $options->{is} eq 'bare' ) {
315 # do nothing, but don't complain (later) about missing methods
318 $class->throw_error( "I do not understand this option (is => "
320 . ") on attribute ($name)", data => $options->{is} );
324 sub _process_isa_option {
325 my ( $class, $name, $options ) = @_;
327 return unless exists $options->{isa};
329 if ( exists $options->{does} ) {
330 if ( try { $options->{isa}->can('does') } ) {
331 ( $options->{isa}->does( $options->{does} ) )
332 || $class->throw_error(
333 "Cannot have an isa option and a does option if the isa does not do the does on attribute ($name)",
338 "Cannot have an isa option which cannot ->does() on attribute ($name)",
343 # allow for anon-subtypes here ...
344 if ( blessed( $options->{isa} )
345 && $options->{isa}->isa('Moose::Meta::TypeConstraint') ) {
346 $options->{type_constraint} = $options->{isa};
349 $options->{type_constraint}
350 = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint(
355 sub _process_does_option {
356 my ( $class, $name, $options ) = @_;
358 return unless exists $options->{does} && ! exists $options->{isa};
360 # allow for anon-subtypes here ...
361 if ( blessed( $options->{does} )
362 && $options->{does}->isa('Moose::Meta::TypeConstraint') ) {
363 $options->{type_constraint} = $options->{does};
366 $options->{type_constraint}
367 = Moose::Util::TypeConstraints::find_or_create_does_type_constraint(
372 sub _process_coerce_option {
373 my ( $class, $name, $options ) = @_;
375 return unless $options->{coerce};
377 ( exists $options->{type_constraint} )
378 || $class->throw_error(
379 "You cannot have coercion without specifying a type constraint on attribute ($name)",
383 "You cannot have a weak reference to a coerced value on attribute ($name)",
385 if $options->{weak_ref};
387 unless ( $options->{type_constraint}->has_coercion ) {
388 my $type = $options->{type_constraint}->name;
390 Moose::Deprecated::deprecated(
391 feature => 'coerce without coercion',
393 "You cannot coerce an attribute ($name) unless its type ($type) has a coercion"
398 sub _process_trigger_option {
399 my ( $class, $name, $options ) = @_;
401 return unless exists $options->{trigger};
403 ( 'CODE' eq ref $options->{trigger} )
404 || $class->throw_error("Trigger must be a CODE ref on attribute ($name)", data => $options->{trigger});
407 sub _process_auto_deref_option {
408 my ( $class, $name, $options ) = @_;
410 return unless $options->{auto_deref};
412 ( exists $options->{type_constraint} )
413 || $class->throw_error(
414 "You cannot auto-dereference without specifying a type constraint on attribute ($name)",
417 ( $options->{type_constraint}->is_a_type_of('ArrayRef')
418 || $options->{type_constraint}->is_a_type_of('HashRef') )
419 || $class->throw_error(
420 "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)",
424 sub _process_lazy_build_option {
425 my ( $class, $name, $options ) = @_;
427 return unless $options->{lazy_build};
430 "You can not use lazy_build and default for the same attribute ($name)",
432 if exists $options->{default};
434 $options->{lazy} = 1;
435 $options->{builder} ||= "_build_${name}";
437 if ( $name =~ /^_/ ) {
438 $options->{clearer} ||= "_clear${name}";
439 $options->{predicate} ||= "_has${name}";
442 $options->{clearer} ||= "clear_${name}";
443 $options->{predicate} ||= "has_${name}";
447 sub _process_lazy_option {
448 my ( $class, $name, $options ) = @_;
450 return unless $options->{lazy};
452 ( exists $options->{default} || defined $options->{builder} )
453 || $class->throw_error(
454 "You cannot have a lazy attribute ($name) without specifying a default value for it",
458 sub _process_required_option {
459 my ( $class, $name, $options ) = @_;
464 ( !exists $options->{init_arg} || defined $options->{init_arg} )
465 || exists $options->{default}
466 || defined $options->{builder}
470 "You cannot have a required attribute ($name) without a default, builder, or an init_arg",
475 sub initialize_instance_slot {
476 my ($self, $meta_instance, $instance, $params) = @_;
477 my $init_arg = $self->init_arg();
478 # try to fetch the init arg from the %params ...
482 if ( defined($init_arg) and exists $params->{$init_arg}) {
483 $val = $params->{$init_arg};
487 # skip it if it's lazy
488 return if $self->is_lazy;
489 # and die if it's required and doesn't have a default value
490 $self->throw_error("Attribute (" . $self->name . ") is required", object => $instance, data => $params)
491 if $self->is_required && !$self->has_default && !$self->has_builder;
493 # if nothing was in the %params, we can use the
494 # attribute's default value (if it has one)
495 if ($self->has_default) {
496 $val = $self->default($instance);
499 elsif ($self->has_builder) {
500 $val = $self->_call_builder($instance);
505 return unless $value_is_set;
507 $val = $self->_coerce_and_verify( $val, $instance );
509 $self->set_initial_value($instance, $val);
511 if ( ref $val && $self->is_weak_ref ) {
512 $self->_weaken_value($instance);
517 my ( $self, $instance ) = @_;
519 my $builder = $self->builder();
521 return $instance->$builder()
522 if $instance->can( $self->builder );
524 $self->throw_error( blessed($instance)
525 . " does not support builder method '"
527 . "' for attribute '"
536 sub _make_initializer_writer_callback {
538 my ($meta_instance, $instance, $slot_name) = @_;
539 my $old_callback = $self->SUPER::_make_initializer_writer_callback(@_);
541 $old_callback->($self->_coerce_and_verify($_[0], $instance));
546 my ($self, $instance, @args) = @_;
547 my $value = $args[0];
549 my $attr_name = quotemeta($self->name);
551 if ($self->is_required and not @args) {
552 $self->throw_error("Attribute ($attr_name) is required", object => $instance);
555 $value = $self->_coerce_and_verify( $value, $instance );
558 if ( $self->has_trigger && $self->has_value($instance) ) {
559 @old = $self->get_value($instance, 'for trigger');
562 $self->SUPER::set_value($instance, $value);
564 if ( ref $value && $self->is_weak_ref ) {
565 $self->_weaken_value($instance);
568 if ($self->has_trigger) {
569 $self->trigger->($instance, $value, @old);
573 sub _inline_set_value {
575 my ($instance, $value, $tc, $coercion, $message, $for_constructor) = @_;
579 $tc ||= '$type_constraint';
580 $coercion ||= '$type_coercion';
581 $message ||= '$type_message';
584 if ($self->_writer_value_needs_copy) {
585 push @code, $self->_inline_copy_value($value, $copy);
589 # constructors already handle required checks
590 push @code, $self->_inline_check_required
591 unless $for_constructor;
593 push @code, $self->_inline_tc_code($value, $tc, $coercion, $message);
595 # constructors do triggers all at once at the end
596 push @code, $self->_inline_get_old_value_for_trigger($instance, $old)
597 unless $for_constructor;
600 $self->SUPER::_inline_set_value($instance, $value),
601 $self->_inline_weaken_value($instance, $value),
604 # constructors do triggers all at once at the end
605 push @code, $self->_inline_trigger($instance, $value, $old)
606 unless $for_constructor;
611 sub _writer_value_needs_copy {
613 return $self->should_coerce;
616 sub _inline_copy_value {
618 my ($value, $copy) = @_;
620 return 'my ' . $copy . ' = ' . $value . ';'
623 sub _inline_check_required {
626 return unless $self->is_required;
628 my $attr_name = quotemeta($self->name);
632 $self->_inline_throw_error(
633 '"Attribute (' . $attr_name . ') is required, so cannot '
634 . 'be set to undef"' # defined $_[1] is not good enough
640 sub _inline_tc_code {
642 my ($value, $tc, $coercion, $message, $is_lazy) = @_;
644 $self->_inline_check_coercion(
645 $value, $tc, $coercion, $is_lazy,
647 $self->_inline_check_constraint(
648 $value, $tc, $message, $is_lazy,
653 sub _inline_check_coercion {
655 my ($value, $tc, $coercion) = @_;
657 return unless $self->should_coerce && $self->type_constraint->has_coercion;
659 if ( $self->type_constraint->can_be_inlined ) {
661 'if (! (' . $self->type_constraint->_inline_check($value) . ')) {',
662 $value . ' = ' . $coercion . '->(' . $value . ');',
668 'if (!' . $tc . '->(' . $value . ')) {',
669 $value . ' = ' . $coercion . '->(' . $value . ');',
675 sub _inline_check_constraint {
677 my ($value, $tc, $message) = @_;
679 return unless $self->has_type_constraint;
681 my $attr_name = quotemeta($self->name);
683 if ( $self->type_constraint->can_be_inlined ) {
685 'if (! (' . $self->type_constraint->_inline_check($value) . ')) {',
686 $self->_inline_throw_error(
687 '"Attribute (' . $attr_name . ') does not pass the type '
688 . 'constraint because: " . '
689 . 'do { local $_ = ' . $value . '; '
690 . $message . '->(' . $value . ')'
699 'if (!' . $tc . '->(' . $value . ')) {',
700 $self->_inline_throw_error(
701 '"Attribute (' . $attr_name . ') does not pass the type '
702 . 'constraint because: " . '
703 . 'do { local $_ = ' . $value . '; '
704 . $message . '->(' . $value . ')'
713 sub _inline_get_old_value_for_trigger {
715 my ($instance, $old) = @_;
717 return unless $self->has_trigger;
720 'my ' . $old . ' = ' . $self->_inline_instance_has($instance),
721 '? ' . $self->_inline_instance_get($instance),
726 sub _inline_weaken_value {
728 my ($instance, $value) = @_;
730 return unless $self->is_weak_ref;
732 my $mi = $self->associated_class->get_meta_instance;
734 $mi->inline_weaken_slot_value($instance, $self->name, $value),
735 'if ref ' . $value . ';',
739 sub _inline_trigger {
741 my ($instance, $value, $old) = @_;
743 return unless $self->has_trigger;
745 return '$trigger->(' . $instance . ', ' . $value . ', ' . $old . ');';
749 my ( $self, $instance ) = @_;
751 my $meta_instance = Class::MOP::Class->initialize( blessed($instance) )
754 $meta_instance->weaken_slot_value( $instance, $self->name );
758 my ($self, $instance, $for_trigger) = @_;
760 if ($self->is_lazy) {
761 unless ($self->has_value($instance)) {
763 if ($self->has_default) {
764 $value = $self->default($instance);
765 } elsif ( $self->has_builder ) {
766 $value = $self->_call_builder($instance);
769 $value = $self->_coerce_and_verify( $value, $instance );
771 $self->set_initial_value($instance, $value);
775 if ( $self->should_auto_deref && ! $for_trigger ) {
777 my $type_constraint = $self->type_constraint;
779 if ($type_constraint->is_a_type_of('ArrayRef')) {
780 my $rv = $self->SUPER::get_value($instance);
781 return unless defined $rv;
782 return wantarray ? @{ $rv } : $rv;
784 elsif ($type_constraint->is_a_type_of('HashRef')) {
785 my $rv = $self->SUPER::get_value($instance);
786 return unless defined $rv;
787 return wantarray ? %{ $rv } : $rv;
790 $self->throw_error("Can not auto de-reference the type constraint '" . $type_constraint->name . "'", object => $instance, type_constraint => $type_constraint);
796 return $self->SUPER::get_value($instance);
800 sub _inline_get_value {
802 my ($instance, $tc, $coercion, $message) = @_;
804 my $slot_access = $self->_inline_instance_get($instance);
805 $tc ||= '$type_constraint';
806 $coercion ||= '$type_coercion';
807 $message ||= '$type_message';
810 $self->_inline_check_lazy($instance, $tc, $coercion, $message),
811 $self->_inline_return_auto_deref($slot_access),
815 sub _inline_check_lazy {
817 my ($instance, $tc, $coercion, $message) = @_;
819 return unless $self->is_lazy;
821 my $slot_exists = $self->_inline_instance_has($instance);
824 'if (!' . $slot_exists . ') {',
825 $self->_inline_init_from_default($instance, '$default', $tc, $coercion, $message, 'lazy'),
830 sub _inline_init_from_default {
832 my ($instance, $default, $tc, $coercion, $message, $for_lazy) = @_;
834 if (!($self->has_default || $self->has_builder)) {
836 'You cannot have a lazy attribute '
837 . '(' . $self->name . ') '
838 . 'without specifying a default value for it',
844 $self->_inline_generate_default($instance, $default),
845 # intentionally not using _inline_tc_code, since that can be overridden
846 # to do things like possibly only do member tc checks, which isn't
847 # appropriate for checking the result of a default
848 $self->has_type_constraint
849 ? ($self->_inline_check_coercion($default, $tc, $coercion, $for_lazy),
850 $self->_inline_check_constraint($default, $tc, $message, $for_lazy))
852 $self->_inline_init_slot($instance, $default),
856 sub _inline_generate_default {
858 my ($instance, $default) = @_;
860 if ($self->has_default) {
861 my $source = 'my ' . $default . ' = $default';
862 $source .= '->(' . $instance . ')'
863 if $self->is_default_a_coderef;
864 return $source . ';';
866 elsif ($self->has_builder) {
867 my $builder = B::perlstring($self->builder);
868 my $builder_str = quotemeta($self->builder);
869 my $attr_name_str = quotemeta($self->name);
871 'my ' . $default . ';',
872 'if (my $builder = ' . $instance . '->can(' . $builder . ')) {',
873 $default . ' = ' . $instance . '->$builder;',
876 'my $class = ref(' . $instance . ') || ' . $instance . ';',
877 $self->_inline_throw_error(
878 '"$class does not support builder method '
879 . '\'' . $builder_str . '\' for attribute '
880 . '\'' . $attr_name_str . '\'"'
887 "Can't generate a default for " . $self->name
888 . " since no default or builder was specified"
893 sub _inline_init_slot {
895 my ($inv, $value) = @_;
897 if ($self->has_initializer) {
898 return '$attr->set_initial_value(' . $inv . ', ' . $value . ');';
901 return $self->_inline_instance_set($inv, $value) . ';';
905 sub _inline_return_auto_deref {
908 return 'return ' . $self->_auto_deref(@_) . ';';
913 my ($ref_value) = @_;
915 return $ref_value unless $self->should_auto_deref;
917 my $type_constraint = $self->type_constraint;
920 if ($type_constraint->is_a_type_of('ArrayRef')) {
923 elsif ($type_constraint->is_a_type_of('HashRef')) {
928 'Can not auto de-reference the type constraint \''
929 . $type_constraint->name
931 type_constraint => $type_constraint,
936 . '? ' . $sigil . '{ (' . $ref_value . ') || return } '
937 . ': (' . $ref_value . ')';
940 ## installing accessors
942 sub accessor_metaclass { 'Moose::Meta::Method::Accessor' }
944 sub install_accessors {
946 $self->SUPER::install_accessors(@_);
947 $self->install_delegation if $self->has_handles;
951 sub _check_associated_methods {
954 @{ $self->associated_methods }
955 || ($self->_is_metadata || '') eq 'bare'
958 'Attribute (' . $self->name . ') of class '
959 . $self->associated_class->name
960 . ' has no associated methods'
961 . ' (did you mean to provide an "is" argument?)'
967 sub _process_accessors {
969 my ($type, $accessor, $generate_as_inline_methods) = @_;
971 $accessor = ( keys %$accessor )[0] if ( ref($accessor) || '' ) eq 'HASH';
972 my $method = $self->associated_class->get_method($accessor);
975 && $method->isa('Class::MOP::Method::Accessor')
976 && $method->associated_attribute->name ne $self->name ) {
978 my $other_attr_name = $method->associated_attribute->name;
979 my $name = $self->name;
982 "You are overwriting an accessor ($accessor) for the $other_attr_name attribute"
983 . " with a new accessor method for the $name attribute" );
988 && !$method->isa('Class::MOP::Method::Accessor')
989 && ( !$self->definition_context
990 || $method->package_name eq $self->definition_context->{package} )
994 "You are overwriting a locally defined method ($accessor) with "
998 if ( !$self->associated_class->has_method($accessor)
999 && $self->associated_class->has_package_symbol( '&' . $accessor ) ) {
1002 "You are overwriting a locally defined function ($accessor) with "
1006 $self->SUPER::_process_accessors(@_);
1009 sub remove_accessors {
1011 $self->SUPER::remove_accessors(@_);
1012 $self->remove_delegation if $self->has_handles;
1016 sub install_delegation {
1020 # Here we canonicalize the 'handles' option
1021 # this will sort out any details and always
1022 # return an hash of methods which we want
1023 # to delagate to, see that method for details
1024 my %handles = $self->_canonicalize_handles;
1027 # install the delegation ...
1028 my $associated_class = $self->associated_class;
1029 foreach my $handle (keys %handles) {
1030 my $method_to_call = $handles{$handle};
1031 my $class_name = $associated_class->name;
1032 my $name = "${class_name}::${handle}";
1034 (!$associated_class->has_method($handle))
1035 || $self->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation", method_name => $handle);
1038 # handles is not allowed to delegate
1039 # any of these methods, as they will
1040 # override the ones in your class, which
1041 # is almost certainly not what you want.
1043 # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
1044 #cluck("Not delegating method '$handle' because it is a core method") and
1045 next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
1047 my $method = $self->_make_delegation_method($handle, $method_to_call);
1049 $self->associated_class->add_method($method->name, $method);
1050 $self->associate_method($method);
1054 sub remove_delegation {
1056 my %handles = $self->_canonicalize_handles;
1057 my $associated_class = $self->associated_class;
1058 foreach my $handle (keys %handles) {
1059 next unless any { $handle eq $_ }
1061 @{ $self->associated_methods };
1062 $self->associated_class->remove_method($handle);
1066 # private methods to help delegation ...
1068 sub _canonicalize_handles {
1070 my $handles = $self->handles;
1071 if (my $handle_type = ref($handles)) {
1072 if ($handle_type eq 'HASH') {
1075 elsif ($handle_type eq 'ARRAY') {
1076 return map { $_ => $_ } @{$handles};
1078 elsif ($handle_type eq 'Regexp') {
1079 ($self->has_type_constraint)
1080 || $self->throw_error("Cannot delegate methods based on a Regexp without a type constraint (isa)", data => $handles);
1081 return map { ($_ => $_) }
1082 grep { /$handles/ } $self->_get_delegate_method_list;
1084 elsif ($handle_type eq 'CODE') {
1085 return $handles->($self, $self->_find_delegate_metaclass);
1087 elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::DuckType')) {
1088 return map { $_ => $_ } @{ $handles->methods };
1090 elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::Role')) {
1091 $handles = $handles->role;
1094 $self->throw_error("Unable to canonicalize the 'handles' option with $handles", data => $handles);
1098 Class::MOP::load_class($handles);
1099 my $role_meta = Class::MOP::class_of($handles);
1101 (blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
1102 || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because its metaclass is not a Moose::Meta::Role", data => $handles);
1104 return map { $_ => $_ }
1106 grep { !$_->isa('Class::MOP::Method::Meta') } (
1107 $role_meta->_get_local_methods,
1108 $role_meta->get_required_method_list,
1112 sub _get_delegate_method_list {
1114 my $meta = $self->_find_delegate_metaclass;
1115 if ($meta->isa('Class::MOP::Class')) {
1116 return map { $_->name } # NOTE: !never! delegate &meta
1117 grep { $_->package_name ne 'Moose::Object' && !$_->isa('Class::MOP::Method::Meta') }
1118 $meta->get_all_methods;
1120 elsif ($meta->isa('Moose::Meta::Role')) {
1121 return $meta->get_method_list;
1124 $self->throw_error("Unable to recognize the delegate metaclass '$meta'", data => $meta);
1128 sub _find_delegate_metaclass {
1130 if (my $class = $self->_isa_metadata) {
1131 unless ( Class::MOP::is_class_loaded($class) ) {
1134 'The %s attribute is trying to delegate to a class which has not been loaded - %s',
1139 # we might be dealing with a non-Moose class,
1140 # and need to make our own metaclass. if there's
1141 # already a metaclass, it will be returned
1142 return Class::MOP::Class->initialize($class);
1144 elsif (my $role = $self->_does_metadata) {
1145 unless ( Class::MOP::is_class_loaded($class) ) {
1148 'The %s attribute is trying to delegate to a role which has not been loaded - %s',
1154 return Class::MOP::class_of($role);
1157 $self->throw_error("Cannot find delegate metaclass for attribute " . $self->name);
1161 sub delegation_metaclass { 'Moose::Meta::Method::Delegation' }
1163 sub _make_delegation_method {
1164 my ( $self, $handle_name, $method_to_call ) = @_;
1166 my @curried_arguments;
1168 ($method_to_call, @curried_arguments) = @$method_to_call
1169 if 'ARRAY' eq ref($method_to_call);
1171 return $self->delegation_metaclass->new(
1172 name => $handle_name,
1173 package_name => $self->associated_class->name,
1175 delegate_to_method => $method_to_call,
1176 curried_arguments => \@curried_arguments,
1180 sub _coerce_and_verify {
1183 my $instance = shift;
1185 return $val unless $self->has_type_constraint;
1187 $val = $self->type_constraint->coerce($val)
1188 if $self->should_coerce && $self->type_constraint->has_coercion;
1190 $self->verify_against_type_constraint($val, instance => $instance);
1195 sub verify_against_type_constraint {
1199 return 1 if !$self->has_type_constraint;
1201 my $type_constraint = $self->type_constraint;
1203 $type_constraint->check($val)
1204 || $self->throw_error("Attribute ("
1206 . ") does not pass the type constraint because: "
1207 . $type_constraint->get_message($val), data => $val, @_);
1210 package Moose::Meta::Attribute::Custom::Moose;
1211 sub register_implementation { 'Moose::Meta::Attribute' }
1215 # ABSTRACT: The Moose attribute metaclass
1223 This class is a subclass of L<Class::MOP::Attribute> that provides
1224 additional Moose-specific functionality.
1226 To really understand this class, you will need to start with the
1227 L<Class::MOP::Attribute> documentation. This class can be understood
1228 as a set of additional features on top of the basic feature provided
1229 by that parent class.
1233 C<Moose::Meta::Attribute> is a subclass of L<Class::MOP::Attribute>.
1237 Many of the documented below override methods in
1238 L<Class::MOP::Attribute> and add Moose specific features.
1244 =item B<< Moose::Meta::Attribute->new(%options) >>
1246 This method overrides the L<Class::MOP::Attribute> constructor.
1248 Many of the options below are described in more detail in the
1249 L<Moose::Manual::Attributes> document.
1251 It adds the following options to the constructor:
1255 =item * is => 'ro', 'rw', 'bare'
1257 This provides a shorthand for specifying the C<reader>, C<writer>, or
1258 C<accessor> names. If the attribute is read-only ('ro') then it will
1259 have a C<reader> method with the same attribute as the name.
1261 If it is read-write ('rw') then it will have an C<accessor> method
1262 with the same name. If you provide an explicit C<writer> for a
1263 read-write attribute, then you will have a C<reader> with the same
1264 name as the attribute, and a C<writer> with the name you provided.
1266 Use 'bare' when you are deliberately not installing any methods
1267 (accessor, reader, etc.) associated with this attribute; otherwise,
1268 Moose will issue a deprecation warning when this attribute is added to a
1271 =item * isa => $type
1273 This option accepts a type. The type can be a string, which should be
1274 a type name. If the type name is unknown, it is assumed to be a class
1277 This option can also accept a L<Moose::Meta::TypeConstraint> object.
1279 If you I<also> provide a C<does> option, then your C<isa> option must
1280 be a class name, and that class must do the role specified with
1283 =item * does => $role
1285 This is short-hand for saying that the attribute's type must be an
1286 object which does the named role.
1288 =item * coerce => $bool
1290 This option is only valid for objects with a type constraint
1291 (C<isa>) that defined a coercion. If this is true, then coercions will be applied whenever
1292 this attribute is set.
1294 You can make both this and the C<weak_ref> option true.
1296 =item * trigger => $sub
1298 This option accepts a subroutine reference, which will be called after
1299 the attribute is set.
1301 =item * required => $bool
1303 An attribute which is required must be provided to the constructor. An
1304 attribute which is required can also have a C<default> or C<builder>,
1305 which will satisfy its required-ness.
1307 A required attribute must have a C<default>, C<builder> or a
1308 non-C<undef> C<init_arg>
1310 =item * lazy => $bool
1312 A lazy attribute must have a C<default> or C<builder>. When an
1313 attribute is lazy, the default value will not be calculated until the
1316 =item * weak_ref => $bool
1318 If this is true, the attribute's value will be stored as a weak
1321 =item * auto_deref => $bool
1323 If this is true, then the reader will dereference the value when it is
1324 called. The attribute must have a type constraint which defines the
1325 attribute as an array or hash reference.
1327 =item * lazy_build => $bool
1329 Setting this to true makes the attribute lazy and provides a number of
1337 is equivalent to this:
1342 builder => '_build_size',
1343 clearer => 'clear_size',
1344 predicate => 'has_size',
1348 If your attribute name starts with an underscore (C<_>), then the clearer
1349 and predicate will as well:
1361 builder => '_build__size',
1362 clearer => '_clear_size',
1363 predicate => '_has_size',
1366 Note the doubled underscore in the builder name. Internally, Moose
1367 simply prepends the attribute name with "_build_" to come up with the
1370 =item * documentation
1372 An arbitrary string that can be retrieved later by calling C<<
1373 $attr->documentation >>.
1377 =item B<< $attr->clone(%options) >>
1379 This creates a new attribute based on attribute being cloned. You must
1380 supply a C<name> option to provide a new name for the attribute.
1382 The C<%options> can only specify options handled by
1383 L<Class::MOP::Attribute>.
1387 =head2 Value management
1391 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
1393 This method is used internally to initialize the attribute's slot in
1394 the object C<$instance>.
1396 This overrides the L<Class::MOP::Attribute> method to handle lazy
1397 attributes, weak references, and type constraints.
1403 eval { $point->meta->get_attribute('x')->set_value($point, 'forty-two') };
1408 I<Attribute (x) does not pass the type constraint (Int) with 'forty-two'>
1410 Before setting the value, a check is made on the type constraint of
1411 the attribute, if it has one, to see if the value passes it. If the
1412 value fails to pass, the set operation dies with a L</throw_error>.
1414 Any coercion to convert values is done before checking the type constraint.
1416 To check a value against a type constraint before setting it, fetch the
1417 attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
1418 fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
1419 and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::Basics::Recipe4>
1424 =head2 Attribute Accessor generation
1428 =item B<< $attr->install_accessors >>
1430 This method overrides the parent to also install delegation methods.
1432 If, after installing all methods, the attribute object has no associated
1433 methods, it throws an error unless C<< is => 'bare' >> was passed to the
1434 attribute constructor. (Trying to add an attribute that has no associated
1435 methods is almost always an error.)
1437 =item B<< $attr->remove_accessors >>
1439 This method overrides the parent to also remove delegation methods.
1441 =item B<< $attr->inline_set($instance_var, $value_var) >>
1443 This method return a code snippet suitable for inlining the relevant
1444 operation. It expect strings containing variable names to be used in the
1445 inlining, like C<'$self'> or C<'$_[1]'>.
1447 =item B<< $attr->install_delegation >>
1449 This method adds its delegation methods to the attribute's associated
1450 class, if it has any to add.
1452 =item B<< $attr->remove_delegation >>
1454 This method remove its delegation methods from the attribute's
1457 =item B<< $attr->accessor_metaclass >>
1459 Returns the accessor metaclass name, which defaults to
1460 L<Moose::Meta::Method::Accessor>.
1462 =item B<< $attr->delegation_metaclass >>
1464 Returns the delegation metaclass name, which defaults to
1465 L<Moose::Meta::Method::Delegation>.
1469 =head2 Additional Moose features
1471 These methods are not found in the superclass. They support features
1476 =item B<< $attr->does($role) >>
1478 This indicates whether the I<attribute itself> does the given
1479 role. The role can be given as a full class name, or as a resolvable
1482 Note that this checks the attribute itself, not its type constraint,
1483 so it is checking the attribute's metaclass and any traits applied to
1486 =item B<< Moose::Meta::Class->interpolate_class_and_new($name, %options) >>
1488 This is an alternate constructor that handles the C<metaclass> and
1491 Effectively, this method is a factory that finds or creates the
1492 appropriate class for the given C<metaclass> and/or C<traits>.
1494 Once it has the appropriate class, it will call C<< $class->new($name,
1495 %options) >> on that class.
1497 =item B<< $attr->clone_and_inherit_options(%options) >>
1499 This method supports the C<has '+foo'> feature. It does various bits
1500 of processing on the supplied C<%options> before ultimately calling
1501 the C<clone> method.
1503 One of its main tasks is to make sure that the C<%options> provided
1504 does not include the options returned by the
1505 C<illegal_options_for_inheritance> method.
1507 =item B<< $attr->illegal_options_for_inheritance >>
1509 This returns a blacklist of options that can not be overridden in a
1510 subclass's attribute definition.
1512 This exists to allow a custom metaclass to change or add to the list
1513 of options which can not be changed.
1515 =item B<< $attr->type_constraint >>
1517 Returns the L<Moose::Meta::TypeConstraint> object for this attribute,
1520 =item B<< $attr->has_type_constraint >>
1522 Returns true if this attribute has a type constraint.
1524 =item B<< $attr->verify_against_type_constraint($value) >>
1526 Given a value, this method returns true if the value is valid for the
1527 attribute's type constraint. If the value is not valid, it throws an
1530 =item B<< $attr->handles >>
1532 This returns the value of the C<handles> option passed to the
1535 =item B<< $attr->has_handles >>
1537 Returns true if this attribute performs delegation.
1539 =item B<< $attr->is_weak_ref >>
1541 Returns true if this attribute stores its value as a weak reference.
1543 =item B<< $attr->is_required >>
1545 Returns true if this attribute is required to have a value.
1547 =item B<< $attr->is_lazy >>
1549 Returns true if this attribute is lazy.
1551 =item B<< $attr->is_lazy_build >>
1553 Returns true if the C<lazy_build> option was true when passed to the
1556 =item B<< $attr->should_coerce >>
1558 Returns true if the C<coerce> option passed to the constructor was
1561 =item B<< $attr->should_auto_deref >>
1563 Returns true if the C<auto_deref> option passed to the constructor was
1566 =item B<< $attr->trigger >>
1568 This is the subroutine reference that was in the C<trigger> option
1569 passed to the constructor, if any.
1571 =item B<< $attr->has_trigger >>
1573 Returns true if this attribute has a trigger set.
1575 =item B<< $attr->documentation >>
1577 Returns the value that was in the C<documentation> option passed to
1578 the constructor, if any.
1580 =item B<< $attr->has_documentation >>
1582 Returns true if this attribute has any documentation.
1584 =item B<< $attr->applied_traits >>
1586 This returns an array reference of all the traits which were applied
1587 to this attribute. If none were applied, this returns C<undef>.
1589 =item B<< $attr->has_applied_traits >>
1591 Returns true if this attribute has any traits applied.
1597 See L<Moose/BUGS> for details on reporting bugs.