X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FAutobox%2FArray.pm;h=e43c8932ec49fa519489e3fde0d94fff98509ff3;hb=c0ab09e353689f340e840f44b4158fc5a33790db;hp=6d4c1e8bd3eaba25ef8f48271df4552d7d45d9d9;hpb=31d40d7362f4154746428525561af751208b0805;p=gitmo%2FMoose-Autobox.git diff --git a/lib/Moose/Autobox/Array.pm b/lib/Moose/Autobox/Array.pm index 6d4c1e8..e43c893 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, @@ -47,16 +53,6 @@ sub sprintf { CORE::sprintf $_[1], @{$_[0]} } sub head { $_[0]->[0] } sub tail { [ @{$_[0]}[ 1 .. $#{$_[0]} ] ] } -sub at { - my ($array, $index) = @_; - $array->[$index]; -} - -sub put { - my ($array, $index, $value) = @_; - $array->[$index] = $value; -} - sub length { my ($array) = @_; CORE::scalar @$array; @@ -89,11 +85,17 @@ sub sort { [ CORE::sort { $sub->($a, $b) } @$array ]; } -# ::Value requirement +## ::Indexed implementation -sub print { CORE::print @{$_[0]} } +sub at { + my ($array, $index) = @_; + $array->[$index]; +} -## ::Indexed implementation +sub put { + my ($array, $index, $value) = @_; + $array->[$index] = $value; +} sub exists { my ($array, $index) = @_; @@ -115,6 +117,74 @@ 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; +} + +# 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__ @@ -128,12 +198,133 @@ 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 +This is a role to describe operations on the Array type. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head2 Indexed implementation + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head2 List implementation + +=over 4 + +=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 + +=back + +=head2 Junctions + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=back + +=over 4 + +=item B + +=item B + +=item B + +=back + =head1 BUGS All complex software has bugs lurking in it, and this module is no @@ -146,11 +337,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