File Coverage

lib/Template/Namespace/Constants.pm
Criterion Covered Total %
statement 44 48 91.6
branch 12 22 54.5
condition 5 8 62.5
subroutine 8 8 100.0
pod 1 1 100.0
total 70 87 80.4


line stmt bran cond sub pod time code
1             #================================================================= -*-Perl-*-
2             #
3             # Template::Namespace::Constants
4             #
5             # DESCRIPTION
6             # Plugin compiler module for performing constant folding at compile time
7             # on variables in a particular namespace.
8             #
9             # AUTHOR
10             # Andy Wardley
11             #
12             # COPYRIGHT
13             # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
14             #
15             # This module is free software; you can redistribute it and/or
16             # modify it under the same terms as Perl itself.
17             #
18             #============================================================================
19              
20             package Template::Namespace::Constants;
21              
22 5     5   635 use strict;
  5         11  
  5         189  
23 5     5   29 use warnings;
  5         11  
  5         182  
24 5     5   27 use base 'Template::Base';
  5         9  
  5         499  
25 5     5   32 use Template::Config;
  5         8  
  5         112  
26 5     5   2179 use Template::Directive;
  5         13  
  5         135  
27 5     5   40 use Template::Exception;
  5         9  
  5         2721  
28              
29             our $VERSION = 1.27;
30             our $DEBUG = 0 unless defined $DEBUG;
31              
32              
33             sub _init {
34 8     8   15 my ($self, $config) = @_;
35 8   50     47 $self->{ STASH } = Template::Config->stash($config)
36             || return $self->error(Template::Config->error());
37 8         138 return $self;
38             }
39              
40              
41              
42             #------------------------------------------------------------------------
43             # ident(\@ident) foo.bar(baz)
44             #------------------------------------------------------------------------
45              
46             sub ident {
47 36     36 1 117 my ($self, $ident) = @_;
48 36         93 my @save = @$ident;
49              
50             # discard first node indicating constants namespace
51 36         71 splice(@$ident, 0, 2);
52              
53 36         68 my $nelems = @$ident / 2;
54 36         50 my ($e, $result);
55 36         61 local $" = ', ';
56              
57 36 50       83 print STDERR "constant ident [ @$ident ] " if $DEBUG;
58              
59 36         91 foreach $e (0..$nelems-1) {
60             # node name must be a constant
61 61 50       367 unless ($ident->[$e * 2] =~ s/^'(.+)'$/$1/s) {
62 0 0       0 $self->DEBUG(" * deferred (non-constant item: ", $ident->[$e * 2], ")\n")
63             if $DEBUG;
64 0         0 return Template::Directive->ident(\@save);
65             }
66              
67             # if args is non-zero then it must be eval'ed
68 61 100       204 if ($ident->[$e * 2 + 1]) {
69 4         9 my $args = $ident->[$e * 2 + 1];
70 4         271 my $comp = eval "$args";
71 4 50       16 if ($@) {
72 0 0       0 $self->DEBUG(" * deferred (non-constant args: $args)\n") if $DEBUG;
73 0         0 return Template::Directive->ident(\@save);
74             }
75 4 50 33     21 $self->DEBUG("($args) ") if $comp && $DEBUG;
76 4         15 $ident->[$e * 2 + 1] = $comp;
77             }
78             }
79              
80              
81 36         569 $result = $self->{ STASH }->get($ident);
82              
83 36 100 100     212 if (! length $result || ref $result) {
84 2 100       8 my $reason = length $result ? 'reference' : 'no result';
85 2 50       7 $self->DEBUG(" * deferred ($reason)\n") if $DEBUG;
86 2         13 return Template::Directive->ident(\@save);
87             }
88              
89 34         75 $result =~ s/'/\\'/g;
90              
91 34 50       70 $self->DEBUG(" * resolved => '$result'\n") if $DEBUG;
92              
93 34         205 return "'$result'";
94             }
95              
96             1;
97              
98             __END__