2 package Moose::Meta::Attribute;
7 use Scalar::Util 'blessed', 'weaken', 'reftype';
10 our $VERSION = '0.03';
12 use Moose::Util::TypeConstraints '-no-export';
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',
26 my ($class, $name, %options) = @_;
28 if (exists $options{is}) {
29 if ($options{is} eq 'ro') {
30 $options{reader} = $name;
32 elsif ($options{is} eq 'rw') {
33 $options{accessor} = $name;
37 if (exists $options{isa}) {
38 # allow for anon-subtypes here ...
39 if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
40 $options{type_constraint} = $options{isa};
43 # otherwise assume it is a constraint
44 my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
45 # if the constraing it not found ....
46 unless (defined $constraint) {
47 # assume it is a foreign class, and make
48 # an anon constraint for it
49 $constraint = Moose::Util::TypeConstraints::subtype(
51 Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
54 $options{type_constraint} = $constraint;
58 if (exists $options{coerce} && $options{coerce}) {
59 (exists $options{type_constraint})
60 || confess "You cannot have coercion without specifying a type constraint";
61 confess "You cannot have a weak reference to a coerced value"
62 if $options{weak_ref};
65 if (exists $options{lazy} && $options{lazy}) {
66 (exists $options{default})
67 || confess "You cannot have lazy attribute without specifying a default value for it";
70 $class->SUPER::new($name, %options);
73 sub generate_accessor_method {
74 my ($self, $attr_name) = @_;
75 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
77 . 'if (scalar(@_) == 2) {'
78 . ($self->is_required ?
79 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
81 . ($self->should_coerce ?
82 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
84 . ($self->has_type_constraint ?
85 ('(defined $self->type_constraint->check(' . $value_name . '))'
86 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
87 . 'if defined ' . $value_name . ';')
89 . '$_[0]->{$attr_name} = ' . $value_name . ';'
90 . ($self->is_weak_ref ?
91 'weaken($_[0]->{$attr_name});'
95 '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)'
96 . 'unless exists $_[0]->{$attr_name};'
98 . ' $_[0]->{$attr_name};'
100 my $sub = eval $code;
101 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
105 sub generate_writer_method {
106 my ($self, $attr_name) = @_;
107 my $value_name = $self->should_coerce ? '$val' : '$_[1]';
109 . ($self->is_required ?
110 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";'
112 . ($self->should_coerce ?
113 'my $val = $self->type_constraint->coercion->coerce($_[1]);'
115 . ($self->has_type_constraint ?
116 ('(defined $self->type_constraint->check(' . $value_name . '))'
117 . '|| confess "Attribute ($attr_name) does not pass the type contraint with \'' . $value_name . '\'"'
118 . 'if defined ' . $value_name . ';')
120 . '$_[0]->{$attr_name} = ' . $value_name . ';'
121 . ($self->is_weak_ref ?
122 'weaken($_[0]->{$attr_name});'
125 my $sub = eval $code;
126 confess "Could not create writer for '$attr_name' because $@ \n code: $code" if $@;
130 sub generate_reader_method {
131 my ($self, $attr_name) = @_;
133 . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
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 reader for '$attr_name' because $@ \n code: $code" if $@;
153 Moose::Meta::Attribute - The Moose attribute metaclass
157 This is a subclass of L<Class::MOP::Attribute> with Moose specific
160 For the most part, the only time you will ever encounter an
161 instance of this class is if you are doing some serious deep
162 introspection. To really understand this class, you need to refer
163 to the L<Class::MOP::Attribute> documentation.
167 =head2 Overridden methods
169 These methods override methods in L<Class::MOP::Attribute> and add
170 Moose specific features. You can safely assume though that they
171 will behave just as L<Class::MOP::Attribute> does.
177 =item B<generate_accessor_method>
179 =item B<generate_writer_method>
181 =item B<generate_reader_method>
185 =head2 Additional Moose features
187 Moose attributes support type-contstraint checking, weak reference
188 creation and type coercion.
192 =item B<has_type_constraint>
194 Returns true if this meta-attribute has a type constraint.
196 =item B<type_constraint>
198 A read-only accessor for this meta-attribute's type constraint. For
199 more information on what you can do with this, see the documentation
200 for L<Moose::Meta::TypeConstraint>.
204 Returns true of this meta-attribute produces a weak reference.
208 Returns true of this meta-attribute is required to have a value.
212 Returns true of this meta-attribute should be initialized lazily.
214 NOTE: lazy attributes, B<must> have a C<default> field set.
216 =item B<should_coerce>
218 Returns true of this meta-attribute should perform type coercion.
224 All complex software has bugs lurking in it, and this module is no
225 exception. If you find a bug please either email me, or add the bug
230 Stevan Little E<lt>stevan@iinteractive.comE<gt>
232 =head1 COPYRIGHT AND LICENSE
234 Copyright 2006 by Infinity Interactive, Inc.
236 L<http://www.iinteractive.com>
238 This library is free software; you can redistribute it and/or modify
239 it under the same terms as Perl itself.