2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'weaken';
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore';
17 # NOTE: (meta-circularity)
18 # This method will be replaced in the
19 # boostrap section of Class::MOP, by
20 # a new version which uses the
21 # &Class::MOP::Class::construct_instance
22 # method to build an attribute meta-object
23 # which itself is described with attribute
25 # - Ain't meta-circularity grand? :)
27 my ( $class, @args ) = @_;
29 unshift @args, "name" if @args % 2 == 1;
32 my $name = $options{name};
35 || confess "You must provide a name for the attribute";
37 $options{init_arg} = $name
38 if not exists $options{init_arg};
39 if(exists $options{builder}){
40 confess("builder must be a defined scalar value which is a method name")
41 if ref $options{builder} || !(defined $options{builder});
42 confess("Setting both default and builder is not allowed.")
43 if exists $options{default};
45 ($class->is_default_a_coderef(\%options))
46 || confess("References are not allowed as default values, you must ".
47 "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
48 if exists $options{default} && ref $options{default};
50 if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
51 confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
54 $class->_new(\%options);
60 return Class::MOP::Class->initialize($class)->new_object(@_)
61 if $class ne __PACKAGE__;
63 my $options = @_ == 1 ? $_[0] : {@_};
66 'name' => $options->{name},
67 'accessor' => $options->{accessor},
68 'reader' => $options->{reader},
69 'writer' => $options->{writer},
70 'predicate' => $options->{predicate},
71 'clearer' => $options->{clearer},
72 'builder' => $options->{builder},
73 'init_arg' => $options->{init_arg},
74 exists $options->{default}
75 ? ('default' => $options->{default})
77 'initializer' => $options->{initializer},
78 'definition_context' => $options->{definition_context},
79 # keep a weakened link to the
80 # class we are associated with
81 'associated_class' => undef,
82 # and a list of the methods
83 # associated with this attr
84 'associated_methods' => [],
85 # this let's us keep track of
86 # our order inside the associated
88 'insertion_order' => undef,
93 # this is a primative (and kludgy) clone operation
94 # for now, it will be replaced in the Class::MOP
95 # bootstrap with a proper one, however we know
96 # that this one will work fine for now.
101 || confess "Can only clone an instance";
102 return bless { %{$self}, %options } => ref($self);
105 sub initialize_instance_slot {
106 my ($self, $meta_instance, $instance, $params) = @_;
107 my $init_arg = $self->{'init_arg'};
109 # try to fetch the init arg from the %params ...
111 # if nothing was in the %params, we can use the
112 # attribute's default value (if it has one)
113 if(defined $init_arg and exists $params->{$init_arg}){
114 $self->_set_initial_slot_value(
117 $params->{$init_arg},
120 elsif (exists $self->{'default'}) {
121 $self->_set_initial_slot_value(
124 $self->default($instance),
127 elsif (defined( my $builder = $self->{'builder'})) {
128 if ($builder = $instance->can($builder)) {
129 $self->_set_initial_slot_value(
136 confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
141 sub _set_initial_slot_value {
142 my ($self, $meta_instance, $instance, $value) = @_;
144 my $slot_name = $self->name;
146 return $meta_instance->set_slot_value($instance, $slot_name, $value)
147 unless $self->has_initializer;
149 my $callback = $self->_make_initializer_writer_callback(
150 $meta_instance, $instance, $slot_name
153 my $initializer = $self->initializer;
155 # most things will just want to set a value, so make it first arg
156 $instance->$initializer($value, $callback, $self);
159 sub _make_initializer_writer_callback {
161 my ($meta_instance, $instance, $slot_name) = @_;
164 $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
168 sub get_read_method {
170 my $reader = $self->reader || $self->accessor;
172 return $reader unless ref $reader;
174 my ($name) = %$reader;
178 sub get_write_method {
180 my $writer = $self->writer || $self->accessor;
182 return $writer unless ref $writer;
184 my ($name) = %$writer;
188 sub get_read_method_ref {
190 if ((my $reader = $self->get_read_method) && $self->associated_class) {
191 return $self->associated_class->get_method($reader);
194 my $code = sub { $self->get_value(@_) };
195 if (my $class = $self->associated_class) {
196 return $class->method_metaclass->wrap(
198 package_name => $class->name,
208 sub get_write_method_ref {
210 if ((my $writer = $self->get_write_method) && $self->associated_class) {
211 return $self->associated_class->get_method($writer);
214 my $code = sub { $self->set_value(@_) };
215 if (my $class = $self->associated_class) {
216 return $class->method_metaclass->wrap(
218 package_name => $class->name,
230 sub slots { (shift)->name }
234 sub attach_to_class {
235 my ($self, $class) = @_;
236 (blessed($class) && $class->isa('Class::MOP::Class'))
237 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
238 weaken($self->{'associated_class'} = $class);
241 sub detach_from_class {
243 $self->{'associated_class'} = undef;
248 sub associate_method {
249 my ($self, $method) = @_;
250 push @{$self->{'associated_methods'}} => $method;
255 sub set_initial_value {
256 my ($self, $instance, $value) = @_;
257 $self->_set_initial_slot_value(
258 Class::MOP::Class->initialize(ref($instance))->get_meta_instance,
264 sub set_value { shift->set_raw_value(@_) }
268 my ($instance, $value) = @_;
270 my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
271 return $mi->set_slot_value($instance, $self->name, $value);
274 sub _inline_set_value {
276 return $self->_inline_instance_set(@_) . ';';
279 sub _inline_instance_set {
281 my ($instance, $value) = @_;
283 my $mi = $self->associated_class->get_meta_instance;
284 return $mi->inline_set_slot_value($instance, $self->name, $value);
287 sub get_value { shift->get_raw_value(@_) }
293 my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
294 return $mi->get_slot_value($instance, $self->name);
297 sub _inline_get_value {
299 return $self->_inline_instance_get(@_) . ';';
302 sub _inline_instance_get {
306 my $mi = $self->associated_class->get_meta_instance;
307 return $mi->inline_get_slot_value($instance, $self->name);
314 my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
315 return $mi->is_slot_initialized($instance, $self->name);
318 sub _inline_has_value {
320 return $self->_inline_instance_has(@_) . ';';
323 sub _inline_instance_has {
327 my $mi = $self->associated_class->get_meta_instance;
328 return $mi->inline_is_slot_initialized($instance, $self->name);
335 my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance;
336 return $mi->deinitialize_slot($instance, $self->name);
339 sub _inline_clear_value {
341 return $self->_inline_instance_clear(@_) . ';';
344 sub _inline_instance_clear {
348 my $mi = $self->associated_class->get_meta_instance;
349 return $mi->inline_deinitialize_slot($instance, $self->name);
354 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
356 sub _process_accessors {
357 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
361 if ( my $ctx = $self->definition_context ) {
362 $method_ctx = { %$ctx };
365 if (ref($accessor)) {
366 (ref($accessor) eq 'HASH')
367 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
368 my ($name, $method) = %{$accessor};
369 $method = $self->accessor_metaclass->wrap(
371 package_name => $self->associated_class->name,
373 definition_context => $method_ctx,
375 $self->associate_method($method);
376 return ($name, $method);
379 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
383 my $desc = "accessor $accessor";
384 if ( $accessor ne $self->name ) {
385 $desc .= " of attribute " . $self->name;
388 $method_ctx->{description} = $desc;
391 $method = $self->accessor_metaclass->new(
393 is_inline => $inline_me,
394 accessor_type => $type,
395 package_name => $self->associated_class->name,
397 definition_context => $method_ctx,
401 confess "Could not create the '$type' method for " . $self->name . " because : $_";
403 $self->associate_method($method);
404 return ($accessor, $method);
408 sub install_accessors {
411 my $class = $self->associated_class;
414 $self->_process_accessors('accessor' => $self->accessor(), $inline)
415 ) if $self->has_accessor();
418 $self->_process_accessors('reader' => $self->reader(), $inline)
419 ) if $self->has_reader();
422 $self->_process_accessors('writer' => $self->writer(), $inline)
423 ) if $self->has_writer();
426 $self->_process_accessors('predicate' => $self->predicate(), $inline)
427 ) if $self->has_predicate();
430 $self->_process_accessors('clearer' => $self->clearer(), $inline)
431 ) if $self->has_clearer();
437 my $_remove_accessor = sub {
438 my ($accessor, $class) = @_;
439 if (ref($accessor) && ref($accessor) eq 'HASH') {
440 ($accessor) = keys %{$accessor};
442 my $method = $class->get_method($accessor);
443 $class->remove_method($accessor)
444 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
447 sub remove_accessors {
450 # we really need to make sure to remove from the
451 # associates methods here as well. But this is
452 # such a slimly used method, I am not worried
453 # about it right now.
454 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
455 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
456 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
457 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
458 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
466 # ABSTRACT: Attribute Meta Object
474 Class::MOP::Attribute->new(
476 accessor => 'foo', # dual purpose get/set accessor
477 predicate => 'has_foo', # predicate check for defined-ness
478 init_arg => '-foo', # class->new will look for a -foo key
479 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
483 Class::MOP::Attribute->new(
485 reader => 'bar', # getter
486 writer => 'set_bar', # setter
487 predicate => 'has_bar', # predicate check for defined-ness
488 init_arg => ':bar', # class->new will look for a :bar key
489 # no default value means it is undef
495 The Attribute Protocol is almost entirely an invention of
496 C<Class::MOP>. Perl 5 does not have a consistent notion of
497 attributes. There are so many ways in which this is done, and very few
498 (if any) are easily discoverable by this module.
500 With that said, this module attempts to inject some order into this
501 chaos, by introducing a consistent API which can be used to create
510 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
512 An attribute must (at the very least), have a C<$name>. All other
513 C<%options> are added as key-value pairs.
519 This is a string value representing the expected key in an
520 initialization hash. For instance, if we have an C<init_arg> value of
521 C<-foo>, then the following code will Just Work.
523 MyClass->meta->new_object( -foo => 'Hello There' );
525 If an init_arg is not assigned, it will automatically use the
526 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
527 attribute cannot be specified during initialization.
531 This provides the name of a method that will be called to initialize
532 the attribute. This method will be called on the object after it is
533 constructed. It is expected to return a valid value for the attribute.
537 This can be used to provide an explicit default for initializing the
538 attribute. If the default you provide is a subroutine reference, then
539 this reference will be called I<as a method> on the object.
541 If the value is a simple scalar (string or number), then it can be
542 just passed as is. However, if you wish to initialize it with a HASH
543 or ARRAY ref, then you need to wrap that inside a subroutine
546 Class::MOP::Attribute->new(
548 default => sub { [] },
554 Class::MOP::Attribute->new(
556 default => sub { {} },
560 If you wish to initialize an attribute with a subroutine reference
561 itself, then you need to wrap that in a subroutine as well:
563 Class::MOP::Attribute->new(
566 sub { print "Hello World" }
571 And lastly, if the value of your attribute is dependent upon some
572 other aspect of the instance structure, then you can take advantage of
573 the fact that when the C<default> value is called as a method:
575 Class::MOP::Attribute->new(
576 'object_identity' => (
577 default => sub { Scalar::Util::refaddr( $_[0] ) },
581 Note that there is no guarantee that attributes are initialized in any
582 particular order, so you cannot rely on the value of some other
583 attribute when generating the default.
587 This option can be either a method name or a subroutine
588 reference. This method will be called when setting the attribute's
589 value in the constructor. Unlike C<default> and C<builder>, the
590 initializer is only called when a value is provided to the
591 constructor. The initializer allows you to munge this value during
594 The initializer is called as a method with three arguments. The first
595 is the value that was passed to the constructor. The second is a
596 subroutine reference that can be called to actually set the
597 attribute's value, and the last is the associated
598 C<Class::MOP::Attribute> object.
600 This contrived example shows an initializer that sets the attribute to
601 twice the given value.
603 Class::MOP::Attribute->new(
606 my ( $self, $value, $set, $attr ) = @_;
607 $set->( $value * 2 );
612 Since an initializer can be a method name, you can easily make
613 attribute initialization use the writer:
615 Class::MOP::Attribute->new(
617 writer => 'some_attr',
618 initializer => 'some_attr',
622 Your writer will need to examine C<@_> and determine under which
623 context it is being called.
627 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
628 options all accept the same parameters. You can provide the name of
629 the method, in which case an appropriate default method will be
630 generated for you. Or instead you can also provide hash reference
631 containing exactly one key (the method name) and one value. The value
632 should be a subroutine reference, which will be installed as the
639 An C<accessor> is a standard Perl-style read/write accessor. It will
640 return the value of the attribute, and if a value is passed as an
641 argument, it will assign that value to the attribute.
643 Note that C<undef> is a legitimate value, so this will work:
645 $object->set_something(undef);
649 This is a basic read-only accessor. It returns the value of the
654 This is a basic write accessor, it accepts a single argument, and
655 assigns that value to the attribute.
657 Note that C<undef> is a legitimate value, so this will work:
659 $object->set_something(undef);
663 The predicate method returns a boolean indicating whether or not the
664 attribute has been explicitly set.
666 Note that the predicate returns true even if the attribute was set to
667 a false value (C<0> or C<undef>).
671 This method will uninitialize the attribute. After an attribute is
672 cleared, its C<predicate> will return false.
674 =item * definition_context
676 Mostly, this exists as a hook for the benefit of Moose.
678 This option should be a hash reference containing several keys which
679 will be used when inlining the attribute's accessors. The keys should
680 include C<line>, the line number where the attribute was created, and
681 either C<file> or C<description>.
683 This information will ultimately be used when eval'ing inlined
684 accessor code so that error messages report a useful line and file
689 =item B<< $attr->clone(%options) >>
691 This clones the attribute. Any options you provide will override the
692 settings of the original attribute. You can change the name of the new
693 attribute by passing a C<name> key in C<%options>.
699 These are all basic read-only accessors for the values passed into
704 =item B<< $attr->name >>
706 Returns the attribute's name.
708 =item B<< $attr->accessor >>
710 =item B<< $attr->reader >>
712 =item B<< $attr->writer >>
714 =item B<< $attr->predicate >>
716 =item B<< $attr->clearer >>
718 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
719 methods all return exactly what was passed to the constructor, so it
720 can be either a string containing a method name, or a hash reference.
722 =item B<< $attr->initializer >>
724 Returns the initializer as passed to the constructor, so this may be
725 either a method name or a subroutine reference.
727 =item B<< $attr->init_arg >>
729 =item B<< $attr->is_default_a_coderef >>
731 =item B<< $attr->default($instance) >>
733 The C<$instance> argument is optional. If you don't pass it, the
734 return value for this method is exactly what was passed to the
735 constructor, either a simple scalar or a subroutine reference.
737 If you I<do> pass an C<$instance> and the default is a subroutine
738 reference, then the reference is called as a method on the
739 C<$instance> and the generated value is returned.
741 =item B<< $attr->slots >>
743 Return a list of slots required by the attribute. This is usually just
744 one, the name of the attribute.
746 A slot is the name of the hash key used to store the attribute in an
749 =item B<< $attr->get_read_method >>
751 =item B<< $attr->get_write_method >>
753 Returns the name of a method suitable for reading or writing the value
754 of the attribute in the associated class.
756 If an attribute is read- or write-only, then these methods can return
757 C<undef> as appropriate.
759 =item B<< $attr->has_read_method >>
761 =item B<< $attr->has_write_method >>
763 This returns a boolean indicating whether the attribute has a I<named>
764 read or write method.
766 =item B<< $attr->get_read_method_ref >>
768 =item B<< $attr->get_write_method_ref >>
770 Returns the subroutine reference of a method suitable for reading or
771 writing the attribute's value in the associated class. These methods
772 always return a subroutine reference, regardless of whether or not the
773 attribute is read- or write-only.
775 =item B<< $attr->insertion_order >>
777 If this attribute has been inserted into a class, this returns a zero
778 based index regarding the order of insertion.
782 =head2 Informational predicates
784 These are all basic predicate methods for the values passed into C<new>.
788 =item B<< $attr->has_accessor >>
790 =item B<< $attr->has_reader >>
792 =item B<< $attr->has_writer >>
794 =item B<< $attr->has_predicate >>
796 =item B<< $attr->has_clearer >>
798 =item B<< $attr->has_initializer >>
800 =item B<< $attr->has_init_arg >>
802 This will be I<false> if the C<init_arg> was set to C<undef>.
804 =item B<< $attr->has_default >>
806 This will be I<false> if the C<default> was set to C<undef>, since
807 C<undef> is the default C<default> anyway.
809 =item B<< $attr->has_builder >>
811 =item B<< $attr->has_insertion_order >>
813 This will be I<false> if this attribute has not be inserted into a class
817 =head2 Value management
819 These methods are basically "back doors" to the instance, and can be
820 used to bypass the regular accessors, but still stay within the MOP.
822 These methods are not for general use, and should only be used if you
823 really know what you are doing.
827 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
829 This method is used internally to initialize the attribute's slot in
830 the object C<$instance>.
832 The C<$params> is a hash reference of the values passed to the object
835 It's unlikely that you'll need to call this method yourself.
837 =item B<< $attr->set_value($instance, $value) >>
839 Sets the value without going through the accessor. Note that this
840 works even with read-only attributes.
842 =item B<< $attr->set_raw_value($instance, $value) >>
844 Sets the value with no side effects such as a trigger.
846 This doesn't actually apply to Class::MOP attributes, only to subclasses.
848 =item B<< $attr->set_initial_value($instance, $value) >>
850 Sets the value without going through the accessor. This method is only
851 called when the instance is first being initialized.
853 =item B<< $attr->get_value($instance) >>
855 Returns the value without going through the accessor. Note that this
856 works even with write-only accessors.
858 =item B<< $attr->get_raw_value($instance) >>
860 Returns the value without any side effects such as lazy attributes.
862 Doesn't actually apply to Class::MOP attributes, only to subclasses.
864 =item B<< $attr->has_value($instance) >>
866 Return a boolean indicating whether the attribute has been set in
867 C<$instance>. This how the default C<predicate> method works.
869 =item B<< $attr->clear_value($instance) >>
871 This will clear the attribute's value in C<$instance>. This is what
872 the default C<clearer> calls.
874 Note that this works even if the attribute does not have any
875 associated read, write or clear methods.
879 =head2 Class association
881 These methods allow you to manage the attributes association with
882 the class that contains it. These methods should not be used
883 lightly, nor are they very magical, they are mostly used internally
884 and by metaclass instances.
888 =item B<< $attr->associated_class >>
890 This returns the C<Class::MOP::Class> with which this attribute is
893 =item B<< $attr->attach_to_class($metaclass) >>
895 This method stores a weakened reference to the C<$metaclass> object
898 This method does not remove the attribute from its old class,
899 nor does it create any accessors in the new class.
901 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
904 =item B<< $attr->detach_from_class >>
906 This method removes the associate metaclass object from the attribute
909 This method does not remove the attribute itself from the class, or
910 remove its accessors.
912 It is probably best to use the L<Class::MOP::Class>
913 C<remove_attribute> method instead.
917 =head2 Attribute Accessor generation
921 =item B<< $attr->accessor_metaclass >>
923 Accessor methods are generated using an accessor metaclass. By
924 default, this is L<Class::MOP::Method::Accessor>. This method returns
925 the name of the accessor metaclass that this attribute uses.
927 =item B<< $attr->associate_method($method) >>
929 This associates a L<Class::MOP::Method> object with the
930 attribute. Typically, this is called internally when an attribute
931 generates its accessors.
933 =item B<< $attr->associated_methods >>
935 This returns the list of methods which have been associated with the
938 =item B<< $attr->install_accessors >>
940 This method generates and installs code the attributes various
941 accessors. It is typically called from the L<Class::MOP::Class>
942 C<add_attribute> method.
944 =item B<< $attr->remove_accessors >>
946 This method removes all of the accessors associated with the
949 This does not currently remove methods from the list returned by
950 C<associated_methods>.
952 =item B<< $attr->inline_get >>
954 =item B<< $attr->inline_set >>
956 =item B<< $attr->inline_has >>
958 =item B<< $attr->inline_clear >>
960 These methods return a code snippet suitable for inlining the relevant
961 operation. They expect strings containing variable names to be used in the
962 inlining, like C<'$self'> or C<'$_[1]'>.
970 =item B<< Class::MOP::Attribute->meta >>
972 This will return a L<Class::MOP::Class> instance for this class.
974 It should also be noted that L<Class::MOP> will actually bootstrap
975 this module by installing a number of attribute meta-objects into its