2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'weaken';
12 our $VERSION = '0.92';
13 $VERSION = eval $VERSION;
14 our $AUTHORITY = 'cpan:STEVAN';
16 use base 'Class::MOP::Object';
18 # NOTE: (meta-circularity)
19 # This method will be replaced in the
20 # boostrap section of Class::MOP, by
21 # a new version which uses the
22 # &Class::MOP::Class::construct_instance
23 # method to build an attribute meta-object
24 # which itself is described with attribute
26 # - Ain't meta-circularity grand? :)
28 my ( $class, @args ) = @_;
30 unshift @args, "name" if @args % 2 == 1;
33 my $name = $options{name};
36 || confess "You must provide a name for the attribute";
38 $options{init_arg} = $name
39 if not exists $options{init_arg};
40 if(exists $options{builder}){
41 confess("builder must be a defined scalar value which is a method name")
42 if ref $options{builder} || !(defined $options{builder});
43 confess("Setting both default and builder is not allowed.")
44 if exists $options{default};
46 (is_default_a_coderef(\%options))
47 || confess("References are not allowed as default values, you must ".
48 "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
49 if exists $options{default} && ref $options{default};
51 if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
52 confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
55 $class->_new(\%options);
61 return Class::MOP::Class->initialize($class)->new_object(@_)
62 if $class ne __PACKAGE__;
64 my $options = @_ == 1 ? $_[0] : {@_};
67 'name' => $options->{name},
68 'accessor' => $options->{accessor},
69 'reader' => $options->{reader},
70 'writer' => $options->{writer},
71 'predicate' => $options->{predicate},
72 'clearer' => $options->{clearer},
73 'builder' => $options->{builder},
74 'init_arg' => $options->{init_arg},
75 'default' => $options->{default},
76 'initializer' => $options->{initializer},
77 'definition_context' => $options->{definition_context},
78 # keep a weakened link to the
79 # class we are associated with
80 'associated_class' => undef,
81 # and a list of the methods
82 # associated with this attr
83 'associated_methods' => [],
84 # this let's us keep track of
85 # our order inside the associated
87 'insertion_order' => undef,
92 # this is a primative (and kludgy) clone operation
93 # for now, it will be replaced in the Class::MOP
94 # bootstrap with a proper one, however we know
95 # that this one will work fine for now.
100 || confess "Can only clone an instance";
101 return bless { %{$self}, %options } => ref($self);
104 sub initialize_instance_slot {
105 my ($self, $meta_instance, $instance, $params) = @_;
106 my $init_arg = $self->{'init_arg'};
108 # try to fetch the init arg from the %params ...
110 # if nothing was in the %params, we can use the
111 # attribute's default value (if it has one)
112 if(defined $init_arg and exists $params->{$init_arg}){
113 $self->_set_initial_slot_value(
116 $params->{$init_arg},
119 elsif (defined $self->{'default'}) {
120 $self->_set_initial_slot_value(
123 $self->default($instance),
126 elsif (defined( my $builder = $self->{'builder'})) {
127 if ($builder = $instance->can($builder)) {
128 $self->_set_initial_slot_value(
135 confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
140 sub _set_initial_slot_value {
141 my ($self, $meta_instance, $instance, $value) = @_;
143 my $slot_name = $self->name;
145 return $meta_instance->set_slot_value($instance, $slot_name, $value)
146 unless $self->has_initializer;
149 $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
152 my $initializer = $self->initializer;
154 # most things will just want to set a value, so make it first arg
155 $instance->$initializer($value, $callback, $self);
158 sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor }
159 sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor }
161 sub get_read_method {
163 my $reader = $self->reader || $self->accessor;
165 return $reader unless ref $reader;
167 my ($name) = %$reader;
171 sub get_write_method {
173 my $writer = $self->writer || $self->accessor;
175 return $writer unless ref $writer;
177 my ($name) = %$writer;
181 sub get_read_method_ref {
183 if ((my $reader = $self->get_read_method) && $self->associated_class) {
184 return $self->associated_class->get_method($reader);
187 my $code = sub { $self->get_value(@_) };
188 if (my $class = $self->associated_class) {
189 return $class->method_metaclass->wrap(
191 package_name => $class->name,
201 sub get_write_method_ref {
203 if ((my $writer = $self->get_write_method) && $self->associated_class) {
204 return $self->associated_class->get_method($writer);
207 my $code = sub { $self->set_value(@_) };
208 if (my $class = $self->associated_class) {
209 return $class->method_metaclass->wrap(
211 package_name => $class->name,
221 sub is_default_a_coderef {
222 my ($value) = $_[0]->{'default'};
223 return unless ref($value);
224 return ref($value) eq 'CODE' || (blessed($value) && $value->isa('Class::MOP::Method'));
228 my ($self, $instance) = @_;
229 if (defined $instance && $self->is_default_a_coderef) {
230 # if the default is a CODE ref, then
231 # we pass in the instance and default
232 # can return a value based on that
233 # instance. Somewhat crude, but works.
234 return $self->{'default'}->($instance);
241 sub slots { (shift)->name }
245 sub attach_to_class {
246 my ($self, $class) = @_;
247 (blessed($class) && $class->isa('Class::MOP::Class'))
248 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
249 weaken($self->{'associated_class'} = $class);
252 sub detach_from_class {
254 $self->{'associated_class'} = undef;
259 sub associate_method {
260 my ($self, $method) = @_;
261 push @{$self->{'associated_methods'}} => $method;
266 sub set_initial_value {
267 my ($self, $instance, $value) = @_;
268 $self->_set_initial_slot_value(
269 Class::MOP::Class->initialize(ref($instance))->get_meta_instance,
276 my ($self, $instance, $value) = @_;
278 Class::MOP::Class->initialize(ref($instance))
280 ->set_slot_value($instance, $self->name, $value);
284 my ($self, $instance) = @_;
286 Class::MOP::Class->initialize(ref($instance))
288 ->get_slot_value($instance, $self->name);
292 my ($self, $instance) = @_;
294 Class::MOP::Class->initialize(ref($instance))
296 ->is_slot_initialized($instance, $self->name);
300 my ($self, $instance) = @_;
302 Class::MOP::Class->initialize(ref($instance))
304 ->deinitialize_slot($instance, $self->name);
309 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
311 sub _process_accessors {
312 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
316 if ( my $ctx = $self->definition_context ) {
317 $method_ctx = { %$ctx };
320 my $metaclass = $self->associated_class;
322 if (ref($accessor)) {
323 (ref($accessor) eq 'HASH')
324 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
325 my ($name, $method) = %{$accessor};
327 $method = $self->accessor_metaclass->wrap(
329 associated_metaclass => $metaclass,
330 package_name => $metaclass->name,
332 definition_context => $method_ctx,
334 $self->associate_method($method);
335 return ($name, $method);
341 my $desc = "accessor $accessor";
342 if ( $accessor ne $self->name ) {
343 $desc .= " of attribute " . $self->name;
346 $method_ctx->{description} = $desc;
349 $method = $self->accessor_metaclass->new(
351 accessor_type => $type,
352 associated_metaclass => $metaclass,
353 package_name => $metaclass->name,
355 definition_context => $method_ctx,
356 is_inline => $metaclass->instance_metaclass->is_inlinable,
359 confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
360 $self->associate_method($method);
361 return ($accessor, $method);
365 sub install_accessors {
368 my $class = $self->associated_class;
371 $self->_process_accessors('accessor' => $self->accessor(), $inline)
372 ) if $self->has_accessor();
375 $self->_process_accessors('reader' => $self->reader(), $inline)
376 ) if $self->has_reader();
379 $self->_process_accessors('writer' => $self->writer(), $inline)
380 ) if $self->has_writer();
383 $self->_process_accessors('predicate' => $self->predicate(), $inline)
384 ) if $self->has_predicate();
387 $self->_process_accessors('clearer' => $self->clearer(), $inline)
388 ) if $self->has_clearer();
394 my $_remove_accessor = sub {
395 my ($accessor, $class) = @_;
396 if (ref($accessor) && ref($accessor) eq 'HASH') {
397 ($accessor) = keys %{$accessor};
399 my $method = $class->get_method($accessor);
400 $class->remove_method($accessor)
401 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
404 sub remove_accessors {
407 # we really need to make sure to remove from the
408 # associates methods here as well. But this is
409 # such a slimly used method, I am not worried
410 # about it right now.
411 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
412 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
413 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
414 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
415 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
429 Class::MOP::Attribute - Attribute Meta Object
433 Class::MOP::Attribute->new(
435 accessor => 'foo', # dual purpose get/set accessor
436 predicate => 'has_foo', # predicate check for defined-ness
437 init_arg => '-foo', # class->new will look for a -foo key
438 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
442 Class::MOP::Attribute->new(
444 reader => 'bar', # getter
445 writer => 'set_bar', # setter
446 predicate => 'has_bar', # predicate check for defined-ness
447 init_arg => ':bar', # class->new will look for a :bar key
448 # no default value means it is undef
454 The Attribute Protocol is almost entirely an invention of
455 C<Class::MOP>. Perl 5 does not have a consistent notion of
456 attributes. There are so many ways in which this is done, and very few
457 (if any) are easily discoverable by this module.
459 With that said, this module attempts to inject some order into this
460 chaos, by introducing a consistent API which can be used to create
469 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
471 An attribute must (at the very least), have a C<$name>. All other
472 C<%options> are added as key-value pairs.
478 This is a string value representing the expected key in an
479 initialization hash. For instance, if we have an C<init_arg> value of
480 C<-foo>, then the following code will Just Work.
482 MyClass->meta->new_object( -foo => 'Hello There' );
484 If an init_arg is not assigned, it will automatically use the
485 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
486 attribute cannot be specified during initialization.
490 This provides the name of a method that will be called to initialize
491 the attribute. This method will be called on the object after it is
492 constructed. It is expected to return a valid value for the attribute.
496 This can be used to provide an explicit default for initializing the
497 attribute. If the default you provide is a subroutine reference, then
498 this reference will be called I<as a method> on the object.
500 If the value is a simple scalar (string or number), then it can be
501 just passed as is. However, if you wish to initialize it with a HASH
502 or ARRAY ref, then you need to wrap that inside a subroutine
505 Class::MOP::Attribute->new(
507 default => sub { [] },
513 Class::MOP::Attribute->new(
515 default => sub { {} },
519 If you wish to initialize an attribute with a subroutine reference
520 itself, then you need to wrap that in a subroutine as well:
522 Class::MOP::Attribute->new(
525 sub { print "Hello World" }
530 And lastly, if the value of your attribute is dependent upon some
531 other aspect of the instance structure, then you can take advantage of
532 the fact that when the C<default> value is called as a method:
534 Class::MOP::Attribute->new(
535 'object_identity' => (
536 default => sub { Scalar::Util::refaddr( $_[0] ) },
540 Note that there is no guarantee that attributes are initialized in any
541 particular order, so you cannot rely on the value of some other
542 attribute when generating the default.
546 This option can be either a method name or a subroutine
547 reference. This method will be called when setting the attribute's
548 value in the constructor. Unlike C<default> and C<builder>, the
549 initializer is only called when a value is provided to the
550 constructor. The initializer allows you to munge this value during
553 The initializer is called as a method with three arguments. The first
554 is the value that was passed to the constructor. The second is a
555 subroutine reference that can be called to actually set the
556 attribute's value, and the last is the associated
557 C<Class::MOP::Attribute> object.
559 This contrived example shows an initializer that sets the attribute to
560 twice the given value.
562 Class::MOP::Attribute->new(
565 my ( $instance, $value, $set ) = @_;
566 $set->( $value * 2 );
571 Since an initializer can be a method name, you can easily make
572 attribute initialization use the writer:
574 Class::MOP::Attribute->new(
576 writer => 'some_attr',
577 initializer => 'some_attr',
581 Your writer will need to examine C<@_> and determine under which
582 context it is being called.
586 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
587 options all accept the same parameters. You can provide the name of
588 the method, in which case an appropriate default method will be
589 generated for you. Or instead you can also provide hash reference
590 containing exactly one key (the method name) and one value. The value
591 should be a subroutine reference, which will be installed as the
598 An C<accessor> is a standard Perl-style read/write accessor. It will
599 return the value of the attribute, and if a value is passed as an
600 argument, it will assign that value to the attribute.
602 Note that C<undef> is a legitimate value, so this will work:
604 $object->set_something(undef);
608 This is a basic read-only accessor. It returns the value of the
613 This is a basic write accessor, it accepts a single argument, and
614 assigns that value to the attribute.
616 Note that C<undef> is a legitimate value, so this will work:
618 $object->set_something(undef);
622 The predicate method returns a boolean indicating whether or not the
623 attribute has been explicitly set.
625 Note that the predicate returns true even if the attribute was set to
626 a false value (C<0> or C<undef>).
630 This method will uninitialize the attribute. After an attribute is
631 cleared, its C<predicate> will return false.
633 =item * definition_context
635 Mostly, this exists as a hook for the benefit of Moose.
637 This option should be a hash reference containing several keys which
638 will be used when inlining the attribute's accessors. The keys should
639 include C<line>, the line number where the attribute was created, and
640 either C<file> or C<description>.
642 This information will ultimately be used when eval'ing inlined
643 accessor code so that error messages report a useful line and file
648 =item B<< $attr->clone(%options) >>
650 This clones the attribute. Any options you provide will override the
651 settings of the original attribute. You can change the name of the new
652 attribute by passing a C<name> key in C<%options>.
658 These are all basic read-only accessors for the values passed into
663 =item B<< $attr->name >>
665 Returns the attribute's name.
667 =item B<< $attr->accessor >>
669 =item B<< $attr->reader >>
671 =item B<< $attr->writer >>
673 =item B<< $attr->predicate >>
675 =item B<< $attr->clearer >>
677 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
678 methods all return exactly what was passed to the constructor, so it
679 can be either a string containing a method name, or a hash reference.
681 =item B<< $attr->initializer >>
683 Returns the initializer as passed to the constructor, so this may be
684 either a method name or a subroutine reference.
686 =item B<< $attr->init_arg >>
688 =item B<< $attr->is_default_a_coderef >>
690 =item B<< $attr->default($instance) >>
692 The C<$instance> argument is optional. If you don't pass it, the
693 return value for this method is exactly what was passed to the
694 constructor, either a simple scalar or a subroutine reference.
696 If you I<do> pass an C<$instance> and the default is a subroutine
697 reference, then the reference is called as a method on the
698 C<$instance> and the generated value is returned.
700 =item B<< $attr->slots >>
702 Return a list of slots required by the attribute. This is usually just
703 one, the name of the attribute.
705 A slot is the name of the hash key used to store the attribute in an
708 =item B<< $attr->get_read_method >>
710 =item B<< $attr->get_write_method >>
712 Returns the name of a method suitable for reading or writing the value
713 of the attribute in the associated class.
715 If an attribute is read- or write-only, then these methods can return
716 C<undef> as appropriate.
718 =item B<< $attr->has_read_method >>
720 =item B<< $attr->has_write_method >>
722 This returns a boolean indicating whether the attribute has a I<named>
723 read or write method.
725 =item B<< $attr->get_read_method_ref >>
727 =item B<< $attr->get_write_method_ref >>
729 Returns the subroutine reference of a method suitable for reading or
730 writing the attribute's value in the associated class. These methods
731 always return a subroutine reference, regardless of whether or not the
732 attribute is read- or write-only.
734 =item B<< $attr->insertion_order >>
736 If this attribute has been inserted into a class, this returns a zero
737 based index regarding the order of insertion.
741 =head2 Informational predicates
743 These are all basic predicate methods for the values passed into C<new>.
747 =item B<< $attr->has_accessor >>
749 =item B<< $attr->has_reader >>
751 =item B<< $attr->has_writer >>
753 =item B<< $attr->has_predicate >>
755 =item B<< $attr->has_clearer >>
757 =item B<< $attr->has_initializer >>
759 =item B<< $attr->has_init_arg >>
761 This will be I<false> if the C<init_arg> was set to C<undef>.
763 =item B<< $attr->has_default >>
765 This will be I<false> if the C<default> was set to C<undef>, since
766 C<undef> is the default C<default> anyway.
768 =item B<< $attr->has_builder >>
770 =item B<< $attr->has_insertion_order >>
772 This will be I<false> if this attribute has not be inserted into a class
776 =head2 Value management
778 These methods are basically "back doors" to the instance, and can be
779 used to bypass the regular accessors, but still stay within the MOP.
781 These methods are not for general use, and should only be used if you
782 really know what you are doing.
786 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
788 This method is used internally to initialize the attribute's slot in
789 the object C<$instance>.
791 The C<$params> is a hash reference of the values passed to the object
794 It's unlikely that you'll need to call this method yourself.
796 =item B<< $attr->set_value($instance, $value) >>
798 Sets the value without going through the accessor. Note that this
799 works even with read-only attributes.
801 =item B<< $attr->set_initial_value($instance, $value) >>
803 Sets the value without going through the accessor. This method is only
804 called when the instance is first being initialized.
806 =item B<< $attr->get_value($instance) >>
808 Returns the value without going through the accessor. Note that this
809 works even with write-only accessors.
811 =item B<< $attr->has_value($instance) >>
813 Return a boolean indicating whether the attribute has been set in
814 C<$instance>. This how the default C<predicate> method works.
816 =item B<< $attr->clear_value($instance) >>
818 This will clear the attribute's value in C<$instance>. This is what
819 the default C<clearer> calls.
821 Note that this works even if the attribute does not have any
822 associated read, write or clear methods.
826 =head2 Class association
828 These methods allow you to manage the attributes association with
829 the class that contains it. These methods should not be used
830 lightly, nor are they very magical, they are mostly used internally
831 and by metaclass instances.
835 =item B<< $attr->associated_class >>
837 This returns the C<Class::MOP::Class> with which this attribute is
840 =item B<< $attr->attach_to_class($metaclass) >>
842 This method stores a weakened reference to the C<$metaclass> object
845 This method does not remove the attribute from its old class,
846 nor does it create any accessors in the new class.
848 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
851 =item B<< $attr->detach_from_class >>
853 This method removes the associate metaclass object from the attribute
856 This method does not remove the attribute itself from the class, or
857 remove its accessors.
859 It is probably best to use the L<Class::MOP::Class>
860 C<remove_attribute> method instead.
864 =head2 Attribute Accessor generation
868 =item B<< $attr->accessor_metaclass >>
870 Accessor methods are generated using an accessor metaclass. By
871 default, this is L<Class::MOP::Method::Accessor>. This method returns
872 the name of the accessor metaclass that this attribute uses.
874 =item B<< $attr->associate_method($method) >>
876 This associates a L<Class::MOP::Method> object with the
877 attribute. Typically, this is called internally when an attribute
878 generates its accessors.
880 =item B<< $attr->associated_methods >>
882 This returns the list of methods which have been associated with the
885 =item B<< $attr->install_accessors >>
887 This method generates and installs code the attributes various
888 accessors. It is typically called from the L<Class::MOP::Class>
889 C<add_attribute> method.
891 =item B<< $attr->remove_accessors >>
893 This method removes all of the accessors associated with the
896 This does not currently remove methods from the list returned by
897 C<associated_methods>.
905 =item B<< Class::MOP::Attribute->meta >>
907 This will return a L<Class::MOP::Class> instance for this class.
909 It should also be noted that L<Class::MOP> will actually bootstrap
910 this module by installing a number of attribute meta-objects into its
917 Stevan Little E<lt>stevan@iinteractive.comE<gt>
919 =head1 COPYRIGHT AND LICENSE
921 Copyright 2006-2009 by Infinity Interactive, Inc.
923 L<http://www.iinteractive.com>
925 This library is free software; you can redistribute it and/or modify
926 it under the same terms as Perl itself.