Filename | /usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Service.pm |
Statements | Executed 20 statements in 2.06ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.01ms | 1.22ms | BEGIN@27 | Template::Service::
1 | 1 | 1 | 23µs | 72µs | BEGIN@31 | Template::Service::
1 | 1 | 1 | 22µs | 59µs | BEGIN@28 | Template::Service::
1 | 1 | 1 | 21µs | 37µs | BEGIN@23 | Template::Service::
1 | 1 | 1 | 18µs | 65µs | BEGIN@29 | Template::Service::
1 | 1 | 1 | 12µs | 74µs | BEGIN@25 | Template::Service::
1 | 1 | 1 | 12µs | 23µs | BEGIN@24 | 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 | _init | Template::Service::
0 | 0 | 0 | 0s | 0s | _recover | Template::Service::
0 | 0 | 0 | 0s | 0s | context | Template::Service::
0 | 0 | 0 | 0s | 0s | process | 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 | 52µs | 2 | 54µs | # spent 37µs (21+17) within Template::Service::BEGIN@23 which was called:
# once (21µs+17µs) by Template::BEGIN@30 at line 23 # spent 37µs making 1 call to Template::Service::BEGIN@23
# spent 16µs making 1 call to strict::import |
24 | 2 | 45µs | 2 | 35µs | # spent 23µs (12+12) within Template::Service::BEGIN@24 which was called:
# once (12µs+12µs) by Template::BEGIN@30 at line 24 # spent 23µs making 1 call to Template::Service::BEGIN@24
# spent 12µs making 1 call to warnings::import |
25 | 2 | 95µs | 2 | 136µs | # spent 74µs (12+62) within Template::Service::BEGIN@25 which was called:
# once (12µs+62µs) by Template::BEGIN@30 at line 25 # spent 74µs making 1 call to Template::Service::BEGIN@25
# spent 62µs making 1 call to base::import |
26 | 2 | 34µ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 | 237µs | 1 | 1.22ms | # spent 1.22ms (1.01+216µs) within Template::Service::BEGIN@27 which was called:
# once (1.01ms+216µs) by Template::BEGIN@30 at line 27 # spent 1.22ms making 1 call to Template::Service::BEGIN@27 |
28 | 2 | 97µs | 2 | 96µs | # spent 59µs (22+37) within Template::Service::BEGIN@28 which was called:
# once (22µs+37µs) by Template::BEGIN@30 at line 28 # spent 59µs making 1 call to Template::Service::BEGIN@28
# spent 37µs making 1 call to Exporter::import |
29 | 2 | 104µs | 2 | 111µs | # spent 65µs (18+46) within Template::Service::BEGIN@29 which was called:
# once (18µs+46µs) by Template::BEGIN@30 at line 29 # spent 65µs making 1 call to Template::Service::BEGIN@29
# spent 46µs making 1 call to Exporter::import |
30 | |||||
31 | 2 | 1.39ms | 2 | 121µs | # spent 72µs (23+49) within Template::Service::BEGIN@31 which was called:
# once (23µs+49µs) by Template::BEGIN@30 at line 31 # spent 72µs making 1 call to Template::Service::BEGIN@31
# spent 49µs making 1 call to constant::import |
32 | |||||
33 | 1 | 700ns | our $VERSION = 2.80; | ||
34 | 1 | 1µs | 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 | sub process { | ||||
54 | my ($self, $template, $params) = @_; | ||||
55 | my $context = $self->{ CONTEXT }; | ||||
56 | my ($name, $output, $procout, $error); | ||||
57 | $output = ''; | ||||
58 | |||||
59 | $self->debug("process($template, ", | ||||
60 | defined $params ? $params : '<no params>', | ||||
61 | ')') if $self->{ DEBUG }; | ||||
62 | |||||
63 | $context->reset() | ||||
64 | if $self->{ AUTO_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 | eval { $template = $context->template($template) }; | ||||
69 | return $self->error($@) | ||||
70 | if $@; | ||||
71 | |||||
72 | # localise the variable stash with any parameters passed | ||||
73 | # and set the 'template' variable | ||||
74 | $params ||= { }; | ||||
75 | # TODO: change this to C<||=> so we can use a template parameter | ||||
76 | $params->{ template } = $template | ||||
77 | unless ref $template eq 'CODE'; | ||||
78 | $context->localise($params); | ||||
79 | |||||
80 | SERVICE: { | ||||
81 | # PRE_PROCESS | ||||
82 | eval { | ||||
83 | foreach $name (@{ $self->{ PRE_PROCESS } }) { | ||||
84 | $self->debug("PRE_PROCESS: $name") if $self->{ DEBUG }; | ||||
85 | $output .= $context->process($name); | ||||
86 | } | ||||
87 | }; | ||||
88 | last SERVICE if ($error = $@); | ||||
89 | |||||
90 | # PROCESS | ||||
91 | eval { | ||||
92 | foreach $name (@{ $self->{ PROCESS } || [ $template ] }) { | ||||
93 | $self->debug("PROCESS: $name") if $self->{ DEBUG }; | ||||
94 | $procout .= $context->process($name); | ||||
95 | } | ||||
96 | }; | ||||
97 | if ($error = $@) { | ||||
98 | last SERVICE | ||||
99 | unless defined ($procout = $self->_recover(\$error)); | ||||
100 | } | ||||
101 | |||||
102 | if (defined $procout) { | ||||
103 | # WRAPPER | ||||
104 | eval { | ||||
105 | foreach $name (reverse @{ $self->{ WRAPPER } }) { | ||||
106 | $self->debug("WRAPPER: $name") if $self->{ DEBUG }; | ||||
107 | $procout = $context->process($name, { content => $procout }); | ||||
108 | } | ||||
109 | }; | ||||
110 | last SERVICE if ($error = $@); | ||||
111 | $output .= $procout; | ||||
112 | } | ||||
113 | |||||
114 | # POST_PROCESS | ||||
115 | eval { | ||||
116 | foreach $name (@{ $self->{ POST_PROCESS } }) { | ||||
117 | $self->debug("POST_PROCESS: $name") if $self->{ DEBUG }; | ||||
118 | $output .= $context->process($name); | ||||
119 | } | ||||
120 | }; | ||||
121 | last SERVICE if ($error = $@); | ||||
122 | } | ||||
123 | |||||
124 | $context->delocalise(); | ||||
125 | delete $params->{ template }; | ||||
126 | |||||
127 | if ($error) { | ||||
128 | # $error = $error->as_string if ref $error; | ||||
129 | return $self->error($error); | ||||
130 | } | ||||
131 | |||||
132 | 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 | sub _init { | ||||
152 | my ($self, $config) = @_; | ||||
153 | my ($item, $data, $context, $block, $blocks); | ||||
154 | my $delim = $config->{ DELIMITER }; | ||||
155 | $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 | foreach $item (qw( PRE_PROCESS PROCESS POST_PROCESS WRAPPER )) { | ||||
160 | $data = $config->{ $item }; | ||||
161 | $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 | unless defined $config->{ PROCESS }; | ||||
169 | |||||
170 | $self->{ ERROR } = $config->{ ERROR } || $config->{ ERRORS }; | ||||
171 | $self->{ AUTO_RESET } = defined $config->{ AUTO_RESET } | ||||
172 | ? $config->{ AUTO_RESET } : 1; | ||||
173 | $self->{ DEBUG } = ( $config->{ DEBUG } || 0 ) | ||||
174 | & Template::Constants::DEBUG_SERVICE; | ||||
175 | |||||
176 | $context = $self->{ CONTEXT } = $config->{ CONTEXT } | ||||
177 | || Template::Config->context($config) | ||||
178 | || return $self->error(Template::Config->error); | ||||
179 | |||||
180 | 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 | 5µs | 1; | ||
284 | |||||
285 | __END__ |