File Coverage

blib/lib/Text/APL/Compiler.pm
Criterion Covered Total %
statement 153 153 100.0
branch 2 2 100.0
condition 3 4 75.0
subroutine 35 35 100.0
pod 1 1 100.0
total 194 195 99.4


line stmt bran cond sub pod time code
1             package Text::APL::Compiler;
2              
3 3     3   16 use strict;
  3         4  
  3         98  
4 3     3   16 use warnings;
  3         4  
  3         71  
5              
6 3     3   12 use base 'Text::APL::Base';
  3         5  
  3         909  
7              
8             sub _BUILD {
9 21     21   37 my $self = shift;
10              
11 21   50     127 $self->{namespace} ||= 'Text::APL::';
12             }
13              
14             sub compile {
15 22     22 1 76 my $self = shift;
16 22         33 my ($code, $context) = @_;
17              
18 22         38 my $template_class = "$self->{namespace}";
19              
20 22   100     64 $template_class .= '_' . ($context->name || '__anon__') . $context->id;
21 22         124 $template_class =~ s{[^A-Za-z0-9:]}{_}g;
22              
23 22         36 my $package = '';
24 22         144 $package .= qq/no strict 'refs'; %{"$template_class\::"} = ();/;
25 22         37 $package .= "package $template_class;";
26 22         25 $package .= 'sub {';
27 22         66 $package .= 'use strict; use warnings;';
28 22         27 $package .= 'my $__self = $_[0];';
29              
30 22         49 $package .= $self->_generate_vars($context);
31              
32 22         58 $package .= $self->_generate_helpers($context);
33              
34 22         48 $package .= $code . '}';
35              
36 3 100   3   18 eval $package or die $@;
  3     3   11  
  3     3   185  
  3     3   18  
  3     1   10  
  3     1   89  
  3     1   18  
  3     1   6  
  3     1   412  
  3     1   15  
  3     1   6  
  3     1   141  
  3     1   17  
  3     1   4  
  3     1   47  
  3     1   11  
  3     1   15  
  3     1   387  
  22     1   1184  
  1     1   15  
  1     1   4  
  1     1   1  
  1     1   151  
  1     1   5  
  1     1   2  
  1     1   35  
  1     1   4  
  1     1   2  
  1         23  
  1         4  
  1         1  
  1         134  
  1         6  
  1         2  
  1         44  
  1         6  
  1         1  
  1         23  
  1         4  
  1         2  
  1         163  
  1         5  
  1         2  
  1         43  
  1         5  
  1         2  
  1         27  
  1         4  
  1         1  
  1         127  
  1         5  
  1         2  
  1         44  
  1         5  
  1         2  
  1         15  
  1         3  
  1         2  
  1         168  
  1         6  
  1         1  
  1         44  
  1         5  
  1         1  
  1         21  
  1         5  
  1         1  
  1         119  
  1         4  
  1         2  
  1         50  
  1         5  
  1         2  
  1         15  
  1         3  
  1         2  
  1         121  
  1         5  
  1         1  
  1         46  
  1         6  
  1         1  
  1         23  
  1         4  
  1         2  
  1         126  
  1         6  
  1         1  
  1         59  
  1         5  
  1         1  
  1         16  
  1         4  
  1         1  
  1         116  
  1         5  
  1         2  
  1         52  
  1         5  
  1         2  
  1         34  
  1         7  
  1         2  
  1         136  
  1         5  
  1         2  
  1         56  
  1         16  
  1         2  
  1         71  
  1         6  
  1         2  
  1         140  
37             }
38              
39             sub _generate_vars {
40 22     22   148 my $self = shift;
41 22         50 my ($context) = @_;
42              
43 22         24 my $string = '';
44 22         72 foreach my $var (keys %{$context->vars}) {
  22         40  
45 12         26 $string .= qq/my \$$var = \$__self->vars->{$var};/;
46             }
47              
48 22         63 return $string;
49             }
50              
51             sub _generate_helpers {
52 22     22   27 my $self = shift;
53 22         31 my ($context) = @_;
54              
55 22         134 my $string = '';
56              
57 22         34 $string .= "sub var; local *var = sub { \$__self->vars->{\$_[0]} };";
58 22         24 foreach my $key (keys %{$context->helpers}) {
  22         100  
59 44         93 $string .= "sub $key; local *$key = \$__self->helpers->{$key};";
60             }
61              
62 22         37 return $string;
63             }
64              
65             1;
66             __END__