metaclass and traits interpolation moved to Meta::Attribute
[gitmo/Moose.git] / lib / Moose / Meta / Attribute.pm
1
2 package Moose::Meta::Attribute;
3
4 use strict;
5 use warnings;
6
7 use Scalar::Util 'blessed', 'weaken', 'reftype';
8 use Carp         'confess';
9 use Sub::Name    'subname';
10 use overload     ();
11
12 our $VERSION   = '0.22';
13 our $AUTHORITY = 'cpan:STEVAN';
14
15 use Moose::Meta::Method::Accessor;
16 use Moose::Util ();
17 use Moose::Util::TypeConstraints ();
18
19 use base 'Class::MOP::Attribute';
20
21 # options which are not directly used
22 # but we store them for metadata purposes
23 __PACKAGE__->meta->add_attribute('isa'  => (reader    => '_isa_metadata'));
24 __PACKAGE__->meta->add_attribute('does' => (reader    => '_does_metadata'));
25 __PACKAGE__->meta->add_attribute('is'   => (reader    => '_is_metadata'));
26
27 # these are actual options for the attrs
28 __PACKAGE__->meta->add_attribute('required'   => (reader => 'is_required'      ));
29 __PACKAGE__->meta->add_attribute('lazy'       => (reader => 'is_lazy'          ));
30 __PACKAGE__->meta->add_attribute('lazy_build' => (reader => 'is_lazy_build'    ));
31 __PACKAGE__->meta->add_attribute('coerce'     => (reader => 'should_coerce'    ));
32 __PACKAGE__->meta->add_attribute('weak_ref'   => (reader => 'is_weak_ref'      ));
33 __PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
34 __PACKAGE__->meta->add_attribute('type_constraint' => (
35     reader    => 'type_constraint',
36     predicate => 'has_type_constraint',
37 ));
38 __PACKAGE__->meta->add_attribute('trigger' => (
39     reader    => 'trigger',
40     predicate => 'has_trigger',
41 ));
42 __PACKAGE__->meta->add_attribute('handles' => (
43     reader    => 'handles',
44     predicate => 'has_handles',
45 ));
46 __PACKAGE__->meta->add_attribute('documentation' => (
47     reader    => 'documentation',
48     predicate => 'has_documentation',
49 ));
50 __PACKAGE__->meta->add_attribute('traits' => (
51     reader    => 'applied_traits',
52     predicate => 'has_applied_traits',
53 ));
54
55 # NOTE:
56 # we need to have a ->does method in here to 
57 # more easily support traits, and the introspection 
58 # of those traits. So in order to do this we 
59 # just alias Moose::Object's version of it.
60 # - SL
61 *does = \&Moose::Object::does;
62
63 sub new {
64     my ($class, $name, %options) = @_;
65     $class->_process_options($name, \%options);
66     return $class->SUPER::new($name, %options);
67 }
68
69 sub interpolate_class_and_new {
70     my ($class, $name, @args) = @_;
71
72     $class->interpolate_class(@args)->new($name, @args);
73 }
74
75 sub interpolate_class {
76     my ($class, %options) = @_;
77
78     if ( my $metaclass_name = $options{metaclass} ) {
79         $class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name );
80     }
81
82     if (my $traits = $options{traits}) {
83         my @traits = map {
84             Moose::Util::resolve_metatrait_alias( Attribute => $_ )
85                 or
86             $_
87         } @$traits;
88
89         my $anon_class = Moose::Meta::Class->create_anon_class(
90             superclasses => [ $class ],
91             roles        => [ @traits ],
92             cache        => 1,
93         );
94
95         return $anon_class->name;
96     }
97     else {
98         return $class;
99     }
100 }
101
102 sub clone_and_inherit_options {
103     my ($self, %options) = @_;
104     # you can change default, required, coerce, documentation, lazy, handles, builder, metaclass and traits
105     my %actual_options;
106     foreach my $legal_option (qw(default coerce required documentation lazy handles builder metaclass traits)) {
107         if (exists $options{$legal_option}) {
108             $actual_options{$legal_option} = $options{$legal_option};
109             delete $options{$legal_option};
110         }
111     }
112
113     if ($options{isa}) {
114         my $type_constraint;
115         if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
116             $type_constraint = $options{isa};
117         }
118         else {
119             $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa});
120             (defined $type_constraint)
121                 || confess "Could not find the type constraint '" . $options{isa} . "'";
122         }
123
124         $actual_options{type_constraint} = $type_constraint;
125         delete $options{isa};
126     }
127     
128     if ($options{does}) {
129         my $type_constraint;
130         if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) {
131             $type_constraint = $options{does};
132         }
133         else {
134             $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does});
135             (defined $type_constraint)
136                 || confess "Could not find the type constraint '" . $options{does} . "'";
137         }
138
139         $actual_options{type_constraint} = $type_constraint;
140         delete $options{does};
141     }    
142     
143     (scalar keys %options == 0)
144         || confess "Illegal inherited options => (" . (join ', ' => keys %options) . ")";
145     $self->clone(%actual_options);
146 }
147
148 sub _process_options {
149     my ($class, $name, $options) = @_;
150
151     if (exists $options->{is}) {
152         if ($options->{is} eq 'ro') {
153             $options->{reader} ||= $name;
154             (!exists $options->{trigger})
155                 || confess "Cannot have a trigger on a read-only attribute $name";
156         }
157         elsif ($options->{is} eq 'rw') {
158             $options->{accessor} = $name;
159             ((reftype($options->{trigger}) || '') eq 'CODE')
160                 || confess "Trigger must be a CODE ref"
161                     if exists $options->{trigger};
162         }
163         else {
164             confess "I do not understand this option (is => " . $options->{is} . ") on attribute $name"
165         }
166     }
167
168     if (exists $options->{isa}) {
169         if (exists $options->{does}) {
170             if (eval { $options->{isa}->can('does') }) {
171                 ($options->{isa}->does($options->{does}))
172                     || confess "Cannot have an isa option and a does option if the isa does not do the does on attribute $name";
173             }
174             else {
175                 confess "Cannot have an isa option which cannot ->does() on attribute $name";
176             }
177         }
178
179         # allow for anon-subtypes here ...
180         if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) {
181             $options->{type_constraint} = $options->{isa};
182         }
183         else {
184             $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options->{isa});
185         }
186     }
187     elsif (exists $options->{does}) {
188         # allow for anon-subtypes here ...
189         if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) {
190                 $options->{type_constraint} = $options->{does};
191         }
192         else {
193             $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options->{does});
194         }
195     }
196
197     if (exists $options->{coerce} && $options->{coerce}) {
198         (exists $options->{type_constraint})
199             || confess "You cannot have coercion without specifying a type constraint on attribute $name";
200         confess "You cannot have a weak reference to a coerced value on attribute $name"
201             if $options->{weak_ref};
202     }
203
204     if (exists $options->{auto_deref} && $options->{auto_deref}) {
205         (exists $options->{type_constraint})
206             || confess "You cannot auto-dereference without specifying a type constraint on attribute $name";
207         ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
208          $options->{type_constraint}->is_a_type_of('HashRef'))
209             || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name";
210     }
211
212     if (exists $options->{lazy_build} && $options->{lazy_build} == 1) {
213         confess("You can not use lazy_build and default for the same attribute $name")
214             if exists $options->{default};
215         $options->{lazy}      = 1;
216         $options->{required}  = 1;
217         $options->{builder} ||= "_build_${name}";
218         if ($name =~ /^_/) {
219             $options->{clearer}   ||= "_clear${name}";
220             $options->{predicate} ||= "_has${name}";
221         } 
222         else {
223             $options->{clearer}   ||= "clear_${name}";
224             $options->{predicate} ||= "has_${name}";
225         }
226     }
227
228     if (exists $options->{lazy} && $options->{lazy}) {
229         (exists $options->{default} || defined $options->{builder} )
230             || confess "You cannot have lazy attribute ($name) without specifying a default value for it";
231     }
232
233     if ( $options->{required} && !( ( !exists $options->{init_arg} || defined $options->{init_arg} ) || exists $options->{default} || defined $options->{builder} ) ) {
234         confess "You cannot have a required attribute ($name) without a default, builder, or an init_arg";
235     }
236
237 }
238
239 sub initialize_instance_slot {
240     my ($self, $meta_instance, $instance, $params) = @_;
241     my $init_arg = $self->init_arg();
242     # try to fetch the init arg from the %params ...
243
244     my $val;
245     my $value_is_set;
246     if ( defined($init_arg) and exists $params->{$init_arg}) {
247         $val = $params->{$init_arg};
248         $value_is_set = 1;    
249     }
250     else {
251         # skip it if it's lazy
252         return if $self->is_lazy;
253         # and die if it's required and doesn't have a default value
254         confess "Attribute (" . $self->name . ") is required"
255             if $self->is_required && !$self->has_default && !$self->has_builder;
256
257         # if nothing was in the %params, we can use the
258         # attribute's default value (if it has one)
259         if ($self->has_default) {
260             $val = $self->default($instance);
261             $value_is_set = 1;
262         } 
263         elsif ($self->has_builder) {
264             if (my $builder = $instance->can($self->builder)){
265                 $val = $instance->$builder;
266                 $value_is_set = 1;
267             } 
268             else {
269                 confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
270             }
271         }
272     }
273
274     return unless $value_is_set;
275
276     if ($self->has_type_constraint) {
277         my $type_constraint = $self->type_constraint;
278         if ($self->should_coerce && $type_constraint->has_coercion) {
279             $val = $type_constraint->coerce($val);
280         }
281         $type_constraint->check($val)
282             || confess "Attribute (" 
283                      . $self->name 
284                      . ") does not pass the type constraint because: " 
285                      . $type_constraint->get_message($val);
286     }
287
288     $self->set_initial_value($instance, $val);
289     $meta_instance->weaken_slot_value($instance, $self->name)
290         if ref $val && $self->is_weak_ref;
291 }
292
293 ## Slot management
294
295 # FIXME:
296 # this duplicates too much code from 
297 # Class::MOP::Attribute, we need to 
298 # refactor these bits eventually.
299 # - SL
300 sub _set_initial_slot_value {
301     my ($self, $meta_instance, $instance, $value) = @_;
302
303     my $slot_name = $self->name;
304
305     return $meta_instance->set_slot_value($instance, $slot_name, $value)
306         unless $self->has_initializer;
307
308     my ($type_constraint, $can_coerce);
309     if ($self->has_type_constraint) {
310         $type_constraint = $self->type_constraint;
311         $can_coerce      = ($self->should_coerce && $type_constraint->has_coercion);
312     }
313
314     my $callback = sub {
315         my $val = shift;
316         if ($type_constraint) {
317             $val = $type_constraint->coerce($val)
318                 if $can_coerce;
319             $type_constraint->check($val)
320                 || confess "Attribute (" 
321                          . $slot_name 
322                          . ") does not pass the type constraint because: " 
323                          . $type_constraint->get_message($val);            
324         }
325         $meta_instance->set_slot_value($instance, $slot_name, $val);
326     };
327     
328     my $initializer = $self->initializer;
329
330     # most things will just want to set a value, so make it first arg
331     $instance->$initializer($value, $callback, $self);
332 }
333
334 sub set_value {
335     my ($self, $instance, $value) = @_;
336
337     my $attr_name = $self->name;
338
339     if ($self->is_required) {
340         defined($value)
341             || confess "Attribute ($attr_name) is required, so cannot be set to undef";
342     }
343
344     if ($self->has_type_constraint) {
345
346         my $type_constraint = $self->type_constraint;
347
348         if ($self->should_coerce) {
349             $value = $type_constraint->coerce($value);
350         }        
351         $type_constraint->_compiled_type_constraint->($value)
352             || confess "Attribute (" 
353                      . $self->name 
354                      . ") does not pass the type constraint because " 
355                      . $type_constraint->get_message($value);
356     }
357
358     my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
359                                          ->get_meta_instance;
360
361     $meta_instance->set_slot_value($instance, $attr_name, $value);
362
363     if (ref $value && $self->is_weak_ref) {
364         $meta_instance->weaken_slot_value($instance, $attr_name);
365     }
366
367     if ($self->has_trigger) {
368         $self->trigger->($instance, $value, $self);
369     }
370 }
371
372 sub get_value {
373     my ($self, $instance) = @_;
374
375     if ($self->is_lazy) {
376         unless ($self->has_value($instance)) {
377             if ($self->has_default) {
378                 my $default = $self->default($instance);
379                 $self->set_initial_value($instance, $default);
380             }
381             if ( $self->has_builder ){
382                 if (my $builder = $instance->can($self->builder)){
383                     $self->set_initial_value($instance, $instance->$builder);
384                 } 
385                 else {
386                     confess(blessed($instance) 
387                           . " does not support builder method '"
388                           . $self->builder 
389                           . "' for attribute '" 
390                           . $self->name 
391                           . "'");
392                 }
393             } 
394             else {
395                 $self->set_initial_value($instance, undef);
396             }
397         }
398     }
399
400     if ($self->should_auto_deref) {
401
402         my $type_constraint = $self->type_constraint;
403
404         if ($type_constraint->is_a_type_of('ArrayRef')) {
405             my $rv = $self->SUPER::get_value($instance);
406             return unless defined $rv;
407             return wantarray ? @{ $rv } : $rv;
408         }
409         elsif ($type_constraint->is_a_type_of('HashRef')) {
410             my $rv = $self->SUPER::get_value($instance);
411             return unless defined $rv;
412             return wantarray ? %{ $rv } : $rv;
413         }
414         else {
415             confess "Can not auto de-reference the type constraint '" . $type_constraint->name . "'";
416         }
417
418     }
419     else {
420
421         return $self->SUPER::get_value($instance);
422     }
423 }
424
425 ## installing accessors
426
427 sub accessor_metaclass { 'Moose::Meta::Method::Accessor' }
428
429 sub install_accessors {
430     my $self = shift;
431     $self->SUPER::install_accessors(@_);
432
433     if ($self->has_handles) {
434
435         # NOTE:
436         # Here we canonicalize the 'handles' option
437         # this will sort out any details and always
438         # return an hash of methods which we want
439         # to delagate to, see that method for details
440         my %handles = $self->_canonicalize_handles();
441
442         # find the accessor method for this attribute
443         my $accessor = $self->get_read_method_ref;
444         # then unpack it if we need too ...
445         $accessor = $accessor->body if blessed $accessor;
446
447         # install the delegation ...
448         my $associated_class = $self->associated_class;
449         foreach my $handle (keys %handles) {
450             my $method_to_call = $handles{$handle};
451             my $class_name = $associated_class->name;
452             my $name = "${class_name}::${handle}";
453
454             (!$associated_class->has_method($handle))
455                 || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
456
457             # NOTE:
458             # handles is not allowed to delegate
459             # any of these methods, as they will
460             # override the ones in your class, which
461             # is almost certainly not what you want.
462
463             # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
464             #cluck("Not delegating method '$handle' because it is a core method") and
465             next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
466
467             if ((reftype($method_to_call) || '') eq 'CODE') {
468                 $associated_class->add_method($handle => subname $name, $method_to_call);
469             }
470             else {
471                 # NOTE:
472                 # we used to do a goto here, but the
473                 # goto didn't handle failure correctly
474                 # (it just returned nothing), so I took 
475                 # that out. However, the more I thought
476                 # about it, the less I liked it doing 
477                 # the goto, and I prefered the act of 
478                 # delegation being actually represented
479                 # in the stack trace. 
480                 # - SL
481                 $associated_class->add_method($handle => subname $name, sub {
482                     my $proxy = (shift)->$accessor();
483                     (defined $proxy) 
484                         || confess "Cannot delegate $handle to $method_to_call because " . 
485                                    "the value of " . $self->name . " is not defined";
486                     $proxy->$method_to_call(@_);
487                 });
488             }
489         }
490     }
491
492     return;
493 }
494
495 # private methods to help delegation ...
496
497 sub _canonicalize_handles {
498     my $self    = shift;
499     my $handles = $self->handles;
500     if (my $handle_type = ref($handles)) {
501         if ($handle_type eq 'HASH') {
502             return %{$handles};
503         }
504         elsif ($handle_type eq 'ARRAY') {
505             return map { $_ => $_ } @{$handles};
506         }
507         elsif ($handle_type eq 'Regexp') {
508             ($self->has_type_constraint)
509                 || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
510             return map  { ($_ => $_) }
511                    grep { /$handles/ } $self->_get_delegate_method_list;
512         }
513         elsif ($handle_type eq 'CODE') {
514             return $handles->($self, $self->_find_delegate_metaclass);
515         }
516         else {
517             confess "Unable to canonicalize the 'handles' option with $handles";
518         }
519     }
520     else {
521         my $role_meta = eval { $handles->meta };
522         if ($@) {
523             confess "Unable to canonicalize the 'handles' option with $handles because : $@";
524         }
525
526         (blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
527             || confess "Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role";
528
529         return map { $_ => $_ } (
530             $role_meta->get_method_list,
531             $role_meta->get_required_method_list
532         );
533     }
534 }
535
536 sub _find_delegate_metaclass {
537     my $self = shift;
538     if (my $class = $self->_isa_metadata) {
539         # if the class does have
540         # a meta method, use it
541         return $class->meta if $class->can('meta');
542         # otherwise we might be
543         # dealing with a non-Moose
544         # class, and need to make
545         # our own metaclass
546         return Moose::Meta::Class->initialize($class);
547     }
548     elsif (my $role = $self->_does_metadata) {
549         # our role will always have
550         # a meta method
551         return $role->meta;
552     }
553     else {
554         confess "Cannot find delegate metaclass for attribute " . $self->name;
555     }
556 }
557
558 sub _get_delegate_method_list {
559     my $self = shift;
560     my $meta = $self->_find_delegate_metaclass;
561     if ($meta->isa('Class::MOP::Class')) {
562         return map  { $_->{name}                     }  # NOTE: !never! delegate &meta
563                grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' }
564                     $meta->compute_all_applicable_methods;
565     }
566     elsif ($meta->isa('Moose::Meta::Role')) {
567         return $meta->get_method_list;
568     }
569     else {
570         confess "Unable to recognize the delegate metaclass '$meta'";
571     }
572 }
573
574 1;
575
576 __END__
577
578 =pod
579
580 =head1 NAME
581
582 Moose::Meta::Attribute - The Moose attribute metaclass
583
584 =head1 DESCRIPTION
585
586 This is a subclass of L<Class::MOP::Attribute> with Moose specific
587 extensions.
588
589 For the most part, the only time you will ever encounter an
590 instance of this class is if you are doing some serious deep
591 introspection. To really understand this class, you need to refer
592 to the L<Class::MOP::Attribute> documentation.
593
594 =head1 METHODS
595
596 =head2 Overridden methods
597
598 These methods override methods in L<Class::MOP::Attribute> and add
599 Moose specific features. You can safely assume though that they
600 will behave just as L<Class::MOP::Attribute> does.
601
602 =over 4
603
604 =item B<new>
605
606 =item B<does>
607
608 =item B<initialize_instance_slot>
609
610 =item B<install_accessors>
611
612 =item B<accessor_metaclass>
613
614 =item B<get_value>
615
616 =item B<set_value>
617
618   eval { $point->meta->get_attribute('x')->set_value($point, 'fourty-two') };
619   if($@) {
620     print "Oops: $@\n";
621   }
622
623 I<Attribute (x) does not pass the type constraint (Int) with 'fourty-two'>
624
625 Before setting the value, a check is made on the type constraint of
626 the attribute, if it has one, to see if the value passes it. If the
627 value fails to pass, the set operation dies with a L<Carp/confess>.
628
629 Any coercion to convert values is done before checking the type constraint.
630
631 To check a value against a type constraint before setting it, fetch the
632 attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
633 fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
634 and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::RecipeX>
635 for an example.
636
637 =back
638
639 =head2 Additional Moose features
640
641 Moose attributes support type-constraint checking, weak reference
642 creation and type coercion.
643
644 =over 4
645
646 =item B<interpolate_class_and_new>
647
648 =item B<interpolate_class>
649
650 When called as a class method causes interpretation of the C<metaclass> and
651 C<traits> options.
652
653 =item B<clone_and_inherit_options>
654
655 This is to support the C<has '+foo'> feature, it clones an attribute
656 from a superclass and allows a very specific set of changes to be made
657 to the attribute.
658
659 =item B<has_type_constraint>
660
661 Returns true if this meta-attribute has a type constraint.
662
663 =item B<type_constraint>
664
665 A read-only accessor for this meta-attribute's type constraint. For
666 more information on what you can do with this, see the documentation
667 for L<Moose::Meta::TypeConstraint>.
668
669 =item B<has_handles>
670
671 Returns true if this meta-attribute performs delegation.
672
673 =item B<handles>
674
675 This returns the value which was passed into the handles option.
676
677 =item B<is_weak_ref>
678
679 Returns true if this meta-attribute produces a weak reference.
680
681 =item B<is_required>
682
683 Returns true if this meta-attribute is required to have a value.
684
685 =item B<is_lazy>
686
687 Returns true if this meta-attribute should be initialized lazily.
688
689 NOTE: lazy attributes, B<must> have a C<default> or C<builder> field set.
690
691 =item B<is_lazy_build>
692
693 Returns true if this meta-attribute should be initialized lazily through
694 the builder generated by lazy_build. Using C<lazy_build =E<gt> 1> will
695 make your attribute required and lazy. In addition it will set the builder, clearer
696 and predicate options for you using the following convention.
697
698    #If your attribute name starts with an underscore:
699    has '_foo' => (lazy_build => 1);
700    #is the same as
701    has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo);
702    # or
703    has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', default => sub{shift->_build__foo});
704
705    #If your attribute name does not start with an underscore:
706    has 'foo' => (lazy_build => 1);
707    #is the same as
708    has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo);
709    # or
710    has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', default => sub{shift->_build_foo});
711
712 The reason for the different naming of the C<builder> is that the C<builder>
713 method is a private method while the C<clearer> and C<predicate> methods
714 are public methods.
715
716 NOTE: This means your class should provide a method whose name matches the value
717 of the builder part, in this case _build__foo or _build_foo.
718
719 =item B<should_coerce>
720
721 Returns true if this meta-attribute should perform type coercion.
722
723 =item B<should_auto_deref>
724
725 Returns true if this meta-attribute should perform automatic
726 auto-dereferencing.
727
728 NOTE: This can only be done for attributes whose type constraint is
729 either I<ArrayRef> or I<HashRef>.
730
731 =item B<has_trigger>
732
733 Returns true if this meta-attribute has a trigger set.
734
735 =item B<trigger>
736
737 This is a CODE reference which will be executed every time the
738 value of an attribute is assigned. The CODE ref will get two values,
739 the invocant and the new value. This can be used to handle I<basic>
740 bi-directional relations.
741
742 =item B<documentation>
743
744 This is a string which contains the documentation for this attribute.
745 It serves no direct purpose right now, but it might in the future
746 in some kind of automated documentation system perhaps.
747
748 =item B<has_documentation>
749
750 Returns true if this meta-attribute has any documentation.
751
752 =item B<applied_traits>
753
754 This will return the ARRAY ref of all the traits applied to this 
755 attribute, or if no traits have been applied, it returns C<undef>.
756
757 =item B<has_applied_traits>
758
759 Returns true if this meta-attribute has any traits applied.
760
761 =back
762
763 =head1 BUGS
764
765 All complex software has bugs lurking in it, and this module is no
766 exception. If you find a bug please either email me, or add the bug
767 to cpan-RT.
768
769 =head1 AUTHOR
770
771 Stevan Little E<lt>stevan@iinteractive.comE<gt>
772
773 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
774
775 =head1 COPYRIGHT AND LICENSE
776
777 Copyright 2006-2008 by Infinity Interactive, Inc.
778
779 L<http://www.iinteractive.com>
780
781 This library is free software; you can redistribute it and/or modify
782 it under the same terms as Perl itself.
783
784 =cut