1package Array::Group; 2 3use 5.006; 4 5use strict; 6 7use Carp; 8 9require Exporter; 10 11our @ISA = qw(Exporter); 12 13# Items to export into callers namespace by default. Note: do not export 14# names by default without a very good reason. Use EXPORT_OK instead. 15# Do not simply export all your public functions/methods/constants. 16 17# This allows declaration use Array::Group ':all'; 18# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK 19# will save memory. 20our %EXPORT_TAGS = ( 'all' => [ qw( 21 ngroup 22 dissect 23 ) ] ); 24 25our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); 26 27our @EXPORT = qw(); 28 29our $VERSION = '4.2'; 30 31# Preloaded methods go here. 32sub ngroup { 33 my ($size, $r_list) = &_validate_params; 34 35 my @list = @{$r_list}; 36 my @lol; 37 38 push @lol, [splice @list, 0, $size] while @list; 39 40 return wantarray ? @lol : \@lol; 41} 42 43sub dissect { 44 my ($size, $r_list) = &_validate_params; 45 46 my @lol; 47 my ($i, $j) = (0, 0); 48 49 foreach (@$r_list) { 50 $lol[$i]->[$j] = $_; 51 $i = 0, $j++ unless (++$i % $size); 52 } 53 54 return wantarray ? @lol : \@lol; 55} 56 57 58# Internal parameter validation function 59sub _validate_params { 60 # Check we've been called with at least one argument 61 Carp::confess( "Called with no arguments" ) if $#_ == -1; 62 63 # First param might be a class (if invoked as a class method). Discard it if so. 64 shift if $_[0] =~ /^[a-zA-Z0-9]+ (?: :: [a-zA-Z0-9]+ )$/x; 65 66 # Check we have at least 2 arguments remaining 67 Carp::confess( "Called with insufficient arguments" ) if( $#_ < 1 ); 68 69 # Next argument is size. check it is a valid positive integer. 70 my $size = shift; 71 if( $size !~ /^\+?\d+$/ ) { 72 Carp::confess( "Size '$size' is not a valid positive integer" ); 73 } elsif( $size == 0 ) { 74 Carp::confess( "'$size' is an invalid array size" ); 75 } 76 77 # If only one argument remains, check to see if it is an arrayref, otherwise, reate a reference to it 78 my $r_list; 79# if( ($#_ == 0) && 80# (ref($_[0]) eq 'ARRAY') ) { 81 $r_list = $_[0]; 82# } else { 83# $r_list = \@_; 84# } 85 86 return $size, $r_list; 87} 88 89# Autoload methods go after =cut, and are processed by the autosplit program. 90 911; 92__END__ 93# Below is the stub of documentation for your module. You better edit it! 94 95=head1 NAME 96 97Array::Group - Convert an array into array of arrayrefs of uniform size N. 98 99=head1 SYNOPSIS 100 101 use Array::Group qw( :all ); 102 103 @sample = ( 1 .. 10 ); 104 $rowsize = 3; 105 106 ngroup $rowsize => \@sample ; 107 # yields 108 ( 109 [ 1, 2, 3 ], 110 [ 4, 5, 6 ], 111 [ 7, 8, 9 ], 112 [ 10 ] 113 ); 114 115 dissect $rowsize => \@sample ; 116 # yields 117 ( 118 [ 1, 5, 9 ], 119 [ 2, 6, 10 ], 120 [ 3, 7 ], 121 [ 4, 8 ] 122 ); 123 124 125 126=head1 DESCRIPTION 127 128The C<ngroup> method reformats a list into a list of 129arrayrefs. It is often used for formatting data into HTML tables, amongst 130other things. 131 132C<dissect()> returns a list of lists where the first 133element of each sublist will be one of the first elements of the 134source list, and the last element will be one of the last. 135This behaviour is much more useful when the input list is sorted. 136 137The key difference between the two methods is that C<dissect()> takes 138elements from the start of the list provided and pushes them onto each 139of the subarrays sequentially, rather than simply dividing the list 140into discrete chunks. 141 142Both methods can be called as either functions or class methods (to 143ensure compatibility with previous releases), and the array to be 144reformed can be passed as a reference. 145 146 147 148 149=head1 SEE ALSO 150 151=over 4 152 153=item * L<Array::Reform> 154 155=back 156 157=head1 AUTHOR 158 159Currently maintained by Mike Accardo, <accardo@cpan.org> 160 161Original author Terrence Monroe Brannon. 162 163=head2 CONTRIBUTORS 164 165I would like to thank Alexandr Ciornii for his help in upgrading this 166distribution's format. He took me from using a F<test.pl> file to using 167the F<t/> directory and removed some old crufty things that were not needed. 168He also upgraded the Makefile.PL. 169 170=head1 COPYRIGHT 171 172 Copyright (c) 2015 Mike Accardo 173 Copyright (c) 1999-2014 Terrence Brannon 174 175This library is free software; you can redistribute it and/or modify it under 176the same terms as Perl itself. 177 178=cut 179