2 package Class::MOP::Attribute;
7 use Class::MOP::Method::Accessor;
10 use Scalar::Util 'blessed', 'weaken';
13 our $VERSION = '1.11';
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();
411 return $self->associated_class->get_meta_instance->inline_get_slot_value(
412 $instance, $self->name );
417 my ( $instance, $value ) = @_;
419 return $self->associated_class->get_meta_instance->inline_set_slot_value(
420 $instance, $self->name, $value );
428 $self->associated_class->get_meta_instance
429 ->inline_is_slot_initialized( $instance, $self->name );
437 $self->associated_class->get_meta_instance
438 ->inline_deinitialize_slot( $instance, $self->name );
449 Class::MOP::Attribute - Attribute Meta Object
453 Class::MOP::Attribute->new(
455 accessor => 'foo', # dual purpose get/set accessor
456 predicate => 'has_foo', # predicate check for defined-ness
457 init_arg => '-foo', # class->new will look for a -foo key
458 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
462 Class::MOP::Attribute->new(
464 reader => 'bar', # getter
465 writer => 'set_bar', # setter
466 predicate => 'has_bar', # predicate check for defined-ness
467 init_arg => ':bar', # class->new will look for a :bar key
468 # no default value means it is undef
474 The Attribute Protocol is almost entirely an invention of
475 C<Class::MOP>. Perl 5 does not have a consistent notion of
476 attributes. There are so many ways in which this is done, and very few
477 (if any) are easily discoverable by this module.
479 With that said, this module attempts to inject some order into this
480 chaos, by introducing a consistent API which can be used to create
489 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
491 An attribute must (at the very least), have a C<$name>. All other
492 C<%options> are added as key-value pairs.
498 This is a string value representing the expected key in an
499 initialization hash. For instance, if we have an C<init_arg> value of
500 C<-foo>, then the following code will Just Work.
502 MyClass->meta->new_object( -foo => 'Hello There' );
504 If an init_arg is not assigned, it will automatically use the
505 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
506 attribute cannot be specified during initialization.
510 This provides the name of a method that will be called to initialize
511 the attribute. This method will be called on the object after it is
512 constructed. It is expected to return a valid value for the attribute.
516 This can be used to provide an explicit default for initializing the
517 attribute. If the default you provide is a subroutine reference, then
518 this reference will be called I<as a method> on the object.
520 If the value is a simple scalar (string or number), then it can be
521 just passed as is. However, if you wish to initialize it with a HASH
522 or ARRAY ref, then you need to wrap that inside a subroutine
525 Class::MOP::Attribute->new(
527 default => sub { [] },
533 Class::MOP::Attribute->new(
535 default => sub { {} },
539 If you wish to initialize an attribute with a subroutine reference
540 itself, then you need to wrap that in a subroutine as well:
542 Class::MOP::Attribute->new(
545 sub { print "Hello World" }
550 And lastly, if the value of your attribute is dependent upon some
551 other aspect of the instance structure, then you can take advantage of
552 the fact that when the C<default> value is called as a method:
554 Class::MOP::Attribute->new(
555 'object_identity' => (
556 default => sub { Scalar::Util::refaddr( $_[0] ) },
560 Note that there is no guarantee that attributes are initialized in any
561 particular order, so you cannot rely on the value of some other
562 attribute when generating the default.
566 This option can be either a method name or a subroutine
567 reference. This method will be called when setting the attribute's
568 value in the constructor. Unlike C<default> and C<builder>, the
569 initializer is only called when a value is provided to the
570 constructor. The initializer allows you to munge this value during
573 The initializer is called as a method with three arguments. The first
574 is the value that was passed to the constructor. The second is a
575 subroutine reference that can be called to actually set the
576 attribute's value, and the last is the associated
577 C<Class::MOP::Attribute> object.
579 This contrived example shows an initializer that sets the attribute to
580 twice the given value.
582 Class::MOP::Attribute->new(
585 my ( $self, $value, $set, $attr ) = @_;
586 $set->( $value * 2 );
591 Since an initializer can be a method name, you can easily make
592 attribute initialization use the writer:
594 Class::MOP::Attribute->new(
596 writer => 'some_attr',
597 initializer => 'some_attr',
601 Your writer will need to examine C<@_> and determine under which
602 context it is being called.
606 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
607 options all accept the same parameters. You can provide the name of
608 the method, in which case an appropriate default method will be
609 generated for you. Or instead you can also provide hash reference
610 containing exactly one key (the method name) and one value. The value
611 should be a subroutine reference, which will be installed as the
618 An C<accessor> is a standard Perl-style read/write accessor. It will
619 return the value of the attribute, and if a value is passed as an
620 argument, it will assign that value to the attribute.
622 Note that C<undef> is a legitimate value, so this will work:
624 $object->set_something(undef);
628 This is a basic read-only accessor. It returns the value of the
633 This is a basic write accessor, it accepts a single argument, and
634 assigns that value to the attribute.
636 Note that C<undef> is a legitimate value, so this will work:
638 $object->set_something(undef);
642 The predicate method returns a boolean indicating whether or not the
643 attribute has been explicitly set.
645 Note that the predicate returns true even if the attribute was set to
646 a false value (C<0> or C<undef>).
650 This method will uninitialize the attribute. After an attribute is
651 cleared, its C<predicate> will return false.
653 =item * definition_context
655 Mostly, this exists as a hook for the benefit of Moose.
657 This option should be a hash reference containing several keys which
658 will be used when inlining the attribute's accessors. The keys should
659 include C<line>, the line number where the attribute was created, and
660 either C<file> or C<description>.
662 This information will ultimately be used when eval'ing inlined
663 accessor code so that error messages report a useful line and file
668 =item B<< $attr->clone(%options) >>
670 This clones the attribute. Any options you provide will override the
671 settings of the original attribute. You can change the name of the new
672 attribute by passing a C<name> key in C<%options>.
678 These are all basic read-only accessors for the values passed into
683 =item B<< $attr->name >>
685 Returns the attribute's 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.
754 =item B<< $attr->insertion_order >>
756 If this attribute has been inserted into a class, this returns a zero
757 based index regarding the order of insertion.
761 =head2 Informational predicates
763 These are all basic predicate methods for the values passed into C<new>.
767 =item B<< $attr->has_accessor >>
769 =item B<< $attr->has_reader >>
771 =item B<< $attr->has_writer >>
773 =item B<< $attr->has_predicate >>
775 =item B<< $attr->has_clearer >>
777 =item B<< $attr->has_initializer >>
779 =item B<< $attr->has_init_arg >>
781 This will be I<false> if the C<init_arg> was set to C<undef>.
783 =item B<< $attr->has_default >>
785 This will be I<false> if the C<default> was set to C<undef>, since
786 C<undef> is the default C<default> anyway.
788 =item B<< $attr->has_builder >>
790 =item B<< $attr->has_insertion_order >>
792 This will be I<false> if this attribute has not be inserted into a class
796 =head2 Value management
798 These methods are basically "back doors" to the instance, and can be
799 used to bypass the regular accessors, but still stay within the MOP.
801 These methods are not for general use, and should only be used if you
802 really know what you are doing.
806 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
808 This method is used internally to initialize the attribute's slot in
809 the object C<$instance>.
811 The C<$params> is a hash reference of the values passed to the object
814 It's unlikely that you'll need to call this method yourself.
816 =item B<< $attr->set_value($instance, $value) >>
818 Sets the value without going through the accessor. Note that this
819 works even with read-only attributes.
821 =item B<< $attr->set_raw_value($instance, $value) >>
823 Sets the value with no side effects such as a trigger.
825 This doesn't actually apply to Class::MOP attributes, only to subclasses.
827 =item B<< $attr->set_initial_value($instance, $value) >>
829 Sets the value without going through the accessor. This method is only
830 called when the instance is first being initialized.
832 =item B<< $attr->get_value($instance) >>
834 Returns the value without going through the accessor. Note that this
835 works even with write-only accessors.
837 =item B<< $attr->get_raw_value($instance) >>
839 Returns the value without any side effects such as lazy attributes.
841 Doesn't actually apply to Class::MOP attributes, only to subclasses.
843 =item B<< $attr->has_value($instance) >>
845 Return a boolean indicating whether the attribute has been set in
846 C<$instance>. This how the default C<predicate> method works.
848 =item B<< $attr->clear_value($instance) >>
850 This will clear the attribute's value in C<$instance>. This is what
851 the default C<clearer> calls.
853 Note that this works even if the attribute does not have any
854 associated read, write or clear methods.
858 =head2 Class association
860 These methods allow you to manage the attributes association with
861 the class that contains it. These methods should not be used
862 lightly, nor are they very magical, they are mostly used internally
863 and by metaclass instances.
867 =item B<< $attr->associated_class >>
869 This returns the C<Class::MOP::Class> with which this attribute is
872 =item B<< $attr->attach_to_class($metaclass) >>
874 This method stores a weakened reference to the C<$metaclass> object
877 This method does not remove the attribute from its old class,
878 nor does it create any accessors in the new class.
880 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
883 =item B<< $attr->detach_from_class >>
885 This method removes the associate metaclass object from the attribute
888 This method does not remove the attribute itself from the class, or
889 remove its accessors.
891 It is probably best to use the L<Class::MOP::Class>
892 C<remove_attribute> method instead.
896 =head2 Attribute Accessor generation
900 =item B<< $attr->accessor_metaclass >>
902 Accessor methods are generated using an accessor metaclass. By
903 default, this is L<Class::MOP::Method::Accessor>. This method returns
904 the name of the accessor metaclass that this attribute uses.
906 =item B<< $attr->associate_method($method) >>
908 This associates a L<Class::MOP::Method> object with the
909 attribute. Typically, this is called internally when an attribute
910 generates its accessors.
912 =item B<< $attr->associated_methods >>
914 This returns the list of methods which have been associated with the
917 =item B<< $attr->install_accessors >>
919 This method generates and installs code the attributes various
920 accessors. It is typically called from the L<Class::MOP::Class>
921 C<add_attribute> method.
923 =item B<< $attr->remove_accessors >>
925 This method removes all of the accessors associated with the
928 This does not currently remove methods from the list returned by
929 C<associated_methods>.
931 =item B<< $attr->inline_get >>
933 =item B<< $attr->inline_set >>
935 =item B<< $attr->inline_has >>
937 =item B<< $attr->inline_clear >>
939 These methods return a code snippet suitable for inlining the relevant
940 operation. They expect strings containing variable names to be used in the
941 inlining, like C<'$self'> or C<'$_[1]'>.
949 =item B<< Class::MOP::Attribute->meta >>
951 This will return a L<Class::MOP::Class> instance for this class.
953 It should also be noted that L<Class::MOP> will actually bootstrap
954 this module by installing a number of attribute meta-objects into its
961 Stevan Little E<lt>stevan@iinteractive.comE<gt>
963 =head1 COPYRIGHT AND LICENSE
965 Copyright 2006-2010 by Infinity Interactive, Inc.
967 L<http://www.iinteractive.com>
969 This library is free software; you can redistribute it and/or modify
970 it under the same terms as Perl itself.