2 package Moose::Meta::Attribute;
7 use Scalar::Util 'blessed', 'weaken', 'reftype';
10 our $VERSION = '0.08';
12 use Moose::Meta::Method::Accessor;
13 use Moose::Util::TypeConstraints ();
15 use base 'Class::MOP::Attribute';
17 # options which are not directly used
18 # but we store them for metadata purposes
19 __PACKAGE__->meta->add_attribute('isa' => (reader => '_isa_metadata'));
20 __PACKAGE__->meta->add_attribute('does' => (reader => '_does_metadata'));
21 __PACKAGE__->meta->add_attribute('is' => (reader => '_is_metadata'));
23 # these are actual options for the attrs
24 __PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' ));
25 __PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' ));
26 __PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce' ));
27 __PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' ));
28 __PACKAGE__->meta->add_attribute('auto_deref' => (reader => 'should_auto_deref'));
29 __PACKAGE__->meta->add_attribute('type_constraint' => (
30 reader => 'type_constraint',
31 predicate => 'has_type_constraint',
33 __PACKAGE__->meta->add_attribute('trigger' => (
35 predicate => 'has_trigger',
37 __PACKAGE__->meta->add_attribute('handles' => (
39 predicate => 'has_handles',
43 my ($class, $name, %options) = @_;
44 $class->_process_options($name, \%options);
45 return $class->SUPER::new($name, %options);
48 sub clone_and_inherit_options {
49 my ($self, %options) = @_;
50 # you can change default, required and coerce
52 foreach my $legal_option (qw(default coerce required)) {
53 if (exists $options{$legal_option}) {
54 $actual_options{$legal_option} = $options{$legal_option};
55 delete $options{$legal_option};
58 # isa can be changed, but only if the
59 # new type is a subtype
62 if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
63 $type_constraint = $options{isa};
66 $type_constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
67 (defined $type_constraint)
68 || confess "Could not find the type constraint '" . $options{isa} . "'";
71 # check here to see if the new type
72 # is a subtype of the old one
73 ($type_constraint->is_subtype_of($self->type_constraint->name))
74 || confess "New type constraint setting must be a subtype of inherited one"
75 # iff we have a type constraint that is ...
76 if $self->has_type_constraint;
78 $actual_options{type_constraint} = $type_constraint;
81 (scalar keys %options == 0)
82 || confess "Illegal inherited options => (" . (join ', ' => keys %options) . ")";
83 $self->clone(%actual_options);
86 sub _process_options {
87 my ($class, $name, $options) = @_;
89 if (exists $options->{is}) {
90 if ($options->{is} eq 'ro') {
91 $options->{reader} = $name;
92 (!exists $options->{trigger})
93 || confess "Cannot have a trigger on a read-only attribute";
95 elsif ($options->{is} eq 'rw') {
96 $options->{accessor} = $name;
97 ((reftype($options->{trigger}) || '') eq 'CODE')
98 || confess "Trigger must be a CODE ref"
99 if exists $options->{trigger};
102 confess "I do not understand this option (is => " . $options->{is} . ")"
106 if (exists $options->{isa}) {
108 if (exists $options->{does}) {
109 if (eval { $options->{isa}->can('does') }) {
110 ($options->{isa}->does($options->{does}))
111 || confess "Cannot have an isa option and a does option if the isa does not do the does";
114 confess "Cannot have an isa option which cannot ->does()";
118 # allow for anon-subtypes here ...
119 if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) {
120 $options->{type_constraint} = $options->{isa};
124 if ($options->{isa} =~ /\|/) {
125 my @type_constraints = split /\s*\|\s*/ => $options->{isa};
126 $options->{type_constraint} = Moose::Util::TypeConstraints::create_type_constraint_union(
131 # otherwise assume it is a constraint
132 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options->{isa});
133 # if the constraing it not found ....
134 unless (defined $constraint) {
135 # assume it is a foreign class, and make
136 # an anon constraint for it
137 $constraint = Moose::Util::TypeConstraints::subtype(
139 Moose::Util::TypeConstraints::where { $_->isa($options->{isa}) }
142 $options->{type_constraint} = $constraint;
146 elsif (exists $options->{does}) {
147 # allow for anon-subtypes here ...
148 if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) {
149 $options->{type_constraint} = $options->{isa};
152 # otherwise assume it is a constraint
153 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options->{does});
154 # if the constraing it not found ....
155 unless (defined $constraint) {
156 # assume it is a foreign class, and make
157 # an anon constraint for it
158 $constraint = Moose::Util::TypeConstraints::subtype(
160 Moose::Util::TypeConstraints::where { $_->does($options->{does}) }
163 $options->{type_constraint} = $constraint;
167 if (exists $options->{coerce} && $options->{coerce}) {
168 (exists $options->{type_constraint})
169 || confess "You cannot have coercion without specifying a type constraint";
170 confess "You cannot have a weak reference to a coerced value"
171 if $options->{weak_ref};
174 if (exists $options->{auto_deref} && $options->{auto_deref}) {
175 (exists $options->{type_constraint})
176 || confess "You cannot auto-dereference without specifying a type constraint";
177 ($options->{type_constraint}->is_a_type_of('ArrayRef') ||
178 $options->{type_constraint}->is_a_type_of('HashRef'))
179 || confess "You cannot auto-dereference anything other than a ArrayRef or HashRef";
182 if (exists $options->{lazy} && $options->{lazy}) {
183 (exists $options->{default})
184 || confess "You cannot have lazy attribute without specifying a default value for it";
188 sub initialize_instance_slot {
189 my ($self, $meta_instance, $instance, $params) = @_;
190 my $init_arg = $self->init_arg();
191 # try to fetch the init arg from the %params ...
194 if (exists $params->{$init_arg}) {
195 $val = $params->{$init_arg};
198 # skip it if it's lazy
199 return if $self->is_lazy;
200 # and die if it's required and doesn't have a default value
201 confess "Attribute (" . $self->name . ") is required"
202 if $self->is_required && !$self->has_default;
205 # if nothing was in the %params, we can use the
206 # attribute's default value (if it has one)
207 if (!defined $val && $self->has_default) {
208 $val = $self->default($instance);
211 if ($self->has_type_constraint) {
212 my $type_constraint = $self->type_constraint;
213 if ($self->should_coerce && $type_constraint->has_coercion) {
214 $val = $type_constraint->coerce($val);
216 (defined($type_constraint->check($val)))
217 || confess "Attribute (" .
219 ") does not pass the type constraint (" .
220 $type_constraint->name .
225 $meta_instance->set_slot_value($instance, $self->name, $val);
226 $meta_instance->weaken_slot_value($instance, $self->name)
227 if ref $val && $self->is_weak_ref;
233 # my ($self, $instance, $value) = @_;
237 # my ($self, $instance) = @_;
241 # my ($self, $instance) = @_;
245 # my ($self, $instance) = @_;
248 ## installing accessors
250 sub accessor_metaclass { 'Moose::Meta::Method::Accessor' }
252 sub install_accessors {
254 $self->SUPER::install_accessors(@_);
256 if ($self->has_handles) {
259 # Here we canonicalize the 'handles' option
260 # this will sort out any details and always
261 # return an hash of methods which we want
262 # to delagate to, see that method for details
263 my %handles = $self->_canonicalize_handles();
265 # find the name of the accessor for this attribute
266 my $accessor_name = $self->reader || $self->accessor;
267 (defined $accessor_name)
268 || confess "You cannot install delegation without a reader or accessor for the attribute";
270 # make sure we handle HASH accessors correctly
271 ($accessor_name) = keys %{$accessor_name}
272 if ref($accessor_name) eq 'HASH';
274 # install the delegation ...
275 my $associated_class = $self->associated_class;
276 foreach my $handle (keys %handles) {
277 my $method_to_call = $handles{$handle};
279 (!$associated_class->has_method($handle))
280 || confess "You cannot overwrite a locally defined method ($handle) with a delegation";
282 if ((reftype($method_to_call) || '') eq 'CODE') {
283 $associated_class->add_method($handle => $method_to_call);
286 $associated_class->add_method($handle => sub {
288 # we should check for lack of
289 # a callable return value from
291 ((shift)->$accessor_name())->$method_to_call(@_);
300 # private methods to help delegation ...
302 sub _canonicalize_handles {
304 my $handles = $self->handles;
305 if (ref($handles) eq 'HASH') {
308 elsif (ref($handles) eq 'ARRAY') {
309 return map { $_ => $_ } @{$handles};
311 elsif (ref($handles) eq 'Regexp') {
312 ($self->has_type_constraint)
313 || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)";
314 return map { ($_ => $_) }
315 grep { $handles } $self->_get_delegate_method_list;
317 elsif (ref($handles) eq 'CODE') {
318 return $handles->($self, $self->_find_delegate_metaclass);
321 confess "Unable to canonicalize the 'handles' option with $handles";
325 sub _find_delegate_metaclass {
327 if (my $class = $self->_isa_metadata) {
328 # if the class does have
329 # a meta method, use it
330 return $class->meta if $class->can('meta');
331 # otherwise we might be
332 # dealing with a non-Moose
333 # class, and need to make
335 return Moose::Meta::Class->initialize($class);
337 elsif (my $role = $self->_does_metadata) {
338 # our role will always have
343 confess "Cannot find delegate metaclass for attribute " . $self->name;
347 sub _get_delegate_method_list {
349 my $meta = $self->_find_delegate_metaclass;
350 if ($meta->isa('Class::MOP::Class')) {
351 return map { $_->{name} } # NOTE: !never! delegate &meta
352 grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' }
353 $meta->compute_all_applicable_methods;
355 elsif ($meta->isa('Moose::Meta::Role')) {
356 return $meta->get_method_list;
359 confess "Unable to recognize the delegate metaclass '$meta'";
371 Moose::Meta::Attribute - The Moose attribute metaclass
375 This is a subclass of L<Class::MOP::Attribute> with Moose specific
378 For the most part, the only time you will ever encounter an
379 instance of this class is if you are doing some serious deep
380 introspection. To really understand this class, you need to refer
381 to the L<Class::MOP::Attribute> documentation.
385 =head2 Overridden methods
387 These methods override methods in L<Class::MOP::Attribute> and add
388 Moose specific features. You can safely assume though that they
389 will behave just as L<Class::MOP::Attribute> does.
395 =item B<initialize_instance_slot>
397 =item B<install_accessors>
399 =item B<accessor_metaclass>
403 =head2 Additional Moose features
405 Moose attributes support type-constraint checking, weak reference
406 creation and type coercion.
410 =item B<clone_and_inherit_options>
412 This is to support the C<has '+foo'> feature, it clones an attribute
413 from a superclass and allows a very specific set of changes to be made
416 =item B<has_type_constraint>
418 Returns true if this meta-attribute has a type constraint.
420 =item B<type_constraint>
422 A read-only accessor for this meta-attribute's type constraint. For
423 more information on what you can do with this, see the documentation
424 for L<Moose::Meta::TypeConstraint>.
428 Returns true if this meta-attribute performs delegation.
432 This returns the value which was passed into the handles option.
436 Returns true if this meta-attribute produces a weak reference.
440 Returns true if this meta-attribute is required to have a value.
444 Returns true if this meta-attribute should be initialized lazily.
446 NOTE: lazy attributes, B<must> have a C<default> field set.
448 =item B<should_coerce>
450 Returns true if this meta-attribute should perform type coercion.
452 =item B<should_auto_deref>
454 Returns true if this meta-attribute should perform automatic
457 NOTE: This can only be done for attributes whose type constraint is
458 either I<ArrayRef> or I<HashRef>.
462 Returns true if this meta-attribute has a trigger set.
466 This is a CODE reference which will be executed every time the
467 value of an attribute is assigned. The CODE ref will get two values,
468 the invocant and the new value. This can be used to handle I<basic>
469 bi-directional relations.
475 All complex software has bugs lurking in it, and this module is no
476 exception. If you find a bug please either email me, or add the bug
481 Stevan Little E<lt>stevan@iinteractive.comE<gt>
483 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
485 =head1 COPYRIGHT AND LICENSE
487 Copyright 2006 by Infinity Interactive, Inc.
489 L<http://www.iinteractive.com>
491 This library is free software; you can redistribute it and/or modify
492 it under the same terms as Perl itself.