X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FEmulate%2FClass%2FAccessor%2FFast.pm;h=4047c0df246efc490e148a2c066b41d3333e2be9;hb=5e2dfe0a3e5d99f248bbf30df7cd40878fe83f03;hp=0f1fbdd9db4718bb3b0f9ab9f7f234dc5e2a1402;hpb=5a6e3389d072389c7d9a798a1b35c4cfa86012f3;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 0f1fbdd..4047c0d 100644
--- a/lib/MooseX/Emulate/Class/Accessor/Fast.pm
+++ b/lib/MooseX/Emulate/Class/Accessor/Fast.pm
@@ -4,12 +4,13 @@ use Moose::Role;
 use Class::MOP ();
 use Scalar::Util ();
 
-our $VERSION = '0.00600';
+use MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor ();
+
+our $VERSION = '0.00801';
 
 =head1 NAME
 
-MooseX::Emulate::Class::Accessor::Fast -
-  Emulate Class::Accessor::Fast behavior using Moose attributes
+MooseX::Emulate::Class::Accessor::Fast - Emulate Class::Accessor::Fast behavior using Moose attributes
 
 =head1 SYNOPSYS
 
@@ -22,9 +23,9 @@ MooseX::Emulate::Class::Accessor::Fast -
     #fields with readers and writers
     __PACKAGE__->mk_accessors(qw/field1 field2/);
     #fields with readers only
-    __PACKAGE__->mk_accessors(qw/field3 field4/);
+    __PACKAGE__->mk_ro_accessors(qw/field3 field4/);
     #fields with writers only
-    __PACKAGE__->mk_accessors(qw/field5 field6/);
+    __PACKAGE__->mk_wo_accessors(qw/field5 field6/);
 
 
 =head1 DESCRIPTION
@@ -99,27 +100,37 @@ will be passed. Please see L<Class::MOP::Attribute> for more information.
 
 =cut
 
-sub mk_accessors{
+sub mk_accessors {
   my $self = shift;
   my $meta = $locate_metaclass->($self);
+  my $class = $meta->name;
+  confess("You are trying to modify ${class}, which has been made immutable, this is ".
+    "not supported. Try subclassing ${class}, rather than monkeypatching it")
+    if $meta->is_immutable;
+
   for my $attr_name (@_){
+    $meta->remove_attribute($attr_name)
+      if $meta->find_attribute_by_name($attr_name);
     my $reader = $self->accessor_name_for($attr_name);
     my $writer = $self->mutator_name_for( $attr_name);
 
     #dont overwrite existing methods
     if($reader eq $writer){
       my %opts = ( $meta->has_method($reader) ? () : (accessor => $reader) );
-      my $attr = $meta->add_attribute($attr_name, %opts);
+      my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, %opts,
+        traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+      );
       if($attr_name eq $reader){
         my $alias = "_${attr_name}_accessor";
         next if $meta->has_method($alias);
-        my @alias_method = $attr->process_accessors(accessor => $alias, 0);
-        $meta->add_method(@alias_method);
+        $meta->add_method($alias => $attr->get_read_method_ref);
       }
     } else {
       my @opts = ( $meta->has_method($writer) ? () : (writer => $writer) );
       push(@opts, (reader => $reader)) unless $meta->has_method($reader);
-      $meta->add_attribute($attr_name, @opts);
+      my $attr = $meta->find_attribute_by_name($attr_name) || $meta->add_attribute($attr_name, @opts,
+        traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+      );
     }
   }
 }
@@ -130,13 +141,21 @@ Create read-only accessors.
 
 =cut
 
