1 package MooseX::Emulate::Class::Accessor::Fast;
7 use MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor ();
9 our $VERSION = '0.00801';
13 MooseX::Emulate::Class::Accessor::Fast - Emulate Class::Accessor::Fast behavior using Moose attributes
20 with 'MooseX::Emulate::Class::Accessor::Fast';
23 #fields with readers and writers
24 __PACKAGE__->mk_accessors(qw/field1 field2/);
25 #fields with readers only
26 __PACKAGE__->mk_ro_accessors(qw/field3 field4/);
27 #fields with writers only
28 __PACKAGE__->mk_wo_accessors(qw/field5 field6/);
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
37 matter of switching your C<use base> line to a C<with> line.
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.
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>.
47 =head2 A note about introspection
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
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;
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;
66 =head2 BUILD $self %args
68 Change the default Moose class building to emulate the behavior of C::A::F and
69 store arguments in the instance hashref.
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);
82 if (scalar @_ == 1 && defined $_[0] && ref($_[0]) eq 'HASH') {
84 } elsif( scalar(@_) ) {
87 my @extra = grep { !exists($self->{$_}) } keys %args;
88 @{$self}{@extra} = @args{@extra};
92 =head2 mk_accessors @field_names
94 Create read-write accessors. An attribute named C<$field_name> will be created.
95 The name of the c<reader> and C<writer> methods will be determined by the return
96 value of C<accessor_name_for> and C<mutator_name_for>, which by default return the
97 name passed unchanged. If the accessor and mutator names are equal the C<accessor>
98 attribute will be passes to Moose, otherwise the C<reader> and C<writer> attributes
99 will be passed. Please see L<Class::MOP::Attribute> for more information.
105 my $meta = $locate_metaclass->($self);
106 my $class = $meta->name;
107 confess("You are trying to modify ${class}, which has been made immutable, this is ".
108 "not supported. Try subclassing ${class}, rather than monkeypatching it")
109 if $meta->is_immutable;
111 for my $attr_name (@_){
112 $meta->remove_attribute($attr_name)
113 if $meta->find_attribute_by_name($attr_name);
114 my $reader = $self->accessor_name_for($attr_name);
115 my $writer = $self->mutator_name_for( $attr_name);
117 #dont overwrite existing methods
118 if($reader eq $writer){
119 my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) );
120 my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, %opts,
121 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
123 if($attr_name eq $reader){
124 my $alias = "_${attr_name}_accessor";
125 next if $meta->has_method($alias);
126 $meta->add_method($alias => $attr->get_read_method_ref);
129 my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) );
130 push(@opts, (reader => $reader)) unless $meta->has_method($reader);
131 my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, @opts,
132 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
138 =head2 mk_ro_accessors @field_names
140 Create read-only accessors.
144 sub mk_ro_accessors {
146 my $meta = $locate_metaclass->($self);
147 my $class = $meta->name;
148 confess("You are trying to modify ${class}, which has been made immutable, this is ".
149 "not supported. Try subclassing ${class}, rather than monkeypatching it")
150 if $meta->is_immutable;
151 for my $attr_name (@_){
152 $meta->remove_attribute($attr_name)
153 if $meta->find_attribute_by_name($attr_name);
154 my $reader = $self->accessor_name_for($attr_name);
155 my @opts = ($meta->has_method($reader) ? () : (reader => $reader) );
156 my $attr = $meta->add_attribute($attr_name, @opts,
157 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
159 if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){
160 $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref)
161 unless $meta->has_method("_${attr_name}_accessor");
166 =head2 mk_ro_accessors @field_names
168 Create write-only accessors.
172 #this is retarded.. but we need it for compatibility or whatever.
173 sub mk_wo_accessors {
175 my $meta = $locate_metaclass->($self);
176 my $class = $meta->name;
177 confess("You are trying to modify ${class}, which has been made immutable, this is ".
178 "not supported. Try subclassing ${class}, rather than monkeypatching it")
179 if $meta->is_immutable;
180 for my $attr_name (@_){
181 $meta->remove_attribute($attr_name)
182 if $meta->find_attribute_by_name($attr_name);
183 my $writer = $self->mutator_name_for($attr_name);
184 my @opts = ($meta->has_method($writer) ? () : (writer => $writer) );
185 my $attr = $meta->add_attribute($attr_name, @opts,
186 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
188 if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){
189 $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref)
190 unless $meta->has_method("_${attr_name}_accessor");
195 =head2 follow_best_practices
197 Preface readers with 'get_' and writers with 'set_'.
198 See original L<Class::Accessor> documentation for more information.
202 sub follow_best_practice {
204 my $meta = $locate_metaclass->($self);
206 $meta->remove_method('mutator_name_for');
207 $meta->remove_method('accessor_name_for');
208 $meta->add_method('mutator_name_for', sub{ return "set_".$_[1] });
209 $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] });
212 =head2 mutator_name_for
214 =head2 accessor_name_for
216 See original L<Class::Accessor> documentation for more information.
220 sub mutator_name_for { return $_[1] }
221 sub accessor_name_for { return $_[1] }
225 See original L<Class::Accessor> documentation for more information.
232 confess "Wrong number of arguments received" unless scalar @_;
233 my $meta = $locate_metaclass->($self);
235 confess "No such attribute '$k'"
236 unless ( my $attr = $meta->find_attribute_by_name($k) );
237 my $writer = $attr->get_write_method;
238 $self->$writer(@_ > 1 ? [@_] : @_);
243 See original L<Class::Accessor> documentation for more information.
249 confess "Wrong number of arguments received" unless scalar @_;
250 my $meta = $locate_metaclass->($self);
254 confess "No such attribute '$_'"
255 unless ( my $attr = $meta->find_attribute_by_name($_) );
256 my $reader = $attr->get_read_method;
257 @_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
264 my($class, $field) = @_;
265 my $meta = $locate_metaclass->($class);
266 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field,
267 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
269 my $reader = $attr->get_read_method_ref;
270 my $writer = $attr->get_write_method_ref;
273 return $reader->($self) unless @_;
274 return $writer->($self,(@_ > 1 ? [@_] : @_));
279 sub make_ro_accessor {
280 my($class, $field) = @_;
281 my $meta = $locate_metaclass->($class);
282 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field,
283 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
285 return $attr->get_read_method_ref;
289 sub make_wo_accessor {
290 my($class, $field) = @_;
291 my $meta = $locate_metaclass->($class);
292 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field,
293 traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
295 return $attr->get_write_method_ref;
302 See L<Moose::Meta::Class>.
308 L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>,
309 L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast>
313 Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
315 With contributions from:
319 =item Tomas Doran (t0m) E<lt>bobtfish@bobtfish.netE<gt>
321 =item Florian Ragwitz (rafl) E<lt>rafl@debian.orgE<gt>
327 You may distribute this code under the same terms as Perl itself.