added grep_in_place attribute trait attic/grep_in_place
Robin Edwards [Thu, 16 Dec 2010 15:37:01 +0000 (15:37 +0000)]
lib/Moose/Meta/Attribute/Native/Trait/Array.pm
lib/Moose/Meta/Method/Accessor/Native/Array/grep_in_place.pm [new file with mode: 0644]
t/070_native_traits/010_trait_array.t

index 9c4f2ad..112623c 100644 (file)
@@ -160,6 +160,14 @@ matching logic.
 
 This method requires a single argument.
 
+=item * B<grep_in_place( sub { ... } )>
+
+This method greps through the array I<in place>, modifying the attributes value.
+This method accepts a subroutine which implements the matching logic.
+
+This method does not define a return value.
+
+
 =item * B<map( sub { ... } )>
 
 This method transforms every element in the array and returns a new array,
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/grep_in_place.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/grep_in_place.pm
new file mode 100644 (file)
index 0000000..68cb4cb
--- /dev/null
@@ -0,0 +1,46 @@
+package Moose::Meta::Method::Accessor::Native::Array::grep_in_place;
+
+use strict;
+use warnings;
+
+use Params::Util ();
+
+our $VERSION = '1.9900';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use Moose::Role;
+
+with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
+    -excludes => [
+        qw(
+            _maximum_arguments
+            _inline_check_arguments
+            _return_value
+            )
+    ]
+};
+
+sub _maximum_arguments { 1 }
+sub _minimun_arguments { 1 }
+
+sub _inline_check_arguments {
+    my $self = shift;
+    return $self->_inline_throw_error(
+        q{'The argument passed to grep_in_place must be a code reference'})
+        . q{ unless Params::Util::_CODELIKE( $_[0] );};
+}
+
+sub _adds_members { 0 }
+
+sub _potential_value {
+    my ($self, $slot_access) = @_;
+
+    return '[ grep { $_[0]->($_) } @{ (' . $slot_access . ') } ]';
+}
+
+sub _return_value { '' }
+
+no Moose::Role;
+
+1;
index decf151..27faea7 100644 (file)
@@ -50,6 +50,7 @@ use Test::Moose;
         map           => 'map',
         map_curried   => [ map => ( sub { $_ + 1 } ) ],
         grep          => 'grep',
+        grep_in_place => 'grep_in_place',
         grep_curried  => [ grep => ( sub { $_ < 5 } ) ],
         first         => 'first',
         first_curried => [ first => ( sub { $_ % 2 } ) ],
@@ -497,6 +498,16 @@ sub run_tests {
             $obj->grep_curried( sub { } );
         }, qr/Cannot call grep with more than 1 argument/, 'throws an error when passing one argument passed to grep_curried' );
 
+        $obj->_values( [ 1, 2, 3, 4, 5, 6, 7, 8 ] );
+
+        $obj->grep_in_place(sub { $_ > 4 } );
+
+        is_deeply (
+            $obj->_values,
+            [5, 6, 7, 8], 
+            'grep_in_place alters attribute vars'
+        );
+
         $obj->_values( [ 2, 4, 22, 99, 101, 6 ] );
 
         is(