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