[Moose-commits] r7501 - in MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor: . Fast Fast/Meta Fast/Meta/Role

[rafl at code2.0beta.co.uk]

Author: rafl
Date: 2009-02-03 10:28:02 -0800 (Tue, 03 Feb 2009)
New Revision: 7501

Added:
   MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/
   MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/
   MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm
   MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/
   MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm
Modified:
   MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast.pm
Log:
Make list assignment work.

Added: MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm
===================================================================
--- MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm	                        (rev 0)
+++ MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Accessor.pm	2009-02-03 18:28:02 UTC (rev 7501)
@@ -0,0 +1,51 @@
+package MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor;
+
+use Moose;
+
+extends 'Moose::Meta::Method::Accessor';
+
+sub generate_accessor_method {
+    my $attr = (shift)->associated_attribute;
+    return sub {
+        my $self = shift;
+        $attr->set_value($self, $_[0]) if scalar(@_) == 1;
+        $attr->set_value($self, [@_]) if scalar(@_) > 1;
+        $attr->get_value($self);
+    };
+}
+
+sub generate_writer_method {
+    my $attr = (shift)->associated_attribute;
+    return sub {
+        my $self = shift;
+        $attr->set_value($self, $_[0]) if scalar(@_) == 1;
+        $attr->set_value($self, [@_]) if scalar(@_) > 1;
+    };
+}
+
+# FIXME - this is shite, but it does work...
+sub generate_accessor_method_inline {
+    my $attr          = (shift)->associated_attribute;
+    my $attr_name     = $attr->name;
+    my $meta_instance = $attr->associated_class->instance_metaclass;
+
+    my $code = eval "sub {
+        my \$self = shift;
+        \$self->{'$attr_name'} = \$_[0] if scalar(\@_) == 1;
+        \$self->{'$attr_name'} = [\@_] if scalar(\@_) > 1;
+        \$self->{'$attr_name'};
+    }";
+    confess "Could not generate inline accessor because : $@" if $@;
+
+    return $code;
+}
+
+{
+    my $meta = __PACKAGE__->meta;
+    $meta->add_method(generate_writer_method_inline => $meta->get_method('generate_accessor_method_inline'));
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
+1;

Added: MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm
===================================================================
--- MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm	                        (rev 0)
+++ MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast/Meta/Role/Attribute.pm	2009-02-03 18:28:02 UTC (rev 7501)
@@ -0,0 +1,6 @@
+package MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute;
+use Moose::Role;
+
+sub accessor_metaclass { 'MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor' }
+
+1;

Modified: MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast.pm
===================================================================
--- MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast.pm	2009-02-03 18:27:42 UTC (rev 7500)
+++ MooseX-Emulate-Class-Accessor-Fast/trunk/lib/MooseX/Emulate/Class/Accessor/Fast.pm	2009-02-03 18:28:02 UTC (rev 7501)
@@ -4,6 +4,8 @@
 use Class::MOP ();
 use Scalar::Util ();
 
+use MooseX::Emulate::Class::Accessor::Fast::Meta::Accessor ();
+
 our $VERSION = '0.00701';
 
 =head1 NAME
@@ -116,7 +118,9 @@
     #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);
@@ -126,7 +130,9 @@
     } 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']
+      );
     }
   }
 }
@@ -149,7 +155,9 @@
       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");
@@ -176,7 +184,9 @@
       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");
@@ -255,7 +265,9 @@
 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 {
@@ -269,7 +281,9 @@
 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;
 }
 
@@ -277,7 +291,9 @@
 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;
 }