File Coverage

blib/lib/Template/Plugin/Group.pm

Criterion	Covered	Total	%
statement	31	36	86.1
branch	6	12	50.0
condition	1	3	33.3
subroutine	8	9	88.8
pod	1	1	100.0
total	47	61	77.0

line

stmt

bran

cond

sub

pod

time

code

package Template::Plugin::Group;

=pod

=head1 NAME

Template::Plugin::Group - Template plugin to group lists into simple subgroups

=head1 SYNOPSIS

# In your Template

[% USE rows = Group(cells, 3) %]

[% FOREACH row IN rows %]

[% FOREACH cell IN rows %]

[% cell.content %]

[% END %]

23
24							=head1 DESCRIPTION
25
26							C is a fairly simple (for now) module for
27							grouping a list of things into a number of subgroups.
28
29							In this intial implementation you can only group C references,
30							and they can only be grouped into groups of a numbered size.
31
32							In practical terms, you can make columns of things and you can break up a
33							list into smaller chunks (for example to chop a large lists into a number
34							of smaller lists for display purposes)
35
36							=head1 METHODS
37
38							=cut
39
40	2			2		26238	use 5.005;
	2					7
	2					73
41	2			2		12	use strict;
	2					3
	2					73
42	2			2		1860	use Template::Plugin ();
	2					11475
	2					55
43	2			2		2271	use Params::Util qw{ _ARRAY _HASH _INSTANCE };
	2					15715
	2					178
44
45	2			2		14	use vars qw{$VERSION @ISA};
	2					5
	2					129
46							BEGIN {
47	2			2		5	$VERSION = '1.03';
48	2					705	@ISA = 'Template::Plugin';
49							}
50
51
52
53
54
55							#####################################################################
56							# Constructor
57
58							=pod
59
60							=head2 new [ $Context, ] \@ARRAY, $cols [, 'pad' ]
61
62							Although this is the "new" method, it doesn't really actually create any
63							objects. It simply takes an array reference, splits up the list into
64							groups, and returns the whole things as another array reference.
65
66							The rest you do normally, with normal Template Toolkit commands.
67
68							If there isn't a perfectly divisible number of elements normally the last group
69							will have less elements than the rest of the groups. If you provide the optional
70							parameter 'pad', the last group will be padded with additional C values
71							so that it has the full number.
72
73							=cut
74
75							sub new {
76	2			2	1	33	my $class = shift;
77	2	50				16	shift if _INSTANCE($_[0], 'Template::Context');
78	2	50	33			33	unless ( defined $_[1] and $_[1] =~ /^[1-9]\d*$/ ) {
79	0					0	$class->error('Group constructor argument not a positive integer');
80							}
81	2	50				16	return $class->_new_array(@_) if _ARRAY($_[0]);
82	0	0				0	return $class->_new_hash(@_) if _HASH($_[0]);
83	0					0	$class->error('Group constructor argument not an ARRAY or HASH ref');
84							}
85
86							sub _new_array {
87							# Make sure to copy the original array in case they care about it
88	2			2		6	my ($class, $array_ref, $cols) = @_;
89	2					7	my @array = @$array_ref;
90
91							# Support the padding option
92	2	50				5	if ( grep { defined $_ and lc $_ eq 'pad' } @_ ) {
	7	100				43
93	1					4	my $items = scalar(@array) % $cols;
94	1					4	push @array, (undef) x $items;
95							}
96
97							# Create the outside array and pack it
98	2					3	my @groups = ();
99	2					7	while ( @array ) {
100	4					17	push @groups, [ splice @array, 0, $cols ];
101							}
102
103	2					15	\@groups;
104							}
105
106							sub _new_hash {
107	0			0			my ($class, $hash, $cols) = @_;
108	0						$class->error('HASH grouping is not implented in this release');
109
110							# Implementation steps.
111							# 1. Get the list of keys, sorted in default order
112							# 2. Take groups of these and build new hashs for only those
113							# keys, with the same values as the original.
114							# 3. Wrap them all inside an ARRAY ref and return.
115
116							# I'm not sure we can do padding in this case...
117							}
118
119							1;
120
121							=pod
122
123							=head1 TO DO
124
125							- Support grouping HASH references
126
127							- If everything in the list is an object, support group/sort by method
128
129							- Support complex multi-level grouping (I have code for this already, but
130							it needs to be rewritten and should probably be a separate plugin).
131
132							=head1 SUPPORT
133
134							Bugs should be submitted via the CPAN bug tracker, located at
135
136							L
137
138							For other issues, or commercial enhancement or support, contact the author.
139
140							=head1 AUTHOR
141
142							Adam Kennedy Ecpan@ali.asE
143
144							=head1 COPYRIGHT
145
146							Copyright 2004 - 2008 Adam Kennedy.
147
148							This program is free software; you can redistribute
149							it and/or modify it under the same terms as Perl itself.
150
151							The full text of the license can be found in the
152							LICENSE file included with this module.
153
154							=cut