2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'reftype', 'weaken';
12 our $VERSION = '0.24';
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Object';
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? :)
31 (defined $name && $name)
32 || confess "You must provide a name for the attribute";
34 $options{init_arg} = $name
35 if not exists $options{init_arg};
36 if(exists $options{builder}){
37 confess("builder must be a defined scalar value which is a method name")
38 if ref $options{builder} || !(defined $options{builder});
39 confess("Setting both default and builder is not allowed.")
40 if exists $options{default};
42 (is_default_a_coderef(\%options))
43 || confess("References are not allowed as default values, you must ".
44 "wrap then in a CODE reference (ex: sub { [] } and not [])")
45 if exists $options{default} && ref $options{default};
47 if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
48 confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
52 '$!accessor' => $options{accessor},
53 '$!reader' => $options{reader},
54 '$!writer' => $options{writer},
55 '$!predicate' => $options{predicate},
56 '$!clearer' => $options{clearer},
57 '$!builder' => $options{builder},
58 '$!init_arg' => $options{init_arg},
59 '$!default' => $options{default},
60 '$!initializer' => $options{initializer},
61 # keep a weakened link to the
62 # class we are associated with
63 '$!associated_class' => undef,
64 # and a list of the methods
65 # associated with this attr
66 '@!associated_methods' => [],
68 # protect this from silliness
74 # this is a primative (and kludgy) clone operation
75 # for now, it will be replaced in the Class::MOP
76 # bootstrap with a proper one, however we know
77 # that this one will work fine for now.
82 || confess "Can only clone an instance";
83 return bless { %{$self}, %options } => blessed($self);
86 sub initialize_instance_slot {
87 my ($self, $meta_instance, $instance, $params) = @_;
88 my $init_arg = $self->{'$!init_arg'};
89 # try to fetch the init arg from the %params ...
91 # if nothing was in the %params, we can use the
92 # attribute's default value (if it has one)
93 if(defined $init_arg and exists $params->{$init_arg}){
94 $self->_set_initial_slot_value(
100 elsif (defined $self->{'$!default'}) {
101 $self->_set_initial_slot_value(
104 $self->default($instance),
107 elsif (defined( my $builder = $self->{'$!builder'})) {
108 if ($builder = $instance->can($builder)) {
109 $self->_set_initial_slot_value(
116 confess(blessed($instance)." does not support builder method '". $self->{'$!builder'} ."' for attribute '" . $self->name . "'");
121 sub _set_initial_slot_value {
122 my ($self, $meta_instance, $instance, $value) = @_;
124 my $slot_name = $self->name;
126 return $meta_instance->set_slot_value($instance, $slot_name, $value)
127 unless $self->has_initializer;
130 $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
133 my $initializer = $self->initializer;
135 # most things will just want to set a value, so make it first arg
136 $instance->$initializer($value, $callback, $self);
140 # the next bunch of methods will get bootstrapped
141 # away in the Class::MOP bootstrapping section
143 sub name { $_[0]->{'$!name'} }
145 sub associated_class { $_[0]->{'$!associated_class'} }
146 sub associated_methods { $_[0]->{'@!associated_methods'} }
148 sub has_accessor { defined($_[0]->{'$!accessor'}) ? 1 : 0 }
149 sub has_reader { defined($_[0]->{'$!reader'}) ? 1 : 0 }
150 sub has_writer { defined($_[0]->{'$!writer'}) ? 1 : 0 }
151 sub has_predicate { defined($_[0]->{'$!predicate'}) ? 1 : 0 }
152 sub has_clearer { defined($_[0]->{'$!clearer'}) ? 1 : 0 }
153 sub has_builder { defined($_[0]->{'$!builder'}) ? 1 : 0 }
154 sub has_init_arg { defined($_[0]->{'$!init_arg'}) ? 1 : 0 }
155 sub has_default { defined($_[0]->{'$!default'}) ? 1 : 0 }
156 sub has_initializer { defined($_[0]->{'$!initializer'}) ? 1 : 0 }
158 sub accessor { $_[0]->{'$!accessor'} }
159 sub reader { $_[0]->{'$!reader'} }
160 sub writer { $_[0]->{'$!writer'} }
161 sub predicate { $_[0]->{'$!predicate'} }
162 sub clearer { $_[0]->{'$!clearer'} }
163 sub builder { $_[0]->{'$!builder'} }
164 sub init_arg { $_[0]->{'$!init_arg'} }
165 sub initializer { $_[0]->{'$!initializer'} }
167 # end bootstrapped away method section.
168 # (all methods below here are kept intact)
170 sub get_read_method {
172 my $reader = $self->reader || $self->accessor;
174 return $reader unless ref $reader;
176 my ($name) = %$reader;
180 sub get_write_method {
182 my $writer = $self->writer || $self->accessor;
184 return $writer unless ref $writer;
186 my ($name) = %$writer;
190 sub get_read_method_ref {
192 if ((my $reader = $self->get_read_method) && $self->associated_class) {
193 return $self->associated_class->get_method($reader);
196 return sub { $self->get_value(@_) };
200 sub get_write_method_ref {
202 if ((my $writer = $self->get_write_method) && $self->associated_class) {
203 return $self->associated_class->get_method($writer);
206 return sub { $self->set_value(@_) };
210 sub is_default_a_coderef {
211 ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || ''))
215 my ($self, $instance) = @_;
216 if (defined $instance && $self->is_default_a_coderef) {
217 # if the default is a CODE ref, then
218 # we pass in the instance and default
219 # can return a value based on that
220 # instance. Somewhat crude, but works.
221 return $self->{'$!default'}->($instance);
223 $self->{'$!default'};
228 sub slots { (shift)->name }
232 sub attach_to_class {
233 my ($self, $class) = @_;
234 (blessed($class) && $class->isa('Class::MOP::Class'))
235 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
236 weaken($self->{'$!associated_class'} = $class);
239 sub detach_from_class {
241 $self->{'$!associated_class'} = undef;
246 sub associate_method {
247 my ($self, $method) = @_;
248 push @{$self->{'@!associated_methods'}} => $method;
253 sub set_initial_value {
254 my ($self, $instance, $value) = @_;
255 $self->_set_initial_slot_value(
256 Class::MOP::Class->initialize(blessed($instance))->get_meta_instance,
263 my ($self, $instance, $value) = @_;
265 Class::MOP::Class->initialize(blessed($instance))
267 ->set_slot_value($instance, $self->name, $value);
271 my ($self, $instance) = @_;
273 Class::MOP::Class->initialize(blessed($instance))
275 ->get_slot_value($instance, $self->name);
279 my ($self, $instance) = @_;
281 Class::MOP::Class->initialize(blessed($instance))
283 ->is_slot_initialized($instance, $self->name);
287 my ($self, $instance) = @_;
289 Class::MOP::Class->initialize(blessed($instance))
291 ->deinitialize_slot($instance, $self->name);
296 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
298 sub process_accessors {
299 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
300 if (reftype($accessor)) {
301 (reftype($accessor) eq 'HASH')
302 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
303 my ($name, $method) = %{$accessor};
304 $method = $self->accessor_metaclass->wrap($method);
305 $self->associate_method($method);
306 return ($name, $method);
309 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
312 $method = $self->accessor_metaclass->new(
314 is_inline => $inline_me,
315 accessor_type => $type,
318 confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
319 $self->associate_method($method);
320 return ($accessor, $method);
324 sub install_accessors {
327 my $class = $self->associated_class;
330 $self->process_accessors('accessor' => $self->accessor(), $inline)
331 ) if $self->has_accessor();
334 $self->process_accessors('reader' => $self->reader(), $inline)
335 ) if $self->has_reader();
338 $self->process_accessors('writer' => $self->writer(), $inline)
339 ) if $self->has_writer();
342 $self->process_accessors('predicate' => $self->predicate(), $inline)
343 ) if $self->has_predicate();
346 $self->process_accessors('clearer' => $self->clearer(), $inline)
347 ) if $self->has_clearer();
353 my $_remove_accessor = sub {
354 my ($accessor, $class) = @_;
355 if (reftype($accessor) && reftype($accessor) eq 'HASH') {
356 ($accessor) = keys %{$accessor};
358 my $method = $class->get_method($accessor);
359 $class->remove_method($accessor)
360 if (blessed($method) && $method->isa('Class::MOP::Method::Accessor'));
363 sub remove_accessors {
366 # we really need to make sure to remove from the
367 # associates methods here as well. But this is
368 # such a slimly used method, I am not worried
369 # about it right now.
370 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
371 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
372 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
373 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
374 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
388 Class::MOP::Attribute - Attribute Meta Object
392 Class::MOP::Attribute->new('$foo' => (
393 accessor => 'foo', # dual purpose get/set accessor
394 predicate => 'has_foo' # predicate check for defined-ness
395 init_arg => '-foo', # class->new will look for a -foo key
396 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
399 Class::MOP::Attribute->new('$.bar' => (
400 reader => 'bar', # getter
401 writer => 'set_bar', # setter
402 predicate => 'has_bar' # predicate check for defined-ness
403 init_arg => ':bar', # class->new will look for a :bar key
404 # no default value means it is undef
409 The Attribute Protocol is almost entirely an invention of this module,
410 and is completely optional to this MOP. This is because Perl 5 does not
411 have consistent notion of what is an attribute of a class. There are
412 so many ways in which this is done, and very few (if any) are
413 easily discoverable by this module.
415 So, all that said, this module attempts to inject some order into this
416 chaos, by introducing a consistent API which can be used to create
425 =item B<new ($name, ?%options)>
427 An attribute must (at the very least), have a C<$name>. All other
428 C<%options> are contained added as key-value pairs. Acceptable keys
435 This should be a string value representing the expected key in
436 an initialization hash. For instance, if we have an I<init_arg>
437 value of C<-foo>, then the following code will Just Work.
439 MyClass->meta->construct_instance(-foo => "Hello There");
441 In an init_arg is not assigned, it will automatically use the
442 value of C<$name>. If an explicit C<undef> is given for an init_arg,
443 an attribute value can't be specified during initialization.
447 The value of this key is the name of the method that will be
448 called to obtain the value used to initialize the attribute.
449 This should be a method in the class associated with the attribute,
450 not a method in the attribute class itself.
454 The value of this key is the default value which
455 C<Class::MOP::Class::construct_instance> will initialize the
459 If the value is a simple scalar (string or number), then it can
460 be just passed as is. However, if you wish to initialize it with
461 a HASH or ARRAY ref, then you need to wrap that inside a CODE
464 Class::MOP::Attribute->new('@foo' => (
465 default => sub { [] },
470 Class::MOP::Attribute->new('%foo' => (
471 default => sub { {} },
474 If you wish to initialize an attribute with a CODE reference
475 itself, then you need to wrap that in a subroutine as well, like
478 Class::MOP::Attribute->new('&foo' => (
479 default => sub { sub { print "Hello World" } },
482 And lastly, if the value of your attribute is dependent upon
483 some other aspect of the instance structure, then you can take
484 advantage of the fact that when the I<default> value is a CODE
485 reference, it is passed the (as yet unfinished) instance structure
486 as it's only argument. So you can do things like this:
488 Class::MOP::Attribute->new('$object_identity' => (
489 default => sub { Scalar::Util::refaddr($_[0]) },
492 This last feature is fairly limited as there is no gurantee of
493 the order of attribute initializations, so you cannot perform
494 any kind of dependent initializations. However, if this is
495 something you need, you could subclass B<Class::MOP::Class> and
496 this class to acheive it. However, this is currently left as
497 an exercise to the reader :).
501 This may be a method name (referring to a method on the class with this
502 attribute) or a CODE ref. The initializer is used to set the attribute value
503 on an instance when the attribute is set during instance initialization. When
504 called, it is passed the instance (as the invocant), the value to set, a
505 slot-setting CODE ref, and the attribute meta-instance. The slot-setting code
506 is provided to make it easy to set the (possibly altered) value on the instance
507 without going through several more method calls.
509 This contrived example shows an initializer that sets the attribute to twice
512 Class::MOP::Attribute->new('$doubled' => (
514 my ($instance, $value, $set) = @_;
519 As method names can be given as initializers, one can easily make
520 attribute initialization use the writer:
522 Class::MOP::Attribute->new('$some_attr' => (
523 writer => 'some_attr',
524 initializer => 'some_attr',
527 Your writer will simply need to examine it's C<@_> and determine under
528 which context it is being called.
532 The I<accessor>, I<reader>, I<writer>, I<predicate> and I<clearer> keys can
533 contain either; the name of the method and an appropriate default one will be
534 generated for you, B<or> a HASH ref containing exactly one key (which will be
535 used as the name of the method) and one value, which should contain a CODE
536 reference which will be installed as the method itself.
542 The I<accessor> is a standard perl-style read/write accessor. It will
543 return the value of the attribute, and if a value is passed as an argument,
544 it will assign that value to the attribute.
547 This method will properly handle the following code, by assigning an
548 C<undef> value to the attribute.
550 $object->set_something(undef);
554 This is a basic read-only accessor, it will just return the value of
559 This is a basic write accessor, it accepts a single argument, and
560 assigns that value to the attribute. This method does not intentially
561 return a value, however perl will return the result of the last
562 expression in the subroutine, which returns in this returning the
563 same value that it was passed.
566 This method will properly handle the following code, by assigning an
567 C<undef> value to the attribute.
569 $object->set_something();
573 This is a basic test to see if any value has been set for the
574 attribute. It will return true (C<1>) if the attribute has been set
575 to any value (even C<undef>), and false (C<0>) otherwise.
578 The predicate will return true even when you set an attribute's
579 value to C<undef>. This behaviour has changed as of version 0.43. In
580 older versions, the predicate (erroneously) checked for attribute
581 value definedness, instead of presence as it is now.
583 If you really want to get rid of the value, you have to define and
584 use a I<clearer> (see below).
588 This is the a method that will uninitialize the attr, reverting lazy values
589 back to their "unfulfilled" state.
593 =item B<clone (%options)>
595 This will return a clone of the attribute instance, allowing the overriding
596 of various attributes through the C<%options> supplied.
598 =item B<initialize_instance_slot ($instance, $params)>
600 This method is used internally to initialize the approriate slot for this
601 attribute in a given C<$instance>, the C<$params> passed are those that were
602 passed to the constructor.
606 =head2 Value management
608 These methods are basically "backdoors" to the instance, which can be used
609 to bypass the regular accessors, but still stay within the context of the MOP.
611 These methods are not for general use, and should only be used if you really
612 know what you are doing.
616 =item B<set_value ($instance, $value)>
618 Set the value without going through the accessor. Note that this may be done to
619 even attributes with just read only accessors.
621 =item B<set_initial_value ($instance, $value)>
623 This method sets the value without going through the accessor -- but it is only
624 called when the instance data is first initialized.
626 =item B<get_value ($instance)>
628 Return the value without going through the accessor. Note that this may be done
629 even to attributes with just write only accessors.
631 =item B<has_value ($instance)>
633 Return a boolean indicating if the item in the C<$instance> has a value in it.
634 This is basically what the default C<predicate> method calls.
636 =item B<clear_value ($instance)>
638 This will clear the value in the C<$instance>. This is basically what the default
639 C<clearer> would call. Note that this may be done even if the attirbute does not
640 have any associated read, write or clear methods.
646 These are all basic read-only value accessors for the values
647 passed into C<new>. I think they are pretty much self-explanitory.
667 =item B<is_default_a_coderef>
669 =item B<default (?$instance)>
671 Return the default value for the attribute.
673 If you pass in an C<$instance> argument to this accessor and the
674 I<default> is a CODE reference, then the CODE reference will be
675 executed with the C<$instance> as its argument.
679 Return a list of slots required by the attribute. This is usually
680 just one, which is the name of the attribute.
682 =item B<get_read_method>
684 =item B<get_write_method>
686 Return the name of a method name suitable for reading / writing the value
687 of the attribute in the associated class. Suitable for use whether
688 C<reader> and C<writer> or C<accessor> was used.
690 =item B<get_read_method_ref>
692 =item B<get_write_method_ref>
694 Return the CODE reference of a method suitable for reading / writing the
695 value of the attribute in the associated class. Suitable for use whether
696 C<reader> and C<writer> or C<accessor> was specified or not.
698 NOTE: If no reader/writer/accessor was specified, this will use the
699 attribute get_value/set_value methods, which can be very inefficient.
703 =head2 Informational predicates
705 These are all basic predicate methods for the values passed into C<new>.
709 =item B<has_accessor>
715 =item B<has_predicate>
719 =item B<has_initializer>
721 =item B<has_init_arg>
729 =head2 Class association
731 These methods allow you to manage the attributes association with
732 the class that contains it. These methods should not be used
733 lightly, nor are they very magical, they are mostly used internally
734 and by metaclass instances.
738 =item B<associated_class>
740 This returns the metaclass this attribute is associated with.
742 =item B<attach_to_class ($class)>
744 This will store a weaken reference to C<$class> internally. You should
745 note that just changing the class assocation will not remove the attribute
746 from it's old class, and initialize it (and it's accessors) in the new
747 C<$class>. It is up to you to do this manually.
749 =item B<detach_from_class>
751 This will remove the weakened reference to the class. It does B<not>
752 remove the attribute itself from the class (or remove it's accessors),
753 you must do that yourself if you want too. Actually if that is what
754 you want to do, you should probably be looking at
755 L<Class::MOP::Class::remove_attribute> instead.
759 =head2 Attribute Accessor generation
763 =item B<accessor_metaclass>
765 Accessors are generated by an accessor metaclass, which is usually
766 a subclass of C<Class::MOP::Method::Accessor>. This method returns
767 the name of the accessor metaclass that this attribute uses.
769 =item B<associate_method ($method)>
771 This will associate a C<$method> with the given attribute which is
772 used internally by the accessor generator.
774 =item B<associated_methods>
776 This will return the list of methods which have been associated with
777 the C<associate_method> methods. This is a good way of seeing what
778 methods are used to manage a given attribute.
780 =item B<install_accessors>
782 This allows the attribute to generate and install code for it's own
783 I<accessor/reader/writer/predicate> methods. This is called by
784 C<Class::MOP::Class::add_attribute>.
786 This method will call C<process_accessors> for each of the possible
787 method types (accessor, reader, writer & predicate).
789 =item B<process_accessors ($type, $value)>
791 This takes a C<$type> (accessor, reader, writer or predicate), and
792 a C<$value> (the value passed into the constructor for each of the
793 different types). It will then either generate the method itself
794 (using the C<generate_*_method> methods listed below) or it will
795 use the custom method passed through the constructor.
797 =item B<remove_accessors>
799 This allows the attribute to remove the method for it's own
800 I<accessor/reader/writer/predicate/clearer>. This is called by
801 C<Class::MOP::Class::remove_attribute>.
803 NOTE: This does not currently remove methods from the list returned
804 by C<associated_methods>, that is on the TODO list.
814 This will return a B<Class::MOP::Class> instance which is related
817 It should also be noted that B<Class::MOP> will actually bootstrap
818 this module by installing a number of attribute meta-objects into
819 it's metaclass. This will allow this class to reap all the benefits
820 of the MOP when subclassing it.
826 Stevan Little E<lt>stevan@iinteractive.comE<gt>
828 =head1 COPYRIGHT AND LICENSE
830 Copyright 2006-2008 by Infinity Interactive, Inc.
832 L<http://www.iinteractive.com>
834 This library is free software; you can redistribute it and/or modify
835 it under the same terms as Perl itself.