File Coverage

lib/Template.pm
Criterion Covered Total %
statement 82 88 93.1
branch 32 40 80.0
condition 22 30 73.3
subroutine 16 17 94.1
pod 4 4 100.0
total 156 179 87.1


line stmt bran cond sub pod time code
1             #============================================================= -*-perl-*-
2             #
3             # Template
4             #
5             # DESCRIPTION
6             # Module implementing a simple, user-oriented front-end to the Template
7             # Toolkit.
8             #
9             # AUTHOR
10             # Andy Wardley
11             #
12             # COPYRIGHT
13             # Copyright (C) 1996-2014 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;
21              
22 85     85   57052 use strict;
  85         156  
  85         3059  
23 85     85   415 use warnings;
  85         138  
  85         2548  
24 85     85   2442 use 5.006;
  85         279  
  85         4291  
25 85     85   495 use base 'Template::Base';
  85         559  
  85         48124  
26              
27 85     85   62932 use Template::Config;
  85         231  
  85         2764  
28 85     85   615 use Template::Constants;
  85         201  
  85         4409  
29 85     85   68494 use Template::Provider;
  85         308  
  85         3483  
30 85     85   47150 use Template::Service;
  85         304  
  85         3797  
31 85     85   916 use File::Basename;
  85         297  
  85         10813  
32 85     85   554 use File::Path;
  85         177  
  85         12142  
33 85     85   543 use Scalar::Util qw(blessed);
  85         180  
  85         101799  
