2 package Moose::Meta::Attribute;
7 use Scalar::Util 'weaken', 'reftype';
10 our $VERSION = '0.02';
12 use base 'Class::MOP::Attribute';
14 __PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce'));
15 __PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' ));
16 __PACKAGE__->meta->add_attribute('type_constraint' => (
17 reader => 'type_constraint',
18 predicate => 'has_type_constraint',
21 __PACKAGE__->meta->add_before_method_modifier('new' => sub {
22 my (undef, undef, %options) = @_;
23 if (exists $options{coerce} && $options{coerce}) {
24 (exists $options{type_constraint})
25 || confess "You cannot have coercion without specifying a type constraint";
26 confess "You cannot have a weak reference to a coerced value"
27 if $options{weak_ref};
31 sub generate_accessor_method {
32 my ($self, $attr_name) = @_;
33 if ($self->has_type_constraint) {
34 if ($self->is_weak_ref) {
36 if (scalar(@_) == 2) {
37 (defined $self->type_constraint->check($_[1]))
38 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
40 $_[0]->{$attr_name} = $_[1];
41 weaken($_[0]->{$attr_name});
47 if ($self->should_coerce) {
49 if (scalar(@_) == 2) {
50 my $val = $self->type_constraint->coercion->coerce($_[1]);
51 (defined $self->type_constraint->check($val))
52 || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
54 $_[0]->{$attr_name} = $val;
61 if (scalar(@_) == 2) {
62 (defined $self->type_constraint->check($_[1]))
63 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
65 $_[0]->{$attr_name} = $_[1];
73 if ($self->is_weak_ref) {
75 if (scalar(@_) == 2) {
76 $_[0]->{$attr_name} = $_[1];
77 weaken($_[0]->{$attr_name});
84 $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2;
91 sub generate_writer_method {
92 my ($self, $attr_name) = @_;
93 if ($self->has_type_constraint) {
94 if ($self->is_weak_ref) {
96 (defined $self->type_constraint->check($_[1]))
97 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
99 $_[0]->{$attr_name} = $_[1];
100 weaken($_[0]->{$attr_name});
104 if ($self->should_coerce) {
106 my $val = $self->type_constraint->coercion->coerce($_[1]);
107 (defined $self->type_constraint->check($val))
108 || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
110 $_[0]->{$attr_name} = $val;
115 (defined $self->type_constraint->check($_[1]))
116 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
118 $_[0]->{$attr_name} = $_[1];
124 if ($self->is_weak_ref) {
126 $_[0]->{$attr_name} = $_[1];
127 weaken($_[0]->{$attr_name});
131 return sub { $_[0]->{$attr_name} = $_[1] };
136 sub generate_reader_method {
137 my ($self, $attr_name) = @_;
139 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
152 Moose::Meta::Attribute - The Moose attribute metaclass
156 This is a subclass of L<Class::MOP::Attribute> with Moose specific
159 For the most part, the only time you will ever encounter an
160 instance of this class is if you are doing some serious deep
161 introspection. To really understand this class, you need to refer
162 to the L<Class::MOP::Attribute> documentation.
166 =head2 Overridden methods
168 These methods override methods in L<Class::MOP::Attribute> and add
169 Moose specific features. You can safely assume though that they
170 will behave just as L<Class::MOP::Attribute> does.
176 =item B<generate_accessor_method>
178 =item B<generate_writer_method>
180 =item B<generate_reader_method>
184 =head2 Additional Moose features
186 Moose attributes support type-contstraint checking, weak reference
187 creation and type coercion.
191 =item B<has_type_constraint>
193 Returns true if this meta-attribute has a type constraint.
195 =item B<type_constraint>
197 A read-only accessor for this meta-attribute's type constraint. For
198 more information on what you can do with this, see the documentation
199 for L<Moose::Meta::TypeConstraint>.
203 Returns true of this meta-attribute produces a weak reference.
205 =item B<should_coerce>
207 Returns true of this meta-attribute should perform type coercion.
213 All complex software has bugs lurking in it, and this module is no
214 exception. If you find a bug please either email me, or add the bug
219 Stevan Little E<lt>stevan@iinteractive.comE<gt>
221 =head1 COPYRIGHT AND LICENSE
223 Copyright 2006 by Infinity Interactive, Inc.
225 L<http://www.iinteractive.com>
227 This library is free software; you can redistribute it and/or modify
228 it under the same terms as Perl itself.