2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'weaken';
13 our $VERSION = '1.04';
14 $VERSION = eval $VERSION;
15 our $AUTHORITY = 'cpan:STEVAN';
17 use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore';
19 # NOTE: (meta-circularity)
20 # This method will be replaced in the
21 # boostrap section of Class::MOP, by
22 # a new version which uses the
23 # &Class::MOP::Class::construct_instance
24 # method to build an attribute meta-object
25 # which itself is described with attribute
27 # - Ain't meta-circularity grand? :)
29 my ( $class, @args ) = @_;
31 unshift @args, "name" if @args % 2 == 1;
34 my $name = $options{name};
37 || confess "You must provide a name for the attribute";
39 $options{init_arg} = $name
40 if not exists $options{init_arg};
41 if(exists $options{builder}){
42 confess("builder must be a defined scalar value which is a method name")
43 if ref $options{builder} || !(defined $options{builder});
44 confess("Setting both default and builder is not allowed.")
45 if exists $options{default};
47 ($class->is_default_a_coderef(\%options))
48 || confess("References are not allowed as default values, you must ".
49 "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
50 if exists $options{default} && ref $options{default};
52 if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
53 confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
56 $class->_new(\%options);
62 return Class::MOP::Class->initialize($class)->new_object(@_)
63 if $class ne __PACKAGE__;
65 my $options = @_ == 1 ? $_[0] : {@_};
68 'name' => $options->{name},
69 'accessor' => $options->{accessor},
70 'reader' => $options->{reader},
71 'writer' => $options->{writer},
72 'predicate' => $options->{predicate},
73 'clearer' => $options->{clearer},
74 'builder' => $options->{builder},
75 'init_arg' => $options->{init_arg},
76 exists $options->{default}
77 ? ('default' => $options->{default})
79 'initializer' => $options->{initializer},
80 'definition_context' => $options->{definition_context},
81 # keep a weakened link to the
82 # class we are associated with
83 'associated_class' => undef,
84 # and a list of the methods
85 # associated with this attr
86 'associated_methods' => [],
87 # this let's us keep track of
88 # our order inside the associated
90 'insertion_order' => undef,
95 # this is a primative (and kludgy) clone operation
96 # for now, it will be replaced in the Class::MOP
97 # bootstrap with a proper one, however we know
98 # that this one will work fine for now.
103 || confess "Can only clone an instance";
104 return bless { %{$self}, %options } => ref($self);
107 sub initialize_instance_slot {
108 my ($self, $meta_instance, $instance, $params) = @_;
109 my $init_arg = $self->{'init_arg'};
111 # try to fetch the init arg from the %params ...
113 # if nothing was in the %params, we can use the
114 # attribute's default value (if it has one)
115 if(defined $init_arg and exists $params->{$init_arg}){
116 $self->_set_initial_slot_value(
119 $params->{$init_arg},
122 elsif (exists $self->{'default'}) {
123 $self->_set_initial_slot_value(
126 $self->default($instance),
129 elsif (defined( my $builder = $self->{'builder'})) {
130 if ($builder = $instance->can($builder)) {
131 $self->_set_initial_slot_value(
138 confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
143 sub _set_initial_slot_value {
144 my ($self, $meta_instance, $instance, $value) = @_;
146 my $slot_name = $self->name;
148 return $meta_instance->set_slot_value($instance, $slot_name, $value)
149 unless $self->has_initializer;
152 $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
155 my $initializer = $self->initializer;
157 # most things will just want to set a value, so make it first arg
158 $instance->$initializer($value, $callback, $self);
161 sub associated_class { $_[0]->{'associated_class'} }
162 sub associated_methods { $_[0]->{'associated_methods'} }
164 sub get_read_method {
166 my $reader = $self->reader || $self->accessor;
168 return $reader unless ref $reader;
170 my ($name) = %$reader;
174 sub get_write_method {
176 my $writer = $self->writer || $self->accessor;
178 return $writer unless ref $writer;
180 my ($name) = %$writer;
184 sub get_read_method_ref {
186 if ((my $reader = $self->get_read_method) && $self->associated_class) {
187 return $self->associated_class->get_method($reader);
190 my $code = sub { $self->get_value(@_) };
191 if (my $class = $self->associated_class) {
192 return $class->method_metaclass->wrap(
194 package_name => $class->name,
204 sub get_write_method_ref {
206 if ((my $writer = $self->get_write_method) && $self->associated_class) {
207 return $self->associated_class->get_method($writer);
210 my $code = sub { $self->set_value(@_) };
211 if (my $class = $self->associated_class) {
212 return $class->method_metaclass->wrap(
214 package_name => $class->name,
226 sub slots { (shift)->name }
230 sub attach_to_class {
231 my ($self, $class) = @_;
232 (blessed($class) && $class->isa('Class::MOP::Class'))
233 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
234 weaken($self->{'associated_class'} = $class);
237 sub detach_from_class {
239 $self->{'associated_class'} = undef;
244 sub associate_method {
245 my ($self, $method) = @_;
246 push @{$self->{'associated_methods'}} => $method;
251 sub set_initial_value {
252 my ($self, $instance, $value) = @_;
253 $self->_set_initial_slot_value(
254 Class::MOP::Class->initialize(ref($instance))->get_meta_instance,
260 sub set_value { shift->set_raw_value(@_) }
261 sub get_value { shift->get_raw_value(@_) }
264 my ($self, $instance, $value) = @_;
266 Class::MOP::Class->initialize(ref($instance))
268 ->set_slot_value($instance, $self->name, $value);
272 my ($self, $instance) = @_;
274 Class::MOP::Class->initialize(ref($instance))
276 ->get_slot_value($instance, $self->name);
280 my ($self, $instance) = @_;
282 Class::MOP::Class->initialize(ref($instance))
284 ->is_slot_initialized($instance, $self->name);
288 my ($self, $instance) = @_;
290 Class::MOP::Class->initialize(ref($instance))
292 ->deinitialize_slot($instance, $self->name);
297 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
299 sub _process_accessors {
300 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
304 if ( my $ctx = $self->definition_context ) {
305 $method_ctx = { %$ctx };
308 if (ref($accessor)) {
309 (ref($accessor) eq 'HASH')
310 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
311 my ($name, $method) = %{$accessor};
312 $method = $self->accessor_metaclass->wrap(
314 package_name => $self->associated_class->name,
316 definition_context => $method_ctx,
318 $self->associate_method($method);
319 return ($name, $method);
322 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
326 my $desc = "accessor $accessor";
327 if ( $accessor ne $self->name ) {
328 $desc .= " of attribute " . $self->name;
331 $method_ctx->{description} = $desc;
334 $method = $self->accessor_metaclass->new(
336 is_inline => $inline_me,
337 accessor_type => $type,
338 package_name => $self->associated_class->name,
340 definition_context => $method_ctx,
344 confess "Could not create the '$type' method for " . $self->name . " because : $_";
346 $self->associate_method($method);
347 return ($accessor, $method);
351 sub install_accessors {
354 my $class = $self->associated_class;
357 $self->_process_accessors('accessor' => $self->accessor(), $inline)
358 ) if $self->has_accessor();
361 $self->_process_accessors('reader' => $self->reader(), $inline)
362 ) if $self->has_reader();
365 $self->_process_accessors('writer' => $self->writer(), $inline)
366 ) if $self->has_writer();
369 $self->_process_accessors('predicate' => $self->predicate(), $inline)
370 ) if $self->has_predicate();
373 $self->_process_accessors('clearer' => $self->clearer(), $inline)
374 ) if $self->has_clearer();
380 my $_remove_accessor = sub {
381 my ($accessor, $class) = @_;
382 if (ref($accessor) && ref($accessor) eq 'HASH') {
383 ($accessor) = keys %{$accessor};
385 my $method = $class->get_method($accessor);
386 $class->remove_method($accessor)
387 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
390 sub remove_accessors {
393 # we really need to make sure to remove from the
394 # associates methods here as well. But this is
395 # such a slimly used method, I am not worried
396 # about it right now.
397 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
398 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
399 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
400 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
401 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
415 Class::MOP::Attribute - Attribute Meta Object
419 Class::MOP::Attribute->new(
421 accessor => 'foo', # dual purpose get/set accessor
422 predicate => 'has_foo', # predicate check for defined-ness
423 init_arg => '-foo', # class->new will look for a -foo key
424 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
428 Class::MOP::Attribute->new(
430 reader => 'bar', # getter
431 writer => 'set_bar', # setter
432 predicate => 'has_bar', # predicate check for defined-ness
433 init_arg => ':bar', # class->new will look for a :bar key
434 # no default value means it is undef
440 The Attribute Protocol is almost entirely an invention of
441 C<Class::MOP>. Perl 5 does not have a consistent notion of
442 attributes. There are so many ways in which this is done, and very few
443 (if any) are easily discoverable by this module.
445 With that said, this module attempts to inject some order into this
446 chaos, by introducing a consistent API which can be used to create
455 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
457 An attribute must (at the very least), have a C<$name>. All other
458 C<%options> are added as key-value pairs.
464 This is a string value representing the expected key in an
465 initialization hash. For instance, if we have an C<init_arg> value of
466 C<-foo>, then the following code will Just Work.
468 MyClass->meta->new_object( -foo => 'Hello There' );
470 If an init_arg is not assigned, it will automatically use the
471 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
472 attribute cannot be specified during initialization.
476 This provides the name of a method that will be called to initialize
477 the attribute. This method will be called on the object after it is
478 constructed. It is expected to return a valid value for the attribute.
482 This can be used to provide an explicit default for initializing the
483 attribute. If the default you provide is a subroutine reference, then
484 this reference will be called I<as a method> on the object.
486 If the value is a simple scalar (string or number), then it can be
487 just passed as is. However, if you wish to initialize it with a HASH
488 or ARRAY ref, then you need to wrap that inside a subroutine
491 Class::MOP::Attribute->new(
493 default => sub { [] },
499 Class::MOP::Attribute->new(
501 default => sub { {} },
505 If you wish to initialize an attribute with a subroutine reference
506 itself, then you need to wrap that in a subroutine as well:
508 Class::MOP::Attribute->new(
511 sub { print "Hello World" }
516 And lastly, if the value of your attribute is dependent upon some
517 other aspect of the instance structure, then you can take advantage of
518 the fact that when the C<default> value is called as a method:
520 Class::MOP::Attribute->new(
521 'object_identity' => (
522 default => sub { Scalar::Util::refaddr( $_[0] ) },
526 Note that there is no guarantee that attributes are initialized in any
527 particular order, so you cannot rely on the value of some other
528 attribute when generating the default.
532 This option can be either a method name or a subroutine
533 reference. This method will be called when setting the attribute's
534 value in the constructor. Unlike C<default> and C<builder>, the
535 initializer is only called when a value is provided to the
536 constructor. The initializer allows you to munge this value during
539 The initializer is called as a method with three arguments. The first
540 is the value that was passed to the constructor. The second is a
541 subroutine reference that can be called to actually set the
542 attribute's value, and the last is the associated
543 C<Class::MOP::Attribute> object.
545 This contrived example shows an initializer that sets the attribute to
546 twice the given value.
548 Class::MOP::Attribute->new(
551 my ( $self, $value, $set, $attr ) = @_;
552 $set->( $value * 2 );
557 Since an initializer can be a method name, you can easily make
558 attribute initialization use the writer:
560 Class::MOP::Attribute->new(
562 writer => 'some_attr',
563 initializer => 'some_attr',
567 Your writer will need to examine C<@_> and determine under which
568 context it is being called.
572 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
573 options all accept the same parameters. You can provide the name of
574 the method, in which case an appropriate default method will be
575 generated for you. Or instead you can also provide hash reference
576 containing exactly one key (the method name) and one value. The value
577 should be a subroutine reference, which will be installed as the
584 An C<accessor> is a standard Perl-style read/write accessor. It will
585 return the value of the attribute, and if a value is passed as an
586 argument, it will assign that value to the attribute.
588 Note that C<undef> is a legitimate value, so this will work:
590 $object->set_something(undef);
594 This is a basic read-only accessor. It returns the value of the
599 This is a basic write accessor, it accepts a single argument, and
600 assigns that value to the attribute.
602 Note that C<undef> is a legitimate value, so this will work:
604 $object->set_something(undef);
608 The predicate method returns a boolean indicating whether or not the
609 attribute has been explicitly set.
611 Note that the predicate returns true even if the attribute was set to
612 a false value (C<0> or C<undef>).
616 This method will uninitialize the attribute. After an attribute is
617 cleared, its C<predicate> will return false.
619 =item * definition_context
621 Mostly, this exists as a hook for the benefit of Moose.
623 This option should be a hash reference containing several keys which
624 will be used when inlining the attribute's accessors. The keys should
625 include C<line>, the line number where the attribute was created, and
626 either C<file> or C<description>.
628 This information will ultimately be used when eval'ing inlined
629 accessor code so that error messages report a useful line and file
634 =item B<< $attr->clone(%options) >>
636 This clones the attribute. Any options you provide will override the
637 settings of the original attribute. You can change the name of the new
638 attribute by passing a C<name> key in C<%options>.
644 These are all basic read-only accessors for the values passed into
649 =item B<< $attr->name >>
651 Returns the attribute's name.
653 =item B<< $attr->accessor >>
655 =item B<< $attr->reader >>
657 =item B<< $attr->writer >>
659 =item B<< $attr->predicate >>
661 =item B<< $attr->clearer >>
663 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
664 methods all return exactly what was passed to the constructor, so it
665 can be either a string containing a method name, or a hash reference.
667 =item B<< $attr->initializer >>
669 Returns the initializer as passed to the constructor, so this may be
670 either a method name or a subroutine reference.
672 =item B<< $attr->init_arg >>
674 =item B<< $attr->is_default_a_coderef >>
676 =item B<< $attr->default($instance) >>
678 The C<$instance> argument is optional. If you don't pass it, the
679 return value for this method is exactly what was passed to the
680 constructor, either a simple scalar or a subroutine reference.
682 If you I<do> pass an C<$instance> and the default is a subroutine
683 reference, then the reference is called as a method on the
684 C<$instance> and the generated value is returned.
686 =item B<< $attr->slots >>
688 Return a list of slots required by the attribute. This is usually just
689 one, the name of the attribute.
691 A slot is the name of the hash key used to store the attribute in an
694 =item B<< $attr->get_read_method >>
696 =item B<< $attr->get_write_method >>
698 Returns the name of a method suitable for reading or writing the value
699 of the attribute in the associated class.
701 If an attribute is read- or write-only, then these methods can return
702 C<undef> as appropriate.
704 =item B<< $attr->has_read_method >>
706 =item B<< $attr->has_write_method >>
708 This returns a boolean indicating whether the attribute has a I<named>
709 read or write method.
711 =item B<< $attr->get_read_method_ref >>
713 =item B<< $attr->get_write_method_ref >>
715 Returns the subroutine reference of a method suitable for reading or
716 writing the attribute's value in the associated class. These methods
717 always return a subroutine reference, regardless of whether or not the
718 attribute is read- or write-only.
720 =item B<< $attr->insertion_order >>
722 If this attribute has been inserted into a class, this returns a zero
723 based index regarding the order of insertion.
727 =head2 Informational predicates
729 These are all basic predicate methods for the values passed into C<new>.
733 =item B<< $attr->has_accessor >>
735 =item B<< $attr->has_reader >>
737 =item B<< $attr->has_writer >>
739 =item B<< $attr->has_predicate >>
741 =item B<< $attr->has_clearer >>
743 =item B<< $attr->has_initializer >>
745 =item B<< $attr->has_init_arg >>
747 This will be I<false> if the C<init_arg> was set to C<undef>.
749 =item B<< $attr->has_default >>
751 This will be I<false> if the C<default> was set to C<undef>, since
752 C<undef> is the default C<default> anyway.
754 =item B<< $attr->has_builder >>
756 =item B<< $attr->has_insertion_order >>
758 This will be I<false> if this attribute has not be inserted into a class
762 =head2 Value management
764 These methods are basically "back doors" to the instance, and can be
765 used to bypass the regular accessors, but still stay within the MOP.
767 These methods are not for general use, and should only be used if you
768 really know what you are doing.
772 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
774 This method is used internally to initialize the attribute's slot in
775 the object C<$instance>.
777 The C<$params> is a hash reference of the values passed to the object
780 It's unlikely that you'll need to call this method yourself.
782 =item B<< $attr->set_value($instance, $value) >>
784 Sets the value without going through the accessor. Note that this
785 works even with read-only attributes.
787 =item B<< $attr->set_raw_value($instance, $value) >>
789 Sets the value with no side effects such as a trigger.
791 This doesn't actually apply to Class::MOP attributes, only to subclasses.
793 =item B<< $attr->set_initial_value($instance, $value) >>
795 Sets the value without going through the accessor. This method is only
796 called when the instance is first being initialized.
798 =item B<< $attr->get_value($instance) >>
800 Returns the value without going through the accessor. Note that this
801 works even with write-only accessors.
803 =item B<< $attr->get_raw_value($instance) >>
805 Returns the value without any side effects such as lazy attributes.
807 Doesn't actually apply to Class::MOP attributes, only to subclasses.
809 =item B<< $attr->has_value($instance) >>
811 Return a boolean indicating whether the attribute has been set in
812 C<$instance>. This how the default C<predicate> method works.
814 =item B<< $attr->clear_value($instance) >>
816 This will clear the attribute's value in C<$instance>. This is what
817 the default C<clearer> calls.
819 Note that this works even if the attribute does not have any
820 associated read, write or clear methods.
824 =head2 Class association
826 These methods allow you to manage the attributes association with
827 the class that contains it. These methods should not be used
828 lightly, nor are they very magical, they are mostly used internally
829 and by metaclass instances.
833 =item B<< $attr->associated_class >>
835 This returns the C<Class::MOP::Class> with which this attribute is
838 =item B<< $attr->attach_to_class($metaclass) >>
840 This method stores a weakened reference to the C<$metaclass> object
843 This method does not remove the attribute from its old class,
844 nor does it create any accessors in the new class.
846 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
849 =item B<< $attr->detach_from_class >>
851 This method removes the associate metaclass object from the attribute
854 This method does not remove the attribute itself from the class, or
855 remove its accessors.
857 It is probably best to use the L<Class::MOP::Class>
858 C<remove_attribute> method instead.
862 =head2 Attribute Accessor generation
866 =item B<< $attr->accessor_metaclass >>
868 Accessor methods are generated using an accessor metaclass. By
869 default, this is L<Class::MOP::Method::Accessor>. This method returns
870 the name of the accessor metaclass that this attribute uses.
872 =item B<< $attr->associate_method($method) >>
874 This associates a L<Class::MOP::Method> object with the
875 attribute. Typically, this is called internally when an attribute
876 generates its accessors.
878 =item B<< $attr->associated_methods >>
880 This returns the list of methods which have been associated with the
883 =item B<< $attr->install_accessors >>
885 This method generates and installs code the attributes various
886 accessors. It is typically called from the L<Class::MOP::Class>
887 C<add_attribute> method.
889 =item B<< $attr->remove_accessors >>
891 This method removes all of the accessors associated with the
894 This does not currently remove methods from the list returned by
895 C<associated_methods>.
903 =item B<< Class::MOP::Attribute->meta >>
905 This will return a L<Class::MOP::Class> instance for this class.
907 It should also be noted that L<Class::MOP> will actually bootstrap
908 this module by installing a number of attribute meta-objects into its
915 Stevan Little E<lt>stevan@iinteractive.comE<gt>
917 =head1 COPYRIGHT AND LICENSE
919 Copyright 2006-2010 by Infinity Interactive, Inc.
921 L<http://www.iinteractive.com>
923 This library is free software; you can redistribute it and/or modify
924 it under the same terms as Perl itself.