line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTML::Template::Pro::WrapAssociate; |
2
|
|
|
|
|
|
|
|
3
|
14
|
|
|
14
|
|
99
|
use strict; |
|
14
|
|
|
|
|
30
|
|
|
14
|
|
|
|
|
456
|
|
4
|
14
|
|
|
14
|
|
84
|
use Carp; |
|
14
|
|
|
|
|
28
|
|
|
14
|
|
|
|
|
925
|
|
5
|
14
|
|
|
14
|
|
92
|
use vars qw($VERSION @ISA); |
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
8548
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub _wrap { |
8
|
2
|
|
|
2
|
|
7
|
my ($class, $associate_object, $is_case_sensitive, $is_strict_compatibility) = @_; |
9
|
2
|
50
|
33
|
|
|
19
|
if (ref($associate_object) && UNIVERSAL::can($associate_object,'param')) { |
|
|
0
|
0
|
|
|
|
|
10
|
2
|
|
|
|
|
5
|
my %hash; |
11
|
2
|
50
|
|
|
|
5
|
if ($is_case_sensitive) { |
12
|
0
|
|
|
|
|
0
|
tie %hash, $class, $associate_object; |
13
|
|
|
|
|
|
|
} else { |
14
|
2
|
|
|
|
|
8
|
foreach my $key ($associate_object->param()) { |
15
|
2
|
|
|
|
|
23
|
$hash{lc($key)} = $associate_object->param($key); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
} |
18
|
2
|
|
|
|
|
32
|
return \%hash; |
19
|
|
|
|
|
|
|
} elsif (!$is_strict_compatibility && UNIVERSAL::isa($associate_object,'HASH')) { |
20
|
0
|
0
|
|
|
|
|
if ($is_case_sensitive) { |
21
|
0
|
|
|
|
|
|
return $associate_object; |
22
|
|
|
|
|
|
|
} else { |
23
|
0
|
|
|
|
|
|
my %hash; |
24
|
0
|
|
|
|
|
|
foreach my $key (keys(%$associate_object)) { |
25
|
0
|
|
|
|
|
|
$hash{lc($key)} = $associate_object->{$key}; |
26
|
|
|
|
|
|
|
} |
27
|
0
|
|
|
|
|
|
return \%hash; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
} else { |
30
|
0
|
|
|
|
|
|
Carp::croak "bad value for associate: HTML::Template::Pro->new called with associate option, containing object of type " . ref($associate_object) . " which lacks a param() method and does not look like a hash!"; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub param { |
35
|
0
|
|
|
0
|
0
|
|
my $this = shift; |
36
|
0
|
|
|
|
|
|
return $this->[0]->param(@_); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub TIEHASH { |
40
|
0
|
|
|
0
|
|
|
my ($class, $associate) = @_; |
41
|
0
|
|
|
|
|
|
my $self=[$associate,[]]; |
42
|
0
|
|
|
|
|
|
return bless $self, $class; |
43
|
|
|
|
|
|
|
}; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
sub FETCH { |
46
|
0
|
|
|
0
|
|
|
my ($this, $key) = @_; |
47
|
0
|
|
|
|
|
|
return $this->[0]->param($key); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub EXISTS { |
51
|
0
|
|
|
0
|
|
|
my ($this, $key) = @_; |
52
|
0
|
|
|
|
|
|
return defined($this->[0]->param($key)); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub FIRSTKEY{ |
56
|
0
|
|
|
0
|
|
|
my ($this) = @_; |
57
|
0
|
|
|
|
|
|
my @param=$this->[0]->param(); |
58
|
0
|
|
|
|
|
|
$this->[1]=\@param; |
59
|
0
|
|
|
|
|
|
return shift @{$this->[1]}; |
|
0
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub NEXTKEY{ |
63
|
0
|
|
|
0
|
|
|
my ($this) = @_; |
64
|
0
|
|
|
|
|
|
return shift @{$this->[1]}; |
|
0
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
0
|
|
|
sub STORE{} |
68
|
|
|
|
0
|
|
|
sub DELETE{} |
69
|
|
|
|
0
|
|
|
sub CLEAR{} |
70
|
|
|
|
0
|
|
|
sub SCALAR{} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
__END__ |