add shallow_clone to Array and Hash traits

diff --git a/lib/Moose/Meta/Attribute/Native/Trait/Array.pm b/lib/Moose/Meta/Attribute/Native/Trait/Array.pm
index a743c4d..872e6a6 100644 (file)
--- a/lib/Moose/Meta/Attribute/Native/Trait/Array.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait/Array.pm
@@ -300,6 +300,13 @@ in the array.
 
 This method accepts one or two arguments.
 
+=item B<shallow_clone>
+
+This method returns a shallow clone of the array reference.  The return value
+is a reference to a new array with the same elements.  It is I<shallow>
+because any elements that were references in the original will be the I<same>
+references in the clone.
+
 =back
 
 =head1 BUGS

diff --git a/lib/Moose/Meta/Attribute/Native/Trait/Hash.pm b/lib/Moose/Meta/Attribute/Native/Trait/Hash.pm
index 145d0b5..9762d72 100644 (file)
--- a/lib/Moose/Meta/Attribute/Native/Trait/Hash.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait/Hash.pm
@@ -136,6 +136,13 @@ arguments, sets the value of the specified key.
 
 When called as a setter, this method returns the value that was set.
 
+=item B<shallow_clone>
+
+This method returns a shallow clone of the hash reference.  The return value
+is a reference to a new hash with the same keys and values.  It is I<shallow>
+because any values that were references in the original will be the I<same>
+references in the clone.
+
 =back
 
 Note that C<each> is deliberately omitted, due to its stateful interaction

diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm
new file mode 100644 (file)
index 0000000..484d271
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/shallow_clone.pm
@@ -0,0 +1,32 @@
+package Moose::Meta::Method::Accessor::Native::Array::shallow_clone;
+
+use strict;
+use warnings;
+
+use Params::Util ();
+
+use Moose::Role;
+
+with 'Moose::Meta::Method::Accessor::Native::Reader' => {
+    -excludes => [
+        qw(
+            _minimum_arguments
+            _maximum_arguments
+            )
+    ]
+};
+
+sub _minimum_arguments { 0 }
+
+sub _maximum_arguments { 0 }
+
+sub _return_value {
+    my $self = shift;
+    my ($slot_access) = @_;
+
+    return '[ @{ (' . $slot_access . ') } ]';
+}
+
+no Moose::Role;
+
+1;

diff --git a/lib/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm b/lib/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm
new file mode 100644 (file)
index 0000000..7191ea3
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Hash/shallow_clone.pm
@@ -0,0 +1,32 @@
+package Moose::Meta::Method::Accessor::Native::Hash::shallow_clone;
+
+use strict;
+use warnings;
+
+use Params::Util ();
+
+use Moose::Role;
+
+with 'Moose::Meta::Method::Accessor::Native::Reader' => {
+    -excludes => [
+        qw(
+            _minimum_arguments
+            _maximum_arguments
+            )
+    ]
+};
+
+sub _minimum_arguments { 0 }
+
+sub _maximum_arguments { 0 }
+
+sub _return_value {
+    my $self = shift;
+    my ($slot_access) = @_;
+
+    return '{ %{ (' . $slot_access . ') } }';
+}
+
+no Moose::Role;
+
+1;

diff --git a/t/native_traits/shallow_clone.t b/t/native_traits/shallow_clone.t
new file mode 100644 (file)
index 0000000..bdcf005
--- /dev/null
+++ b/t/native_traits/shallow_clone.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+use Scalar::Util qw(refaddr);
+
+{
+    package Foo;
+    use Moose;
+
+    has 'array' => (
+        traits  => ['Array'],
+        is      => 'ro',
+        handles => { array_clone => 'shallow_clone' },
+    );
+
+    has 'hash' => (
+        traits  => ['Hash'],
+        is      => 'ro',
+        handles => { hash_clone => 'shallow_clone' },
+    );
+
+    no Moose;
+}
+
+my $array = [ 1, 2, 3 ];
+my $hash  = { a => 1, b => 2 };
+
+my $obj = Foo->new({
+  array => $array,
+  hash  => $hash,
+});
+
+my $array_clone = $obj->array_clone;
+my $hash_clone  = $obj->hash_clone;
+
+isnt(refaddr($array), refaddr($array_clone), "array clone refers to new copy");
+is_deeply($array_clone, $array, "...but contents are the same");
+isnt(refaddr($hash),  refaddr($hash_clone),  "hash clone refers to new copy");
+is_deeply($hash_clone, $hash, "...but contents are the same");
+
+done_testing;