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.'
333 . " The public version is deprecated and will be removed in a future release.\n";
334 goto &_process_accessors;
337 sub _process_accessors {
338 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
342 if ( my $ctx = $self->definition_context ) {
343 $method_ctx = { %$ctx };
346 if (ref($accessor)) {
347 (ref($accessor) eq 'HASH')
348 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
349 my ($name, $method) = %{$accessor};
350 $method = $self->accessor_metaclass->wrap(
352 package_name => $self->associated_class->name,
354 definition_context => $method_ctx,
356 $self->associate_method($method);
357 return ($name, $method);
360 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
364 my $desc = "accessor $accessor";
365 if ( $accessor ne $self->name ) {
366 $desc .= " of attribute " . $self->name;
369 $method_ctx->{description} = $desc;
372 $method = $self->accessor_metaclass->new(
374 is_inline => $inline_me,
375 accessor_type => $type,
376 package_name => $self->associated_class->name,
378 definition_context => $method_ctx,
381 confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
382 $self->associate_method($method);
383 return ($accessor, $method);
387 sub install_accessors {
390 my $class = $self->associated_class;
393 $self->_process_accessors('accessor' => $self->accessor(), $inline)
394 ) if $self->has_accessor();
397 $self->_process_accessors('reader' => $self->reader(), $inline)
398 ) if $self->has_reader();
401 $self->_process_accessors('writer' => $self->writer(), $inline)
402 ) if $self->has_writer();
405 $self->_process_accessors('predicate' => $self->predicate(), $inline)
406 ) if $self->has_predicate();
409 $self->_process_accessors('clearer' => $self->clearer(), $inline)
410 ) if $self->has_clearer();
416 my $_remove_accessor = sub {
417 my ($accessor, $class) = @_;
418 if (ref($accessor) && ref($accessor) eq 'HASH') {
419 ($accessor) = keys %{$accessor};
421 my $method = $class->get_method($accessor);
422 $class->remove_method($accessor)
423 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
426 sub remove_accessors {
429 # we really need to make sure to remove from the
430 # associates methods here as well. But this is
431 # such a slimly used method, I am not worried
432 # about it right now.
433 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
434 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
435 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
436 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
437 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
451 Class::MOP::Attribute - Attribute Meta Object
455 Class::MOP::Attribute->new(
457 accessor => 'foo', # dual purpose get/set accessor
458 predicate => 'has_foo', # predicate check for defined-ness
459 init_arg => '-foo', # class->new will look for a -foo key
460 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
464 Class::MOP::Attribute->new(
466 reader => 'bar', # getter
467 writer => 'set_bar', # setter
468 predicate => 'has_bar', # predicate check for defined-ness
469 init_arg => ':bar', # class->new will look for a :bar key
470 # no default value means it is undef
476 The Attribute Protocol is almost entirely an invention of
477 C<Class::MOP>. Perl 5 does not have a consistent notion of
478 attributes. There are so many ways in which this is done, and very few
479 (if any) are easily discoverable by this module.
481 With that said, this module attempts to inject some order into this
482 chaos, by introducing a consistent API which can be used to create
491 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
493 An attribute must (at the very least), have a C<$name>. All other
494 C<%options> are added as key-value pairs.
500 This is a string value representing the expected key in an
501 initialization hash. For instance, if we have an C<init_arg> value of
502 C<-foo>, then the following code will Just Work.
504 MyClass->meta->construct_instance( -foo => 'Hello There' );
506 If an init_arg is not assigned, it will automatically use the
507 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
508 attribute cannot be specified during initialization.
512 This provides the name of a method that will be called to initialize
513 the attribute. This method will be called on the object after it is
514 constructed. It is expected to return a valid value for the attribute.
518 This can be used to provide an explicit default for initializing the
519 attribute. If the default you provide is a subroutine reference, then
520 this reference will be called I<as a method> on the object.
522 If the value is a simple scalar (string or number), then it can be
523 just passed as is. However, if you wish to initialize it with a HASH
524 or ARRAY ref, then you need to wrap that inside a subroutine
527 Class::MOP::Attribute->new(
529 default => sub { [] },
535 Class::MOP::Attribute->new(
537 default => sub { {} },
541 If you wish to initialize an attribute with a subroutine reference
542 itself, then you need to wrap that in a subroutine as well:
544 Class::MOP::Attribute->new(
547 sub { print "Hello World" }
552 And lastly, if the value of your attribute is dependent upon some
553 other aspect of the instance structure, then you can take advantage of
554 the fact that when the C<default> value is called as a method:
556 Class::MOP::Attribute->new(
557 'object_identity' => (
558 default => sub { Scalar::Util::refaddr( $_[0] ) },
562 Note that there is no guarantee that attributes are initialized in any
563 particular order, so you cannot rely on the value of some other
564 attribute when generating the default.
568 This option can be either a method name or a subroutine
569 reference. This method will be called when setting the attribute's
570 value in the constructor. Unlike C<default> and C<builder>, the
571 initializer is only called when a value is provided to the
572 constructor. The initializer allows you to munge this value during
575 The initializer is called as a method with three arguments. The first
576 is the value that was passed to the constructor. The second is a
577 subroutine reference that can be called to actually set the
578 attribute's value, and the last is the associated
579 C<Class::MOP::Attribute> object.
581 This contrived example shows an initializer that sets the attribute to
582 twice the given value.
584 Class::MOP::Attribute->new(
587 my ( $instance, $value, $set ) = @_;
588 $set->( $value * 2 );
593 Since an initializer can be a method name, you can easily make
594 attribute initialization use the writer:
596 Class::MOP::Attribute->new(
598 writer => 'some_attr',
599 initializer => 'some_attr',
603 Your writer will need to examine C<@_> and determine under which
604 context it is being called.
608 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
609 options all accept the same parameters. You can provide the name of
610 the method, in which case an appropriate default method will be
611 generated for you. Or instead you can also provide hash reference
612 containing exactly one key (the method name) and one value. The value
613 should be a subroutine reference, which will be installed as the
620 An C<accessor> is a standard Perl-style read/write accessor. It will
621 return the value of the attribute, and if a value is passed as an
622 argument, it will assign that value to the attribute.
624 Note that C<undef> is a legitimate value, so this will work:
626 $object->set_something(undef);
630 This is a basic read-only accessor. It returns the value of the
635 This is a basic write accessor, it accepts a single argument, and
636 assigns that value to the attribute.
638 Note that C<undef> is a legitimate value, so this will work:
640 $object->set_something(undef);
644 The predicate method returns a boolean indicating whether or not the
645 attribute has been explicitly set.
647 Note that the predicate returns true even if the attribute was set to
648 a false value (C<0> or C<undef>).
652 This method will uninitialize the attribute. After an attribute is
653 cleared, its C<predicate> will return false.
655 =item I<definition_context>
657 Mostly, this exists as a hook for the benefit of Moose.
659 This option should be a hash reference containing several keys which
660 will be used when inlining the attribute's accessors. The keys should
661 include C<line>, the line number where the attribute was created, and
662 either C<file> or C<description>.
664 This information will ultimately be used when eval'ing inlined
665 accessor code so that error messages report a useful line and file
670 =item B<< $attr->clone(%options) >>
672 This clones the attribute. Any options you provide will override the
673 settings of the original attribute. You can change the name of the new
674 attribute by passing a C<name> key in C<%options>.
680 These are all basic read-only accessors for the values passed into
685 =item B<< $attr->name >>
687 =item B<< $attr->accessor >>
689 =item B<< $attr->reader >>
691 =item B<< $attr->writer >>
693 =item B<< $attr->predicate >>
695 =item B<< $attr->clearer >>
697 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
698 methods all return exactly what was passed to the constructor, so it
699 can be either a string containing a method name, or a hash reference.
701 =item B<< $attr->initializer >>
703 Returns the initializer as passed to the constructor, so this may be
704 either a method name or a subroutine reference.
706 =item B<< $attr->init_arg >>
708 =item B<< $attr->is_default_a_coderef >>
710 =item B<< $attr->default($instance) >>
712 The C<$instance> argument is optional. If you don't pass it, the
713 return value for this method is exactly what was passed to the
714 constructor, either a simple scalar or a subroutine reference.
716 If you I<do> pass an C<$instance> and the default is a subroutine
717 reference, then the reference is called as a method on the
718 C<$instance> and the generated value is returned.
720 =item B<< $attr->slots >>
722 Return a list of slots required by the attribute. This is usually just
723 one, the name of the attribute.
725 A slot is the name of the hash key used to store the attribute in an
728 =item B<< $attr->get_read_method >>
730 =item B<< $attr->get_write_method >>
732 Returns the name of a method suitable for reading or writing the value
733 of the attribute in the associated class.
735 If an attribute is read- or write-only, then these methods can return
736 C<undef> as appropriate.
738 =item B<< $attr->has_read_method >>
740 =item B<< $attr->has_write_method >>
742 This returns a boolean indicating whether the attribute has a I<named>
743 read or write method.
745 =item B<< $attr->get_read_method_ref >>
747 =item B<< $attr->get_write_method_ref >>
749 Returns the subroutine reference of a method suitable for reading or
750 writing the attribute's value in the associated class. These methods
751 always return a subroutine reference, regardless of whether or not the
752 attribute is read- or write-only.
756 =head2 Informational predicates
758 These are all basic predicate methods for the values passed into C<new>.
762 =item B<< $attr->has_accessor >>
764 =item B<< $attr->has_reader >>
766 =item B<< $attr->has_writer >>
768 =item B<< $attr->has_predicate >>
770 =item B<< $attr->has_clearer >>
772 =item B<< $attr->has_initializer >>
774 =item B<< $attr->has_init_arg >>
776 This will be I<false> if the C<init_arg> was set to C<undef>.
778 =item B<< $attr->has_default >>
780 This will be I<false> if the C<default> was set to C<undef>, since
781 C<undef> is the default C<default> anyway.
783 =item B<< $attr->has_builder >>
787 =head2 Value management
789 These methods are basically "back doors" to the instance, and can be
790 used to bypass the regular accessors, but still stay within the MOP.
792 These methods are not for general use, and should only be used if you
793 really know what you are doing.
797 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
799 This method is used internally to initialize the attribute's slot in
800 the object C<$instance>.
802 The C<$params> is a hash reference of the values passed to the object
805 It's unlikely that you'll need to call this method yourself.
807 =item B<< $attr->set_value($instance, $value) >>
809 Sets the value without going through the accessor. Note that this
810 works even with read-only attributes.
812 =item B<< $attr->set_initial_value($instance, $value) >>
814 Sets the value without going through the accessor. This method is only
815 called when the instance is first being initialized.
817 =item B<< $attr->get_value($instance) >>
819 Returns the value without going through the accessor. Note that this
820 works even with write-only accessors.
822 =item B<< $attr->has_value($instance) >>
824 Return a boolean indicating whether the attribute has been set in
825 C<$instance>. This how the default C<predicate> method works.
827 =item B<< $attr->clear_value($instance) >>
829 This will clear the attribute's value in C<$instance>. This is what
830 the default C<clearer> calls.
832 Note that this works even if the attribute does not have any
833 associated read, write or clear methods.
837 =head2 Class association
839 These methods allow you to manage the attributes association with
840 the class that contains it. These methods should not be used
841 lightly, nor are they very magical, they are mostly used internally
842 and by metaclass instances.
846 =item B<< $attr->associated_class >>
848 This returns the C<Class::MOP::Class> with which this attribute is
851 =item B<< $attr->attach_to_class($metaclass) >>
853 This method stores a weakened reference to the C<$metaclass> object
856 This method does not remove the attribute from its old class,
857 nor does it create any accessors in the new class.
859 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
862 =item B<< $attr->detach_from_class >>
864 This method removes the associate metaclass object from the attribute
867 This method does not remove the attribute itself from the class, or
868 remove its accessors.
870 It is probably best to use the L<Class::MOP::Class>
871 C<remove_attribute> method instead.
875 =head2 Attribute Accessor generation
879 =item B<< $attr->accessor_metaclass >>
881 Accessor methods are generated using an accessor metaclass. By
882 default, this is L<Class::MOP::Method::Accessor>. This method returns
883 the name of the accessor metaclass that this attribute uses.
885 =item B<< $attr->associate_method($method) >>
887 This associates a L<Class::MOP::Method> object with the
888 attribute. Typically, this is called internally when an attribute
889 generates its accessors.
891 =item B<< $attr->associated_methods >>
893 This returns the list of methods which have been associated with the
896 =item B<< $attr->install_accessors >>
898 This method generates and installs code the attributes various
899 accessors. It is typically called from the L<Class::MOP::Class>
900 C<add_attribute> method.
902 =item B<< $attr->remove_accessors >>
904 This method removes all of the accessors associated with the
907 This does not currently remove methods from the list returned by
908 C<associated_methods>.
916 =item B<< $attr->meta >>
918 This will return a L<Class::MOP::Class> instance for this class.
920 It should also be noted that L<Class::MOP> will actually bootstrap
921 this module by installing a number of attribute meta-objects into its
928 Stevan Little E<lt>stevan@iinteractive.comE<gt>
930 =head1 COPYRIGHT AND LICENSE
932 Copyright 2006-2009 by Infinity Interactive, Inc.
934 L<http://www.iinteractive.com>
936 This library is free software; you can redistribute it and/or modify
937 it under the same terms as Perl itself.