Commit | Line | Data |
c5a105b3 |
1 | package MooseX::Emulate::Class::Accessor::Fast; |
2 | |
e579fc46 |
3 | use Moose::Role; |
5a6e3389 |
4 | use Class::MOP (); |
5 | use Scalar::Util (); |
c5a105b3 |
6 | |
b41ad5fb |
7 | use MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor (); |
8 | |
5475faec |
9 | our $VERSION = '0.00802'; |
c5a105b3 |
10 | |
11 | =head1 NAME |
12 | |
736d6822 |
13 | MooseX::Emulate::Class::Accessor::Fast - Emulate Class::Accessor::Fast behavior using Moose attributes |
c5a105b3 |
14 | |
15 | =head1 SYNOPSYS |
16 | |
17 | package MyClass; |
144866f7 |
18 | use Moose; |
e579fc46 |
19 | |
20 | with 'MooseX::Emulate::Class::Accessor::Fast'; |
c5a105b3 |
21 | |
c5a105b3 |
22 | |
23 | #fields with readers and writers |
24 | __PACKAGE__->mk_accessors(qw/field1 field2/); |
25 | #fields with readers only |
5e2dfe0a |
26 | __PACKAGE__->mk_ro_accessors(qw/field3 field4/); |
c5a105b3 |
27 | #fields with writers only |
5e2dfe0a |
28 | __PACKAGE__->mk_wo_accessors(qw/field5 field6/); |
c5a105b3 |
29 | |
30 | |
31 | =head1 DESCRIPTION |
32 | |
33 | This module attempts to emulate the behavior of L<Class::Accessor::Fast> as |
34 | accurately as possible using the Moose attribute system. The public API of |
35 | C<Class::Accessor::Fast> is wholly supported, but the private methods are not. |
36 | If you are only using the public methods (as you should) migration should be a |
e579fc46 |
37 | matter of switching your C<use base> line to a C<with> line. |
c5a105b3 |
38 | |
39 | While I have attempted to emulate the behavior of Class::Accessor::Fast as closely |
40 | as possible bugs may still be lurking in edge-cases. |
41 | |
42 | =head1 BEHAVIOR |
43 | |
44 | Simple documentation is provided here for your convenience, but for more thorough |
45 | documentation please see L<Class::Accessor::Fast> and L<Class::Accessor>. |
46 | |
47 | =head2 A note about introspection |
48 | |
49 | Please note that, at this time, the C<is> flag attribute is not being set. To |
50 | determine the C<reader> and C<writer> methods using introspection in later versions |
51 | of L<Class::MOP> ( > 0.38) please use the C<get_read_method> and C<get_write_method> |
52 | methods in L<Class::MOP::Attribute>. Example |
53 | |
54 | # with Class::MOP <= 0.38 |
55 | my $attr = $self->meta->find_attribute_by_name($field_name); |
56 | my $reader_method = $attr->reader || $attr->accessor; |
57 | my $writer_method = $attr->writer || $attr->accessor; |
58 | |
59 | # with Class::MOP > 0.38 |
60 | my $attr = $self->meta->find_attribute_by_name($field_name); |
61 | my $reader_method = $attr->get_read_method; |
62 | my $writer_method = $attr->get_write_method; |
63 | |
64 | =head1 METHODS |
65 | |
144866f7 |
66 | =head2 BUILD $self %args |
6b8ba79f |
67 | |
144866f7 |
68 | Change the default Moose class building to emulate the behavior of C::A::F and |
6b8ba79f |
69 | store arguments in the instance hashref. |
70 | |
71 | =cut |
72 | |
5a6e3389 |
73 | my $locate_metaclass = sub { |
74 | my $class = Scalar::Util::blessed($_[0]) || $_[0]; |
75 | return Class::MOP::get_metaclass_by_name($class) |
76 | || Moose::Meta::Class->initialize($class); |
77 | }; |
78 | |
c7120a5c |
79 | sub BUILD { } |
db88e89a |
80 | |
81 | around 'BUILD' => sub { |
82 | my $orig = shift; |
144866f7 |
83 | my $self = shift; |
db88e89a |
84 | my %args = %{ $_[0] }; |
c7120a5c |
85 | $self->$orig(\%args); |
6b8ba79f |
86 | my @extra = grep { !exists($self->{$_}) } keys %args; |
87 | @{$self}{@extra} = @args{@extra}; |
88 | return $self; |
db88e89a |
89 | }; |
6b8ba79f |
90 | |
c5a105b3 |
91 | =head2 mk_accessors @field_names |
92 | |
93 | Create read-write accessors. An attribute named C<$field_name> will be created. |
94 | The name of the c<reader> and C<writer> methods will be determined by the return |
95 | value of C<accessor_name_for> and C<mutator_name_for>, which by default return the |
96 | name passed unchanged. If the accessor and mutator names are equal the C<accessor> |
97 | attribute will be passes to Moose, otherwise the C<reader> and C<writer> attributes |
98 | will be passed. Please see L<Class::MOP::Attribute> for more information. |
99 | |
100 | =cut |
101 | |
6b6bc6e8 |
102 | sub mk_accessors { |
c5a105b3 |
103 | my $self = shift; |
5a6e3389 |
104 | my $meta = $locate_metaclass->($self); |
b3050bf2 |
105 | my $class = $meta->name; |
106 | confess("You are trying to modify ${class}, which has been made immutable, this is ". |
107 | "not supported. Try subclassing ${class}, rather than monkeypatching it") |
108 | if $meta->is_immutable; |
109 | |
c5a105b3 |
110 | for my $attr_name (@_){ |
54a5b50a |
111 | $meta->remove_attribute($attr_name) |
112 | if $meta->find_attribute_by_name($attr_name); |
c5a105b3 |
113 | my $reader = $self->accessor_name_for($attr_name); |
114 | my $writer = $self->mutator_name_for( $attr_name); |
30cbeb5e |
115 | |
c5a105b3 |
116 | #dont overwrite existing methods |
30cbeb5e |
117 | if($reader eq $writer){ |
5a6e3389 |
118 | my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) ); |
b41ad5fb |
119 | my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, %opts, |
120 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
121 | ); |
30cbeb5e |
122 | if($attr_name eq $reader){ |
123 | my $alias = "_${attr_name}_accessor"; |
5a6e3389 |
124 | next if $meta->has_method($alias); |
18991513 |
125 | $meta->add_method($alias => $attr->get_read_method_ref); |
30cbeb5e |
126 | } |
127 | } else { |
5a6e3389 |
128 | my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) ); |
129 | push(@opts, (reader => $reader)) unless $meta->has_method($reader); |
b41ad5fb |
130 | my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, @opts, |
131 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
132 | ); |
30cbeb5e |
133 | } |
c5a105b3 |
134 | } |
135 | } |
136 | |
137 | =head2 mk_ro_accessors @field_names |
138 | |
139 | Create read-only accessors. |
140 | |
141 | =cut |
142 | |
6b6bc6e8 |
143 | sub mk_ro_accessors { |
c5a105b3 |
144 | my $self = shift; |
5a6e3389 |
145 | my $meta = $locate_metaclass->($self); |
b3050bf2 |
146 | my $class = $meta->name; |
147 | confess("You are trying to modify ${class}, which has been made immutable, this is ". |
148 | "not supported. Try subclassing ${class}, rather than monkeypatching it") |
149 | if $meta->is_immutable; |
c5a105b3 |
150 | for my $attr_name (@_){ |
54a5b50a |
151 | $meta->remove_attribute($attr_name) |
152 | if $meta->find_attribute_by_name($attr_name); |
c5a105b3 |
153 | my $reader = $self->accessor_name_for($attr_name); |
5a6e3389 |
154 | my @opts = ($meta->has_method($reader) ? () : (reader => $reader) ); |
b41ad5fb |
155 | my $attr = $meta->add_attribute($attr_name, @opts, |
156 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
157 | ) if scalar(@opts); |
30cbeb5e |
158 | if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){ |
159 | $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref) |
5a6e3389 |
160 | unless $meta->has_method("_${attr_name}_accessor"); |
30cbeb5e |
161 | } |
c5a105b3 |
162 | } |
163 | } |
164 | |
165 | =head2 mk_ro_accessors @field_names |
166 | |
167 | Create write-only accessors. |
168 | |
169 | =cut |
170 | |
171 | #this is retarded.. but we need it for compatibility or whatever. |
6b6bc6e8 |
172 | sub mk_wo_accessors { |
c5a105b3 |
173 | my $self = shift; |
5a6e3389 |
174 | my $meta = $locate_metaclass->($self); |
b3050bf2 |
175 | my $class = $meta->name; |
176 | confess("You are trying to modify ${class}, which has been made immutable, this is ". |
177 | "not supported. Try subclassing ${class}, rather than monkeypatching it") |
178 | if $meta->is_immutable; |
c5a105b3 |
179 | for my $attr_name (@_){ |
54a5b50a |
180 | $meta->remove_attribute($attr_name) |
181 | if $meta->find_attribute_by_name($attr_name); |
c5a105b3 |
182 | my $writer = $self->mutator_name_for($attr_name); |
5a6e3389 |
183 | my @opts = ($meta->has_method($writer) ? () : (writer => $writer) ); |
b41ad5fb |
184 | my $attr = $meta->add_attribute($attr_name, @opts, |
185 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
186 | ) if scalar(@opts); |
30cbeb5e |
187 | if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){ |
188 | $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref) |
5a6e3389 |
189 | unless $meta->has_method("_${attr_name}_accessor"); |
30cbeb5e |
190 | } |
c5a105b3 |
191 | } |
192 | } |
193 | |
194 | =head2 follow_best_practices |
195 | |
196 | Preface readers with 'get_' and writers with 'set_'. |
197 | See original L<Class::Accessor> documentation for more information. |
198 | |
199 | =cut |
200 | |
6b6bc6e8 |
201 | sub follow_best_practice { |
c5a105b3 |
202 | my $self = shift; |
5a6e3389 |
203 | my $meta = $locate_metaclass->($self); |
c5a105b3 |
204 | |
205 | $meta->remove_method('mutator_name_for'); |
206 | $meta->remove_method('accessor_name_for'); |
207 | $meta->add_method('mutator_name_for', sub{ return "set_".$_[1] }); |
208 | $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] }); |
209 | } |
210 | |
211 | =head2 mutator_name_for |
212 | |
213 | =head2 accessor_name_for |
214 | |
215 | See original L<Class::Accessor> documentation for more information. |
216 | |
217 | =cut |
218 | |
6b6bc6e8 |
219 | sub mutator_name_for { return $_[1] } |
220 | sub accessor_name_for { return $_[1] } |
c5a105b3 |
221 | |
222 | =head2 set |
223 | |
224 | See original L<Class::Accessor> documentation for more information. |
225 | |
226 | =cut |
227 | |
6b6bc6e8 |
228 | sub set { |
c5a105b3 |
229 | my $self = shift; |
230 | my $k = shift; |
231 | confess "Wrong number of arguments received" unless scalar @_; |
5a6e3389 |
232 | my $meta = $locate_metaclass->($self); |
c5a105b3 |
233 | |
c5a105b3 |
234 | confess "No such attribute '$k'" |
5a6e3389 |
235 | unless ( my $attr = $meta->find_attribute_by_name($k) ); |
236 | my $writer = $attr->get_write_method; |
c5a105b3 |
237 | $self->$writer(@_ > 1 ? [@_] : @_); |
238 | } |
239 | |
240 | =head2 get |
241 | |
242 | See original L<Class::Accessor> documentation for more information. |
243 | |
244 | =cut |
245 | |
6b6bc6e8 |
246 | sub get { |
c5a105b3 |
247 | my $self = shift; |
248 | confess "Wrong number of arguments received" unless scalar @_; |
5a6e3389 |
249 | my $meta = $locate_metaclass->($self); |
c5a105b3 |
250 | my @values; |
5a6e3389 |
251 | |
c5a105b3 |
252 | for( @_ ){ |
253 | confess "No such attribute '$_'" |
5a6e3389 |
254 | unless ( my $attr = $meta->find_attribute_by_name($_) ); |
255 | my $reader = $attr->get_read_method; |
c5a105b3 |
256 | @_ > 1 ? push(@values, $self->$reader) : return $self->$reader; |
257 | } |
258 | |
259 | return @values; |
260 | } |
261 | |
8eb9108b |
262 | sub make_accessor { |
263 | my($class, $field) = @_; |
5a6e3389 |
264 | my $meta = $locate_metaclass->($class); |
b41ad5fb |
265 | my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field, |
266 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
267 | ); |
8eb9108b |
268 | my $reader = $attr->get_read_method_ref; |
269 | my $writer = $attr->get_write_method_ref; |
270 | return sub { |
271 | my $self = shift; |
e8abb6ef |
272 | return $reader->($self) unless @_; |
273 | return $writer->($self,(@_ > 1 ? [@_] : @_)); |
8eb9108b |
274 | } |
275 | } |
276 | |
277 | |
278 | sub make_ro_accessor { |
279 | my($class, $field) = @_; |
5a6e3389 |
280 | my $meta = $locate_metaclass->($class); |
b41ad5fb |
281 | my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field, |
282 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
283 | ); |
8eb9108b |
284 | return $attr->get_read_method_ref; |
285 | } |
286 | |
287 | |
288 | sub make_wo_accessor { |
289 | my($class, $field) = @_; |
5a6e3389 |
290 | my $meta = $locate_metaclass->($class); |
b41ad5fb |
291 | my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field, |
292 | traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'] |
293 | ); |
8eb9108b |
294 | return $attr->get_write_method_ref; |
295 | } |
296 | |
c5a105b3 |
297 | 1; |
298 | |
299 | =head2 meta |
300 | |
301 | See L<Moose::Meta::Class>. |
302 | |
303 | =cut |
304 | |
305 | =head1 SEE ALSO |
306 | |
307 | L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>, |
308 | L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast> |
309 | |
d82bc8be |
310 | =head1 AUTHORS |
c5a105b3 |
311 | |
7ed9430a |
312 | Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt> |
c5a105b3 |
313 | |
d82bc8be |
314 | With contributions from: |
315 | |
316 | =over 4 |
317 | |
986ca883 |
318 | =item Tomas Doran (t0m) E<lt>bobtfish@bobtfish.netE<gt> |
319 | |
320 | =item Florian Ragwitz (rafl) E<lt>rafl@debian.orgE<gt> |
d82bc8be |
321 | |
322 | =back |
323 | |
c5a105b3 |
324 | =head1 LICENSE |
325 | |
326 | You may distribute this code under the same terms as Perl itself. |
327 | |
328 | =cut |