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__ |