File Coverage

blib/lib/HTML/Template/Compiled/Compiler/Classic.pm
Criterion Covered Total %
statement 26 29 89.6
branch 7 10 70.0
condition 1 3 33.3
subroutine 4 4 100.0
pod 1 1 100.0
total 39 47 82.9


line stmt bran cond sub pod time code
1             package HTML::Template::Compiled::Compiler::Classic;
2 1     1   3 use strict;
  1         1  
  1         20  
3 1     1   2 use warnings;
  1         1  
  1         27  
4             our $VERSION = '1.002_001'; # TRIAL VERSION
5              
6 1     1   3 use base 'HTML::Template::Compiled::Compiler';
  1         1  
  1         328  
7              
8             sub parse_var {
9 7     7 1 23 my ( $self, $t, %args ) = @_;
10 7         6 my $context = $args{context};
11 7 50       16 if (!$t->validate_var($args{var})) {
12             $t->get_parser->_error_wrong_tag_syntax(
13             {
14             fname => $context->get_file,
15             line => $context->get_line,
16             token => "",
17             },
18             $args{var}
19 0         0 );
20             }
21 7         29 my %loop_context = (
22             __index__ => '$__ix__',
23             __counter__ => '$__ix__+1',
24             __first__ => '$__ix__ == $[',
25             __last__ => '$__ix__ == $__size__',
26             __odd__ => '!($__ix__ & 1)',
27             __even__ => '($__ix__ & 1)',
28             __inner__ => '$__ix__ != $[ && $__ix__ != $__size__',
29             __outer__ => '$__ix__ == $[ || $__ix__ == $__size__',
30             __break__ => '$__break__',
31             __filename__ => '$t->get_file',
32             __filenameshort__ => '$t->get_filename',
33             __wrapped__ => '$args->{wrapped}',
34             );
35              
36 7 50 33     23 if ( $t->get_loop_context && $args{var} =~ m/^__(\w+)__$/ ) {
37 0         0 my $lc = $loop_context{ lc $args{var} };
38 0         0 return $lc;
39             }
40 7 100       12 my $var = $t->get_case_sensitive ? $args{var} : lc $args{var};
41 7 100       11 if ($t->get_global_vars & 1) {
42 4         6 my $varstr =
43             "\$t->_get_var_global_sub(" . '$P,$$C,0,'."[undef,'$var'])";
44 4         13 return $varstr;
45             }
46             else {
47 3         5 $var =~ s/\\/\\\\/g;
48 3         3 $var =~ s/'/\\'/g;
49 3         5 my $varstr = '$$C->{' . "'$var'" . '}';
50 3         5 my $string = <<"EOM";
51             do { my \$var = $varstr;
52             \$var = (ref \$var eq 'CODE') ? \$var->() : \$var;
53             EOM
54 3 50       8 if ($context->get_name !~ m/^(?:LOOP|WITH)$/) {
55 3         5 $string .= <<"EOM";
56             (ref \$var eq 'ARRAY' ? \@\$var : \$var)
57             EOM
58             }
59 3         3 $string .= '}';
60 3         10 return $string;
61             }
62             }
63              
64              
65             1;
66              
67             __END__