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