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