2 package Moose::Meta::Attribute;
7 use Scalar::Util 'blessed', 'weaken';
11 our $VERSION = '0.52';
12 our $AUTHORITY = 'cpan:STEVAN';
14 use Moose::Meta::Method::Accessor;
16 use Moose::Util::TypeConstraints ();
18 use base 'Class::MOP::Attribute';
20 # options which are not directly used
21 # but we store them for metadata purposes
22 __PACKAGE__->meta->add_attribute('isa' => (reader => '_isa_metadata'));
23 __PACKAGE__->meta->add_attribute('does' => (reader => '_does_metadata'));
24 __PACKAGE__->meta->add_attribute('is' => (reader => '_is_metadata'));
26 # these are actual options for the attrs
27 __PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' ));
28 __PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' ));
29 __PACKAGE__->meta->add_attribute('lazy_build' => (reader => 'is_lazy_build' ));
30 __PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce' ));
31 __PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' ));
32 __PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
33 __PACKAGE__->meta->add_attribute('type_constraint' => (
34 reader => 'type_constraint',
35 predicate => 'has_type_constraint',
37 __PACKAGE__->meta->add_attribute('trigger' => (
39 predicate => 'has_trigger',
41 __PACKAGE__->meta->add_attribute('handles' => (
43 predicate => 'has_handles',
45 __PACKAGE__->meta->add_attribute('documentation' => (
46 reader => 'documentation',
47 predicate => 'has_documentation',
49 __PACKAGE__->meta->add_attribute('traits' => (
50 reader => 'applied_traits',
51 predicate => 'has_applied_traits',
54 # we need to have a ->does method in here to
55 # more easily support traits, and the introspection
56 # of those traits. We extend the does check to look
57 # for metatrait aliases.
59 my ($self, $role_name) = @_;
61 Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
63 return 0 if !defined($name); # failed to load class
64 return Moose::Object::does($self, $name);
68 my ($class, $name, %options) = @_;
69 $class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
70 return $class->SUPER::new($name, %options);
73 sub interpolate_class_and_new {
74 my ($class, $name, @args) = @_;
76 my ( $new_class, @traits ) = $class->interpolate_class(@args);
78 $new_class->new($name, @args, ( scalar(@traits) ? ( traits => \@traits ) : () ) );
81 sub interpolate_class {
82 my ($class, %options) = @_;
84 $class = ref($class) || $class;
86 if ( my $metaclass_name = delete $options{metaclass} ) {
87 my $new_class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
89 if ( $class ne $new_class ) {
90 if ( $new_class->can("interpolate_class") ) {
91 return $new_class->interpolate_class(%options);
100 if (my $traits = $options{traits}) {
101 if ( @traits = grep { not $class->does($_) } map {
102 Moose::Util::resolve_metatrait_alias( Attribute => $_ )
106 my $anon_class = Moose::Meta::Class->create_anon_class(
107 superclasses => [ $class ],
108 roles => [ @traits ],
112 $class = $anon_class->name;
116 return ( wantarray ? ( $class, @traits ) : $class );
119 sub clone_and_inherit_options {
120 my ($self, %options) = @_;
122 # you can change default, required, coerce, documentation, lazy, handles, builder, type_constraint (explicitly or using isa/does), metaclass and traits
124 foreach my $legal_option (qw(default coerce required documentation lazy handles builder type_constraint)) {
125 if (exists $options{$legal_option}) {
126 $actual_options{$legal_option} = $options{$legal_option};
127 delete $options{$legal_option};
133 if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
134 $type_constraint = $options{isa};
137 $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa});
138 (defined $type_constraint)
139 || confess "Could not find the type constraint '" . $options{isa} . "'";
142 $actual_options{type_constraint} = $type_constraint;
143 delete $options{isa};
146 if ($options{does}) {
148 if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) {
149 $type_constraint = $options{does};
152 $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does});
153 (defined $type_constraint)
154 || confess "Could not find the type constraint '" . $options{does} . "'";
157 $actual_options{type_constraint} = $type_constraint;
158 delete $options{does};
162 # this doesn't apply to Class::MOP::Attributes,
163 # so we can ignore it for them.
165 if ($self->can('interpolate_class')) {
166 ( $actual_options{metaclass}, my @traits ) = $self->interpolate_class(%options);
169 my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits;
170 $actual_options{traits} = \@all_traits if @all_traits;
172 delete @options{qw(metaclass traits)};
175 (scalar keys %options == 0)
176 || confess "Illegal inherited options => (" . (join ', ' => keys %options) . ")";
179 $self->clone(%actual_options);
183 my ( $self, %params ) = @_;
185 my $class = $params{metaclass} || ref $self;
187 if ( 0 and $class eq ref $self ) {
188 return $self->SUPER::clone(%params);
190 my ( @init, @non_init );
192 foreach my $attr ( grep { $_->has_value($self) } $self->meta->compute_all_applicable_attributes ) {
193 push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr;
196 my %new_params = ( ( map { $_->init_arg => $_->get_value($self) } @init ), %params );
198 my $name = delete $new_params{name};
200 my $clone = $class->new($name, %new_params, __hack_no_process_options => 1 );
202 foreach my $attr ( @non_init ) {
203 $attr->set_value($clone, $attr->get_value($self));
211 sub _process_options {
212 my ($class, $name, $options) = @_;
214 if (exists $options->{is}) {
216 ### -------------------------
217 ## is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before
218 ## is => rw, writer => _foo # turns into (reader => foo, writer => _foo)
219 ## is => rw, accessor => _foo # turns into (accessor => _foo)
220 ## is => ro, accessor => _foo # error, accesor is rw
221 ### -------------------------
223 if ($options->{is} eq 'ro') {
224 confess "Cannot define an accessor name on a read-only attribute, accessors are read/write"
225 if exists $options->{accessor};
226 $options->{reader} ||= $name;
228 elsif ($options->{is} eq 'rw') {
229 if ($options->{writer}) {
230 $options->{reader} ||= $name;
233 $options->{accessor} ||= $name;
237 confess "I do not understand this option (is => " . $options->{is} . ") on attribute ($name)"
241 if (exists $options->{isa}) {
242 if (exists $options->{does}) {
243 if (eval { $options->{isa}->can('does') }) {
244 ($options->{isa}->does($options->{does}))
245 || confess "Cannot have an isa option and a does option if the isa does not do the does on attribute ($name)";
248 confess "Cannot have an isa option which cannot ->does() on attribute ($name)";
252 # allow for anon-subtypes here ...
253 if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) {
254 $options->{type_constraint} = $options->{isa};
257 $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options->{isa});
260 elsif (exists $options->{does}) {
261 # allow for anon-subtypes here ...
262 if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) {
263 $options->{type_constraint} = $options->{does};
266 $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options->{does});
270 if (exists $options->{coerce} && $options->{coerce}) {
271 (exists $options->{type_constraint})
272 || confess "You cannot have coercion without specifying a type constraint on attribute ($name)";
273 confess "You cannot have a weak reference to a coerced value on attribute ($name)"
274 if $options->{weak_ref};
277 if (exists $options->{trigger}) {
278 ('CODE' eq ref $options->{trigger})
279 || confess "Trigger must be a CODE ref on attribute ($name)";
282 if (exists $options->{auto_deref} && $options->{auto_deref}) {
283 (exists $options->{type_constraint})
284 || confess "You cannot auto-dereference without specifying a type constraint on attribute ($name)";
285 ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
286 $options->{type_constraint}->is_a_type_of('HashRef'))
287 || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)";
290 if (exists $options->{lazy_build} && $options->{lazy_build} == 1) {
291 confess("You can not use lazy_build and default for the same attribute ($name)")
292 if exists $options->{default};
293 $options->{lazy} = 1;
294 $options->{required} = 1;
295 $options->{builder} ||= "_build_${name}";
297 $options->{clearer} ||= "_clear${name}";
298 $options->{predicate} ||= "_has${name}";
301 $options->{clearer} ||= "clear_${name}";
302 $options->{predicate} ||= "has_${name}";
306 if (exists $options->{lazy} && $options->{lazy}) {
307 (exists $options->{default} || defined $options->{builder} )
308 || confess "You cannot have lazy attribute ($name) without specifying a default value for it";
311 if ( $options->{required} && !( ( !exists $options->{init_arg} || defined $options->{init_arg} ) || exists $options->{default} || defined $options->{builder} ) ) {
312 confess "You cannot have a required attribute ($name) without a default, builder, or an init_arg";
317 sub initialize_instance_slot {
318 my ($self, $meta_instance, $instance, $params) = @_;
319 my $init_arg = $self->init_arg();
320 # try to fetch the init arg from the %params ...
324 if ( defined($init_arg) and exists $params->{$init_arg}) {
325 $val = $params->{$init_arg};
329 # skip it if it's lazy
330 return if $self->is_lazy;
331 # and die if it's required and doesn't have a default value
332 confess "Attribute (" . $self->name . ") is required"
333 if $self->is_required && !$self->has_default && !$self->has_builder;
335 # if nothing was in the %params, we can use the
336 # attribute's default value (if it has one)
337 if ($self->has_default) {
338 $val = $self->default($instance);
341 elsif ($self->has_builder) {
342 if (my $builder = $instance->can($self->builder)){
343 $val = $instance->$builder;
347 confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
352 return unless $value_is_set;
354 if ($self->has_type_constraint) {
355 my $type_constraint = $self->type_constraint;
356 if ($self->should_coerce && $type_constraint->has_coercion) {
357 $val = $type_constraint->coerce($val);
359 $type_constraint->check($val)
360 || confess "Attribute ("
362 . ") does not pass the type constraint because: "
363 . $type_constraint->get_message($val);
366 $self->set_initial_value($instance, $val);
367 $meta_instance->weaken_slot_value($instance, $self->name)
368 if ref $val && $self->is_weak_ref;
374 # this duplicates too much code from
375 # Class::MOP::Attribute, we need to
376 # refactor these bits eventually.
378 sub _set_initial_slot_value {
379 my ($self, $meta_instance, $instance, $value) = @_;
381 my $slot_name = $self->name;
383 return $meta_instance->set_slot_value($instance, $slot_name, $value)
384 unless $self->has_initializer;
386 my ($type_constraint, $can_coerce);
387 if ($self->has_type_constraint) {
388 $type_constraint = $self->type_constraint;
389 $can_coerce = ($self->should_coerce && $type_constraint->has_coercion);
394 if ($type_constraint) {
395 $val = $type_constraint->coerce($val)
397 $type_constraint->check($val)
398 || confess "Attribute ("
400 . ") does not pass the type constraint because: "
401 . $type_constraint->get_message($val);
403 $meta_instance->set_slot_value($instance, $slot_name, $val);
406 my $initializer = $self->initializer;
408 # most things will just want to set a value, so make it first arg
409 $instance->$initializer($value, $callback, $self);
413 my ($self, $instance, @args) = @_;
414 my $value = $args[0];
416 my $attr_name = $self->name;
418 if ($self->is_required and not @args) {
419 confess "Attribute ($attr_name) is required";
422 if ($self->has_type_constraint) {
424 my $type_constraint = $self->type_constraint;
426 if ($self->should_coerce) {
427 $value = $type_constraint->coerce($value);
429 $type_constraint->_compiled_type_constraint->($value)
430 || confess "Attribute ("
432 . ") does not pass the type constraint because "
433 . $type_constraint->get_message($value);
436 my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
439 $meta_instance->set_slot_value($instance, $attr_name, $value);
441 if (ref $value && $self->is_weak_ref) {
442 $meta_instance->weaken_slot_value($instance, $attr_name);
445 if ($self->has_trigger) {
446 $self->trigger->($instance, $value, $self);
451 my ($self, $instance) = @_;
453 if ($self->is_lazy) {
454 unless ($self->has_value($instance)) {
455 if ($self->has_default) {
456 my $default = $self->default($instance);
457 $self->set_initial_value($instance, $default);
458 } elsif ( $self->has_builder ) {
459 if (my $builder = $instance->can($self->builder)){
460 $self->set_initial_value($instance, $instance->$builder);
463 confess(blessed($instance)
464 . " does not support builder method '"
466 . "' for attribute '"
472 $self->set_initial_value($instance, undef);
477 if ($self->should_auto_deref) {
479 my $type_constraint = $self->type_constraint;
481 if ($type_constraint->is_a_type_of('ArrayRef')) {
482 my $rv = $self->SUPER::get_value($instance);
483 return unless defined $rv;
484 return wantarray ? @{ $rv } : $rv;
486 elsif ($type_constraint->is_a_type_of('HashRef')) {
487 my $rv = $self->SUPER::get_value($instance);
488 return unless defined $rv;
489 return wantarray ? %{ $rv } : $rv;
492 confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
498 return $self->SUPER::get_value($instance);
502 ## installing accessors
504 sub accessor_metaclass { 'Moose::Meta::Method::Accessor' }
506 sub install_accessors {
508 $self->SUPER::install_accessors(@_);
509 $self->install_delegation if $self->has_handles;
513 sub install_delegation {
517 # Here we canonicalize the 'handles' option
518 # this will sort out any details and always
519 # return an hash of methods which we want
520 # to delagate to, see that method for details
521 my %handles = $self->_canonicalize_handles();
523 # find the accessor method for this attribute
524 my $accessor = $self->get_read_method_ref;
525 # then unpack it if we need too ...
526 $accessor = $accessor->body if blessed $accessor;
528 # install the delegation ...
529 my $associated_class = $self->associated_class;
530 foreach my $handle (keys %handles) {
531 my $method_to_call = $handles{$handle};
532 my $class_name = $associated_class->name;
533 my $name = "${class_name}::${handle}";
535 (!$associated_class->has_method($handle))
536 || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
539 # handles is not allowed to delegate
540 # any of these methods, as they will
541 # override the ones in your class, which
542 # is almost certainly not what you want.
544 # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
545 #cluck("Not delegating method '$handle' because it is a core method") and
546 next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
548 if ('CODE' eq ref($method_to_call)) {
549 $associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call));
553 # we used to do a goto here, but the
554 # goto didn't handle failure correctly
555 # (it just returned nothing), so I took
556 # that out. However, the more I thought
557 # about it, the less I liked it doing
558 # the goto, and I prefered the act of
559 # delegation being actually represented
560 # in the stack trace.
562 $associated_class->add_method($handle => Class::MOP::subname($name, sub {
563 my $proxy = (shift)->$accessor();
565 || confess "Cannot delegate $handle to $method_to_call because " .
566 "the value of " . $self->name . " is not defined";
567 $proxy->$method_to_call(@_);
573 # private methods to help delegation ...
575 sub _canonicalize_handles {
577 my $handles = $self->handles;
578 if (my $handle_type = ref($handles)) {
579 if ($handle_type eq 'HASH') {
582 elsif ($handle_type eq 'ARRAY') {
583 return map { $_ => $_ } @{$handles};
585 elsif ($handle_type eq 'Regexp') {
586 ($self->has_type_constraint)
587 || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
588 return map { ($_ => $_) }
589 grep { /$handles/ } $self->_get_delegate_method_list;
591 elsif ($handle_type eq 'CODE') {
592 return $handles->($self, $self->_find_delegate_metaclass);
595 confess "Unable to canonicalize the 'handles' option with $handles";
599 my $role_meta = eval { $handles->meta };
601 confess "Unable to canonicalize the 'handles' option with $handles because : $@";
604 (blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
605 || confess "Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role";
607 return map { $_ => $_ } (
608 $role_meta->get_method_list,
609 $role_meta->get_required_method_list
614 sub _find_delegate_metaclass {
616 if (my $class = $self->_isa_metadata) {
617 # if the class does have
618 # a meta method, use it
619 return $class->meta if $class->can('meta');
620 # otherwise we might be
621 # dealing with a non-Moose
622 # class, and need to make
624 return Moose::Meta::Class->initialize($class);
626 elsif (my $role = $self->_does_metadata) {
627 # our role will always have
632 confess "Cannot find delegate metaclass for attribute " . $self->name;
636 sub _get_delegate_method_list {
638 my $meta = $self->_find_delegate_metaclass;
639 if ($meta->isa('Class::MOP::Class')) {
640 return map { $_->{name} } # NOTE: !never! delegate &meta
641 grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' }
642 $meta->compute_all_applicable_methods;
644 elsif ($meta->isa('Moose::Meta::Role')) {
645 return $meta->get_method_list;
648 confess "Unable to recognize the delegate metaclass '$meta'";
652 package Moose::Meta::Attribute::Custom::Moose;
653 sub register_implementation { 'Moose::Meta::Attribute' }
663 Moose::Meta::Attribute - The Moose attribute metaclass
667 This is a subclass of L<Class::MOP::Attribute> with Moose specific
670 For the most part, the only time you will ever encounter an
671 instance of this class is if you are doing some serious deep
672 introspection. To really understand this class, you need to refer
673 to the L<Class::MOP::Attribute> documentation.
677 =head2 Overridden methods
679 These methods override methods in L<Class::MOP::Attribute> and add
680 Moose specific features. You can safely assume though that they
681 will behave just as L<Class::MOP::Attribute> does.
691 =item B<initialize_instance_slot>
693 =item B<install_accessors>
695 =item B<install_delegation>
697 =item B<accessor_metaclass>
703 eval { $point->meta->get_attribute('x')->set_value($point, 'fourty-two') };
708 I<Attribute (x) does not pass the type constraint (Int) with 'fourty-two'>
710 Before setting the value, a check is made on the type constraint of
711 the attribute, if it has one, to see if the value passes it. If the
712 value fails to pass, the set operation dies with a L<Carp/confess>.
714 Any coercion to convert values is done before checking the type constraint.
716 To check a value against a type constraint before setting it, fetch the
717 attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
718 fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
719 and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::RecipeX>
724 =head2 Additional Moose features
726 Moose attributes support type-constraint checking, weak reference
727 creation and type coercion.
731 =item B<interpolate_class_and_new>
733 =item B<interpolate_class>
735 When called as a class method causes interpretation of the C<metaclass> and
738 =item B<clone_and_inherit_options>
740 This is to support the C<has '+foo'> feature, it clones an attribute
741 from a superclass and allows a very specific set of changes to be made
744 =item B<has_type_constraint>
746 Returns true if this meta-attribute has a type constraint.
748 =item B<type_constraint>
750 A read-only accessor for this meta-attribute's type constraint. For
751 more information on what you can do with this, see the documentation
752 for L<Moose::Meta::TypeConstraint>.
756 Returns true if this meta-attribute performs delegation.
760 This returns the value which was passed into the handles option.
764 Returns true if this meta-attribute produces a weak reference.
768 Returns true if this meta-attribute is required to have a value.
772 Returns true if this meta-attribute should be initialized lazily.
774 NOTE: lazy attributes, B<must> have a C<default> or C<builder> field set.
776 =item B<is_lazy_build>
778 Returns true if this meta-attribute should be initialized lazily through
779 the builder generated by lazy_build. Using C<lazy_build =E<gt> 1> will
780 make your attribute required and lazy. In addition it will set the builder, clearer
781 and predicate options for you using the following convention.
783 #If your attribute name starts with an underscore:
784 has '_foo' => (lazy_build => 1);
786 has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo);
788 has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', default => sub{shift->_build__foo});
790 #If your attribute name does not start with an underscore:
791 has 'foo' => (lazy_build => 1);
793 has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo);
795 has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', default => sub{shift->_build_foo});
797 The reason for the different naming of the C<builder> is that the C<builder>
798 method is a private method while the C<clearer> and C<predicate> methods
801 NOTE: This means your class should provide a method whose name matches the value
802 of the builder part, in this case _build__foo or _build_foo.
804 =item B<should_coerce>
806 Returns true if this meta-attribute should perform type coercion.
808 =item B<should_auto_deref>
810 Returns true if this meta-attribute should perform automatic
813 NOTE: This can only be done for attributes whose type constraint is
814 either I<ArrayRef> or I<HashRef>.
818 Returns true if this meta-attribute has a trigger set.
822 This is a CODE reference which will be executed every time the
823 value of an attribute is assigned. The CODE ref will get two values,
824 the invocant and the new value. This can be used to handle I<basic>
825 bi-directional relations.
827 =item B<documentation>
829 This is a string which contains the documentation for this attribute.
830 It serves no direct purpose right now, but it might in the future
831 in some kind of automated documentation system perhaps.
833 =item B<has_documentation>
835 Returns true if this meta-attribute has any documentation.
837 =item B<applied_traits>
839 This will return the ARRAY ref of all the traits applied to this
840 attribute, or if no traits have been applied, it returns C<undef>.
842 =item B<has_applied_traits>
844 Returns true if this meta-attribute has any traits applied.
850 All complex software has bugs lurking in it, and this module is no
851 exception. If you find a bug please either email me, or add the bug
856 Stevan Little E<lt>stevan@iinteractive.comE<gt>
858 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
860 =head1 COPYRIGHT AND LICENSE
862 Copyright 2006-2008 by Infinity Interactive, Inc.
864 L<http://www.iinteractive.com>
866 This library is free software; you can redistribute it and/or modify
867 it under the same terms as Perl itself.