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) = @_;
32 if (exists $options{is}) {
33 if ($options{is} eq 'ro') {
34 $options{reader} = $name;
35 (!exists $options{trigger})
36 || confess "Cannot have a trigger on a read-only attribute";
38 elsif ($options{is} eq 'rw') {
39 $options{accessor} = $name;
40 ((reftype($options{trigger}) || '') eq 'CODE')
41 || confess "A trigger must be a CODE reference"
42 if exists $options{trigger};
46 if (exists $options{isa}) {
48 if (exists $options{does}) {
49 if (eval { $options{isa}->can('does') }) {
50 ($options{isa}->does($options{does}))
51 || confess "Cannot have an isa option and a does option if the isa does not do the does";
54 confess "Cannot have an isa option which cannot ->does()";
58 # allow for anon-subtypes here ...
59 if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
60 $options{type_constraint} = $options{isa};
63 # otherwise assume it is a constraint
64 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
65 # if the constraing it not found ....
66 unless (defined $constraint) {
67 # assume it is a foreign class, and make
68 # an anon constraint for it
69 $constraint = Moose::Util::TypeConstraints::subtype(
71 Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
74 $options{type_constraint} = $constraint;
77 elsif (exists $options{does}) {
78 # allow for anon-subtypes here ...
79 if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) {
80 $options{type_constraint} = $options{isa};
83 # otherwise assume it is a constraint
84 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{does});
85 # if the constraing it not found ....
86 unless (defined $constraint) {
87 # assume it is a foreign class, and make
88 # an anon constraint for it
89 $constraint = Moose::Util::TypeConstraints::subtype(
91 Moose::Util::TypeConstraints::where { $_->does($options{does}) }
94 $options{type_constraint} = $constraint;
98 if (exists $options{coerce} && $options{coerce}) {
99 (exists $options{type_constraint})
100 || confess "You cannot have coercion without specifying a type constraint";
101 confess "You cannot have a weak reference to a coerced value"
102 if $options{weak_ref};
105 if (exists $options{lazy} && $options{lazy}) {
106 (exists $options{default})
107 || confess "You cannot have lazy attribute without specifying a default value for it";
110 $class->SUPER::new($name, %options);
113 sub initialize_instance_slot {
114 my ($self, $class, $instance, $params) = @_;
115 my $init_arg = $self->init_arg();
116 # try to fetch the init arg from the %params ...
118 if (exists $params->{$init_arg}) {
119 $val = $params->{$init_arg};
122 # skip it if it's lazy
123 return if $self->is_lazy;
124 # and die if it's required and doesn't have a default value
125 confess "Attribute (" . $self->name . ") is required"
126 if $self->is_required && !$self->has_default;
128 # if nothing was in the %params, we can use the
129 # attribute's default value (if it has one)
130 if (!defined $val && $self->has_default) {
131 $val = $self->default($instance);
134 if ($self->has_type_constraint) {
135 if ($self->should_coerce && $self->type_constraint->has_coercion) {
136 $val = $self->type_constraint->coercion->coerce($val);
138 (defined($self->type_constraint->check($val)))
139 || confess "Attribute (" . $self->name . ") does not pass the type contraint with '$val'";
142 $instance->{$self->name} = $val;
143 if (defined $val && $self->is_weak_ref) {
144 weaken($instance->{$self->name});
148 sub generate_accessor_method {
149 my ($self, $attr_name) = @_;
150 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
152 . 'if (scalar(@_) == 2) {'
153 . ($self->is_required ?
154 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
156 . ($self->should_coerce ?
157 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
159 . ($self->has_type_constraint ?
160 ('(defined $self->type_constraint->check(' . $value_name . '))'
161 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
162 . 'if defined ' . $value_name . ';')
164 . '$_[0]->{$attr_name} = ' . $value_name . ';'
165 . ($self->is_weak_ref ?
166 'weaken($_[0]->{$attr_name});'
168 . ($self->has_trigger ?
169 '$self->trigger->($_[0], ' . $value_name . ');'
173 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
174 . 'unless exists $_[0]->{$attr_name};'
176 . ' $_[0]->{$attr_name};'
178 my $sub = eval $code;
179 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
183 sub generate_writer_method {
184 my ($self, $attr_name) = @_;
185 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
187 . ($self->is_required ?
188 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
190 . ($self->should_coerce ?
191 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
193 . ($self->has_type_constraint ?
194 ('(defined $self->type_constraint->check(' . $value_name . '))'
195 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
196 . 'if defined ' . $value_name . ';')
198 . '$_[0]->{$attr_name} = ' . $value_name . ';'
199 . ($self->is_weak_ref ?
200 'weaken($_[0]->{$attr_name});'
202 . ($self->has_trigger ?
203 '$self->trigger->($_[0], ' . $value_name . ');'
206 my $sub = eval $code;
207 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
211 sub generate_reader_method {
212 my ($self, $attr_name) = @_;
214 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
216 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
217 . 'unless exists $_[0]->{$attr_name};'
219 . '$_[0]->{$attr_name};'
221 my $sub = eval $code;
222 confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;
234 Moose::Meta::Attribute - The Moose attribute metaclass
238 This is a subclass of L<Class::MOP::Attribute> with Moose specific
241 For the most part, the only time you will ever encounter an
242 instance of this class is if you are doing some serious deep
243 introspection. To really understand this class, you need to refer
244 to the L<Class::MOP::Attribute> documentation.
248 =head2 Overridden methods
250 These methods override methods in L<Class::MOP::Attribute> and add
251 Moose specific features. You can safely assume though that they
252 will behave just as L<Class::MOP::Attribute> does.
258 =item B<initialize_instance_slot>
260 =item B<generate_accessor_method>
262 =item B<generate_writer_method>
264 =item B<generate_reader_method>
268 =head2 Additional Moose features
270 Moose attributes support type-contstraint checking, weak reference
271 creation and type coercion.
275 =item B<has_type_constraint>
277 Returns true if this meta-attribute has a type constraint.
279 =item B<type_constraint>
281 A read-only accessor for this meta-attribute's type constraint. For
282 more information on what you can do with this, see the documentation
283 for L<Moose::Meta::TypeConstraint>.
287 Returns true if this meta-attribute produces a weak reference.
291 Returns true if this meta-attribute is required to have a value.
295 Returns true if this meta-attribute should be initialized lazily.
297 NOTE: lazy attributes, B<must> have a C<default> field set.
299 =item B<should_coerce>
301 Returns true if this meta-attribute should perform type coercion.
305 Returns true if this meta-attribute has a trigger set.
309 This is a CODE reference which will be executed every time the
310 value of an attribute is assigned. The CODE ref will get two values,
311 the invocant and the new value. This can be used to handle I<basic>
312 bi-directional relations.
318 All complex software has bugs lurking in it, and this module is no
319 exception. If you find a bug please either email me, or add the bug
324 Stevan Little E<lt>stevan@iinteractive.comE<gt>
326 =head1 COPYRIGHT AND LICENSE
328 Copyright 2006 by Infinity Interactive, Inc.
330 L<http://www.iinteractive.com>
332 This library is free software; you can redistribute it and/or modify
333 it under the same terms as Perl itself.