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 _compute_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};
311 $self->accessor_metaclass,
314 definition_context => $method_ctx,
318 my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
321 my $desc = "accessor $accessor";
322 if ( $accessor ne $self->name ) {
323 $desc .= " of attribute " . $self->name;
326 $method_ctx->{description} = $desc;
330 $self->accessor_metaclass,
332 is_inline => $inline_me,
333 accessor_type => $type,
335 definition_context => $method_ctx,
339 sub _create_accessors {
340 my ($self, $type, $args) = @_;
342 my $accessor_metaclass = shift @{ $args };
343 my $create = (ref $args->[0] && ref $args->[0] eq 'CODE') ? 'wrap' : 'new';
347 $method = $accessor_metaclass->$create(
348 @{ $args }, package_name => $self->associated_class->name,
352 confess "Could not create the '$type' method for " . $self->name . " because : $_";
355 $self->associate_method($method);
360 # for extension compatibility
361 sub _process_accessors {
363 my ($type, $accessor, $generate_as_inline_methods) = @_;
365 my ($name, $args) = $self->_compute_accessors(@_);
366 my $method = $self->_create_accessors($type, $args);
368 return ($name, $method);
371 sub compute_all_accessors {
372 my ($self, $inline) = @_;
376 ? ($_ => [$self->_compute_accessors($_ => $self->$_, $inline)])
378 } qw(accessor reader writer predicate clearer);
383 sub install_accessors {
387 my %accessors = $self->compute_all_accessors($inline);
388 while (my ($type, $desc) = each %accessors) {
389 my ($name, $args) = @{ $desc };
390 $self->_install_accessor($name => $self->_create_accessors($type => $args));
396 sub _install_accessor {
397 my ($self, $name, $method) = @_;
398 my $class = $self->associated_class;
400 $class->add_method($name => $method);
406 my $_remove_accessor = sub {
407 my ($accessor, $class) = @_;
408 if (ref($accessor) && ref($accessor) eq 'HASH') {
409 ($accessor) = keys %{$accessor};
411 my $method = $class->get_method($accessor);
412 $class->remove_method($accessor)
413 if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
416 sub remove_accessors {
419 # we really need to make sure to remove from the
420 # associates methods here as well. But this is
421 # such a slimly used method, I am not worried
422 # about it right now.
423 $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor();
424 $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader();
425 $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer();
426 $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
427 $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer();
441 Class::MOP::Attribute - Attribute Meta Object
445 Class::MOP::Attribute->new(
447 accessor => 'foo', # dual purpose get/set accessor
448 predicate => 'has_foo', # predicate check for defined-ness
449 init_arg => '-foo', # class->new will look for a -foo key
450 default => 'BAR IS BAZ!' # if no -foo key is provided, use this
454 Class::MOP::Attribute->new(
456 reader => 'bar', # getter
457 writer => 'set_bar', # setter
458 predicate => 'has_bar', # predicate check for defined-ness
459 init_arg => ':bar', # class->new will look for a :bar key
460 # no default value means it is undef
466 The Attribute Protocol is almost entirely an invention of
467 C<Class::MOP>. Perl 5 does not have a consistent notion of
468 attributes. There are so many ways in which this is done, and very few
469 (if any) are easily discoverable by this module.
471 With that said, this module attempts to inject some order into this
472 chaos, by introducing a consistent API which can be used to create
481 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
483 An attribute must (at the very least), have a C<$name>. All other
484 C<%options> are added as key-value pairs.
490 This is a string value representing the expected key in an
491 initialization hash. For instance, if we have an C<init_arg> value of
492 C<-foo>, then the following code will Just Work.
494 MyClass->meta->new_object( -foo => 'Hello There' );
496 If an init_arg is not assigned, it will automatically use the
497 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
498 attribute cannot be specified during initialization.
502 This provides the name of a method that will be called to initialize
503 the attribute. This method will be called on the object after it is
504 constructed. It is expected to return a valid value for the attribute.
508 This can be used to provide an explicit default for initializing the
509 attribute. If the default you provide is a subroutine reference, then
510 this reference will be called I<as a method> on the object.
512 If the value is a simple scalar (string or number), then it can be
513 just passed as is. However, if you wish to initialize it with a HASH
514 or ARRAY ref, then you need to wrap that inside a subroutine
517 Class::MOP::Attribute->new(
519 default => sub { [] },
525 Class::MOP::Attribute->new(
527 default => sub { {} },
531 If you wish to initialize an attribute with a subroutine reference
532 itself, then you need to wrap that in a subroutine as well:
534 Class::MOP::Attribute->new(
537 sub { print "Hello World" }
542 And lastly, if the value of your attribute is dependent upon some
543 other aspect of the instance structure, then you can take advantage of
544 the fact that when the C<default> value is called as a method:
546 Class::MOP::Attribute->new(
547 'object_identity' => (
548 default => sub { Scalar::Util::refaddr( $_[0] ) },
552 Note that there is no guarantee that attributes are initialized in any
553 particular order, so you cannot rely on the value of some other
554 attribute when generating the default.
558 This option can be either a method name or a subroutine
559 reference. This method will be called when setting the attribute's
560 value in the constructor. Unlike C<default> and C<builder>, the
561 initializer is only called when a value is provided to the
562 constructor. The initializer allows you to munge this value during
565 The initializer is called as a method with three arguments. The first
566 is the value that was passed to the constructor. The second is a
567 subroutine reference that can be called to actually set the
568 attribute's value, and the last is the associated
569 C<Class::MOP::Attribute> object.
571 This contrived example shows an initializer that sets the attribute to
572 twice the given value.
574 Class::MOP::Attribute->new(
577 my ( $self, $value, $set, $attr ) = @_;
578 $set->( $value * 2 );
583 Since an initializer can be a method name, you can easily make
584 attribute initialization use the writer:
586 Class::MOP::Attribute->new(
588 writer => 'some_attr',
589 initializer => 'some_attr',
593 Your writer will need to examine C<@_> and determine under which
594 context it is being called.
598 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
599 options all accept the same parameters. You can provide the name of
600 the method, in which case an appropriate default method will be
601 generated for you. Or instead you can also provide hash reference
602 containing exactly one key (the method name) and one value. The value
603 should be a subroutine reference, which will be installed as the
610 An C<accessor> is a standard Perl-style read/write accessor. It will
611 return the value of the attribute, and if a value is passed as an
612 argument, it will assign that value to the attribute.
614 Note that C<undef> is a legitimate value, so this will work:
616 $object->set_something(undef);
620 This is a basic read-only accessor. It returns the value of the
625 This is a basic write accessor, it accepts a single argument, and
626 assigns that value to the attribute.
628 Note that C<undef> is a legitimate value, so this will work:
630 $object->set_something(undef);
634 The predicate method returns a boolean indicating whether or not the
635 attribute has been explicitly set.
637 Note that the predicate returns true even if the attribute was set to
638 a false value (C<0> or C<undef>).
642 This method will uninitialize the attribute. After an attribute is
643 cleared, its C<predicate> will return false.
645 =item * definition_context
647 Mostly, this exists as a hook for the benefit of Moose.
649 This option should be a hash reference containing several keys which
650 will be used when inlining the attribute's accessors. The keys should
651 include C<line>, the line number where the attribute was created, and
652 either C<file> or C<description>.
654 This information will ultimately be used when eval'ing inlined
655 accessor code so that error messages report a useful line and file
660 =item B<< $attr->clone(%options) >>
662 This clones the attribute. Any options you provide will override the
663 settings of the original attribute. You can change the name of the new
664 attribute by passing a C<name> key in C<%options>.
670 These are all basic read-only accessors for the values passed into
675 =item B<< $attr->name >>
677 Returns the attribute's name.
679 =item B<< $attr->accessor >>
681 =item B<< $attr->reader >>
683 =item B<< $attr->writer >>
685 =item B<< $attr->predicate >>
687 =item B<< $attr->clearer >>
689 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
690 methods all return exactly what was passed to the constructor, so it
691 can be either a string containing a method name, or a hash reference.
693 =item B<< $attr->initializer >>
695 Returns the initializer as passed to the constructor, so this may be
696 either a method name or a subroutine reference.
698 =item B<< $attr->init_arg >>
700 =item B<< $attr->is_default_a_coderef >>
702 =item B<< $attr->default($instance) >>
704 The C<$instance> argument is optional. If you don't pass it, the
705 return value for this method is exactly what was passed to the
706 constructor, either a simple scalar or a subroutine reference.
708 If you I<do> pass an C<$instance> and the default is a subroutine
709 reference, then the reference is called as a method on the
710 C<$instance> and the generated value is returned.
712 =item B<< $attr->slots >>
714 Return a list of slots required by the attribute. This is usually just
715 one, the name of the attribute.
717 A slot is the name of the hash key used to store the attribute in an
720 =item B<< $attr->get_read_method >>
722 =item B<< $attr->get_write_method >>
724 Returns the name of a method suitable for reading or writing the value
725 of the attribute in the associated class.
727 If an attribute is read- or write-only, then these methods can return
728 C<undef> as appropriate.
730 =item B<< $attr->has_read_method >>
732 =item B<< $attr->has_write_method >>
734 This returns a boolean indicating whether the attribute has a I<named>
735 read or write method.
737 =item B<< $attr->get_read_method_ref >>
739 =item B<< $attr->get_write_method_ref >>
741 Returns the subroutine reference of a method suitable for reading or
742 writing the attribute's value in the associated class. These methods
743 always return a subroutine reference, regardless of whether or not the
744 attribute is read- or write-only.
746 =item B<< $attr->insertion_order >>
748 If this attribute has been inserted into a class, this returns a zero
749 based index regarding the order of insertion.
753 =head2 Informational predicates
755 These are all basic predicate methods for the values passed into C<new>.
759 =item B<< $attr->has_accessor >>
761 =item B<< $attr->has_reader >>
763 =item B<< $attr->has_writer >>
765 =item B<< $attr->has_predicate >>
767 =item B<< $attr->has_clearer >>
769 =item B<< $attr->has_initializer >>
771 =item B<< $attr->has_init_arg >>
773 This will be I<false> if the C<init_arg> was set to C<undef>.
775 =item B<< $attr->has_default >>
777 This will be I<false> if the C<default> was set to C<undef>, since
778 C<undef> is the default C<default> anyway.
780 =item B<< $attr->has_builder >>
782 =item B<< $attr->has_insertion_order >>
784 This will be I<false> if this attribute has not be inserted into a class
788 =head2 Value management
790 These methods are basically "back doors" to the instance, and can be
791 used to bypass the regular accessors, but still stay within the MOP.
793 These methods are not for general use, and should only be used if you
794 really know what you are doing.
798 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
800 This method is used internally to initialize the attribute's slot in
801 the object C<$instance>.
803 The C<$params> is a hash reference of the values passed to the object
806 It's unlikely that you'll need to call this method yourself.
808 =item B<< $attr->set_value($instance, $value) >>
810 Sets the value without going through the accessor. Note that this
811 works even with read-only attributes.
813 =item B<< $attr->set_raw_value($instance, $value) >>
815 Sets the value with no side effects such as a trigger.
817 This doesn't actually apply to Class::MOP attributes, only to subclasses.
819 =item B<< $attr->set_initial_value($instance, $value) >>
821 Sets the value without going through the accessor. This method is only
822 called when the instance is first being initialized.
824 =item B<< $attr->get_value($instance) >>
826 Returns the value without going through the accessor. Note that this
827 works even with write-only accessors.
829 =item B<< $attr->get_raw_value($instance) >>
831 Returns the value without any side effects such as lazy attributes.
833 Doesn't actually apply to Class::MOP attributes, only to subclasses.
835 =item B<< $attr->has_value($instance) >>
837 Return a boolean indicating whether the attribute has been set in
838 C<$instance>. This how the default C<predicate> method works.
840 =item B<< $attr->clear_value($instance) >>
842 This will clear the attribute's value in C<$instance>. This is what
843 the default C<clearer> calls.
845 Note that this works even if the attribute does not have any
846 associated read, write or clear methods.
850 =head2 Class association
852 These methods allow you to manage the attributes association with
853 the class that contains it. These methods should not be used
854 lightly, nor are they very magical, they are mostly used internally
855 and by metaclass instances.
859 =item B<< $attr->associated_class >>
861 This returns the C<Class::MOP::Class> with which this attribute is
864 =item B<< $attr->attach_to_class($metaclass) >>
866 This method stores a weakened reference to the C<$metaclass> object
869 This method does not remove the attribute from its old class,
870 nor does it create any accessors in the new class.
872 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
875 =item B<< $attr->detach_from_class >>
877 This method removes the associate metaclass object from the attribute
880 This method does not remove the attribute itself from the class, or
881 remove its accessors.
883 It is probably best to use the L<Class::MOP::Class>
884 C<remove_attribute> method instead.
888 =head2 Attribute Accessor generation
892 =item B<< $attr->accessor_metaclass >>
894 Accessor methods are generated using an accessor metaclass. By
895 default, this is L<Class::MOP::Method::Accessor>. This method returns
896 the name of the accessor metaclass that this attribute uses.
898 =item B<< $attr->associate_method($method) >>
900 This associates a L<Class::MOP::Method> object with the
901 attribute. Typically, this is called internally when an attribute
902 generates its accessors.
904 =item B<< $attr->associated_methods >>
906 This returns the list of methods which have been associated with the
909 =item B<< $attr->install_accessors >>
911 This method generates and installs code the attributes various
912 accessors. It is typically called from the L<Class::MOP::Class>
913 C<add_attribute> method.
915 =item B<< $attr->remove_accessors >>
917 This method removes all of the accessors associated with the
920 This does not currently remove methods from the list returned by
921 C<associated_methods>.
929 =item B<< Class::MOP::Attribute->meta >>
931 This will return a L<Class::MOP::Class> instance for this class.
933 It should also be noted that L<Class::MOP> will actually bootstrap
934 this module by installing a number of attribute meta-objects into its
941 Stevan Little E<lt>stevan@iinteractive.comE<gt>
943 =head1 COPYRIGHT AND LICENSE
945 Copyright 2006-2010 by Infinity Interactive, Inc.
947 L<http://www.iinteractive.com>
949 This library is free software; you can redistribute it and/or modify
950 it under the same terms as Perl itself.