1 package MooseX::Emulate::Class::Accessor::Fast;
7 our $VERSION = '0.00700';
11 MooseX::Emulate::Class::Accessor::Fast -
12 Emulate Class::Accessor::Fast behavior using Moose attributes
19 with 'MooseX::Emulate::Class::Accessor::Fast';
22 #fields with readers and writers
23 __PACKAGE__->mk_accessors(qw/field1 field2/);
24 #fields with readers only
25 __PACKAGE__->mk_accessors(qw/field3 field4/);
26 #fields with writers only
27 __PACKAGE__->mk_accessors(qw/field5 field6/);
32 This module attempts to emulate the behavior of L<Class::Accessor::Fast> as
33 accurately as possible using the Moose attribute system. The public API of
34 C<Class::Accessor::Fast> is wholly supported, but the private methods are not.
35 If you are only using the public methods (as you should) migration should be a
36 matter of switching your C<use base> line to a C<with> line.
38 While I have attempted to emulate the behavior of Class::Accessor::Fast as closely
39 as possible bugs may still be lurking in edge-cases.
43 Simple documentation is provided here for your convenience, but for more thorough
44 documentation please see L<Class::Accessor::Fast> and L<Class::Accessor>.
46 =head2 A note about introspection
48 Please note that, at this time, the C<is> flag attribute is not being set. To
49 determine the C<reader> and C<writer> methods using introspection in later versions
50 of L<Class::MOP> ( > 0.38) please use the C<get_read_method> and C<get_write_method>
51 methods in L<Class::MOP::Attribute>. Example
53 # with Class::MOP <= 0.38
54 my $attr = $self->meta->find_attribute_by_name($field_name);
55 my $reader_method = $attr->reader || $attr->accessor;
56 my $writer_method = $attr->writer || $attr->accessor;
58 # with Class::MOP > 0.38
59 my $attr = $self->meta->find_attribute_by_name($field_name);
60 my $reader_method = $attr->get_read_method;
61 my $writer_method = $attr->get_write_method;
65 =head2 BUILD $self %args
67 Change the default Moose class building to emulate the behavior of C::A::F and
68 store arguments in the instance hashref.
72 my $locate_metaclass = sub {
73 my $class = Scalar::Util::blessed($_[0]) || $_[0];
74 return Class::MOP::get_metaclass_by_name($class)
75 || Moose::Meta::Class->initialize($class);
81 if (scalar @_ == 1 && defined $_[0] && ref($_[0]) eq 'HASH') {
83 } elsif( scalar(@_) ) {
86 my @extra = grep { !exists($self->{$_}) } keys %args;
87 @{$self}{@extra} = @args{@extra};
91 =head2 mk_accessors @field_names
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.
104 my $meta = $locate_metaclass->($self);
105 for my $attr_name (@_){
106 $meta->remove_attribute($attr_name)
107 if $meta->find_attribute_by_name($attr_name);
108 my $reader = $self->accessor_name_for($attr_name);
109 my $writer = $self->mutator_name_for( $attr_name);
111 #dont overwrite existing methods
112 if($reader eq $writer){
113 my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) );
114 my $attr = $meta->add_attribute($attr_name, %opts);
115 if($attr_name eq $reader){
116 my $alias = "_${attr_name}_accessor";
117 next if $meta->has_method($alias);
118 my @alias_method = $attr->process_accessors(accessor => $alias, 0);
119 $meta->add_method(@alias_method);
122 my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) );
123 push(@opts, (reader => $reader)) unless $meta->has_method($reader);
124 $meta->add_attribute($attr_name, @opts);
129 =head2 mk_ro_accessors @field_names
131 Create read-only accessors.
137 my $meta = $locate_metaclass->($self);
138 for my $attr_name (@_){
139 $meta->remove_attribute($attr_name)
140 if $meta->find_attribute_by_name($attr_name);
141 my $reader = $self->accessor_name_for($attr_name);
142 my @opts = ($meta->has_method($reader) ? () : (reader => $reader) );
143 my $attr = $meta->add_attribute($attr_name, @opts);
144 if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){
145 $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref)
146 unless $meta->has_method("_${attr_name}_accessor");
151 =head2 mk_ro_accessors @field_names
153 Create write-only accessors.
157 #this is retarded.. but we need it for compatibility or whatever.
160 my $meta = $locate_metaclass->($self);
161 for my $attr_name (@_){
162 $meta->remove_attribute($attr_name)
163 if $meta->find_attribute_by_name($attr_name);
164 my $writer = $self->mutator_name_for($attr_name);
165 my @opts = ($meta->has_method($writer) ? () : (writer => $writer) );
166 my $attr = $meta->add_attribute($attr_name, @opts);
167 if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){
168 $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref)
169 unless $meta->has_method("_${attr_name}_accessor");
174 =head2 follow_best_practices
176 Preface readers with 'get_' and writers with 'set_'.
177 See original L<Class::Accessor> documentation for more information.
181 sub follow_best_practice{
183 my $meta = $locate_metaclass->($self);
185 $meta->remove_method('mutator_name_for');
186 $meta->remove_method('accessor_name_for');
187 $meta->add_method('mutator_name_for', sub{ return "set_".$_[1] });
188 $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] });
191 =head2 mutator_name_for
193 =head2 accessor_name_for
195 See original L<Class::Accessor> documentation for more information.
199 sub mutator_name_for{ return $_[1] }
200 sub accessor_name_for{ return $_[1] }
204 See original L<Class::Accessor> documentation for more information.
211 confess "Wrong number of arguments received" unless scalar @_;
212 my $meta = $locate_metaclass->($self);
214 confess "No such attribute '$k'"
215 unless ( my $attr = $meta->find_attribute_by_name($k) );
216 my $writer = $attr->get_write_method;
217 $self->$writer(@_ > 1 ? [@_] : @_);
222 See original L<Class::Accessor> documentation for more information.
228 confess "Wrong number of arguments received" unless scalar @_;
229 my $meta = $locate_metaclass->($self);
233 confess "No such attribute '$_'"
234 unless ( my $attr = $meta->find_attribute_by_name($_) );
235 my $reader = $attr->get_read_method;
236 @_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
243 my($class, $field) = @_;
244 my $meta = $locate_metaclass->($class);
245 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
246 my $reader = $attr->get_read_method_ref;
247 my $writer = $attr->get_write_method_ref;
250 return $reader->($self) unless @_;
251 return $writer->($self,(@_ > 1 ? [@_] : @_));
256 sub make_ro_accessor {
257 my($class, $field) = @_;
258 my $meta = $locate_metaclass->($class);
259 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
260 return $attr->get_read_method_ref;
264 sub make_wo_accessor {
265 my($class, $field) = @_;
266 my $meta = $locate_metaclass->($class);
267 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
268 return $attr->get_write_method_ref;
275 See L<Moose::Meta::Class>.
281 L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>,
282 L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast>
286 Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
288 With contributions from:
292 =item Tomas Doran E<lt>bobtfish@bobtfish.netE<gt>
298 You may distribute this code under the same terms as Perl itself.