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   21 use strict;
  3         5  
  3         116  
4 3     3   23 use warnings;
  3         5  
  3         87  
5              
6 3     3   16 use base 'Text::APL::Base';
  3         6  
  3         1069  
7              
8             sub _BUILD {
9 21     21   36 my $self = shift;
10              
11 21   50     146 $self->{namespace} ||= 'Text::APL::';
12             }
13              
14             sub compile {
15 22     22 1 91 my $self = shift;
16 22         45 my ($code, $context) = @_;
17              
18 22         44 my $template_class = "$self->{namespace}";
19              
20 22   100     80 $template_class .= '_' . ($context->name || '__anon__') . $context->id;
21 22         199 $template_class =~ s{[^A-Za-z0-9:]}{_}g;
22              
23 22         44 my $package = '';
24 22         187 $package .= qq/no strict 'refs'; %{"$template_class\::"} = ();/;
25 22         47 $package .= "package $template_class;";
26 22         36 $package .= 'sub {';
27 22         89 $package .= 'use strict; use warnings;';
28 22         36 $package .= 'my $__self = $_[0];';
29              
30 22         48 $package .= $self->_generate_vars($context);
31              
32 22         71 $package .= $self->_generate_helpers($context);
33              
34 22         56 $package .= $code . '}';
35              
36 3 100   3   23 eval $package or die $@;
  3     3   15  
  3     3   209  
  3     3   20  
  3     1   11  
  3     1   81  
  3     1   23  
  3     1   6  
  3     1   442  
  3     1   24  
  3     1   6  
  3     1   176  
  3     1   26  
  3     1   8  
  3     1   70  
  3     1   16  
  3     1   11  
  3     1   461  
  22     1   1458  
  1     1   19  
  1     1   6  
  1     1   1  
  1     1   171  
  1     1   7  
  1     1   3  
  1     1   46  
  1     1   5  
  1     1   2  
  1         29  
  1         6  
  1         2  
  1         184  
  1         7  
  1         2  
  1         64  
  1         6  
  1         2  
  1         32  
  1         6  
  1         2  
  1         149  
  1         6  
  1         2  
  1         57  
  1         7  
  1         2  
  1         33  
  1         6  
  1         2  
  1         149  
  1         7  
  1         2  
  1         57  
  1         7  
  1         2  
  1         19  
  1         5  
  1         2  
  1         159  
  1         8  
  1         2  
  1         56  
  1         7  
  1         2  
  1         27  
  1         5  
  1         2  
  1         137  
  1         8  
  1         2  
  1         80  
  1         7  
  1         2  
  1         22  
  1         5  
  1         2  
  1         160  
  1         7  
  1         2  
  1         60  
  1         6  
  1         2  
  1         28  
  1         6  
  1         2  
  1         155  
  1         7  
  1         3  
  1         58  
  1         7  
  1         2  
  1         18  
  1         6  
  1         2  
  1         176  
  1         8  
  1         2  
  1         56  
  1         6  
  1         2  
  1         45  
  1         6  
  1         3  
  1         149  
  1         7  
  1         2  
  1         57  
  1         6  
  1         3  
  1         36  
  1         6  
  1         2  
  1         157  
37             }
38              
39             sub _generate_vars {
40 22     22   188 my $self = shift;
41 22         42 my ($context) = @_;
42              
43 22         32 my $string = '';
44 22         87 foreach my $var (keys %{$context->vars}) {
  22         55  
45 12         37 $string .= qq/my \$$var = \$__self->vars->{$var};/;
46             }
47              
48 22         67 return $string;
49             }
50              
51             sub _generate_helpers {
52 22     22   37 my $self = shift;
53 22         32 my ($context) = @_;
54              
55 22         182 my $string = '';
56              
57 22         41 $string .= "sub var; local *var = sub { \$__self->vars->{\$_[0]} };";
58 22         44 foreach my $key (keys %{$context->helpers}) {
  22         116  
59 44         126 $string .= "sub $key; local *$key = \$__self->helpers->{$key};";
60             }
61              
62 22         55 return $string;
63             }
64              
65             1;
66             __END__