-sub mk_ro_accessors{
+sub mk_ro_accessors {
   my $self = shift;
   my $meta = $locate_metaclass->($self);
+  my $class = $meta->name;
+  confess("You are trying to modify ${class}, which has been made immutable, this is ".
+    "not supported. Try subclassing ${class}, rather than monkeypatching it")
+    if $meta->is_immutable;
   for my $attr_name (@_){
+    $meta->remove_attribute($attr_name)
+      if $meta->find_attribute_by_name($attr_name);
     my $reader = $self->accessor_name_for($attr_name);
     my @opts = ($meta->has_method($reader) ? () : (reader => $reader) );
-    my $attr = $meta->add_attribute($attr_name, @opts);
+    my $attr = $meta->add_attribute($attr_name, @opts,
+      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+    ) if scalar(@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 $meta->has_method("_${attr_name}_accessor");
@@ -151,13 +170,21 @@ Create write-only accessors.
 =cut
 
 #this is retarded.. but we need it for compatibility or whatever.
-sub mk_wo_accessors{
+sub mk_wo_accessors {
   my $self = shift;
   my $meta = $locate_metaclass->($self);
+  my $class = $meta->name;
+  confess("You are trying to modify ${class}, which has been made immutable, this is ".
+    "not supported. Try subclassing ${class}, rather than monkeypatching it")
+    if $meta->is_immutable;
   for my $attr_name (@_){
+    $meta->remove_attribute($attr_name)
+      if $meta->find_attribute_by_name($attr_name);
     my $writer = $self->mutator_name_for($attr_name);
     my @opts = ($meta->has_method($writer) ? () : (writer => $writer) );
-    my $attr = $meta->add_attribute($attr_name, @opts);
+    my $attr = $meta->add_attribute($attr_name, @opts,
+      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+    ) if scalar(@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 $meta->has_method("_${attr_name}_accessor");
@@ -172,7 +199,7 @@ See original L<Class::Accessor> documentation for more information.
 
 =cut
 
-sub follow_best_practice{
+sub follow_best_practice {
   my $self = shift;
   my $meta = $locate_metaclass->($self);
 
@@ -190,8 +217,8 @@ See original L<Class::Accessor> documentation for more information.
 
 =cut
 
-sub mutator_name_for{  return $_[1] }
-sub accessor_name_for{ return $_[1] }
+sub mutator_name_for  { return $_[1] }
+sub accessor_name_for { return $_[1] }
 
 =head2 set
 
@@ -199,7 +226,7 @@ See original L<Class::Accessor> documentation for more information.
 
 =cut
 
-sub set{
+sub set {
   my $self = shift;
   my $k = shift;
   confess "Wrong number of arguments received" unless scalar @_;
@@ -217,7 +244,7 @@ See original L<Class::Accessor> documentation for more information.
 
 =cut
 
-sub get{
+sub get {
   my $self = shift;
   confess "Wrong number of arguments received" unless scalar @_;
   my $meta = $locate_metaclass->($self);
@@ -236,7 +263,9 @@ sub get{
 sub make_accessor {
   my($class, $field) = @_;
   my $meta = $locate_metaclass->($class);
-  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field,
+      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+  );
   my $reader = $attr->get_read_method_ref;
   my $writer = $attr->get_write_method_ref;
   return sub {
@@ -250,7 +279,9 @@ sub make_accessor {
 sub make_ro_accessor {
   my($class, $field) = @_;
   my $meta = $locate_metaclass->($class);
-  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field,
+      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+  );
   return $attr->get_read_method_ref;
 }
 
@@ -258,7 +289,9 @@ sub make_ro_accessor {
 sub make_wo_accessor {
   my($class, $field) = @_;
   my $meta = $locate_metaclass->($class);
-  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); 
+  my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field,
+      traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute']
+  );
   return $attr->get_write_method_ref;
 }
 
@@ -283,7 +316,9 @@ With contributions from:
 
 =over 4
 
-=item Tomas Doran E<lt>bobtfish@bobtfish.netE<gt>
+=item Tomas Doran (t0m) E<lt>bobtfish@bobtfish.netE<gt>
+
+=item Florian Ragwitz (rafl) E<lt>rafl@debian.orgE<gt>
 
 =back