X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FEmulate%2FClass%2FAccessor%2FFast.pm;h=377eaa0958287dd119d409c3669d44bb88c9d8b9;hb=e8abb6ef66e72c5943e570e94b31b8b6fc4bf321;hp=14509de4d37281286e6bb3d0edc3fbe9602a0134;hpb=c5a105b3850f1901287595ca26c20b9a8144aabf;p=gitmo%2FMooseX-Emulate-Class-Accessor-Fast.git

diff --git a/lib/MooseX/Emulate/Class/Accessor/Fast.pm b/lib/MooseX/Emulate/Class/Accessor/Fast.pm
index 14509de..377eaa0 100644
--- a/lib/MooseX/Emulate/Class/Accessor/Fast.pm
+++ b/lib/MooseX/Emulate/Class/Accessor/Fast.pm
@@ -1,8 +1,8 @@
 package MooseX::Emulate::Class::Accessor::Fast;
 
-use Moose;
+use Moose::Role;
 
-our $VERSION = 0.0001;
+our $VERSION = '0.00400';
 
 =head1 NAME
 
@@ -12,11 +12,10 @@ MooseX::Emulate::Class::Accessor::Fast -
 =head1 SYNOPSYS
 
     package MyClass;
-
-    use base 'MooseX::Emulate::Class::Accessor::Fast';
-    #or
     use Moose;
-    extends 'MooseX::Emulate::Class::Accessor::Fast';
+
+    with 'MooseX::Emulate::Class::Accessor::Fast';
+
 
     #fields with readers and writers
     __PACKAGE__->mk_accessors(qw/field1 field2/);
@@ -32,7 +31,7 @@ This module attempts to emulate the behavior of L<Class::Accessor::Fast> as
 accurately as possible using the Moose attribute system. The public API of
 C<Class::Accessor::Fast> is wholly supported, but the private methods are not.
 If you are only using the public methods (as you should) migration should be a
-matter of switching your C<use base> line.
+matter of switching your C<use base> line to a C<with> line.
 
 While I have attempted to emulate the behavior of Class::Accessor::Fast as closely
 as possible bugs may still be lurking in edge-cases.
@@ -61,6 +60,26 @@ methods in L<Class::MOP::Attribute>. Example
 
 =head1 METHODS
 
+=head2 BUILD $self %args
+
+Change the default Moose class building to emulate the behavior of C::A::F and
+store arguments in the instance hashref.
+
+=cut
+
+sub BUILD {
+  my $self = shift;
+  my %args;
+  if (scalar @_ == 1 && defined $_[0] && ref($_[0]) eq 'HASH') {
+    %args = %{$_[0]};
+  } elsif( scalar(@_) ) {
+    %args = @_;
+  }
+  my @extra = grep { !exists($self->{$_}) } keys %args;
+  @{$self}{@extra} = @args{@extra};
+  return $self;
+}
+
 =head2 mk_accessors @field_names
 
 Create read-write accessors. An attribute named C<$field_name> will be created.
@@ -78,17 +97,23 @@ sub mk_accessors{
   for my $attr_name (@_){
     my $reader = $self->accessor_name_for($attr_name);
     my $writer = $self->mutator_name_for( $attr_name);
+
     #dont overwrite existing methods
-    my @opts = $reader eq $writer ?
-      ( $self->can($reader) ? () : (accessor => $reader) ) :
-        (
-         ( $self->can($reader) ? () : (reader => $reader) ),
-         ( $self->can($writer) ? () : (writer => $writer) ),
-        );
-    $meta->add_attribute($attr_name, @opts);
-
-    $meta->add_method("_${attr_name}_accessor", $self->can($reader) )
-      if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
+    if($reader eq $writer){
+      my %opts = ( $self->can($reader) ? () : (accessor => $reader) );
+      my $attr = $meta->add_attribute($attr_name, %opts);
+      if($attr_name eq $reader){
+        my $alias = "_${attr_name}_accessor";
+        next if $self->can($alias);
+        my @alias_method = $opts{accessor} ? ( $alias => $self->can($reader) )
+          : ( $attr->process_accessors(accessor => $alias, 0 ) );
+        $meta->add_method(@alias_method);
+      }
+    } else {
+      my @opts = ( $self->can($writer) ? () : (writer => $writer) );
+      push(@opts, (reader => $reader)) unless $self->can($reader);
+      $meta->add_attribute($attr_name, @opts);
+    }
   }
 }
 
@@ -103,10 +128,12 @@ sub mk_ro_accessors{
   my $meta = $self->meta;
   for my $attr_name (@_){
     my $reader = $self->accessor_name_for($attr_name);
-    $meta->add_attribute($attr_name,
-                         $self->can($reader) ? () : (reader => $reader) );
-    $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($reader))
-      if($reader eq $attr_name && !$self->can("_${attr_name}_accessor") );
+    my @opts = ($self->can($reader) ? () : (reader => $reader) );
+    my $attr = $meta->add_attribute($attr_name, @opts);
+    if($reader eq $attr_name && $reader eq $self->mutator_name_for($attr_name)){
+      $meta->add_method("_${attr_name}_accessor" => $attr->get_read_method_ref)
+        unless $self->can("_${attr_name}_accessor");
+    }
   }
 }
 
@@ -122,9 +149,12 @@ sub mk_wo_accessors{
   my $meta = $self->meta;
   for my $attr_name (@_){
     my $writer = $self->mutator_name_for($attr_name);
-    $meta->add_attribute($attr_name, $self->can($writer) ? () : (writer => $writer) );
-    $meta->add_method("_${attr_name}_accessor", $meta->find_method_by_name($writer))
-      if($writer eq $attr_name && !$self->can("_${attr_name}_accessor") );
+    my @opts = ($self->can($writer) ? () : (writer => $writer) );
+    my $attr = $meta->add_attribute($attr_name, @opts);
+    if($writer eq $attr_name && $writer eq $self->accessor_name_for($attr_name)){
+      $meta->add_method("_${attr_name}_accessor" => $attr->get_write_method_ref)
+        unless $self->can("_${attr_name}_accessor");
+    }
   }
 }
 
@@ -196,6 +226,36 @@ sub get{
   return @values;
 }
 
+sub make_accessor {
+  my($class, $field) = @_;
+  my $meta = $class->meta;
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  my $reader = $attr->get_read_method_ref;
+  my $writer = $attr->get_write_method_ref;
+  return sub {
+    my $self = shift;
+    return $reader->($self) unless @_;
+    return $writer->($self,(@_ > 1 ? [@_] : @_));
+  }
+}
+
+
+sub make_ro_accessor {
+  my($class, $field) = @_;
+  my $meta = $class->meta;
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  return $attr->get_read_method_ref;
+}
+
+
+sub make_wo_accessor {
+  my($class, $field) = @_;
+  my $meta = $class->meta;
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  return $attr->get_write_method_ref;
+}
+
+
 1;
 
 =head2 meta
@@ -209,9 +269,17 @@ See L<Moose::Meta::Class>.
 L<Moose>, L<Moose::Meta::Attribute>, L<Class::Accessor>, L<Class::Accessor::Fast>,
 L<Class::MOP::Attribute>, L<MooseX::Adopt::Class::Accessor::Fast>
 
-=head1 AUTHOR
+=head1 AUTHORS
+
+Guillermo Roditi (groditi) E<lt>groditi@cpan.orgE<gt>
+
+With contributions from:
+
+=over 4
+
+=item Tomas Doran E<lt>bobtfish@bobtfish.netE<gt>
 
-Guillermo Roditi (groditi) <groditi@cpan.org>
+=back
 
 =head1 LICENSE