File Coverage

blib/lib/Template/Direct/List.pm
Criterion Covered Total %
statement 104 108 96.3
branch 40 44 90.9
condition 19 28 67.8
subroutine 11 11 100.0
pod 7 7 100.0
total 181 198 91.4


line stmt bran cond sub pod time code
1             package Template::Direct::List;
2              
3 2     2   13 use base Template::Direct::Base;
  2         5  
  2         203  
4              
5 2     2   12 use strict;
  2         4  
  2         67  
6 2     2   11 use warnings;
  2         3  
  2         100  
7              
8             =head1 NAME
9              
10             Template::Direct::List - Handle a list template display
11              
12             =head1 DESCRIPTION
13              
14             Provide support for lists and repetitive templating
15              
16             =head1 METHODS
17              
18             =cut
19              
20 2     2   12 use Carp;
  2         3  
  2         4637  
21              
22             =head2 I<$class>->new( $template, $data )
23              
24             Create a new instance object.
25              
26             =cut
27             sub new {
28 34     34 1 64 my ($class, $index, $data) = @_;
29 34         123 my $self = $class->SUPER::new();
30 34         82 $self->{'startTag'} = $index;
31 34         96 my ($dataName, @options) = split(/\s+/, $data);
32 34         134 $self->{'options'} = $self->getOptions(join(' ', @options));
33 34         68 $self->{'listName'} = $dataName;
34 34         94 return $self;
35             }
36              
37             =head2 I<$list>->tagName( )
38              
39             Returns 'list'
40              
41             =cut
42 90     90 1 372 sub tagName { 'list' }
43              
44             =head2 I<$list>->subTags( )
45              
46             Returns a list of expected tags in a list construct: [sublist, entry, noentry, seperator]
47              
48             =cut
49             sub subTags {
50             {
51 120     120 1 802 'sublist' => 0,
52             'entry' => 2,
53             'noentry' => 1,
54             'seperator' => 1,
55             }
56             }
57              
58              
59             =head2 I<$list>->compile( )
60              
61             Modifies a template with the data listed correctly.
62              
63             =cut
64             sub compile {
65 79     79 1 156 my ($self, $data, $template, %p) = @_;
66              
67             # Do list stuff here
68 79         218 my $section = $self->getFullSection( $template );
69 79         218 $self->{'contents'} = $self->getEntryContent( $section );
70 79         351 my $result = $self->compileListData( $data, $self->{'listName'}, %p );
71              
72             # Prcoess any children in the section content
73 79         365 $self->SUPER::compile( $data, \$result, %p );
74              
75             # Put the whole section back in the template
76 79         260 $self->setSection( $template, $result )
77             }
78              
79             =head2 I<$list>->compileListData( $data, $name, %p )
80              
81             From the scoped data object, find the data named data
82             field and return it as a list.
83              
84             =cut
85             sub compileListData {
86 101     101 1 236 my ($self, $data, $dataName, %p) = @_;
87              
88 101 100       269 $p{'listDepth'} = 0 if not $p{'listDepth'};
89 101         191 my $entry = $self->{'contents'}->{'entry'};
90 101         157 my $seperator = $self->{'contents'}->{'seperator'};
91 101         146 my $noentry = $self->{'contents'}->{'noentry'};
92 101         147 my $section = $self->{'contents'}->{'section'};
93 101         154 my $sublist = $self->{'contents'}->{'sublist'};
94              
95             # Make sure we have some data to list, limit the data to the curent
96             # data scope this is to stop deepRecursions in list data.
97 101         337 my $list = $data->getArrayDatum( $dataName, maxDepth => 1 );
98 101         182 my $result = '';
99              
100 101 100 100     419 if($list and $entry) {
101              
102 56 50       168 if(UNIVERSAL::isa($list, 'ARRAY')) {
103 56         59 my $length = @{$list};
  56         99  
104 56         73 my $depth = 0; # NERN
105              
106             # Should we sort the data in some sort of order
107 56 100       156 if(my $sort = $self->{'options'}->{'sort'}) {
108             # We only support 'name' and 'value' for now
109             # But there is scope to improve this functionality.
110 6 100       19 if($sort eq '1') {
111 1 50       5 if($self->{'options'}->{'numericalSort'}) {
112 1         2 $list = [ sort { $a <=> $b } @{$list} ];
  9         13  
  1         5  
113             } else {
114 0         0 $list = [ sort { $a cmp $b } @{$list} ];
  0         0  
  0         0  
115             }
116             } else {
117             # Loop through each and replace with hash (sorry)
118 5         7 foreach my $item (@{$list}) {
  5         12  
119 15         44 $item = $data->_makeHash( $item );
120             }
121 5         10 $list = [ sort { $a->{$sort} cmp $b->{$sort} } @{$list} ];
  14         45  
  5         27  
122             }
123             }
124              
125             #print "FOUND LIST $length long based on ".$self->{'listName'}." and $entry\n";
126 56         157 for(my $index = 0; $index < $length; $index++) {
127              
128 160 100       340 next if not defined $list->[$index];
129             # Do not process if the entire entry isn't defined
130 159 50 0     283 warn " ! Unable to List: Data disapeared midstream!\n" and next if not defined $list->[$index];
131              
132             # Create new data object with a new scope
133 159         462 my $datum = $data->_makeHash( $list->[$index] );
134              
135             # Push this entries related data
136 159         257 my $odd = $index % 2;
137 159         298 my $even = not $odd;
138 159         808 $datum->{''} = {
139             'index' => $index,
140             'count' => $index+1,
141             'odd' => $odd,
142             'even' => $even,
143             'depth' => $p{'listDepth'},
144             };
145              
146 159         507 my $newdata = $data->pushNew( $datum );
147            
148             # Create a copy of the entry for this list item
149 159         228 my $copy = $entry;
150              
151             #$self->SUPER::compile( $newdata, \$copy, %p, listDepth => $p{'listDepth'} + 1 );
152              
153             # Generate any of the data required for sublists
154 159 100 66     416 if($sublist and $p{'listDepth'} < 10) {
155             #warn "Found sublist for $dataName > $sublist\n";
156 22         82 $datum->{''}->{'sublist'} = $self->compileSubList( \$copy, $newdata, $sublist, %p );
157             }
158            
159             # Generate entry with content and all sub-structures processed
160 159         768 $self->SUPER::compile( $newdata, \$copy, %p, listDepth => $p{'listDepth'} + 1 );
161              
162             # Concaternate each of the new copies together
163 159 100 66     1443 $result .= $seperator if defined $seperator and $seperator ne '' and defined $result and $result ne '';
      66        
      66        
164 159         889 $result .= $copy;
165             }
166             }
167             } else {
168             #warn "Ignoring List using variable ".$self->{'listName'}." ".($list ? "empty content" : "no data")."\n";
169 45 100       93 if($noentry) {
170 2         7 return $noentry;
171             }
172             }
173 99 100       278 return '' if not $result;
174             # Put all the entries back into the list section
175 56         180 $self->setSection( \$section, $result );
176 56         227 return $section;
177             }
178              
179              
180             =head2 I<$list>->compileSubList( $content, $data, $sublist )
181              
182             Modifies the content with the sublist tag replaces with the correctly proccessed data
183              
184             =cut
185             sub compileSubList {
186 22     22 1 50 my ($self, $content, $data, $sublist, %p) = @_;
187              
188 22         36 my $name = $sublist->{'var'};
189 22   100     111 my $depth = $sublist->{'deep'} || 0;
190 22         32 my $index = $sublist->{'tagIndex'};
191 22         28 my $result = '';
192            
193             # Because the data simply uses scope by pushing a new set of local variables onto
194             # a stack each level/depth down, we can induce a deepRecursion here because it will
195             # attempt to find sublists in data, even when the data has run out by using data
196             # in older scopes as per the functionality of getDatum. HERE BE DRAGONS.
197            
198 22         76 my $object = $self->getClassParent( $depth );
199 22 50       48 if(defined($object)) {
200 22         92 $result = $object->compileListData( $data, $name, %p, listDepth => $p{'listDepth'} + 1 );
201             }
202              
203 22         84 $self->setTagSection($content, $index, $result);
204              
205 22 100       112 return 1 if $result;
206             }
207              
208              
209             =head2 I<$list>->getEntryContent( $content )
210              
211             Gathers all the subtags and sorts them out into a content hash (returned)
212             This content is used for all sublists as well as the current list processing.
213              
214             =cut
215             sub getEntryContent {
216 79     79 1 133 my ($self, $template) = @_;
217              
218 79         121 my $result = {};
219 79         97 my ($start, $end);
220 0         0 my $first;
221              
222 79         80 my $length = @{$self->allSubTags()};
  79         245  
223 79         216 for(my $i = 0; $i < $length; $i++) {
224 284         299 my ($name, $index, $data) = @{$self->allSubTags()->[$i]};
  284         740  
225 284 100       635 $first = $index if not defined($first);
226 284 100       825 if($name eq 'entry') {
    100          
    100          
227 142 100 66     606 $start = $index if($name eq 'entry' and $data ne 'END');
228 142 100 66     743 $end = $index if($name eq 'entry' and $data eq 'END');
229             } elsif($name eq 'sublist') {
230 16         51 $result->{'sublist'} = $self->getOptions($data);
231 16         58 $result->{'sublist'}->{'tagIndex'} = $index;
232             } elsif($data ne 'END') {
233 75 100       274 my $next = $i + 1 < $length ? $self->allSubTags()->[$i+1] : undef;
234 75         207 $result->{$name} = $self->getAppendedSection( \$template, $self->allSubTags()->[$i], $next);
235             }
236             }
237              
238 79 100 66     289 if(not defined($start) or not defined($end)) {
239             # This means use entire template content because entry wasn't specified
240 8         21 $result->{'entry'} = $template;
241 8         14 $template = '{{PH}}';
242             } else {
243 71         213 $result->{'entry'} = $self->getSection( \$template, $start, $end );
244             }
245              
246 79         174 $result->{'section'} = $template;
247 79         227 return $result;
248             }
249              
250             =head1 AUTHOR
251              
252             Martin Owens - Copyright 2007, AGPL
253              
254             =cut
255             1;