1 package MooseX::Emulate::Class::Accessor::Fast;
9 MooseX::Emulate::Class::Accessor::Fast -
10 Emulate Class::Accessor::Fast behavior using Moose attributes
16 use base 'MooseX::Emulate::Class::Accessor::Fast';
19 extends 'MooseX::Emulate::Class::Accessor::Fast';
21 #fields with readers and writers
22 __PACKAGE__->mk_accessors(qw/field1 field2/);
23 #fields with readers only
24 __PACKAGE__->mk_accessors(qw/field3 field4/);
25 #fields with writers only
26 __PACKAGE__->mk_accessors(qw/field5 field6/);
31 This module attempts to emulate the behavior of L<Class::Accessor::Fast> as
32 accurately as possible using the Moose attribute system. The public API of
33 C<Class::Accessor::Fast> is wholly supported, but the private methods are not.
34 If you are only using the public methods (as you should) migration should be a
35 matter of switching your C<use base> line.
37 While I have attempted to emulate the behavior of Class::Accessor::Fast as closely
38 as possible bugs may still be lurking in edge-cases.
42 Simple documentation is provided here for your convenience, but for more thorough
43 documentation please see L<Class::Accessor::Fast> and L<Class::Accessor>.
45 =head2 A note about introspection
47 Please note that, at this time, the C<is> flag attribute is not being set. To
48 determine the C<reader> and C<writer> methods using introspection in later versions
49 of L<Class::MOP> ( > 0.38) please use the C<get_read_method> and C<get_write_method>
50 methods in L<Class::MOP::Attribute>. Example
52 # with Class::MOP <= 0.38
53 my $attr = $self->meta->find_attribute_by_name($field_name);
54 my $reader_method = $attr->reader || $attr->accessor;
55 my $writer_method = $attr->writer || $attr->accessor;
57 # with Class::MOP > 0.38
58 my $attr = $self->meta->find_attribute_by_name($field_name);
59 my $reader_method = $attr->get_read_method;
60 my $writer_method = $attr->get_write_method;
64 =head2 mk_accessors @field_names
66 Create read-write accessors. An attribute named C<$field_name> will be created.
67 The name of the c<reader> and C<writer> methods will be determined by the return
68 value of C<accessor_name_for> and C<mutator_name_for>, which by default return the
69 name passed unchanged. If the accessor and mutator names are equal the C<accessor>
70 attribute will be passes to Moose, otherwise the C<reader> and C<writer> attributes
71 will be passed. Please see L<Class::MOP::Attribute> for more information.
77 my $meta = $self->meta;
78 for my $attr_name (@_){
79 my $reader = $self->accessor_name_for($attr_name);
80 my $writer = $self->mutator_name_for( $attr_name);
81 #dont overwrite existing methods
82 my @opts = $reader eq $writer ?
83 ( $self->can($reader) ? () : (accessor => $reader) ) :
85 ( $self->can($reader) ? () : (reader => $reader) ),
86 ( $self->can($writer) ? () : (writer => $writer) ),
88 $meta->add_attribute($attr_name, @opts);
90 $meta->add_method("_${attr_name}_accessor", $self->can($reader) )
91 if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
95 =head2 mk_ro_accessors @field_names
97 Create read-only accessors.
103 my $meta = $self->meta;
104 for my $attr_name (@_){
105 my $reader = $self->accessor_name_for($attr_name);
106 $meta->add_attribute($attr_name,
107 $self->can($reader) ? () : (reader => $reader) );
108 $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($reader))
109 if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
113 =head2 mk_ro_accessors @field_names
115 Create write-only accessors.
119 #this is retarded.. but we need it for compatibility or whatever.
122 my $meta = $self->meta;
123 for my $attr_name (@_){
124 my $writer = $self->mutator_name_for($attr_name);
125 $meta->add_attribute($attr_name, $self->can($writer) ? () : (writer => $writer) );
126 $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($writer))
127 if($writer eq $attr_name && !$self->can("_${attr_name}_accessor") );
131 =head2 follow_best_practices
133 Preface readers with 'get_' and writers with 'set_'.
134 See original L<Class::Accessor> documentation for more information.
138 sub follow_best_practice{
140 my $meta = $self->meta;
142 $meta->remove_method('mutator_name_for');
143 $meta->remove_method('accessor_name_for');
144 $meta->add_method('mutator_name_for', sub{ return "set_".$_[1] });
145 $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] });
148 =head2 mutator_name_for
150 =head2 accessor_name_for
152 See original L<Class::Accessor> documentation for more information.
156 sub mutator_name_for{ return $_[1] }
157 sub accessor_name_for{ return $_[1] }
161 See original L<Class::Accessor> documentation for more information.
168 confess "Wrong number of arguments received" unless scalar @_;
170 #my $writer = $self->mutator_name_for( $k );
171 confess "No such attribute '$k'"
172 unless ( my $attr = $self->meta->find_attribute_by_name($k) );
173 my $writer = $attr->writer || $attr->accessor;
174 $self->$writer(@_ > 1 ? [@_] : @_);
179 See original L<Class::Accessor> documentation for more information.
185 confess "Wrong number of arguments received" unless scalar @_;
188 #while( my $attr = $self->meta->find_attribute_by_name( shift(@_) ){
190 confess "No such attribute '$_'"
191 unless ( my $attr = $self->meta->find_attribute_by_name($_) );
192 my $reader = $attr->reader || $attr->accessor;
193 @_ > 1 ? push(@values, $self->$reader) : return $self->$reader;
203 See L<Moose::Meta::Class>.
209 L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>,
210 L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast>
214 Guillermo Roditi (groditi) <groditi@cpan.org>
218 You may distribute this code under the same terms as Perl itself.