File Coverage

blib/lib/Array/Group.pm
Criterion Covered Total %
statement 30 32 93.7
branch 11 16 68.7
condition n/a
subroutine 6 6 100.0
pod 0 2 0.0
total 47 56 83.9


line stmt bran cond sub pod time code
1             package Array::Group;
2              
3 1     1   54061 use 5.006;
  1         4  
  1         41  
4              
5 1     1   7 use strict;
  1         2  
  1         33  
6              
7 1     1   4 use Carp;
  1         7  
  1         1110  
8              
9             require Exporter;
10              
11             our @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.
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21             ngroup
22             dissect
23             ) ] );
24              
25             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
26              
27             our @EXPORT = qw();
28              
29             our $VERSION = '4.1';
30              
31             # Preloaded methods go here.
32             sub ngroup {
33 4     4 0 1644 my ($size, $r_list) = &_validate_params;
34              
35 4         7 my @list = @{$r_list};
  4         11  
36 4         7 my @lol;
37              
38 4         37 push @lol, [splice @list, 0, $size] while @list;
39              
40 4 100       20 return wantarray ? @lol : \@lol;
41             }
42              
43             sub dissect {
44 3     3 0 1192 my ($size, $r_list) = &_validate_params;
45              
46 3         5 my @lol;
47 3         5 my ($i, $j) = (0, 0);
48              
49 3         7 foreach (@$r_list) {
50 26         37 $lol[$i]->[$j] = $_;
51 26 100       58 $i = 0, $j++ unless (++$i % $size);
52             }
53              
54 3 50       21 return wantarray ? @lol : \@lol;
55             }
56              
57              
58             # Internal parameter validation function
59             sub _validate_params {
60             # Check we've been called with at least one argument
61 7 50   7   21 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 7 100       20 shift if $_[0] =~ /^[a-zA-Z0-9]+ (?: :: [a-zA-Z0-9]+ )$/x;
65              
66             # Check we have at least 2 arguments remaining
67 7 50       14 Carp::confess( "Called with insufficient arguments" ) if( $#_ < 1 );
68              
69             # Next argument is size. check it is a valid positive integer.
70 7         13 my $size = shift;
71 7 50       34 if( $size !~ /^\+?\d+$/ ) {
    50          
72 0         0 Carp::confess( "Size '$size' is not a valid positive integer" );
73             } elsif( $size == 0 ) {
74 0         0 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 7         10 my $r_list;
79             # if( ($#_ == 0) &&
80             # (ref($_[0]) eq 'ARRAY') ) {
81 7         9 $r_list = $_[0];
82             # } else {
83             # $r_list = \@_;
84             # }
85              
86 7         24 return $size, $r_list;
87             }
88              
89             # Autoload methods go after =cut, and are processed by the autosplit program.
90              
91             1;
92             __END__
93             # Below is the stub of documentation for your module. You better edit it!
94              
95             =head1 NAME
96              
97             Array::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              
128             The C<ngroup> method reformats a list into a list of
129             arrayrefs. It is often used for formatting data into HTML tables, amongst
130             other things.
131              
132             C<dissect()> returns a list of lists where the first
133             element of each sublist will be one of the first elements of the
134             source list, and the last element will be one of the last.
135             This behaviour is much more useful when the input list is sorted.
136              
137             The key difference between the two methods is that C<dissect()> takes
138             elements from the start of the list provided and pushes them onto each
139             of the subarrays sequentially, rather than simply dividing the list
140             into discrete chunks.
141              
142             Both methods can be called as either functions or class methods (to
143             ensure compatibility with previous releases), and the array to be
144             reformed 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              
159             Terrence Monroe Brannon <tbone@CPAN.org>
160              
161             =head2 CONTRIBUTORS
162              
163             I would like to thank Alexandr Ciornii for his help in upgrading this
164             distribution's format. He took me from using a F<test.pl> file to using
165             the F<t/> directory and removed some old crufty things that were not needed.
166             He also upgraded the Makefile.PL.
167              
168             =head1 COPYRIGHT
169              
170             Copyright 1999-present by Terrence Brannon.
171              
172             This library is free software; you can redistribute it and/or modify it under
173             the same terms as Perl itself.
174              
175             =cut