2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'weaken';
13 our $VERSION = '0.98';
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 'default' => $options->{default},
77 'initializer' => $options->{initializer},
78 'definition_context' => $options->{definition_context},
79 # keep a weakened link to the
80 # class we are associated with
81 'associated_class' => undef,
82 # and a list of the methods
83 # associated with this attr
84 'associated_methods' => [],
85 # this let's us keep track of
86 # our order inside the associated
88 'insertion_order' => undef,
93 # this is a primative (and kludgy) clone operation
94 # for now, it will be replaced in the Class::MOP
95 # bootstrap with a proper one, however we know
96 # that this one will work fine for now.
101 || confess "Can only clone an instance";
102 return bless { %{$self}, %options } => ref($self);
105 sub initialize_instance_slot {
106 my ($self, $meta_instance, $instance, $params) = @_;
107 my $init_arg = $self->{'init_arg'};
109 # try to fetch the init arg from the %params ...
111 # if nothing was in the %params, we can use the
112 # attribute's default value (if it has one)
113 if(defined $init_arg and exists $params->{$init_arg}){
114 $self->_set_initial_slot_value(
117 $params->{$init_arg},
120 elsif (defined $self->{'default'}) {
121 $self->_set_initial_slot_value(
124 $self->default($instance),
127 elsif (defined( my $builder = $self->{'builder'})) {
128 if ($builder = $instance->can($builder)) {
129 $self->_set_initial_slot_value(
136 confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
141 sub _set_initial_slot_value {
142 my ($self, $meta_instance, $instance, $value) = @_;
144 my $slot_name = $self->name;
146 return $meta_instance->set_slot_value($instance, $slot_name, $value)
147 unless $self->has_initializer;
150 $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
153 my $initializer = $self->initializer;
155 # most things will just want to set a value, so make it first arg
156 $instance->$initializer($value, $callback, $self);
159 sub associated_class { $_[0]->{'associated_class'} }
160 sub associated_methods { $_[0]->{'associated_methods'} }
162 sub get_read_method {
164 my $reader = $self->reader || $self->accessor;
166 return $reader unless ref $reader;
168 my ($name) = %$reader;
172 sub get_write_method {
174 my $writer = $self->writer || $self->accessor;
176 return $writer unless ref $writer;
178 my ($name) = %$writer;
182 sub get_read_method_ref {
184 if ((my $reader = $self->get_read_method) && $self->associated_class) {
185 return $self->associated_class->get_method($reader);
188 my $code = sub { $self->get_value(@_) };
189 if (my $class = $self->associated_class) {
190 return $class->method_metaclass->wrap(
192 package_name => $class->name,
202 sub get_write_method_ref {
204 if ((my $writer = $self->get_write_method) && $self->associated_class) {
205 return $self->associated_class->get_method($writer);
208 my $code = sub { $self->set_value(@_) };
209 if (my $class = $self->associated_class) {
210 return $class->method_metaclass->wrap(
212 package_name => $class->name,
224 sub slots { (shift)->name }
228 sub attach_to_class {
229 my ($self, $class) = @_;
230 (blessed($class) && $class->isa('Class::MOP::Class'))
231 || confess "You must pass a Class::MOP::Class instance (or a subclass)";
232 weaken($self->{'associated_class'} = $class);
235 sub detach_from_class {
237 $self->{'associated_class'} = undef;
242 sub associate_method {
243 my ($self, $method) = @_;
244 push @{$self->{'associated_methods'}} => $method;
249 sub set_initial_value {
250 my ($self, $instance, $value) = @_;
251 $self->_set_initial_slot_value(
252 Class::MOP::Class->initialize(ref($instance))->get_meta_instance,
258 sub set_value { shift->set_raw_value(@_) }
259 sub get_value { shift->get_raw_value(@_) }
262 my ($self, $instance, $value) = @_;
264 Class::MOP::Class->initialize(ref($instance))
266 ->set_slot_value($instance, $self->name, $value);
270 my ($self, $instance) = @_;
272 Class::MOP::Class->initialize(ref($instance))
274 ->get_slot_value($instance, $self->name);
278 my ($self, $instance) = @_;
280 Class::MOP::Class->initialize(ref($instance))
282 ->is_slot_initialized($instance, $self->name);
286 my ($self, $instance) = @_;
288 Class::MOP::Class->initialize(ref($instance))
290 ->deinitialize_slot($instance, $self->name);
295 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
297 sub _process_accessors {
298 my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
302 if ( my $ctx = $self->definition_context ) {
303 $method_ctx = { %$ctx };
306 if (ref($accessor)) {
307 (ref($accessor) eq 'HASH')
308 || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
309 my ($name, $method) = %{$accessor};
310 $method = $self->accessor_metaclass->wrap(
312 package_name => $self->associated_class->name,
314 definition_context => $method_ctx,
316 $self->associate_method($method);
317 return ($name, $method);
320 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
324 my $desc = "accessor $accessor";
325 if ( $accessor ne $self->name ) {
326 $desc .= " of attribute " . $self->name;
329 $method_ctx->{description} = $desc;
332 $method = $self->accessor_metaclass->new(
334 is_inline => $inline_me,
335 accessor_type => $type,
336 package_name => $self->associated_class->name,
338 definition_context => $method_ctx,
342 confess "Could not create the '$type' method for " . $self->name . " because : $_";
344 $self->associate_method($method);
345 return ($accessor, $method);
349 sub install_accessors {
352 my $class = $self->associated_class;
355 $self->_process_accessors('accessor' => $self->accessor(), $inline)
356 ) if $self->has_accessor();
359 $self->_process_accessors('reader' => $self->reader(), $inline)
360 ) if $self->has_reader();
363 $self->_process_accessors('writer' => $self->writer(), $inline)
364 ) if $self->has_writer();
367 $self->_process_accessors('predicate' => $self->predicate(), $inline)
368 ) if $self->has_predicate();
371 $self->_process_accessors('clearer' => $self->clearer(), $inline)
372 ) if $self->has_clearer();
378 my $_remove_accessor = sub {
379 my ($accessor, $class) = @_;
380 if (ref($accessor) && ref($accessor) eq 'HASH') {
381 ($accessor) = keys %{$accessor};
383 my $method = $class->get_method($accessor);
384 $class->remove_method($accessor)
385 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
388 sub remove_accessors {
391 # we really need to make sure to remove from the
392 # associates methods here as well. But this is
393 # such a slimly used method, I am not worried
394 # about it right now.
395 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
396 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
397 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
398 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
399 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
413 Class::MOP::Attribute - Attribute Meta Object
417 Class::MOP::Attribute->new(
419 accessor => 'foo', # dual purpose get/set accessor
420 predicate => 'has_foo', # predicate check for defined-ness
421 init_arg => '-foo', # class->new will look for a -foo key
422 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
426 Class::MOP::Attribute->new(
428 reader => 'bar', # getter
429 writer => 'set_bar', # setter
430 predicate => 'has_bar', # predicate check for defined-ness
431 init_arg => ':bar', # class->new will look for a :bar key
432 # no default value means it is undef
438 The Attribute Protocol is almost entirely an invention of
439 C<Class::MOP>. Perl 5 does not have a consistent notion of
440 attributes. There are so many ways in which this is done, and very few
441 (if any) are easily discoverable by this module.
443 With that said, this module attempts to inject some order into this
444 chaos, by introducing a consistent API which can be used to create
453 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
455 An attribute must (at the very least), have a C<$name>. All other
456 C<%options> are added as key-value pairs.
462 This is a string value representing the expected key in an
463 initialization hash. For instance, if we have an C<init_arg> value of
464 C<-foo>, then the following code will Just Work.
466 MyClass->meta->new_object( -foo => 'Hello There' );
468 If an init_arg is not assigned, it will automatically use the
469 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
470 attribute cannot be specified during initialization.
474 This provides the name of a method that will be called to initialize
475 the attribute. This method will be called on the object after it is
476 constructed. It is expected to return a valid value for the attribute.
480 This can be used to provide an explicit default for initializing the
481 attribute. If the default you provide is a subroutine reference, then
482 this reference will be called I<as a method> on the object.
484 If the value is a simple scalar (string or number), then it can be
485 just passed as is. However, if you wish to initialize it with a HASH
486 or ARRAY ref, then you need to wrap that inside a subroutine
489 Class::MOP::Attribute->new(
491 default => sub { [] },
497 Class::MOP::Attribute->new(
499 default => sub { {} },
503 If you wish to initialize an attribute with a subroutine reference
504 itself, then you need to wrap that in a subroutine as well:
506 Class::MOP::Attribute->new(
509 sub { print "Hello World" }
514 And lastly, if the value of your attribute is dependent upon some
515 other aspect of the instance structure, then you can take advantage of
516 the fact that when the C<default> value is called as a method:
518 Class::MOP::Attribute->new(
519 'object_identity' => (
520 default => sub { Scalar::Util::refaddr( $_[0] ) },
524 Note that there is no guarantee that attributes are initialized in any
525 particular order, so you cannot rely on the value of some other
526 attribute when generating the default.
530 This option can be either a method name or a subroutine
531 reference. This method will be called when setting the attribute's
532 value in the constructor. Unlike C<default> and C<builder>, the
533 initializer is only called when a value is provided to the
534 constructor. The initializer allows you to munge this value during
537 The initializer is called as a method with three arguments. The first
538 is the value that was passed to the constructor. The second is a
539 subroutine reference that can be called to actually set the
540 attribute's value, and the last is the associated
541 C<Class::MOP::Attribute> object.
543 This contrived example shows an initializer that sets the attribute to
544 twice the given value.
546 Class::MOP::Attribute->new(
549 my ( $self, $value, $set, $attr ) = @_;
550 $set->( $value * 2 );
555 Since an initializer can be a method name, you can easily make
556 attribute initialization use the writer:
558 Class::MOP::Attribute->new(
560 writer => 'some_attr',
561 initializer => 'some_attr',
565 Your writer will need to examine C<@_> and determine under which
566 context it is being called.
570 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
571 options all accept the same parameters. You can provide the name of
572 the method, in which case an appropriate default method will be
573 generated for you. Or instead you can also provide hash reference
574 containing exactly one key (the method name) and one value. The value
575 should be a subroutine reference, which will be installed as the
582 An C<accessor> is a standard Perl-style read/write accessor. It will
583 return the value of the attribute, and if a value is passed as an
584 argument, it will assign that value to the attribute.
586 Note that C<undef> is a legitimate value, so this will work:
588 $object->set_something(undef);
592 This is a basic read-only accessor. It returns the value of the
597 This is a basic write accessor, it accepts a single argument, and
598 assigns that value to the attribute.
600 Note that C<undef> is a legitimate value, so this will work:
602 $object->set_something(undef);
606 The predicate method returns a boolean indicating whether or not the
607 attribute has been explicitly set.
609 Note that the predicate returns true even if the attribute was set to
610 a false value (C<0> or C<undef>).
614 This method will uninitialize the attribute. After an attribute is
615 cleared, its C<predicate> will return false.
617 =item * definition_context
619 Mostly, this exists as a hook for the benefit of Moose.
621 This option should be a hash reference containing several keys which
622 will be used when inlining the attribute's accessors. The keys should
623 include C<line>, the line number where the attribute was created, and
624 either C<file> or C<description>.
626 This information will ultimately be used when eval'ing inlined
627 accessor code so that error messages report a useful line and file
632 =item B<< $attr->clone(%options) >>
634 This clones the attribute. Any options you provide will override the
635 settings of the original attribute. You can change the name of the new
636 attribute by passing a C<name> key in C<%options>.
642 These are all basic read-only accessors for the values passed into
647 =item B<< $attr->name >>
649 Returns the attribute's name.
651 =item B<< $attr->accessor >>
653 =item B<< $attr->reader >>
655 =item B<< $attr->writer >>
657 =item B<< $attr->predicate >>
659 =item B<< $attr->clearer >>
661 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
662 methods all return exactly what was passed to the constructor, so it
663 can be either a string containing a method name, or a hash reference.
665 =item B<< $attr->initializer >>
667 Returns the initializer as passed to the constructor, so this may be
668 either a method name or a subroutine reference.
670 =item B<< $attr->init_arg >>
672 =item B<< $attr->is_default_a_coderef >>
674 =item B<< $attr->default($instance) >>
676 The C<$instance> argument is optional. If you don't pass it, the
677 return value for this method is exactly what was passed to the
678 constructor, either a simple scalar or a subroutine reference.
680 If you I<do> pass an C<$instance> and the default is a subroutine
681 reference, then the reference is called as a method on the
682 C<$instance> and the generated value is returned.
684 =item B<< $attr->slots >>
686 Return a list of slots required by the attribute. This is usually just
687 one, the name of the attribute.
689 A slot is the name of the hash key used to store the attribute in an
692 =item B<< $attr->get_read_method >>
694 =item B<< $attr->get_write_method >>
696 Returns the name of a method suitable for reading or writing the value
697 of the attribute in the associated class.
699 If an attribute is read- or write-only, then these methods can return
700 C<undef> as appropriate.
702 =item B<< $attr->has_read_method >>
704 =item B<< $attr->has_write_method >>
706 This returns a boolean indicating whether the attribute has a I<named>
707 read or write method.
709 =item B<< $attr->get_read_method_ref >>
711 =item B<< $attr->get_write_method_ref >>
713 Returns the subroutine reference of a method suitable for reading or
714 writing the attribute's value in the associated class. These methods
715 always return a subroutine reference, regardless of whether or not the
716 attribute is read- or write-only.
718 =item B<< $attr->insertion_order >>
720 If this attribute has been inserted into a class, this returns a zero
721 based index regarding the order of insertion.
725 =head2 Informational predicates
727 These are all basic predicate methods for the values passed into C<new>.
731 =item B<< $attr->has_accessor >>
733 =item B<< $attr->has_reader >>
735 =item B<< $attr->has_writer >>
737 =item B<< $attr->has_predicate >>
739 =item B<< $attr->has_clearer >>
741 =item B<< $attr->has_initializer >>
743 =item B<< $attr->has_init_arg >>
745 This will be I<false> if the C<init_arg> was set to C<undef>.
747 =item B<< $attr->has_default >>
749 This will be I<false> if the C<default> was set to C<undef>, since
750 C<undef> is the default C<default> anyway.
752 =item B<< $attr->has_builder >>
754 =item B<< $attr->has_insertion_order >>
756 This will be I<false> if this attribute has not be inserted into a class
760 =head2 Value management
762 These methods are basically "back doors" to the instance, and can be
763 used to bypass the regular accessors, but still stay within the MOP.
765 These methods are not for general use, and should only be used if you
766 really know what you are doing.
770 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
772 This method is used internally to initialize the attribute's slot in
773 the object C<$instance>.
775 The C<$params> is a hash reference of the values passed to the object
778 It's unlikely that you'll need to call this method yourself.
780 =item B<< $attr->set_value($instance, $value) >>
782 Sets the value without going through the accessor. Note that this
783 works even with read-only attributes.
785 =item B<< $attr->set_raw_value($instance, $value) >>
787 Sets the value with no side effects such as a trigger.
789 This doesn't actually apply to Class::MOP attributes, only to subclasses.
791 =item B<< $attr->set_initial_value($instance, $value) >>
793 Sets the value without going through the accessor. This method is only
794 called when the instance is first being initialized.
796 =item B<< $attr->get_value($instance) >>
798 Returns the value without going through the accessor. Note that this
799 works even with write-only accessors.
801 =item B<< $attr->get_raw_value($instance) >>
803 Returns the value without any side effects such as lazy attributes.
805 Doesn't actually apply to Class::MOP attributes, only to subclasses.
807 =item B<< $attr->has_value($instance) >>
809 Return a boolean indicating whether the attribute has been set in
810 C<$instance>. This how the default C<predicate> method works.
812 =item B<< $attr->clear_value($instance) >>
814 This will clear the attribute's value in C<$instance>. This is what
815 the default C<clearer> calls.
817 Note that this works even if the attribute does not have any
818 associated read, write or clear methods.
822 =head2 Class association
824 These methods allow you to manage the attributes association with
825 the class that contains it. These methods should not be used
826 lightly, nor are they very magical, they are mostly used internally
827 and by metaclass instances.
831 =item B<< $attr->associated_class >>
833 This returns the C<Class::MOP::Class> with which this attribute is
836 =item B<< $attr->attach_to_class($metaclass) >>
838 This method stores a weakened reference to the C<$metaclass> object
841 This method does not remove the attribute from its old class,
842 nor does it create any accessors in the new class.
844 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
847 =item B<< $attr->detach_from_class >>
849 This method removes the associate metaclass object from the attribute
852 This method does not remove the attribute itself from the class, or
853 remove its accessors.
855 It is probably best to use the L<Class::MOP::Class>
856 C<remove_attribute> method instead.
860 =head2 Attribute Accessor generation
864 =item B<< $attr->accessor_metaclass >>
866 Accessor methods are generated using an accessor metaclass. By
867 default, this is L<Class::MOP::Method::Accessor>. This method returns
868 the name of the accessor metaclass that this attribute uses.
870 =item B<< $attr->associate_method($method) >>
872 This associates a L<Class::MOP::Method> object with the
873 attribute. Typically, this is called internally when an attribute
874 generates its accessors.
876 =item B<< $attr->associated_methods >>
878 This returns the list of methods which have been associated with the
881 =item B<< $attr->install_accessors >>
883 This method generates and installs code the attributes various
884 accessors. It is typically called from the L<Class::MOP::Class>
885 C<add_attribute> method.
887 =item B<< $attr->remove_accessors >>
889 This method removes all of the accessors associated with the
892 This does not currently remove methods from the list returned by
893 C<associated_methods>.
901 =item B<< Class::MOP::Attribute->meta >>
903 This will return a L<Class::MOP::Class> instance for this class.
905 It should also be noted that L<Class::MOP> will actually bootstrap
906 this module by installing a number of attribute meta-objects into its
913 Stevan Little E<lt>stevan@iinteractive.comE<gt>
915 =head1 COPYRIGHT AND LICENSE
917 Copyright 2006-2010 by Infinity Interactive, Inc.
919 L<http://www.iinteractive.com>
921 This library is free software; you can redistribute it and/or modify
922 it under the same terms as Perl itself.