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.55';
  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_delegate_accessor;
 562
 563     # install the delegation ...
 564     my $associated_class = $self->associated_class;
 565     foreach my $handle (keys %handles) {
 566         my $method_to_call = $handles{$handle};
 567         my $class_name = $associated_class->name;
 568         my $name = "${class_name}::${handle}";
 569
 570         (!$associated_class->has_method($handle))
 571             || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
 572
 573         # NOTE:
 574         # handles is not allowed to delegate
 575         # any of these methods, as they will
 576         # override the ones in your class, which
 577         # is almost certainly not what you want.
 578
 579         # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something
 580         #cluck("Not delegating method '$handle' because it is a core method") and
 581         next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle);
 582
 583         if ('CODE' eq ref($method_to_call)) {
 584             $associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call));
 585         }
 586         else {
 587             # NOTE:
 588             # we used to do a goto here, but the
 589             # goto didn't handle failure correctly
 590             # (it just returned nothing), so I took
 591             # that out. However, the more I thought
 592             # about it, the less I liked it doing
 593             # the goto, and I prefered the act of
 594             # delegation being actually represented
 595             # in the stack trace.
 596             # - SL
 597             $associated_class->add_method($handle => Class::MOP::subname($name, sub {
 598                 my $proxy = (shift)->$accessor();
 599                 (defined $proxy)
 600                     || confess "Cannot delegate $handle to $method_to_call because " .
 601                                "the value of " . $self->name . " is not defined";
 602                 $proxy->$method_to_call(@_);
 603             }));
 604         }
 605     }
 606 }
 607
 608 # private methods to help delegation ...
 609
 610 sub _get_delegate_accessor {
 611     my $self = shift;
 612     # find the accessor method for this attribute
 613     my $accessor = $self->get_read_method_ref;
 614     # then unpack it if we need too ...
 615     $accessor = $accessor->body if blessed $accessor;
 616     # return the accessor
 617     return $accessor;
 618 }
 619
 620 sub _canonicalize_handles {
 621     my $self    = shift;
 622     my $handles = $self->handles;
 623     if (my $handle_type = ref($handles)) {
 624         if ($handle_type eq 'HASH') {
 625             return %{$handles};
 626         }
 627         elsif ($handle_type eq 'ARRAY') {
 628             return map { $_ => $_ } @{$handles};
 629         }
 630         elsif ($handle_type eq 'Regexp') {
 631             ($self->has_type_constraint)
 632                 || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
 633             return map  { ($_ => $_) }
 634                    grep { /$handles/ } $self->_get_delegate_method_list;
 635         }
 636         elsif ($handle_type eq 'CODE') {
 637             return $handles->($self, $self->_find_delegate_metaclass);
 638         }
 639         else {
 640             confess "Unable to canonicalize the 'handles' option with $handles";
 641         }
 642     }
 643     else {
 644         my $role_meta = eval { $handles->meta };
 645         if ($@) {
 646             confess "Unable to canonicalize the 'handles' option with $handles because : $@";
 647         }
 648
 649         (blessed $role_meta && $role_meta->isa('Moose::Meta::Role'))
 650             || confess "Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role";
 651
 652         return map { $_ => $_ } (
 653             $role_meta->get_method_list,
 654             $role_meta->get_required_method_list
 655         );
 656     }
 657 }
 658
 659 sub _find_delegate_metaclass {
 660     my $self = shift;
 661     if (my $class = $self->_isa_metadata) {
 662         # if the class does have
 663         # a meta method, use it
 664         return $class->meta if $class->can('meta');
 665         # otherwise we might be
 666         # dealing with a non-Moose
 667         # class, and need to make
 668         # our own metaclass
 669         return Moose::Meta::Class->initialize($class);
 670     }
 671     elsif (my $role = $self->_does_metadata) {
 672         # our role will always have
 673         # a meta method
 674         return $role->meta;
 675     }
 676     else {
 677         confess "Cannot find delegate metaclass for attribute " . $self->name;
 678     }
 679 }
 680
 681 sub _get_delegate_method_list {
 682     my $self = shift;
 683     my $meta = $self->_find_delegate_metaclass;
 684     if ($meta->isa('Class::MOP::Class')) {
 685         return map  { $_->{name}                     }  # NOTE: !never! delegate &meta
 686                grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' }
 687                     $meta->compute_all_applicable_methods;
 688     }
 689     elsif ($meta->isa('Moose::Meta::Role')) {
 690         return $meta->get_method_list;
 691     }
 692     else {
 693         confess "Unable to recognize the delegate metaclass '$meta'";
 694     }
 695 }
 696
 697 package Moose::Meta::Attribute::Custom::Moose;
 698 sub register_implementation { 'Moose::Meta::Attribute' }
 699
 700 1;
 701
 702 __END__
 703
 704 =pod
 705
 706 =head1 NAME
 707
 708 Moose::Meta::Attribute - The Moose attribute metaclass
 709
 710 =head1 DESCRIPTION
 711
 712 This is a subclass of L<Class::MOP::Attribute> with Moose specific
 713 extensions.
 714
 715 For the most part, the only time you will ever encounter an
 716 instance of this class is if you are doing some serious deep
 717 introspection. To really understand this class, you need to refer
 718 to the L<Class::MOP::Attribute> documentation.
 719
 720 =head1 METHODS
 721
 722 =head2 Overridden methods
 723
 724 These methods override methods in L<Class::MOP::Attribute> and add
 725 Moose specific features. You can safely assume though that they
 726 will behave just as L<Class::MOP::Attribute> does.
 727
 728 =over 4
 729
 730 =item B<new>
 731
 732 =item B<clone>
 733
 734 =item B<does>
 735
 736 =item B<initialize_instance_slot>
 737
 738 =item B<install_accessors>
 739
 740 =item B<install_delegation>
 741
 742 =item B<accessor_metaclass>
 743
 744 =item B<get_value>
 745
 746 =item B<set_value>
 747
 748   eval { $point->meta->get_attribute('x')->set_value($point, 'fourty-two') };
 749   if($@) {
 750     print "Oops: $@\n";
 751   }
 752
 753 I<Attribute (x) does not pass the type constraint (Int) with 'fourty-two'>
 754
 755 Before setting the value, a check is made on the type constraint of
 756 the attribute, if it has one, to see if the value passes it. If the
 757 value fails to pass, the set operation dies with a L<Carp/confess>.
 758
 759 Any coercion to convert values is done before checking the type constraint.
 760
 761 To check a value against a type constraint before setting it, fetch the
 762 attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
 763 fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
 764 and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::RecipeX>
 765 for an example.
 766
 767 =back
 768
 769 =head2 Additional Moose features
 770
 771 Moose attributes support type-constraint checking, weak reference
 772 creation and type coercion.
 773
 774 =over 4
 775
 776 =item B<interpolate_class_and_new>
 777
 778 =item B<interpolate_class>
 779
 780 When called as a class method causes interpretation of the C<metaclass> and
 781 C<traits> options.
 782
 783 =item B<clone_and_inherit_options>
 784
 785 This is to support the C<has '+foo'> feature, it clones an attribute
 786 from a superclass and allows a very specific set of changes to be made
 787 to the attribute.
 788
 789 =item B<legal_options_for_inheritance>
 790
 791 Whitelist with options you can change. You can overload it in your custom
 792 metaclass to allow your options be inheritable.
 793
 794 =item B<has_type_constraint>
 795
 796 Returns true if this meta-attribute has a type constraint.
 797
 798 =item B<type_constraint>
 799
 800 A read-only accessor for this meta-attribute's type constraint. For
 801 more information on what you can do with this, see the documentation
 802 for L<Moose::Meta::TypeConstraint>.
 803
 804 =item B<has_handles>
 805
 806 Returns true if this meta-attribute performs delegation.
 807
 808 =item B<handles>
 809
 810 This returns the value which was passed into the handles option.
 811
 812 =item B<is_weak_ref>
 813
 814 Returns true if this meta-attribute produces a weak reference.
 815
 816 =item B<is_required>
 817
 818 Returns true if this meta-attribute is required to have a value.
 819
 820 =item B<is_lazy>
 821
 822 Returns true if this meta-attribute should be initialized lazily.
 823
 824 NOTE: lazy attributes, B<must> have a C<default> or C<builder> field set.
 825
 826 =item B<is_lazy_build>
 827
 828 Returns true if this meta-attribute should be initialized lazily through
 829 the builder generated by lazy_build. Using C<lazy_build =E<gt> 1> will
 830 make your attribute required and lazy. In addition it will set the builder, clearer
 831 and predicate options for you using the following convention.
 832
 833    #If your attribute name starts with an underscore:
 834    has '_foo' => (lazy_build => 1);
 835    #is the same as
 836    has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo);
 837    # or
 838    has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', default => sub{shift->_build__foo});
 839
 840    #If your attribute name does not start with an underscore:
 841    has 'foo' => (lazy_build => 1);
 842    #is the same as
 843    has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo);
 844    # or
 845    has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', default => sub{shift->_build_foo});
 846
 847 The reason for the different naming of the C<builder> is that the C<builder>
 848 method is a private method while the C<clearer> and C<predicate> methods
 849 are public methods.
 850
 851 NOTE: This means your class should provide a method whose name matches the value
 852 of the builder part, in this case _build__foo or _build_foo.
 853
 854 =item B<should_coerce>
 855
 856 Returns true if this meta-attribute should perform type coercion.
 857
 858 =item B<should_auto_deref>
 859
 860 Returns true if this meta-attribute should perform automatic
 861 auto-dereferencing.
 862
 863 NOTE: This can only be done for attributes whose type constraint is
 864 either I<ArrayRef> or I<HashRef>.
 865
 866 =item B<has_trigger>
 867
 868 Returns true if this meta-attribute has a trigger set.
 869
 870 =item B<trigger>
 871
 872 This is a CODE reference which will be executed every time the
 873 value of an attribute is assigned. The CODE ref will get two values,
 874 the invocant and the new value. This can be used to handle I<basic>
 875 bi-directional relations.
 876
 877 =item B<documentation>
 878
 879 This is a string which contains the documentation for this attribute.
 880 It serves no direct purpose right now, but it might in the future
 881 in some kind of automated documentation system perhaps.
 882
 883 =item B<has_documentation>
 884
 885 Returns true if this meta-attribute has any documentation.
 886
 887 =item B<applied_traits>
 888
 889 This will return the ARRAY ref of all the traits applied to this
 890 attribute, or if no traits have been applied, it returns C<undef>.
 891
 892 =item B<has_applied_traits>
 893
 894 Returns true if this meta-attribute has any traits applied.
 895
 896 =back
 897
 898 =head1 BUGS
 899
 900 All complex software has bugs lurking in it, and this module is no
 901 exception. If you find a bug please either email me, or add the bug
 902 to cpan-RT.
 903
 904 =head1 AUTHOR
 905
 906 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 907
 908 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 909
 910 =head1 COPYRIGHT AND LICENSE
 911
 912 Copyright 2006-2008 by Infinity Interactive, Inc.
 913
 914 L<http://www.iinteractive.com>
 915
 916 This library is free software; you can redistribute it and/or modify
 917 it under the same terms as Perl itself.
 918
 919 =cut