2 package Moose::Meta::Attribute;
7 use Scalar::Util 'blessed', 'weaken', 'reftype';
10 our $VERSION = '0.05';
12 use Moose::Util::TypeConstraints ();
14 use base 'Class::MOP::Attribute';
16 __PACKAGE__->meta->add_attribute('required' => (reader => 'is_required' ));
17 __PACKAGE__->meta->add_attribute('lazy' => (reader => 'is_lazy' ));
18 __PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce'));
19 __PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' ));
20 __PACKAGE__->meta->add_attribute('type_constraint' => (
21 reader => 'type_constraint',
22 predicate => 'has_type_constraint',
24 __PACKAGE__->meta->add_attribute('trigger' => (
26 predicate => 'has_trigger',
30 my ($class, $name, %options) = @_;
31 $class->_process_options($name, \%options);
32 $class->SUPER::new($name, %options);
36 my ($self, %options) = @_;
37 $self->_process_options($self->name, \%options);
38 $self->SUPER::clone(%options);
41 sub _process_options {
42 my ($class, $name, $options) = @_;
43 if (exists $options->{is}) {
44 if ($options->{is} eq 'ro') {
45 $options->{reader} = $name;
46 (!exists $options->{trigger})
47 || confess "Cannot have a trigger on a read-only attribute";
49 elsif ($options->{is} eq 'rw') {
50 $options->{accessor} = $name;
51 ((reftype($options->{trigger}) || '') eq 'CODE')
52 || confess "A trigger must be a CODE reference"
53 if exists $options->{trigger};
57 if (exists $options->{isa}) {
59 if (exists $options->{does}) {
60 if (eval { $options->{isa}->can('does') }) {
61 ($options->{isa}->does($options->{does}))
62 || confess "Cannot have an isa option and a does option if the isa does not do the does";
65 confess "Cannot have an isa option which cannot ->does()";
69 # allow for anon-subtypes here ...
70 if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) {
71 $options->{type_constraint} = $options->{isa};
75 if ($options->{isa} =~ /\|/) {
76 my @type_constraints = split /\s*\|\s*/ => $options->{isa};
77 $options->{type_constraint} = Moose::Util::TypeConstraints::create_type_constraint_union(
82 # otherwise assume it is a constraint
83 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options->{isa});
84 # if the constraing it not found ....
85 unless (defined $constraint) {
86 # assume it is a foreign class, and make
87 # an anon constraint for it
88 $constraint = Moose::Util::TypeConstraints::subtype(
90 Moose::Util::TypeConstraints::where { $_->isa($options->{isa}) }
93 $options->{type_constraint} = $constraint;
97 elsif (exists $options->{does}) {
98 # allow for anon-subtypes here ...
99 if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) {
100 $options->{type_constraint} = $options->{isa};
103 # otherwise assume it is a constraint
104 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options->{does});
105 # if the constraing it not found ....
106 unless (defined $constraint) {
107 # assume it is a foreign class, and make
108 # an anon constraint for it
109 $constraint = Moose::Util::TypeConstraints::subtype(
111 Moose::Util::TypeConstraints::where { $_->does($options->{does}) }
114 $options->{type_constraint} = $constraint;
118 if (exists $options->{coerce} && $options->{coerce}) {
119 (exists $options->{type_constraint})
120 || confess "You cannot have coercion without specifying a type constraint";
121 (!$options->{type_constraint}->isa('Moose::Meta::TypeConstraint::Union'))
122 || confess "You cannot have coercion with a type constraint union";
123 confess "You cannot have a weak reference to a coerced value"
124 if $options->{weak_ref};
127 if (exists $options->{lazy} && $options->{lazy}) {
128 (exists $options->{default})
129 || confess "You cannot have lazy attribute without specifying a default value for it";
133 sub initialize_instance_slot {
134 my ($self, $class, $instance, $params) = @_;
135 my $init_arg = $self->init_arg();
136 # try to fetch the init arg from the %params ...
138 if (exists $params->{$init_arg}) {
139 $val = $params->{$init_arg};
142 # skip it if it's lazy
143 return if $self->is_lazy;
144 # and die if it's required and doesn't have a default value
145 confess "Attribute (" . $self->name . ") is required"
146 if $self->is_required && !$self->has_default;
148 # if nothing was in the %params, we can use the
149 # attribute's default value (if it has one)
150 if (!defined $val && $self->has_default) {
151 $val = $self->default($instance);
154 if ($self->has_type_constraint) {
155 my $type_constraint = $self->type_constraint;
156 if ($self->should_coerce && $type_constraint->has_coercion) {
157 $val = $type_constraint->coercion->coerce($val);
159 (defined($type_constraint->check($val)))
160 || confess "Attribute (" .
162 ") does not pass the type contraint (" .
163 $type_constraint->name .
167 $instance->{$self->name} = $val;
168 if (defined $val && $self->is_weak_ref) {
169 weaken($instance->{$self->name});
173 sub generate_accessor_method {
174 my ($self, $attr_name) = @_;
175 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
177 . 'if (scalar(@_) == 2) {'
178 . ($self->is_required ?
179 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
181 . ($self->should_coerce ?
182 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
184 . ($self->has_type_constraint ?
185 ('(defined $self->type_constraint->check(' . $value_name . '))'
186 . '|| confess "Attribute ($attr_name) does not pass the type contraint (" . $self->type_constraint->name . ") with \'' . $value_name . '\'"'
187 . 'if defined ' . $value_name . ';')
189 . '$_[0]->{$attr_name} = ' . $value_name . ';'
190 . ($self->is_weak_ref ?
191 'weaken($_[0]->{$attr_name});'
193 . ($self->has_trigger ?
194 '$self->trigger->($_[0], ' . $value_name . ');'
198 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
199 . 'unless exists $_[0]->{$attr_name};'
201 . ' $_[0]->{$attr_name};'
203 my $sub = eval $code;
204 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
208 sub generate_writer_method {
209 my ($self, $attr_name) = @_;
210 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
212 . ($self->is_required ?
213 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
215 . ($self->should_coerce ?
216 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
218 . ($self->has_type_constraint ?
219 ('(defined $self->type_constraint->check(' . $value_name . '))'
220 . '|| confess "Attribute ($attr_name) does not pass the type contraint (" . $self->type_constraint->name . ") with \'' . $value_name . '\'"'
221 . 'if defined ' . $value_name . ';')
223 . '$_[0]->{$attr_name} = ' . $value_name . ';'
224 . ($self->is_weak_ref ?
225 'weaken($_[0]->{$attr_name});'
227 . ($self->has_trigger ?
228 '$self->trigger->($_[0], ' . $value_name . ');'
231 my $sub = eval $code;
232 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
236 sub generate_reader_method {
237 my ($self, $attr_name) = @_;
239 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
241 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
242 . 'unless exists $_[0]->{$attr_name};'
244 . '$_[0]->{$attr_name};'
246 my $sub = eval $code;
247 confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;
259 Moose::Meta::Attribute - The Moose attribute metaclass
263 This is a subclass of L<Class::MOP::Attribute> with Moose specific
266 For the most part, the only time you will ever encounter an
267 instance of this class is if you are doing some serious deep
268 introspection. To really understand this class, you need to refer
269 to the L<Class::MOP::Attribute> documentation.
273 =head2 Overridden methods
275 These methods override methods in L<Class::MOP::Attribute> and add
276 Moose specific features. You can safely assume though that they
277 will behave just as L<Class::MOP::Attribute> does.
285 =item B<initialize_instance_slot>
287 =item B<generate_accessor_method>
289 =item B<generate_writer_method>
291 =item B<generate_reader_method>
295 =head2 Additional Moose features
297 Moose attributes support type-contstraint checking, weak reference
298 creation and type coercion.
302 =item B<has_type_constraint>
304 Returns true if this meta-attribute has a type constraint.
306 =item B<type_constraint>
308 A read-only accessor for this meta-attribute's type constraint. For
309 more information on what you can do with this, see the documentation
310 for L<Moose::Meta::TypeConstraint>.
314 Returns true if this meta-attribute produces a weak reference.
318 Returns true if this meta-attribute is required to have a value.
322 Returns true if this meta-attribute should be initialized lazily.
324 NOTE: lazy attributes, B<must> have a C<default> field set.
326 =item B<should_coerce>
328 Returns true if this meta-attribute should perform type coercion.
332 Returns true if this meta-attribute has a trigger set.
336 This is a CODE reference which will be executed every time the
337 value of an attribute is assigned. The CODE ref will get two values,
338 the invocant and the new value. This can be used to handle I<basic>
339 bi-directional relations.
345 All complex software has bugs lurking in it, and this module is no
346 exception. If you find a bug please either email me, or add the bug
351 Stevan Little E<lt>stevan@iinteractive.comE<gt>
353 =head1 COPYRIGHT AND LICENSE
355 Copyright 2006 by Infinity Interactive, Inc.
357 L<http://www.iinteractive.com>
359 This library is free software; you can redistribute it and/or modify
360 it under the same terms as Perl itself.