34              
35             our $VERSION = '2.26';
36             our $ERROR = '';
37             our $DEBUG = 0;
38             our $BINMODE = 0 unless defined $BINMODE;
39             our $AUTOLOAD;
40              
41             # preload all modules if we're running under mod_perl
42             Template::Config->preload() if $ENV{ MOD_PERL };
43              
44              
45             #------------------------------------------------------------------------
46             # process($input, \%replace, $output)
47             #
48             # Main entry point for the Template Toolkit. The Template module
49             # delegates most of the processing effort to the underlying SERVICE
50             # object, an instance of the Template::Service class.
51             #------------------------------------------------------------------------
52              
53             sub process {
54 1210     1210 1 14508 my ($self, $template, $vars, $outstream, @opts) = @_;
55 1210         1753 my ($output, $error);
56 1210 100 66     5605 my $options = (@opts == 1) && ref($opts[0]) eq 'HASH'
57             ? shift(@opts) : { @opts };
58              
59             $options->{ binmode } = $BINMODE
60 1210 100       6369 unless defined $options->{ binmode };
61              
62             # we're using this for testing in t/output.t and t/filter.t so
63             # don't remove it if you don't want tests to fail...
64 1210 100 66     4747 $self->DEBUG("set binmode\n") if $DEBUG && $options->{ binmode };
65              
66 1210         6652 $output = $self->{ SERVICE }->process($template, $vars);
67              
68 1210 100       4444 if (defined $output) {
69 1207   66     3552 $outstream ||= $self->{ OUTPUT };
70 1207 100       4002 unless (ref $outstream) {
71 4         10 my $outpath = $self->{ OUTPUT_PATH };
72 4 50       19 $outstream = "$outpath/$outstream" if $outpath;
73             }
74              
75             # send processed template to output stream, checking for error
76 1207 50       5517 return ($self->error($error))
77             if ($error = &_output($outstream, \$output, $options));
78              
79 1207         8861 return 1;
80             }
81             else {
82 3         15 return $self->error($self->{ SERVICE }->error);
83             }
84             }
85              
86              
87             #------------------------------------------------------------------------
88             # service()
89             #
90             # Returns a reference to the internal SERVICE object which handles
91             # all requests for this Template object
92             #------------------------------------------------------------------------
93              
94             sub service {
95 2     2 1 7 my $self = shift;
96 2         9 return $self->{ SERVICE };
97             }
98              
99              
100             #------------------------------------------------------------------------
101             # context()
102             #
103             # Returns a reference to the CONTEXT object within the SERVICE
104             # object.
105             #------------------------------------------------------------------------
106              
107             sub context {
108 7     7 1 43 my $self = shift;
109 7         39 return $self->{ SERVICE }->{ CONTEXT };
110             }
111              
112             sub template {
113 0     0 1 0 shift->context->template(@_);
114             }
115              
116              
117             #========================================================================
118             # -- PRIVATE METHODS --
119             #========================================================================
120              
121             #------------------------------------------------------------------------
122             # _init(\%config)
123             #------------------------------------------------------------------------
124             sub _init {
125 144     144   354 my ($self, $config) = @_;
126              
127             # convert any textual DEBUG args to numerical form
128 144         368 my $debug = $config->{ DEBUG };
129 144 100 50     860 $config->{ DEBUG } = Template::Constants::debug_flags($self, $debug)
      100        
130             || return if defined $debug && $debug !~ /^\d+$/;
131              
132             # prepare a namespace handler for any CONSTANTS definition
133 144 100       916 if (my $constants = $config->{ CONSTANTS }) {
134 7   100     58 my $ns = $config->{ NAMESPACE } ||= { };
135 7   100     44 my $cns = $config->{ CONSTANTS_NAMESPACE } || 'constants';
136 7   50     63 $constants = Template::Config->constants($constants)
137             || return $self->error(Template::Config->error);
138 7         28 $ns->{ $cns } = $constants;
139             }
140              
141             $self->{ SERVICE } = $config->{ SERVICE }
142 144   50     1696 || Template::Config->service($config)
143             || return $self->error(Template::Config->error);
144              
145 144   100     1057 $self->{ OUTPUT } = $config->{ OUTPUT } || \*STDOUT;
146 144         400 $self->{ OUTPUT_PATH } = $config->{ OUTPUT_PATH };
147              
148 144         1177 return $self;
149             }
150              
151              
152             #------------------------------------------------------------------------
153             # _output($where, $text)
154             #------------------------------------------------------------------------
155              
156             sub _output {
157 1208     1208   2858 my ($where, $textref, $options) = @_;
158 1208         1671 my $reftype;
159 1208         1970 my $error = 0;
160              
161             # call a CODE reference
162 1208 100 66     7222 if (($reftype = ref($where)) eq 'CODE') {
    50          
    100          
    100          
    100          
    50          
163 1         7 &$where($$textref);
164             }
165             # print to a glob (such as \*STDOUT)
166             elsif ($reftype eq 'GLOB') {
167 0         0 print $where $$textref;
168             }
169             # append output to a SCALAR ref
170             elsif ($reftype eq 'SCALAR') {
171 1200         3272 $$where .= $$textref;
172             }
173             # push onto ARRAY ref
174             elsif ($reftype eq 'ARRAY') {
175 1         4 push @$where, $$textref;
176             }
177             # call the print() method on an object that implements the method
178             # (e.g. IO::Handle, Apache::Request, etc)
179             elsif (blessed($where) && $where->can('print')) {
180 1         6 $where->print($$textref);
181             }
182             # a simple string is taken as a filename
183             elsif (! $reftype) {
184 5         15 local *FP;
185             # make destination directory if it doesn't exist
186 5         293 my $dir = dirname($where);
187 5 50       15 eval { mkpath($dir) unless -d $dir; };
  5         135  
188 5 50       682 if ($@) {
    50          
189             # strip file name and line number from error raised by die()
190 0         0 ($error = $@) =~ s/ at \S+ line \d+\n?$//;
191             }
192             elsif (open(FP, ">$where")) {
193             # binmode option can be 1 or a specific layer, e.g. :utf8
194 5         18 my $bm = $options->{ binmode };
195 5 100 66     45 if ($bm && $bm eq 1) {
    50          
196 2         7 binmode FP;
197             }
198             elsif ($bm){
199 0         0 binmode FP, $bm;
200             }
201 5         86 print FP $$textref;
202 5         313 close FP;
203             }
204             else {
205 0         0 $error = "$where: $!";
206             }
207             }
208             # give up, we've done our best
209             else {
210 0         0 $error = "output_handler() cannot determine target type ($where)\n";
211             }
212              
213 1208         4391 return $error;
214             }
215              
216              
217             1;
218              
219             __END__