1 package MooseX::Emulate::Class::Accessor::Fast;
5 our $VERSION = '0.00400';
9 MooseX::Emulate::Class::Accessor::Fast -
10 Emulate Class::Accessor::Fast behavior using Moose attributes
17 with 'MooseX::Emulate::Class::Accessor::Fast';
20 #fields with readers and writers
21 __PACKAGE__->mk_accessors(qw/field1 field2/);
22 #fields with readers only
23 __PACKAGE__->mk_accessors(qw/field3 field4/);
24 #fields with writers only
25 __PACKAGE__->mk_accessors(qw/field5 field6/);
30 This module attempts to emulate the behavior of L<Class::Accessor::Fast> as
31 accurately as possible using the Moose attribute system. The public API of
32 C<Class::Accessor::Fast> is wholly supported, but the private methods are not.
33 If you are only using the public methods (as you should) migration should be a
34 matter of switching your C<use base> line to a C<with> line.
36 While I have attempted to emulate the behavior of Class::Accessor::Fast as closely
37 as possible bugs may still be lurking in edge-cases.
41 Simple documentation is provided here for your convenience, but for more thorough
42 documentation please see L<Class::Accessor::Fast> and L<Class::Accessor>.
44 =head2 A note about introspection
46 Please note that, at this time, the C<is> flag attribute is not being set. To
47 determine the C<reader> and C<writer> methods using introspection in later versions
48 of L<Class::MOP> ( > 0.38) please use the C<get_read_method> and C<get_write_method>
49 methods in L<Class::MOP::Attribute>. Example
51 # with Class::MOP <= 0.38
52 my $attr = $self->meta->find_attribute_by_name($field_name);
53 my $reader_method = $attr->reader || $attr->accessor;
54 my $writer_method = $attr->writer || $attr->accessor;
56 # with Class::MOP > 0.38
57 my $attr = $self->meta->find_attribute_by_name($field_name);
58 my $reader_method = $attr->get_read_method;
59 my $writer_method = $attr->get_write_method;
63 =head2 BUILD $self %args
65 Change the default Moose class building to emulate the behavior of C::A::F and
66 store arguments in the instance hashref.
73 if (scalar @_ == 1 && defined $_[0] && ref($_[0]) eq 'HASH') {
75 } elsif( scalar(@_) ) {
78 my @extra = grep { !exists($self->{$_}) } keys %args;
79 @{$self}{@extra} = @args{@extra};
83 =head2 mk_accessors @field_names
85 Create read-write accessors. An attribute named C<$field_name> will be created.
86 The name of the c<reader> and C<writer> methods will be determined by the return
87 value of C<accessor_name_for> and C<mutator_name_for>, which by default return the
88 name passed unchanged. If the accessor and mutator names are equal the C<accessor>
89 attribute will be passes to Moose, otherwise the C<reader> and C<writer> attributes
90 will be passed. Please see L<Class::MOP::Attribute> for more information.
96 my $meta = $self->meta;
97 for my $attr_name (@_){
98 my $reader = $self->accessor_name_for($attr_name);
99 my $writer = $self->mutator_name_for( $attr_name);
101 #dont overwrite existing methods
102 if($reader eq $writer){
103 my %opts = ( $self->can($reader) ? () : (accessor => $reader) );
104 my $attr = $meta->add_attribute($attr_name, %opts);
105 if($attr_name eq $reader){
106 my $alias = "_${attr_name}_accessor";
107 next if $self->can($alias);
108 my @alias_method = $opts{accessor} ? ( $alias => $self->can($reader) )
109 : ( $attr->process_accessors(accessor => $alias, 0 ) );
110 $meta->add_method(@alias_method);
113 my @opts = ( $self->can($writer) ? () : (writer => $writer) );
114 push(@opts, (reader => $reader)) unless $self->can($reader);
115 $meta->add_attribute($attr_name, @opts);
120 =head2 mk_ro_accessors @field_names
122 Create read-only accessors.
128 my $meta = $self->meta;
129 for my $attr_name (@_){
130 my $reader = $self->accessor_name_for($attr_name);
131 my @opts = ($self->can($reader) ? () : (reader => $reader) );
132 my $attr = $meta->add_attribute($attr_name, @opts);
133 if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){
134 $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref)
135 unless $self->can("_${attr_name}_accessor");
140 =head2 mk_ro_accessors @field_names
142 Create write-only accessors.
146 #this is retarded.. but we need it for compatibility or whatever.
149 my $meta = $self->meta;
150 for my $attr_name (@_){
151 my $writer = $self->mutator_name_for($attr_name);
152 my @opts = ($self->can($writer) ? () : (writer => $writer) );
153 my $attr = $meta->add_attribute($attr_name, @opts);
154 if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){
155 $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref)
156 unless $self->can("_${attr_name}_accessor");
161 =head2 follow_best_practices
163 Preface readers with 'get_' and writers with 'set_'.
164 See original L<Class::Accessor> documentation for more information.
168 sub follow_best_practice{
170 my $meta = $self->meta;
172 $meta->remove_method('mutator_name_for');
173 $meta->remove_method('accessor_name_for');
174 $meta->add_method('mutator_name_for', sub{ return "set_".$_[1] });
175 $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] });
178 =head2 mutator_name_for
180 =head2 accessor_name_for
182 See original L<Class::Accessor> documentation for more information.
186 sub mutator_name_for{ return $_[1] }
187 sub accessor_name_for{ return $_[1] }
191 See original L<Class::Accessor> documentation for more information.
198 confess "Wrong number of arguments received" unless scalar @_;
200 #my $writer = $self->mutator_name_for( $k );
201 confess "No such attribute '$k'"
202 unless ( my $attr = $self->meta->find_attribute_by_name($k) );
203 my $writer = $attr->writer || $attr->accessor;
204 $self->$writer(@_ > 1 ? [@_] : @_);
209 See original L<Class::Accessor> documentation for more information.
215 confess "Wrong number of arguments received" unless scalar @_;
218 #while( my $attr = $self->meta->find_attribute_by_name( shift(@_) ){
220 confess "No such attribute '$_'"
221 unless ( my $attr = $self->meta->find_attribute_by_name($_) );
222 my $reader = $attr->reader || $attr->accessor;
223 @_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
230 my($class, $field) = @_;
231 my $meta = $class->meta;
232 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
233 my $reader = $attr->get_read_method_ref;
234 my $writer = $attr->get_write_method_ref;
237 return $self->$reader unless @_;
238 return $self->$writer((@_ > 1 ? [@_] : @_));
243 sub make_ro_accessor {
244 my($class, $field) = @_;
245 my $meta = $class->meta;
246 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
247 return $attr->get_read_method_ref;
251 sub make_wo_accessor {
252 my($class, $field) = @_;
253 my $meta = $class->meta;
254 my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field);
255 return $attr->get_write_method_ref;
263 See L<Moose::Meta::Class>.
269 L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>,
270 L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast>
274 Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
276 With contributions from:
280 =item Tomas Doran E<lt>bobtfish@bobtfish.netE<gt>
286 You may distribute this code under the same terms as Perl itself.