2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'weaken';
12 our $VERSION = '0.78';
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};
35 (defined $name && $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);
60 my $options = @_ == 1 ? $_[0] : {@_};
63 'name' => $options->{name},
64 'accessor' => $options->{accessor},
65 'reader' => $options->{reader},
66 'writer' => $options->{writer},
67 'predicate' => $options->{predicate},
68 'clearer' => $options->{clearer},
69 'builder' => $options->{builder},
70 'init_arg' => $options->{init_arg},
71 'default' => $options->{default},
72 'initializer' => $options->{initializer},
73 'definition_context' => $options->{definition_context},
74 # keep a weakened link to the
75 # class we are associated with
76 'associated_class' => undef,
77 # and a list of the methods
78 # associated with this attr
79 'associated_methods' => [],
84 # this is a primative (and kludgy) clone operation
85 # for now, it will be replaced in the Class::MOP
86 # bootstrap with a proper one, however we know
87 # that this one will work fine for now.
92 || confess "Can only clone an instance";
93 return bless { %{$self}, %options } => ref($self);
96 sub initialize_instance_slot {
97 my ($self, $meta_instance, $instance, $params) = @_;
98 my $init_arg = $self->{'init_arg'};
100 # try to fetch the init arg from the %params ...
102 # if nothing was in the %params, we can use the
103 # attribute's default value (if it has one)
104 if(defined $init_arg and exists $params->{$init_arg}){
105 $self->_set_initial_slot_value(
108 $params->{$init_arg},
111 elsif (defined $self->{'default'}) {
112 $self->_set_initial_slot_value(
115 $self->default($instance),
118 elsif (defined( my $builder = $self->{'builder'})) {
119 if ($builder = $instance->can($builder)) {
120 $self->_set_initial_slot_value(
127 confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
132 sub _set_initial_slot_value {
133 my ($self, $meta_instance, $instance, $value) = @_;
135 my $slot_name = $self->name;
137 return $meta_instance->set_slot_value($instance, $slot_name, $value)
138 unless $self->has_initializer;
141 $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
144 my $initializer = $self->initializer;
146 # most things will just want to set a value, so make it first arg
147 $instance->$initializer($value, $callback, $self);
151 # the next bunch of methods will get bootstrapped
152 # away in the Class::MOP bootstrapping section
154 sub associated_class { $_[0]->{'associated_class'} }
155 sub associated_methods { $_[0]->{'associated_methods'} }
157 sub has_accessor { defined($_[0]->{'accessor'}) }
158 sub has_reader { defined($_[0]->{'reader'}) }
159 sub has_writer { defined($_[0]->{'writer'}) }
160 sub has_predicate { defined($_[0]->{'predicate'}) }
161 sub has_clearer { defined($_[0]->{'clearer'}) }
162 sub has_builder { defined($_[0]->{'builder'}) }
163 sub has_init_arg { defined($_[0]->{'init_arg'}) }
164 sub has_default { defined($_[0]->{'default'}) }
165 sub has_initializer { defined($_[0]->{'initializer'}) }
167 sub accessor { $_[0]->{'accessor'} }
168 sub reader { $_[0]->{'reader'} }
169 sub writer { $_[0]->{'writer'} }
170 sub predicate { $_[0]->{'predicate'} }
171 sub clearer { $_[0]->{'clearer'} }
172 sub builder { $_[0]->{'builder'} }
173 sub init_arg { $_[0]->{'init_arg'} }
174 sub initializer { $_[0]->{'initializer'} }
175 sub definition_context { $_[0]->{'definition_context'} }
177 # end bootstrapped away method section.
178 # (all methods below here are kept intact)
180 sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor }
181 sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor }
183 sub get_read_method {
185 my $reader = $self->reader || $self->accessor;
187 return $reader unless ref $reader;
189 my ($name) = %$reader;
193 sub get_write_method {
195 my $writer = $self->writer || $self->accessor;
197 return $writer unless ref $writer;
199 my ($name) = %$writer;
203 sub get_read_method_ref {
205 if ((my $reader = $self->get_read_method) && $self->associated_class) {
206 return $self->associated_class->get_method($reader);
209 my $code = sub { $self->get_value(@_) };
210 if (my $class = $self->associated_class) {
211 return $class->method_metaclass->wrap(
213 package_name => $class->name,
223 sub get_write_method_ref {
225 if ((my $writer = $self->get_write_method) && $self->associated_class) {
226 return $self->associated_class->get_method($writer);
229 my $code = sub { $self->set_value(@_) };
230 if (my $class = $self->associated_class) {
231 return $class->method_metaclass->wrap(
233 package_name => $class->name,
243 sub is_default_a_coderef {
244 ('CODE' eq ref($_[0]->{'default'}))
248 my ($self, $instance) = @_;
249 if (defined $instance && $self->is_default_a_coderef) {
250 # if the default is a CODE ref, then
251 # we pass in the instance and default
252 # can return a value based on that
253 # instance. Somewhat crude, but works.
254 return $self->{'default'}->($instance);
261 sub slots { (shift)->name }
265 sub attach_to_class {
266 my ($self, $class) = @_;
267 (blessed($class) && $class->isa('Class::MOP::Class'))
268 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
269 weaken($self->{'associated_class'} = $class);
272 sub detach_from_class {
274 $self->{'associated_class'} = undef;
279 sub associate_method {
280 my ($self, $method) = @_;
281 push @{$self->{'associated_methods'}} => $method;
286 sub set_initial_value {
287 my ($self, $instance, $value) = @_;
288 $self->_set_initial_slot_value(
289 Class::MOP::Class->initialize(ref($instance))->get_meta_instance,
296 my ($self, $instance, $value) = @_;
298 Class::MOP::Class->initialize(ref($instance))
300 ->set_slot_value($instance, $self->name, $value);
304 my ($self, $instance) = @_;
306 Class::MOP::Class->initialize(ref($instance))
308 ->get_slot_value($instance, $self->name);
312 my ($self, $instance) = @_;
314 Class::MOP::Class->initialize(ref($instance))
316 ->is_slot_initialized($instance, $self->name);
320 my ($self, $instance) = @_;
322 Class::MOP::Class->initialize(ref($instance))
324 ->deinitialize_slot($instance, $self->name);
329 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
331 sub process_accessors {
332 warn "The process_accessors method has been made private and this public alias will be removed in a future release.";
333 goto &_process_accessors;
336 sub _process_accessors {
337 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
341 if ( my $ctx = $self->definition_context ) {
342 $method_ctx = { %$ctx };
345 if (ref($accessor)) {
346 (ref($accessor) eq 'HASH')
347 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
348 my ($name, $method) = %{$accessor};
349 $method = $self->accessor_metaclass->wrap(
351 package_name => $self->associated_class->name,
353 definition_context => $method_ctx,
355 $self->associate_method($method);
356 return ($name, $method);
359 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
363 my $desc = "accessor $accessor";
364 if ( $accessor ne $self->name ) {
365 $desc .= " of attribute " . $self->name;
368 $method_ctx->{description} = $desc;
371 $method = $self->accessor_metaclass->new(
373 is_inline => $inline_me,
374 accessor_type => $type,
375 package_name => $self->associated_class->name,
377 definition_context => $method_ctx,
380 confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
381 $self->associate_method($method);
382 return ($accessor, $method);
386 sub install_accessors {
389 my $class = $self->associated_class;
392 $self->_process_accessors('accessor' => $self->accessor(), $inline)
393 ) if $self->has_accessor();
396 $self->_process_accessors('reader' => $self->reader(), $inline)
397 ) if $self->has_reader();
400 $self->_process_accessors('writer' => $self->writer(), $inline)
401 ) if $self->has_writer();
404 $self->_process_accessors('predicate' => $self->predicate(), $inline)
405 ) if $self->has_predicate();
408 $self->_process_accessors('clearer' => $self->clearer(), $inline)
409 ) if $self->has_clearer();
415 my $_remove_accessor = sub {
416 my ($accessor, $class) = @_;
417 if (ref($accessor) && ref($accessor) eq 'HASH') {
418 ($accessor) = keys %{$accessor};
420 my $method = $class->get_method($accessor);
421 $class->remove_method($accessor)
422 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
425 sub remove_accessors {
428 # we really need to make sure to remove from the
429 # associates methods here as well. But this is
430 # such a slimly used method, I am not worried
431 # about it right now.
432 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
433 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
434 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
435 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
436 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
450 Class::MOP::Attribute - Attribute Meta Object
454 Class::MOP::Attribute->new(
456 accessor => 'foo', # dual purpose get/set accessor
457 predicate => 'has_foo', # predicate check for defined-ness
458 init_arg => '-foo', # class->new will look for a -foo key
459 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
463 Class::MOP::Attribute->new(
465 reader => 'bar', # getter
466 writer => 'set_bar', # setter
467 predicate => 'has_bar', # predicate check for defined-ness
468 init_arg => ':bar', # class->new will look for a :bar key
469 # no default value means it is undef
475 The Attribute Protocol is almost entirely an invention of
476 C<Class::MOP>. Perl 5 does not have a consistent notion of
477 attributes. There are so many ways in which this is done, and very few
478 (if any) are easily discoverable by this module.
480 With that said, this module attempts to inject some order into this
481 chaos, by introducing a consistent API which can be used to create
490 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
492 An attribute must (at the very least), have a C<$name>. All other
493 C<%options> are added as key-value pairs.
499 This is a string value representing the expected key in an
500 initialization hash. For instance, if we have an C<init_arg> value of
501 C<-foo>, then the following code will Just Work.
503 MyClass->meta->construct_instance( -foo => 'Hello There' );
505 If an init_arg is not assigned, it will automatically use the
506 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
507 attribute cannot be specified during initialization.
511 This provides the name of a method that will be called to initialize
512 the attribute. This method will be called on the object after it is
513 constructed. It is expected to return a valid value for the attribute.
517 This can be used to provide an explicit default for initializing the
518 attribute. If the default you provide is a subroutine reference, then
519 this reference will be called I<as a method> on the object.
521 If the value is a simple scalar (string or number), then it can be
522 just passed as is. However, if you wish to initialize it with a HASH
523 or ARRAY ref, then you need to wrap that inside a subroutine
526 Class::MOP::Attribute->new(
528 default => sub { [] },
534 Class::MOP::Attribute->new(
536 default => sub { {} },
540 If you wish to initialize an attribute with a subroutine reference
541 itself, then you need to wrap that in a subroutine as well:
543 Class::MOP::Attribute->new(
546 sub { print "Hello World" }
551 And lastly, if the value of your attribute is dependent upon some
552 other aspect of the instance structure, then you can take advantage of
553 the fact that when the C<default> value is called as a method:
555 Class::MOP::Attribute->new(
556 'object_identity' => (
557 default => sub { Scalar::Util::refaddr( $_[0] ) },
561 Note that there is no guarantee that attributes are initialized in any
562 particular order, so you cannot rely on the value of some other
563 attribute when generating the default.
567 This option can be either a method name or a subroutine
568 reference. This method will be called when setting the attribute's
569 value in the constructor. Unlike C<default> and C<builder>, the
570 initializer is only called when a value is provided to the
571 constructor. The initializer allows you to munge this value during
574 The initializer is called as a method with three arguments. The first
575 is the value that was passed to the constructor. The second is a
576 subroutine reference that can be called to actually set the
577 attribute's value, and the last is the associated
578 C<Class::MOP::Attribute> object.
580 This contrived example shows an initializer that sets the attribute to
581 twice the given value.
583 Class::MOP::Attribute->new(
586 my ( $instance, $value, $set ) = @_;
587 $set->( $value * 2 );
592 Since an initializer can be a method name, you can easily make
593 attribute initialization use the writer:
595 Class::MOP::Attribute->new(
597 writer => 'some_attr',
598 initializer => 'some_attr',
602 Your writer will need to examine C<@_> and determine under which
603 context it is being called.
607 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
608 options all accept the same parameters. You can provide the name of
609 the method, in which case an appropriate default method will be
610 generated for you. Or instead you can also provide hash reference
611 containing exactly one key (the method name) and one value. The value
612 should be a subroutine reference, which will be installed as the
619 An C<accessor> is a standard Perl-style read/write accessor. It will
620 return the value of the attribute, and if a value is passed as an
621 argument, it will assign that value to the attribute.
623 Note that C<undef> is a legitimate value, so this will work:
625 $object->set_something(undef);
629 This is a basic read-only accessor. It returns the value of the
634 This is a basic write accessor, it accepts a single argument, and
635 assigns that value to the attribute.
637 Note that C<undef> is a legitimate value, so this will work:
639 $object->set_something(undef);
643 The predicate method returns a boolean indicating whether or not the
644 attribute has been explicitly set.
646 Note that the predicate returns true even if the attribute was set to
647 a false value (C<0> or C<undef>).
651 This method will uninitialize the attribute. After an attribute is
652 cleared, its C<predicate> will return false.
654 =item I<definition_context>
656 Mostly, this exists as a hook for the benefit of Moose.
658 This option should be a hash reference containing several keys which
659 will be used when inlining the attribute's accessors. The keys should
660 include C<line>, the line number where the attribute was created, and
661 either C<file> or C<description>.
663 This information will ultimately be used when eval'ing inlined
664 accessor code so that error messages report a useful line and file
669 =item B<< $attr->clone(%options) >>
671 This clones the attribute. Any options you provide will override the
672 settings of the original attribute. You can change the name of the new
673 attribute by passing a C<name> key in C<%options>.
679 These are all basic read-only accessors for the values passed into
684 =item B<< $attr->name >>
686 =item B<< $attr->accessor >>
688 =item B<< $attr->reader >>
690 =item B<< $attr->writer >>
692 =item B<< $attr->predicate >>
694 =item B<< $attr->clearer >>
696 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
697 methods all return exactly what was passed to the constructor, so it
698 can be either a string containing a method name, or a hash reference.
700 =item B<< $attr->initializer >>
702 Returns the initializer as passed to the constructor, so this may be
703 either a method name or a subroutine reference.
705 =item B<< $attr->init_arg >>
707 =item B<< $attr->is_default_a_coderef >>
709 =item B<< $attr->default($instance) >>
711 The C<$instance> argument is optional. If you don't pass it, the
712 return value for this method is exactly what was passed to the
713 constructor, either a simple scalar or a subroutine reference.
715 If you I<do> pass an C<$instance> and the default is a subroutine
716 reference, then the reference is called as a method on the
717 C<$instance> and the generated value is returned.
719 =item B<< $attr->slots >>
721 Return a list of slots required by the attribute. This is usually just
722 one, the name of the attribute.
724 A slot is the name of the hash key used to store the attribute in an
727 =item B<< $attr->get_read_method >>
729 =item B<< $attr->get_write_method >>
731 Returns the name of a method suitable for reading or writing the value
732 of the attribute in the associated class.
734 If an attribute is read- or write-only, then these methods can return
735 C<undef> as appropriate.
737 =item B<< $attr->has_read_method >>
739 =item B<< $attr->has_write_method >>
741 This returns a boolean indicating whether the attribute has a I<named>
742 read or write method.
744 =item B<< $attr->get_read_method_ref >>
746 =item B<< $attr->get_write_method_ref >>
748 Returns the subroutine reference of a method suitable for reading or
749 writing the attribute's value in the associated class. These methods
750 always return a subroutine reference, regardless of whether or not the
751 attribute is read- or write-only.
755 =head2 Informational predicates
757 These are all basic predicate methods for the values passed into C<new>.
761 =item B<< $attr->has_accessor >>
763 =item B<< $attr->has_reader >>
765 =item B<< $attr->has_writer >>
767 =item B<< $attr->has_predicate >>
769 =item B<< $attr->has_clearer >>
771 =item B<< $attr->has_initializer >>
773 =item B<< $attr->has_init_arg >>
775 This will be I<false> if the C<init_arg> was set to C<undef>.
777 =item B<< $attr->has_default >>
779 This will be I<false> if the C<default> was set to C<undef>, since
780 C<undef> is the default C<default> anyway.
782 =item B<< $attr->has_builder >>
786 =head2 Value management
788 These methods are basically "back doors" to the instance, and can be
789 used to bypass the regular accessors, but still stay within the MOP.
791 These methods are not for general use, and should only be used if you
792 really know what you are doing.
796 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
798 This method is used internally to initialize the attribute's slot in
799 the object C<$instance>.
801 The C<$params> is a hash reference of the values passed to the object
804 It's unlikely that you'll need to call this method yourself.
806 =item B<< $attr->set_value($instance, $value) >>
808 Sets the value without going through the accessor. Note that this
809 works even with read-only attributes.
811 =item B<< $attr->set_initial_value($instance, $value) >>
813 Sets the value without going through the accessor. This method is only
814 called when the instance is first being initialized.
816 =item B<< $attr->get_value($instance) >>
818 Returns the value without going through the accessor. Note that this
819 works even with write-only accessors.
821 =item B<< $attr->has_value($instance) >>
823 Return a boolean indicating whether the attribute has been set in
824 C<$instance>. This how the default C<predicate> method works.
826 =item B<< $attr->clear_value($instance) >>
828 This will clear the attribute's value in C<$instance>. This is what
829 the default C<clearer> calls.
831 Note that this works even if the attribute does not have any
832 associated read, write or clear methods.
836 =head2 Class association
838 These methods allow you to manage the attributes association with
839 the class that contains it. These methods should not be used
840 lightly, nor are they very magical, they are mostly used internally
841 and by metaclass instances.
845 =item B<< $attr->associated_class >>
847 This returns the C<Class::MOP::Class> with which this attribute is
850 =item B<< $attr->attach_to_class($metaclass) >>
852 This method stores a weakened reference to the C<$metaclass> object
855 This method does not remove the attribute from its old class,
856 nor does it create any accessors in the new class.
858 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
861 =item B<< $attr->detach_from_class >>
863 This method removes the associate metaclass object from the attribute
866 This method does not remove the attribute itself from the class, or
867 remove its accessors.
869 It is probably best to use the L<Class::MOP::Class>
870 C<remove_attribute> method instead.
874 =head2 Attribute Accessor generation
878 =item B<< $attr->accessor_metaclass >>
880 Accessor methods are generated using an accessor metaclass. By
881 default, this is L<Class::MOP::Method::Accessor>. This method returns
882 the name of the accessor metaclass that this attribute uses.
884 =item B<< $attr->associate_method($method) >>
886 This associates a L<Class::MOP::Method> object with the
887 attribute. Typically, this is called internally when an attribute
888 generates its accessors.
890 =item B<< $attr->associated_methods >>
892 This returns the list of methods which have been associated with the
895 =item B<< $attr->install_accessors >>
897 This method generates and installs code the attributes various
898 accessors. It is typically called from the L<Class::MOP::Class>
899 C<add_attribute> method.
901 =item B<< $attr->remove_accessors >>
903 This method removes all of the accessors associated with the
906 This does not currently remove methods from the list returned by
907 C<associated_methods>.
915 =item B<< $attr->meta >>
917 This will return a L<Class::MOP::Class> instance for this class.
919 It should also be noted that L<Class::MOP> will actually bootstrap
920 this module by installing a number of attribute meta-objects into its
927 Stevan Little E<lt>stevan@iinteractive.comE<gt>
929 =head1 COPYRIGHT AND LICENSE
931 Copyright 2006-2009 by Infinity Interactive, Inc.
933 L<http://www.iinteractive.com>
935 This library is free software; you can redistribute it and/or modify
936 it under the same terms as Perl itself.