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