File Coverage

blib/lib/XHTML/Instrumented/Loop.pm
Criterion Covered Total %
statement 12 92 13.0
branch 0 24 0.0
condition 0 2 0.0
subroutine 4 15 26.6
pod 10 10 100.0
total 26 143 18.1


line stmt bran cond sub pod time code
1 2     2   36502 use strict;
  2         6  
  2         83  
2 2     2   12 use warnings;
  2         5  
  2         92  
3              
4             package
5             XHTML::Instrumented::Loop;
6              
7 2     2   12 use base 'XHTML::Instrumented::Control';
  2         3  
  2         324  
8              
9 2     2   13 use Params::Validate qw (validate ARRAYREF HASHREF);
  2         3  
  2         2925  
10              
11             sub new
12             {
13 0     0 1   my $class = shift;
14 0           my %p = validate(@_, {
15             inclusive => 0,
16             headers => {
17             optional => 1,
18             type => ARRAYREF,
19             },
20             data => {
21             optional => 1,
22             type => ARRAYREF,
23             depends => [ 'headers' ],
24             },
25             default => 0,
26             } );
27 0           my $self = bless { headers => [], data => [], _count => 0, %p }, $class;
28              
29 0           for (my $x = 0; $x < @{$self->{headers}}; $x++) {
  0            
30 0           $self->{hash}{ $self->{headers}[$x] } = $x;
31             }
32              
33 0           return $self;
34             }
35              
36             sub count
37             {
38 0     0 1   my $self = shift;
39 0           $self->{_count};
40             }
41              
42             sub inc
43             {
44 0     0 1   my $self = shift;
45              
46 0           $self->{_count}++;
47             }
48              
49             sub _have_data
50             {
51 0     0     my $self = shift;
52 0           my @data = @{$self->{data}};
  0            
53 0 0         if ($self->{_count} >= @data) {
54 0           $self->{_count} = 0;
55 0           return 0;
56             } else {
57 0           return 1;
58             }
59             }
60              
61             sub expand_content
62             {
63 0     0 1   my $self = shift;
64              
65 0           my @ret = $self->SUPER::expand_content(@_);
66              
67 0           return @ret;
68             }
69              
70             sub get_id
71             {
72 0     0 1   my $self = shift;
73 0           my $id = shift;
74 0           my %hash;
75 0           my $x = 0;
76              
77 0           for my $h (@{$self->{headers}}) {
  0            
78 0           $hash{$h} = $x++;
79             }
80              
81 0           my $data;
82              
83 0 0         if (defined $hash{$id}) {
84 0 0         if ($self->{_count} >= @{$self->{data}}) {
  0            
85 0 0         if (ref $self->{default} eq 'ARRAY') {
86 0           $data = $self->{default}[$hash{$id}];
87             } else {
88 0   0       $data = $self->{default} || 'N/A';
89             }
90             } else {
91 0           $data = $self->{data}[$self->{_count}][$hash{$id}];
92             }
93             }
94              
95 0           return $data;
96             }
97              
98             sub if
99             {
100 0     0 1   my $count = shift->rows;
101 0 0         $count ? 1 : 0;
102             }
103              
104             sub rows
105             {
106 0     0 1   my $self = shift;
107 0           scalar @{$self->{data}};
  0            
108             }
109              
110             sub children
111             {
112 0     0 1   my $self = shift;
113              
114 0           my %p = validate(@_, {
115             context => { isa => 'XHTML::Instrumented::Context' },
116             children => ARRAYREF,
117             });
118              
119 0           my @ret;
120              
121 0 0         if ($self->inclusive) {
122 0           my $context = $p{context}->copy;
123 0           @ret = ($self->SUPER::children(@_, context => $context));
124             } else {
125 0           while ($self->_have_data) {
126 0           my $context = $p{context}->copy;
127 0           push(@ret, $self->SUPER::children(%p, context => $context));
128 0           $self->inc;
129             }
130             }
131 0           return @ret;
132             }
133              
134             sub to_text
135             {
136 0     0 1   my $self = shift;
137 0           my %p = validate(@_, {
138             tag => 1,
139             children => ARRAYREF,
140             args => HASHREF,
141             flags => HASHREF,
142             context => { isa => 'XHTML::Instrumented::Context' },
143             });
144 0           my @ret;
145              
146 0           my $context = $p{context};
147              
148             # remove the entire loop element branch if no data
149             # TODO This may need an option
150              
151 0           my $count = $self->rows;
152              
153 0 0         die 'if in loop' if (!!$p{flags}->{if}); # A loop never has an if.
154              
155 0           my $inclusive = $self->inclusive;
156              
157 0 0         if ($p{flags}->{ex}) {
158 0           $inclusive = 0;
159             }
160 0 0         if ($p{flags}->{in}) {
161 0           $inclusive = 1;
162             }
163              
164 0 0         if ($count) {
165 0 0         if ($inclusive) {
166 0           my $s = $self->{inclusive};
167 0           $self->{inclusive} = $inclusive;
168              
169 0           my $x = 1;
170 0           while (my $q = $self->_have_data) {
171 0           my $x = $context->copy(loop => $self);
172              
173 0           $x->set_count($self);
174 0           push @ret, $self->SUPER::to_text(%p, context => $x);
175 0           $self->inc;
176             }
177 0           $self->{inclusive} = $s;
178             } else {
179 0           my $x = $context->copy(loop => $self);
180              
181 0           push @ret, $self->SUPER::to_text(%p, context => $x);
182             }
183             }
184              
185 0           return @ret;
186             }
187              
188             sub inclusive
189             {
190 0     0 1   my $self = shift;
191 0 0         $self->{inclusive} || 0;
192             }
193              
194             1;
195             __END__