allow subclasses to decide whether we need to copy the value into a new variable

add myself to authors :)

diff --git a/Changes b/Changes
index e8008bc..5632683 100644 (file)
--- a/Changes
+++ b/Changes
@@ -6,6 +6,9 @@ Revision history for Perl extension Moose
         be used as a container (sartak)
       - basic support for coercion to ArrayRef and
         HashRef for containers (sartak)
+    * Moose::Meta::Method::Accessor
+      - allow subclasses to decide whether we need
+        to copy the value into a new variable (sartak)
 
 0.32 Tues. Dec. 4, 2007
     * Moose::Util::TypeConstraints

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 526b67f..d4d7e46 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -874,6 +874,8 @@ Piotr (dexter) Roszatycki
 
 Sam (mugwump) Vilain
 
+Shawn (sartak) Moore
+
 ... and many other #moose folks
 
 =head1 COPYRIGHT AND LICENSE

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index f79689d..0e0987d 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -20,11 +20,12 @@ sub generate_accessor_method_inline {
     my $attr_name   = $attr->name;
     my $inv         = '$_[0]';
     my $slot_access = $self->_inline_access($inv, $attr_name);
-    my $value_name  = $attr->should_coerce ? '$val' : '$_[1]';
+    my $value_name  = $self->_value_needs_copy ? '$val' : '$_[1]';
 
     my $code = 'sub { ' . "\n"
     . $self->_inline_pre_body(@_) . "\n"
     . 'if (scalar(@_) == 2) {' . "\n"
+        . $self->_inline_copy_value . "\n"
         . $self->_inline_check_required . "\n"
         . $self->_inline_check_coercion . "\n"
         . $self->_inline_check_constraint($value_name) . "\n"
@@ -53,10 +54,11 @@ sub generate_writer_method_inline {
     my $attr_name   = $attr->name;
     my $inv         = '$_[0]';
     my $slot_access = $self->_inline_get($inv, $attr_name);
-    my $value_name  = $attr->should_coerce ? '$val' : '$_[1]';
+    my $value_name  = $self->_value_needs_copy ? '$val' : '$_[1]';
 
     my $code = 'sub { '
     . $self->_inline_pre_body(@_)
+    . $self->_inline_copy_value
     . $self->_inline_check_required
     . $self->_inline_check_coercion
         . $self->_inline_check_constraint($value_name)
@@ -102,6 +104,16 @@ sub generate_reader_method_inline {
     return $sub;
 }
 
+sub _inline_copy_value {
+    return '' unless shift->_value_needs_copy;
+    return 'my $val = $_[1];'
+}
+
+sub _value_needs_copy {
+    my $attr = (shift)->associated_attribute;
+    return $attr->should_coerce;
+}
+
 sub generate_reader_method { shift->generate_reader_method_inline(@_) }
 sub generate_writer_method { shift->generate_writer_method_inline(@_) }
 sub generate_accessor_method { shift->generate_accessor_method_inline(@_) }
@@ -132,7 +144,7 @@ sub _inline_check_coercion {
         my $attr = (shift)->associated_attribute;
 
         return '' unless $attr->should_coerce;
-    return 'my $val = $attr->type_constraint->coerce($_[1]);'
+    return '$val = $attr->type_constraint->coerce($_[1]);'
 }
 
 sub _inline_check_required {