line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Data::Template; |
3
|
|
|
|
|
|
|
|
4
|
3
|
|
|
3
|
|
126939
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
115
|
|
5
|
3
|
|
|
3
|
|
15
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
131
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.0005'; |
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
15
|
use base qw(Class::Accessor); |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
3548
|
|
10
|
|
|
|
|
|
|
Data::Template->mk_accessors(qw(engine prefix)); |
11
|
|
|
|
|
|
|
|
12
|
3
|
|
|
3
|
|
66192
|
use Template; |
|
3
|
|
|
|
|
127490
|
|
|
3
|
|
|
|
|
2126
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub new { |
15
|
2
|
|
|
2
|
1
|
25
|
my $self = shift; |
16
|
2
|
|
|
|
|
57
|
my $TT = Template->new(INTERPOLATE => 1); |
17
|
|
|
|
|
|
|
# return $self->SUPER::new({engine => $TT, prefix => '=', @_}); |
18
|
2
|
|
|
|
|
54978
|
return $self->SUPER::new({engine => $TT, @_}); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub process { |
22
|
28
|
|
|
28
|
1
|
3110
|
my $self = shift; |
23
|
28
|
|
|
|
|
33
|
my $tt = shift; |
24
|
28
|
|
|
|
|
32
|
my $vars = shift; |
25
|
|
|
|
|
|
|
|
26
|
28
|
100
|
|
|
|
214
|
if (!ref $tt) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
27
|
22
|
|
|
|
|
47
|
return $self->process_s($tt, $vars); |
28
|
|
|
|
|
|
|
} elsif (ref $tt eq 'ARRAY') { |
29
|
4
|
|
|
|
|
16
|
return $self->process_a($tt, $vars); |
30
|
|
|
|
|
|
|
} elsif (ref $tt eq 'HASH') { |
31
|
2
|
|
|
|
|
8
|
return $self->process_h($tt, $vars); |
32
|
|
|
|
|
|
|
} else { |
33
|
0
|
|
|
|
|
0
|
die 'burp' |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub process_h { |
38
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
39
|
2
|
|
|
|
|
5
|
my $h = shift; |
40
|
2
|
|
|
|
|
2
|
my $vars = shift; |
41
|
|
|
|
|
|
|
|
42
|
2
|
|
|
|
|
6
|
my %ph = (); |
43
|
2
|
|
|
|
|
14
|
while (my ($k, $v) = each %$h) { |
44
|
8
|
|
|
|
|
26
|
$k = $self->process_s($k, $vars); |
45
|
8
|
|
|
|
|
27
|
$v = $self->process($v, $vars); |
46
|
8
|
|
|
|
|
41
|
$ph{$k} = $v; |
47
|
|
|
|
|
|
|
} |
48
|
2
|
|
|
|
|
8
|
return \%ph; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub process_a { |
52
|
4
|
|
|
4
|
1
|
6
|
my $self = shift; |
53
|
4
|
|
|
|
|
6
|
my $a = shift; |
54
|
4
|
|
|
|
|
5
|
my $vars = shift; |
55
|
|
|
|
|
|
|
|
56
|
4
|
|
|
|
|
28
|
my @pa; |
57
|
4
|
|
|
|
|
9
|
foreach (@$a) { |
58
|
12
|
|
|
|
|
30
|
push @pa, $self->process($_, $vars); |
59
|
|
|
|
|
|
|
} |
60
|
4
|
|
|
|
|
46
|
return \@pa; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=begin private |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
($p, $t) = $self->_split_scalar($s) |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Determines if C<$s> is a plain scalar or |
68
|
|
|
|
|
|
|
a text template. If it is a plain scalar, |
69
|
|
|
|
|
|
|
C<$p> gets its content and C<$t> gets C. |
70
|
|
|
|
|
|
|
Otherwise, C<$p> is C and C<$t> |
71
|
|
|
|
|
|
|
gets the contents of the template. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
There is difference between C<$s> and |
74
|
|
|
|
|
|
|
the content of C<$s> only if there is a |
75
|
|
|
|
|
|
|
C. In this case, a plain scalar |
76
|
|
|
|
|
|
|
is (1) one which does not begin with the prefix |
77
|
|
|
|
|
|
|
(the content is C<$s> itself) or (2) |
78
|
|
|
|
|
|
|
one which begins with C<"\\"> followed |
79
|
|
|
|
|
|
|
by the prefix (the content is C<$s> without |
80
|
|
|
|
|
|
|
the leading escape). When there is |
81
|
|
|
|
|
|
|
a prefix, C<$s> is a template if it begins |
82
|
|
|
|
|
|
|
with the prefix and its content is C<$s> |
83
|
|
|
|
|
|
|
without the prefix. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# say prefix is '=' |
86
|
|
|
|
|
|
|
($p, $t) = $tt->_split_scalar('foo') |
87
|
|
|
|
|
|
|
# ($p, $t) = ('foo', undef) |
88
|
|
|
|
|
|
|
($p, $t) = $tt->_split_scalar('=foo') |
89
|
|
|
|
|
|
|
# ($p, $t) = (undef, 'foo') |
90
|
|
|
|
|
|
|
($p, $t) = $tt->_split_scalar('\\=foo') |
91
|
|
|
|
|
|
|
# ($p, $t) = ('=foo', undef) |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=end private |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub _split_scalar { |
98
|
34
|
|
|
34
|
|
38
|
my $self = shift; |
99
|
34
|
|
|
|
|
38
|
my $s = shift; |
100
|
34
|
|
|
|
|
87
|
my $prefix = $self->prefix; |
101
|
34
|
100
|
|
|
|
329
|
if ($prefix) { |
102
|
17
|
100
|
|
|
|
85
|
if ($s =~ s/^\Q$prefix\E//) { # it is a template |
103
|
4
|
|
|
|
|
11
|
return (undef, $s); |
104
|
|
|
|
|
|
|
} else { |
105
|
13
|
|
|
|
|
46
|
$s =~ s/^\\(\Q$prefix\E)/$1/; # chomp the leading escape |
106
|
13
|
|
|
|
|
37
|
return ($s, undef); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
# by now everything else looks like a template |
110
|
17
|
|
|
|
|
32
|
return (undef, $s); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub process_s { |
114
|
34
|
|
|
34
|
1
|
44
|
my $self = shift; |
115
|
34
|
|
|
|
|
43
|
my $s = shift; |
116
|
34
|
|
|
|
|
38
|
my $vars = shift; |
117
|
|
|
|
|
|
|
|
118
|
34
|
|
|
|
|
68
|
my ($p, $t) = $self->_split_scalar($s); |
119
|
34
|
100
|
|
|
|
101
|
return $p if defined $p; |
120
|
|
|
|
|
|
|
|
121
|
21
|
|
|
|
|
20
|
my $ps; |
122
|
21
|
50
|
|
|
|
54
|
$self->engine->process(\$t, $vars, \$ps) |
123
|
|
|
|
|
|
|
or die $self->engine->error(); |
124
|
21
|
|
|
|
|
91727
|
return $ps; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
1; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
__END__ |