Commit | Line | Data |
c0e30cf5 |
1 | |
2 | package Moose::Meta::Attribute; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
a15dff8d |
7 | use Scalar::Util 'weaken', 'reftype'; |
8 | use Carp 'confess'; |
9 | |
5569c072 |
10 | our $VERSION = '0.02'; |
bc1e29b5 |
11 | |
c0e30cf5 |
12 | use base 'Class::MOP::Attribute'; |
13 | |
6ba6d68c |
14 | __PACKAGE__->meta->add_attribute('coerce' => (reader => 'should_coerce')); |
15 | __PACKAGE__->meta->add_attribute('weak_ref' => (reader => 'is_weak_ref' )); |
82168dbb |
16 | __PACKAGE__->meta->add_attribute('type_constraint' => ( |
17 | reader => 'type_constraint', |
18 | predicate => 'has_type_constraint', |
19 | )); |
20 | |
21 | __PACKAGE__->meta->add_before_method_modifier('new' => sub { |
a15dff8d |
22 | my (undef, undef, %options) = @_; |
4b598ea3 |
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}; |
7415b2cb |
28 | } |
c0e30cf5 |
29 | }); |
30 | |
a15dff8d |
31 | sub generate_accessor_method { |
32 | my ($self, $attr_name) = @_; |
33 | if ($self->has_type_constraint) { |
34a66aa3 |
34 | if ($self->is_weak_ref) { |
a15dff8d |
35 | return sub { |
36 | if (scalar(@_) == 2) { |
a27aa600 |
37 | (defined $self->type_constraint->check($_[1])) |
5569c072 |
38 | || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" |
a15dff8d |
39 | if defined $_[1]; |
40 | $_[0]->{$attr_name} = $_[1]; |
41 | weaken($_[0]->{$attr_name}); |
42 | } |
43 | $_[0]->{$attr_name}; |
44 | }; |
45 | } |
46 | else { |
34a66aa3 |
47 | if ($self->should_coerce) { |
4b598ea3 |
48 | return sub { |
49 | if (scalar(@_) == 2) { |
a27aa600 |
50 | my $val = $self->type_constraint->coercion->coerce($_[1]); |
51 | (defined $self->type_constraint->check($val)) |
4b598ea3 |
52 | || confess "Attribute ($attr_name) does not pass the type contraint with '$val'" |
53 | if defined $val; |
54 | $_[0]->{$attr_name} = $val; |
55 | } |
56 | $_[0]->{$attr_name}; |
57 | }; |
58 | } |
59 | else { |
60 | return sub { |
61 | if (scalar(@_) == 2) { |
a27aa600 |
62 | (defined $self->type_constraint->check($_[1])) |
4b598ea3 |
63 | || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" |
64 | if defined $_[1]; |
65 | $_[0]->{$attr_name} = $_[1]; |
66 | } |
67 | $_[0]->{$attr_name}; |
68 | }; |
69 | } |
a15dff8d |
70 | } |
71 | } |
72 | else { |
34a66aa3 |
73 | if ($self->is_weak_ref) { |
a15dff8d |
74 | return sub { |
75 | if (scalar(@_) == 2) { |
76 | $_[0]->{$attr_name} = $_[1]; |
77 | weaken($_[0]->{$attr_name}); |
78 | } |
79 | $_[0]->{$attr_name}; |
80 | }; |
81 | } |
82 | else { |
83 | sub { |
84 | $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2; |
85 | $_[0]->{$attr_name}; |
86 | }; |
87 | } |
88 | } |
89 | } |
90 | |
91 | sub generate_writer_method { |
92 | my ($self, $attr_name) = @_; |
93 | if ($self->has_type_constraint) { |
34a66aa3 |
94 | if ($self->is_weak_ref) { |
a15dff8d |
95 | return sub { |
a27aa600 |
96 | (defined $self->type_constraint->check($_[1])) |
5569c072 |
97 | || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" |
a15dff8d |
98 | if defined $_[1]; |
99 | $_[0]->{$attr_name} = $_[1]; |
100 | weaken($_[0]->{$attr_name}); |
101 | }; |
102 | } |
103 | else { |
34a66aa3 |
104 | if ($self->should_coerce) { |
b841b2a3 |
105 | return sub { |
a27aa600 |
106 | my $val = $self->type_constraint->coercion->coerce($_[1]); |
107 | (defined $self->type_constraint->check($val)) |
b841b2a3 |
108 | || confess "Attribute ($attr_name) does not pass the type contraint with '$val'" |
109 | if defined $val; |
110 | $_[0]->{$attr_name} = $val; |
111 | }; |
112 | } |
113 | else { |
114 | return sub { |
a27aa600 |
115 | (defined $self->type_constraint->check($_[1])) |
b841b2a3 |
116 | || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'" |
117 | if defined $_[1]; |
118 | $_[0]->{$attr_name} = $_[1]; |
119 | }; |
120 | } |
a15dff8d |
121 | } |
122 | } |
123 | else { |
34a66aa3 |
124 | if ($self->is_weak_ref) { |
a15dff8d |
125 | return sub { |
126 | $_[0]->{$attr_name} = $_[1]; |
127 | weaken($_[0]->{$attr_name}); |
128 | }; |
129 | } |
130 | else { |
131 | return sub { $_[0]->{$attr_name} = $_[1] }; |
132 | } |
133 | } |
134 | } |
c0e30cf5 |
135 | |
d7f17ebb |
136 | sub generate_reader_method { |
137 | my ($self, $attr_name) = @_; |
138 | sub { |
139 | confess "Cannot assign a value to a read-only accessor" if @_ > 1; |
140 | $_[0]->{$attr_name} |
141 | }; |
142 | } |
143 | |
c0e30cf5 |
144 | 1; |
145 | |
146 | __END__ |
147 | |
148 | =pod |
149 | |
150 | =head1 NAME |
151 | |
6ba6d68c |
152 | Moose::Meta::Attribute - The Moose attribute metaclass |
c0e30cf5 |
153 | |
154 | =head1 DESCRIPTION |
155 | |
e522431d |
156 | This is a subclass of L<Class::MOP::Attribute> with Moose specific |
6ba6d68c |
157 | extensions. |
158 | |
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. |
e522431d |
163 | |
c0e30cf5 |
164 | =head1 METHODS |
165 | |
6ba6d68c |
166 | =head2 Overridden methods |
167 | |
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. |
171 | |
c0e30cf5 |
172 | =over 4 |
173 | |
174 | =item B<new> |
175 | |
a15dff8d |
176 | =item B<generate_accessor_method> |
177 | |
178 | =item B<generate_writer_method> |
179 | |
d7f17ebb |
180 | =item B<generate_reader_method> |
181 | |
a15dff8d |
182 | =back |
183 | |
6ba6d68c |
184 | =head2 Additional Moose features |
185 | |
186 | Moose attributes support type-contstraint checking, weak reference |
187 | creation and type coercion. |
188 | |
a15dff8d |
189 | =over 4 |
190 | |
191 | =item B<has_type_constraint> |
192 | |
6ba6d68c |
193 | Returns true if this meta-attribute has a type constraint. |
194 | |
a15dff8d |
195 | =item B<type_constraint> |
196 | |
6ba6d68c |
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>. |
a15dff8d |
200 | |
6ba6d68c |
201 | =item B<is_weak_ref> |
a15dff8d |
202 | |
6ba6d68c |
203 | Returns true of this meta-attribute produces a weak reference. |
4b598ea3 |
204 | |
34a66aa3 |
205 | =item B<should_coerce> |
4b598ea3 |
206 | |
6ba6d68c |
207 | Returns true of this meta-attribute should perform type coercion. |
208 | |
c0e30cf5 |
209 | =back |
210 | |
211 | =head1 BUGS |
212 | |
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 |
215 | to cpan-RT. |
216 | |
c0e30cf5 |
217 | =head1 AUTHOR |
218 | |
219 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
220 | |
221 | =head1 COPYRIGHT AND LICENSE |
222 | |
223 | Copyright 2006 by Infinity Interactive, Inc. |
224 | |
225 | L<http://www.iinteractive.com> |
226 | |
227 | This library is free software; you can redistribute it and/or modify |
228 | it under the same terms as Perl itself. |
229 | |
230 | =cut |