Filename | /usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Service.pm |
Statements | Executed 72 statements in 1.82ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 894µs | 1.25ms | BEGIN@27 | Template::Service::
1 | 1 | 1 | 76µs | 163ms | process | Template::Service::
1 | 1 | 1 | 28µs | 17.3ms | _init | Template::Service::
1 | 1 | 1 | 18µs | 30µs | BEGIN@23 | Template::Service::
1 | 1 | 1 | 15µs | 39µs | BEGIN@28 | Template::Service::
1 | 1 | 1 | 13µs | 42µs | BEGIN@29 | Template::Service::
1 | 1 | 1 | 12µs | 22µs | BEGIN@24 | Template::Service::
1 | 1 | 1 | 10µs | 68µs | BEGIN@25 | Template::Service::
1 | 1 | 1 | 9µs | 36µs | BEGIN@31 | Template::Service::
1 | 1 | 1 | 7µs | 7µs | BEGIN@26 | Template::Service::
0 | 0 | 0 | 0s | 0s | _dump | Template::Service::
0 | 0 | 0 | 0s | 0s | _recover | Template::Service::
0 | 0 | 0 | 0s | 0s | context | Template::Service::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #============================================================= -*-Perl-*- | ||||
2 | # | ||||
3 | # Template::Service | ||||
4 | # | ||||
5 | # DESCRIPTION | ||||
6 | # Module implementing a template processing service which wraps a | ||||
7 | # template within PRE_PROCESS and POST_PROCESS templates and offers | ||||
8 | # ERROR recovery. | ||||
9 | # | ||||
10 | # AUTHOR | ||||
11 | # Andy Wardley <abw@wardley.org> | ||||
12 | # | ||||
13 | # COPYRIGHT | ||||
14 | # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. | ||||
15 | # | ||||
16 | # This module is free software; you can redistribute it and/or | ||||
17 | # modify it under the same terms as Perl itself. | ||||
18 | # | ||||
19 | #============================================================================ | ||||
20 | |||||
21 | package Template::Service; | ||||
22 | |||||
23 | 2 | 46µs | 2 | 43µs | # spent 30µs (18+13) within Template::Service::BEGIN@23 which was called:
# once (18µs+13µs) by Template::BEGIN@30 at line 23 # spent 30µs making 1 call to Template::Service::BEGIN@23
# spent 13µs making 1 call to strict::import |
24 | 2 | 43µs | 2 | 32µs | # spent 22µs (12+10) within Template::Service::BEGIN@24 which was called:
# once (12µs+10µs) by Template::BEGIN@30 at line 24 # spent 22µs making 1 call to Template::Service::BEGIN@24
# spent 10µs making 1 call to warnings::import |
25 | 2 | 90µs | 2 | 125µs | # spent 68µs (10+57) within Template::Service::BEGIN@25 which was called:
# once (10µs+57µs) by Template::BEGIN@30 at line 25 # spent 68µs making 1 call to Template::Service::BEGIN@25
# spent 57µs making 1 call to base::import |
26 | 2 | 27µs | 1 | 7µs | # spent 7µs within Template::Service::BEGIN@26 which was called:
# once (7µs+0s) by Template::BEGIN@30 at line 26 # spent 7µs making 1 call to Template::Service::BEGIN@26 |
27 | 2 | 194µs | 1 | 1.25ms | # spent 1.25ms (894µs+360µs) within Template::Service::BEGIN@27 which was called:
# once (894µs+360µs) by Template::BEGIN@30 at line 27 # spent 1.25ms making 1 call to Template::Service::BEGIN@27 |
28 | 2 | 58µs | 2 | 62µs | # spent 39µs (15+24) within Template::Service::BEGIN@28 which was called:
# once (15µs+24µs) by Template::BEGIN@30 at line 28 # spent 39µs making 1 call to Template::Service::BEGIN@28
# spent 24µs making 1 call to Exporter::import |
29 | 2 | 68µs | 2 | 71µs | # spent 42µs (13+29) within Template::Service::BEGIN@29 which was called:
# once (13µs+29µs) by Template::BEGIN@30 at line 29 # spent 42µs making 1 call to Template::Service::BEGIN@29
# spent 29µs making 1 call to Exporter::import |
30 | |||||
31 | 2 | 1.19ms | 2 | 63µs | # spent 36µs (9+27) within Template::Service::BEGIN@31 which was called:
# once (9µs+27µs) by Template::BEGIN@30 at line 31 # spent 36µs making 1 call to Template::Service::BEGIN@31
# spent 27µs making 1 call to constant::import |
32 | |||||
33 | 1 | 400ns | our $VERSION = 2.80; | ||
34 | 1 | 500ns | our $DEBUG = 0 unless defined $DEBUG; | ||
35 | 1 | 300ns | our $ERROR = ''; | ||
36 | |||||
37 | |||||
38 | #======================================================================== | ||||
39 | # ----- PUBLIC METHODS ----- | ||||
40 | #======================================================================== | ||||
41 | |||||
42 | #------------------------------------------------------------------------ | ||||
43 | # process($template, \%params) | ||||
44 | # | ||||
45 | # Process a template within a service framework. A service may encompass | ||||
46 | # PRE_PROCESS and POST_PROCESS templates and an ERROR hash which names | ||||
47 | # templates to be substituted for the main template document in case of | ||||
48 | # error. Each service invocation begins by resetting the state of the | ||||
49 | # context object via a call to reset(). The AUTO_RESET option may be set | ||||
50 | # to 0 (default: 1) to bypass this step. | ||||
51 | #------------------------------------------------------------------------ | ||||
52 | |||||
53 | # spent 163ms (76µs+163) within Template::Service::process which was called:
# once (76µs+163ms) by Template::process at line 66 of Template.pm | ||||
54 | 1 | 700ns | my ($self, $template, $params) = @_; | ||
55 | 1 | 900ns | my $context = $self->{ CONTEXT }; | ||
56 | 1 | 300ns | my ($name, $output, $procout, $error); | ||
57 | 1 | 500ns | $output = ''; | ||
58 | |||||
59 | $self->debug("process($template, ", | ||||
60 | defined $params ? $params : '<no params>', | ||||
61 | 1 | 600ns | ')') if $self->{ DEBUG }; | ||
62 | |||||
63 | $context->reset() | ||||
64 | 1 | 4µs | 1 | 7µs | if $self->{ AUTO_RESET }; # spent 7µs making 1 call to Template::Context::reset |
65 | |||||
66 | # pre-request compiled template from context so that we can alias it | ||||
67 | # in the stash for pre-processed templates to reference | ||||
68 | 2 | 4µs | 1 | 53.9ms | eval { $template = $context->template($template) }; # spent 53.9ms making 1 call to Template::Context::template |
69 | 1 | 400ns | return $self->error($@) | ||
70 | if $@; | ||||
71 | |||||
72 | # localise the variable stash with any parameters passed | ||||
73 | # and set the 'template' variable | ||||
74 | 1 | 500ns | $params ||= { }; | ||
75 | # TODO: change this to C<||=> so we can use a template parameter | ||||
76 | 1 | 2µs | $params->{ template } = $template | ||
77 | unless ref $template eq 'CODE'; | ||||
78 | 1 | 4µs | 1 | 125µs | $context->localise($params); # spent 125µs making 1 call to Template::Context::localise |
79 | |||||
80 | SERVICE: { | ||||
81 | # PRE_PROCESS | ||||
82 | 2 | 2µs | eval { | ||
83 | 1 | 3µs | foreach $name (@{ $self->{ PRE_PROCESS } }) { | ||
84 | $self->debug("PRE_PROCESS: $name") if $self->{ DEBUG }; | ||||
85 | $output .= $context->process($name); | ||||
86 | } | ||||
87 | }; | ||||
88 | 1 | 800ns | last SERVICE if ($error = $@); | ||
89 | |||||
90 | # PROCESS | ||||
91 | 1 | 800ns | eval { | ||
92 | 1 | 2µs | foreach $name (@{ $self->{ PROCESS } || [ $template ] }) { | ||
93 | 1 | 400ns | $self->debug("PROCESS: $name") if $self->{ DEBUG }; | ||
94 | 1 | 10µs | 1 | 109ms | $procout .= $context->process($name); # spent 109ms making 1 call to Template::Context::process |
95 | } | ||||
96 | }; | ||||
97 | 1 | 600ns | if ($error = $@) { | ||
98 | last SERVICE | ||||
99 | unless defined ($procout = $self->_recover(\$error)); | ||||
100 | } | ||||
101 | |||||
102 | 1 | 800ns | if (defined $procout) { | ||
103 | # WRAPPER | ||||
104 | 1 | 600ns | eval { | ||
105 | 1 | 2µs | foreach $name (reverse @{ $self->{ WRAPPER } }) { | ||
106 | $self->debug("WRAPPER: $name") if $self->{ DEBUG }; | ||||
107 | $procout = $context->process($name, { content => $procout }); | ||||
108 | } | ||||
109 | }; | ||||
110 | 1 | 400ns | last SERVICE if ($error = $@); | ||
111 | 1 | 2µs | $output .= $procout; | ||
112 | } | ||||
113 | |||||
114 | # POST_PROCESS | ||||
115 | 1 | 400ns | eval { | ||
116 | 1 | 1µs | foreach $name (@{ $self->{ POST_PROCESS } }) { | ||
117 | $self->debug("POST_PROCESS: $name") if $self->{ DEBUG }; | ||||
118 | $output .= $context->process($name); | ||||
119 | } | ||||
120 | }; | ||||
121 | 1 | 200ns | last SERVICE if ($error = $@); | ||
122 | } | ||||
123 | |||||
124 | 1 | 4µs | 1 | 7µs | $context->delocalise(); # spent 7µs making 1 call to Template::Context::delocalise |
125 | 1 | 16µs | 1 | 700ns | delete $params->{ template }; # spent 700ns making 1 call to Template::Stash::XS::DESTROY |
126 | |||||
127 | 1 | 300ns | if ($error) { | ||
128 | # $error = $error->as_string if ref $error; | ||||
129 | return $self->error($error); | ||||
130 | } | ||||
131 | |||||
132 | 1 | 5µs | return $output; | ||
133 | } | ||||
134 | |||||
135 | |||||
136 | #------------------------------------------------------------------------ | ||||
137 | # context() | ||||
138 | # | ||||
139 | # Returns the internal CONTEXT reference. | ||||
140 | #------------------------------------------------------------------------ | ||||
141 | |||||
142 | sub context { | ||||
143 | return $_[0]->{ CONTEXT }; | ||||
144 | } | ||||
145 | |||||
146 | |||||
147 | #======================================================================== | ||||
148 | # -- PRIVATE METHODS -- | ||||
149 | #======================================================================== | ||||
150 | |||||
151 | # spent 17.3ms (28µs+17.3) within Template::Service::_init which was called:
# once (28µs+17.3ms) by Template::Base::new at line 65 of Template/Base.pm | ||||
152 | 1 | 400ns | my ($self, $config) = @_; | ||
153 | 1 | 400ns | my ($item, $data, $context, $block, $blocks); | ||
154 | 1 | 700ns | my $delim = $config->{ DELIMITER }; | ||
155 | 1 | 600ns | $delim = ':' unless defined $delim; | ||
156 | |||||
157 | # coerce PRE_PROCESS, PROCESS and POST_PROCESS to arrays if necessary, | ||||
158 | # by splitting on non-word characters | ||||
159 | 1 | 2µs | foreach $item (qw( PRE_PROCESS PROCESS POST_PROCESS WRAPPER )) { | ||
160 | 4 | 1µs | $data = $config->{ $item }; | ||
161 | 4 | 8µs | $self->{ $item } = [ ], next unless (defined $data); | ||
162 | $data = [ split($delim, $data || '') ] | ||||
163 | unless ref $data eq 'ARRAY'; | ||||
164 | $self->{ $item } = $data; | ||||
165 | } | ||||
166 | # unset PROCESS option unless explicitly specified in config | ||||
167 | $self->{ PROCESS } = undef | ||||
168 | 1 | 2µs | unless defined $config->{ PROCESS }; | ||
169 | |||||
170 | 1 | 2µs | $self->{ ERROR } = $config->{ ERROR } || $config->{ ERRORS }; | ||
171 | $self->{ AUTO_RESET } = defined $config->{ AUTO_RESET } | ||||
172 | 1 | 2µs | ? $config->{ AUTO_RESET } : 1; | ||
173 | 1 | 1µs | $self->{ DEBUG } = ( $config->{ DEBUG } || 0 ) | ||
174 | & Template::Constants::DEBUG_SERVICE; | ||||
175 | |||||
176 | $context = $self->{ CONTEXT } = $config->{ CONTEXT } | ||||
177 | 1 | 4µs | 1 | 17.3ms | || Template::Config->context($config) # spent 17.3ms making 1 call to Template::Config::context |
178 | || return $self->error(Template::Config->error); | ||||
179 | |||||
180 | 1 | 4µs | return $self; | ||
181 | } | ||||
182 | |||||
183 | |||||
184 | #------------------------------------------------------------------------ | ||||
185 | # _recover(\$exception) | ||||
186 | # | ||||
187 | # Examines the internal ERROR hash array to find a handler suitable | ||||
188 | # for the exception object passed by reference. Selecting the handler | ||||
189 | # is done by delegation to the exception's select_handler() method, | ||||
190 | # passing the set of handler keys as arguments. A 'default' handler | ||||
191 | # may also be provided. The handler value represents the name of a | ||||
192 | # template which should be processed. | ||||
193 | #------------------------------------------------------------------------ | ||||
194 | |||||
195 | sub _recover { | ||||
196 | my ($self, $error) = @_; | ||||
197 | my $context = $self->{ CONTEXT }; | ||||
198 | my ($hkey, $handler, $output); | ||||
199 | |||||
200 | # there shouldn't ever be a non-exception object received at this | ||||
201 | # point... unless a module like CGI::Carp messes around with the | ||||
202 | # DIE handler. | ||||
203 | return undef | ||||
204 | unless blessed($$error) && $$error->isa(EXCEPTION); | ||||
205 | |||||
206 | # a 'stop' exception is thrown by [% STOP %] - we return the output | ||||
207 | # buffer stored in the exception object | ||||
208 | return $$error->text() | ||||
209 | if $$error->type() eq 'stop'; | ||||
210 | |||||
211 | my $handlers = $self->{ ERROR } | ||||
212 | || return undef; ## RETURN | ||||
213 | |||||
214 | if (ref $handlers eq 'HASH') { | ||||
215 | if ($hkey = $$error->select_handler(keys %$handlers)) { | ||||
216 | $handler = $handlers->{ $hkey }; | ||||
217 | $self->debug("using error handler for $hkey") if $self->{ DEBUG }; | ||||
218 | } | ||||
219 | elsif ($handler = $handlers->{ default }) { | ||||
220 | # use default handler | ||||
221 | $self->debug("using default error handler") if $self->{ DEBUG }; | ||||
222 | } | ||||
223 | else { | ||||
224 | return undef; ## RETURN | ||||
225 | } | ||||
226 | } | ||||
227 | else { | ||||
228 | $handler = $handlers; | ||||
229 | $self->debug("using default error handler") if $self->{ DEBUG }; | ||||
230 | } | ||||
231 | |||||
232 | eval { $handler = $context->template($handler) }; | ||||
233 | if ($@) { | ||||
234 | $$error = $@; | ||||
235 | return undef; ## RETURN | ||||
236 | }; | ||||
237 | |||||
238 | $context->stash->set('error', $$error); | ||||
239 | eval { | ||||
240 | $output .= $context->process($handler); | ||||
241 | }; | ||||
242 | if ($@) { | ||||
243 | $$error = $@; | ||||
244 | return undef; ## RETURN | ||||
245 | } | ||||
246 | |||||
247 | return $output; | ||||
248 | } | ||||
249 | |||||
- - | |||||
252 | #------------------------------------------------------------------------ | ||||
253 | # _dump() | ||||
254 | # | ||||
255 | # Debug method which return a string representing the internal object | ||||
256 | # state. | ||||
257 | #------------------------------------------------------------------------ | ||||
258 | |||||
259 | sub _dump { | ||||
260 | my $self = shift; | ||||
261 | my $context = $self->{ CONTEXT }->_dump(); | ||||
262 | $context =~ s/\n/\n /gm; | ||||
263 | |||||
264 | my $error = $self->{ ERROR }; | ||||
265 | $error = join('', | ||||
266 | "{\n", | ||||
267 | (map { " $_ => $error->{ $_ }\n" } | ||||
268 | keys %$error), | ||||
269 | "}\n") | ||||
270 | if ref $error; | ||||
271 | |||||
272 | local $" = ', '; | ||||
273 | return <<EOF; | ||||
274 | $self | ||||
275 | PRE_PROCESS => [ @{ $self->{ PRE_PROCESS } } ] | ||||
276 | POST_PROCESS => [ @{ $self->{ POST_PROCESS } } ] | ||||
277 | ERROR => $error | ||||
278 | CONTEXT => $context | ||||
279 | EOF | ||||
280 | } | ||||
281 | |||||
282 | |||||
283 | 1 | 4µs | 1; | ||
284 | |||||
285 | __END__ |