From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 5 Dec 2008 02:24:05 +0000 (+0000)
Subject: break out method generation into an _eval_closure method
X-Git-Tag: 0.76~10^2~5
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f8de9b4f7ee31388ffb3c32f8d3387ec8e0f599;hp=b73007e54d014101aef2819883f051916c7e1544;p=gitmo%2FClass-MOP.git

break out method generation into an _eval_closure method
---

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 3e966a7..3af250f 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -114,41 +114,54 @@ sub generate_clearer_method {
 
 
 sub generate_accessor_method_inline {
-    my $attr          = (shift)->associated_attribute;
+    my $self          = shift;
+    my $attr          = $self->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = eval 'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')  . ' if scalar(@_) == 2; '
+    my $code = $self->_eval_closure(
+        q{},
+        'sub {'
+        . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')
+        . ' if scalar(@_) == 2; '
         . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'")
-    . '}';
+        . '}'
+    );
     confess "Could not generate inline accessor because : $@" if $@;
 
     return $code;
 }
 
 sub generate_reader_method_inline {
-    my $attr          = (shift)->associated_attribute;
+    my $self          = shift;
+    my $attr          = $self->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = eval 'sub {'
+    my $code = $self->_eval_closure(
+         q{},
+        'sub {'
         . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
         . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'")
-    . '}';
+        . '}'
+    );
     confess "Could not generate inline accessor because : $@" if $@;
 
     return $code;
 }
 
 sub generate_writer_method_inline {
-    my $attr          = (shift)->associated_attribute;
+    my $self          = shift;
+    my $attr          = $self->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = eval 'sub {'
+    my $code = $self->_eval_closure(
+        q{},
+        'sub {'
         . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')
-    . '}';
+        . '}'
+    );
     confess "Could not generate inline accessor because : $@" if $@;
 
     return $code;
@@ -156,26 +169,34 @@ sub generate_writer_method_inline {
 
 
 sub generate_predicate_method_inline {
-    my $attr          = (shift)->associated_attribute;
+    my $self          = shift;
+    my $attr          = $self->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = eval 'sub {' .
-       $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'")
-    . '}';
+    my $code = $self->_eval_closure(
+        q{},
+       'sub {'
+       . $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'")
+       . '}'
+    );
     confess "Could not generate inline predicate because : $@" if $@;
 
     return $code;
 }
 
 sub generate_clearer_method_inline {
-    my $attr          = (shift)->associated_attribute;
+    my $self          = shift;
+    my $attr          = $self->associated_attribute;
     my $attr_name     = $attr->name;
     my $meta_instance = $attr->associated_class->instance_metaclass;
 
-    my $code = eval 'sub {'
+    my $code = $self->_eval_closure(
+        q{},
+        'sub {'
         . $meta_instance->inline_deinitialize_slot('$_[0]', "'$attr_name'")
-    . '}';
+        . '}'
+    );
     confess "Could not generate inline clearer because : $@" if $@;
 
     return $code;
diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm
index f14c035..7179940 100644
--- a/lib/Class/MOP/Method/Constructor.pm
+++ b/lib/Class/MOP/Method/Constructor.pm
@@ -110,9 +110,11 @@ sub generate_constructor_method_inline {
         # NOTE:
         # create the nessecary lexicals
         # to be picked up in the eval
-        my $attrs = $self->attributes;
 
-        $code = eval $source;
+        $code = $self->_eval_closure(
+            q{my $attrs = $self->attributes;},
+            $source
+        );
         confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
     }
     return $code;
diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm
index 15e050d..9d9a46f 100644
--- a/lib/Class/MOP/Method/Generated.pm
+++ b/lib/Class/MOP/Method/Generated.pm
@@ -44,7 +44,10 @@ sub initialize_body {
     confess "No body to initialize, " . __PACKAGE__ . " is an abstract base class";
 }
 
-
+sub _eval_closure {
+    my $self = shift;
+    eval join("\n",@_);
+}
 
 1;