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