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