2 package Moose::Meta::Attribute;
7 use Scalar::Util 'blessed', 'weaken', 'reftype';
10 our $VERSION = '0.04';
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";
55 # allow for anon-subtypes here ...
56 if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
57 $options{type_constraint} = $options{isa};
60 # otherwise assume it is a constraint
61 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
62 # if the constraing it not found ....
63 unless (defined $constraint) {
64 # assume it is a foreign class, and make
65 # an anon constraint for it
66 $constraint = Moose::Util::TypeConstraints::subtype(
68 Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
71 $options{type_constraint} = $constraint;
74 elsif (exists $options{does}) {
75 # allow for anon-subtypes here ...
76 if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) {
77 $options{type_constraint} = $options{isa};
80 # otherwise assume it is a constraint
81 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{does});
82 # if the constraing it not found ....
83 unless (defined $constraint) {
84 # assume it is a foreign class, and make
85 # an anon constraint for it
86 $constraint = Moose::Util::TypeConstraints::subtype(
88 Moose::Util::TypeConstraints::where { $_->does($options{does}) }
91 $options{type_constraint} = $constraint;
95 if (exists $options{coerce} && $options{coerce}) {
96 (exists $options{type_constraint})
97 || confess "You cannot have coercion without specifying a type constraint";
98 confess "You cannot have a weak reference to a coerced value"
99 if $options{weak_ref};
102 if (exists $options{lazy} && $options{lazy}) {
103 (exists $options{default})
104 || confess "You cannot have lazy attribute without specifying a default value for it";
107 $class->SUPER::new($name, %options);
110 sub generate_accessor_method {
111 my ($self, $attr_name) = @_;
112 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
114 . 'if (scalar(@_) == 2) {'
115 . ($self->is_required ?
116 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
118 . ($self->should_coerce ?
119 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
121 . ($self->has_type_constraint ?
122 ('(defined $self->type_constraint->check(' . $value_name . '))'
123 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
124 . 'if defined ' . $value_name . ';')
126 . '$_[0]->{$attr_name} = ' . $value_name . ';'
127 . ($self->is_weak_ref ?
128 'weaken($_[0]->{$attr_name});'
130 . ($self->has_trigger ?
131 '$self->trigger->($_[0], ' . $value_name . ');'
135 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
136 . 'unless exists $_[0]->{$attr_name};'
138 . ' $_[0]->{$attr_name};'
140 my $sub = eval $code;
141 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
145 sub generate_writer_method {
146 my ($self, $attr_name) = @_;
147 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
149 . ($self->is_required ?
150 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
152 . ($self->should_coerce ?
153 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
155 . ($self->has_type_constraint ?
156 ('(defined $self->type_constraint->check(' . $value_name . '))'
157 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
158 . 'if defined ' . $value_name . ';')
160 . '$_[0]->{$attr_name} = ' . $value_name . ';'
161 . ($self->is_weak_ref ?
162 'weaken($_[0]->{$attr_name});'
164 . ($self->has_trigger ?
165 '$self->trigger->($_[0], ' . $value_name . ');'
168 my $sub = eval $code;
169 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
173 sub generate_reader_method {
174 my ($self, $attr_name) = @_;
176 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
178 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
179 . 'unless exists $_[0]->{$attr_name};'
181 . '$_[0]->{$attr_name};'
183 my $sub = eval $code;
184 confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@;
196 Moose::Meta::Attribute - The Moose attribute metaclass
200 This is a subclass of L<Class::MOP::Attribute> with Moose specific
203 For the most part, the only time you will ever encounter an
204 instance of this class is if you are doing some serious deep
205 introspection. To really understand this class, you need to refer
206 to the L<Class::MOP::Attribute> documentation.
210 =head2 Overridden methods
212 These methods override methods in L<Class::MOP::Attribute> and add
213 Moose specific features. You can safely assume though that they
214 will behave just as L<Class::MOP::Attribute> does.
220 =item B<generate_accessor_method>
222 =item B<generate_writer_method>
224 =item B<generate_reader_method>
228 =head2 Additional Moose features
230 Moose attributes support type-contstraint checking, weak reference
231 creation and type coercion.
235 =item B<has_type_constraint>
237 Returns true if this meta-attribute has a type constraint.
239 =item B<type_constraint>
241 A read-only accessor for this meta-attribute's type constraint. For
242 more information on what you can do with this, see the documentation
243 for L<Moose::Meta::TypeConstraint>.
247 Returns true if this meta-attribute produces a weak reference.
251 Returns true if this meta-attribute is required to have a value.
255 Returns true if this meta-attribute should be initialized lazily.
257 NOTE: lazy attributes, B<must> have a C<default> field set.
259 =item B<should_coerce>
261 Returns true if this meta-attribute should perform type coercion.
265 Returns true if this meta-attribute has a trigger set.
269 This is a CODE reference which will be executed every time the
270 value of an attribute is assigned. The CODE ref will get two values,
271 the invocant and the new value. This can be used to handle I<basic>
272 bi-directional relations.
278 All complex software has bugs lurking in it, and this module is no
279 exception. If you find a bug please either email me, or add the bug
284 Stevan Little E<lt>stevan@iinteractive.comE<gt>
286 =head1 COPYRIGHT AND LICENSE
288 Copyright 2006 by Infinity Interactive, Inc.
290 L<http://www.iinteractive.com>
292 This library is free software; you can redistribute it and/or modify
293 it under the same terms as Perl itself.