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 generate_accessor_method {
114 my ($self, $attr_name) = @_;
115 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
117 . 'if (scalar(@_) == 2) {'
118 . ($self->is_required ?
119 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
121 . ($self->should_coerce ?
122 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
124 . ($self->has_type_constraint ?
125 ('(defined $self->type_constraint->check(' . $value_name . '))'
126 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
127 . 'if defined ' . $value_name . ';')
129 . '$_[0]->{$attr_name} = ' . $value_name . ';'
130 . ($self->is_weak_ref ?
131 'weaken($_[0]->{$attr_name});'
133 . ($self->has_trigger ?
134 '$self->trigger->($_[0], ' . $value_name . ');'
138 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
139 . 'unless exists $_[0]->{$attr_name};'
141 . ' $_[0]->{$attr_name};'
143 my $sub = eval $code;
144 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
148 sub generate_writer_method {
149 my ($self, $attr_name) = @_;
150 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
152 . ($self->is_required ?
153 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
155 . ($self->should_coerce ?
156 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
158 . ($self->has_type_constraint ?
159 ('(defined $self->type_constraint->check(' . $value_name . '))'
160 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
161 . 'if defined ' . $value_name . ';')
163 . '$_[0]->{$attr_name} = ' . $value_name . ';'
164 . ($self->is_weak_ref ?
165 'weaken($_[0]->{$attr_name});'
167 . ($self->has_trigger ?
168 '$self->trigger->($_[0], ' . $value_name . ');'
171 my $sub = eval $code;
172 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
176 sub generate_reader_method {
177 my ($self, $attr_name) = @_;
179 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
181 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
182 . 'unless exists $_[0]->{$attr_name};'
184 . '$_[0]->{$attr_name};'
186 my $sub = eval $code;
187 confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;
199 Moose::Meta::Attribute - The Moose attribute metaclass
203 This is a subclass of L<Class::MOP::Attribute> with Moose specific
206 For the most part, the only time you will ever encounter an
207 instance of this class is if you are doing some serious deep
208 introspection. To really understand this class, you need to refer
209 to the L<Class::MOP::Attribute> documentation.
213 =head2 Overridden methods
215 These methods override methods in L<Class::MOP::Attribute> and add
216 Moose specific features. You can safely assume though that they
217 will behave just as L<Class::MOP::Attribute> does.
223 =item B<generate_accessor_method>
225 =item B<generate_writer_method>
227 =item B<generate_reader_method>
231 =head2 Additional Moose features
233 Moose attributes support type-contstraint checking, weak reference
234 creation and type coercion.
238 =item B<has_type_constraint>
240 Returns true if this meta-attribute has a type constraint.
242 =item B<type_constraint>
244 A read-only accessor for this meta-attribute's type constraint. For
245 more information on what you can do with this, see the documentation
246 for L<Moose::Meta::TypeConstraint>.
250 Returns true if this meta-attribute produces a weak reference.
254 Returns true if this meta-attribute is required to have a value.
258 Returns true if this meta-attribute should be initialized lazily.
260 NOTE: lazy attributes, B<must> have a C<default> field set.
262 =item B<should_coerce>
264 Returns true if this meta-attribute should perform type coercion.
268 Returns true if this meta-attribute has a trigger set.
272 This is a CODE reference which will be executed every time the
273 value of an attribute is assigned. The CODE ref will get two values,
274 the invocant and the new value. This can be used to handle I<basic>
275 bi-directional relations.
281 All complex software has bugs lurking in it, and this module is no
282 exception. If you find a bug please either email me, or add the bug
287 Stevan Little E<lt>stevan@iinteractive.comE<gt>
289 =head1 COPYRIGHT AND LICENSE
291 Copyright 2006 by Infinity Interactive, Inc.
293 L<http://www.iinteractive.com>
295 This library is free software; you can redistribute it and/or modify
296 it under the same terms as Perl itself.