X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FAutobox%2FArray.pm;h=ab28fbf7876ccce63704e2eb4f132964bbe61d0f;hb=0e4809110e25a83f84e51bd913ae9e233fb3ce63;hp=38e94f1aa5236373df6ed8a0e31de6fc5ce097b3;hpb=8937074ab98e81964dee9ccf9bbd939ebf3252a0;p=gitmo%2FMoose-Autobox.git diff --git a/lib/Moose/Autobox/Array.pm b/lib/Moose/Autobox/Array.pm index 38e94f1..ab28fbf 100644 --- a/lib/Moose/Autobox/Array.pm +++ b/lib/Moose/Autobox/Array.pm @@ -1,8 +1,9 @@ package Moose::Autobox::Array; use Moose::Role 'with'; -use autobox; +use Perl6::Junction; +use Moose::Autobox; -our $VERSION = '0.01'; +our $VERSION = '0.10'; with 'Moose::Autobox::Ref', 'Moose::Autobox::List', @@ -35,7 +36,12 @@ sub delete { sub shift { my ($array) = @_; CORE::shift @$array; -} +} + +sub slice { + my ($array, $indicies) = @_; + [ @{$array}[ @{$indicies} ] ]; +} # NOTE: # sprintf args need to be reversed, @@ -111,6 +117,85 @@ sub kv { $array->keys->map(sub { [ $_, $array->[$_] ] }); } +sub each { + my ($array, $sub) = @_; + for my $i (0 .. $#$array) { + $sub->($i, $array->[ $i ]); + } +} + +sub each_key { + my ($array, $sub) = @_; + $sub->($_) for (0 .. $#$array); +} + +sub each_value { + my ($array, $sub) = @_; + $sub->($_) for @$array; +} + +sub each_n { + my ($array, $n, $sub) = @_; + my $it = List::MoreUtils::natatime($n, @$array); + + while (my @vals = $it->()) { + $sub->(@vals); + } + + return; +} + +# end indexed + +sub flatten { + @{$_[0]} +} + +sub _flatten_deep { + my @array = @_; + my $depth = CORE::pop @array; + --$depth if (defined($depth)); + + CORE::map { + (ref eq 'ARRAY') + ? (defined($depth) && $depth == -1) ? $_ : _flatten_deep( @$_, $depth ) + : $_ + } @array; + +} + +sub flatten_deep { + my ($array, $depth) = @_; + [ _flatten_deep(@$array, $depth) ]; +} + +## Junctions + +sub all { + my ($array) = @_; + return Perl6::Junction::all(@$array); +} + +sub any { + my ($array) = @_; + return Perl6::Junction::any(@$array); +} + +sub none { + my ($array) = @_; + return Perl6::Junction::none(@$array); +} + +sub one { + my ($array) = @_; + return Perl6::Junction::one(@$array); +} + +## Print + +sub print { CORE::print @{$_[0]} } +sub say { CORE::print @{$_[0]}, "\n" } + 1; __END__ @@ -124,9 +209,16 @@ Moose::Autobox::Array - the Array role =head1 SYNOPOSIS use Moose::Autobox; - use autobox; + + [ 1..5 ]->isa('ARRAY'); # true + [ a..z ]->does('Moose::Autobox::Array'); # true + [ 0..2 ]->does('Moose::Autobox::List'); # true print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', '); + + print [ 1, 'number' ]->sprintf('%d is the loneliest %s'); + + print ([ 1 .. 5 ]->any == 3) ? 'true' : 'false'; # prints 'true' =head1 DESCRIPTION @@ -136,41 +228,53 @@ This is a role to describe operations on the Array type. =over 4 -=item B - =item B -=item B +=item B =item B -=item B +=item B + +=item B + +=item B -=item B +=item B -=item B +=item B + +=item B + +=item B =back -=head2 Moose::Autobox::Indexed implementation +=head2 Indexed implementation =over 4 -=item B +=item B -=item B +=item B -=item B +=item B =item B +=item B + =item B -=item B +=item B + +=item B + +=item B =back -=head2 Moose::Autobox::List implementation +=head2 List implementation =over 4 @@ -178,17 +282,59 @@ This is a role to describe operations on the Array type. =item B -=item B +=item B =item B -=item B +=item B + +=item B -=item B +Note that, in both the above, $_ is in scope within the code block, as well as +being passed as $_[0]. As per CORE::map and CORE::grep, $_ is an alias to +the list value, so can be used to to modify the list, viz: + use Moose::Autobox; + + my $foo = [1, 2, 3]; + $foo->map( sub {$_++} ); + print $foo->dump; + +yields + + $VAR1 = [ + 2, + 3, + 4 + ]; + =item B -=item B +=item B + +=back + +=head2 Junctions + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=back + +=over 4 + +=item B + +=item B + +=item B =back @@ -204,11 +350,11 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006-2008 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut