← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:51 2013

Filename/usr/lib/perl5/Template/Filters.pm
StatementsExecuted 4050 statements in 12.4ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1831043.43ms4.18msTemplate::Filters::::html_filterTemplate::Filters::html_filter
214112.78ms2.81msTemplate::Filters::::fetchTemplate::Filters::fetch
76371807µs807µsTemplate::Filters::::CORE:substTemplate::Filters::CORE:subst (opcode)
111451µs465µsTemplate::Filters::::uri_filterTemplate::Filters::uri_filter
2722254µs360µsTemplate::Filters::::url_filterTemplate::Filters::url_filter
111164µs168µsTemplate::Filters::::BEGIN@24Template::Filters::BEGIN@24
33160µs79µsTemplate::Filters::::__ANON__[:506]Template::Filters::__ANON__[:506]
11131µs40µsTemplate::Filters::::BEGIN@22Template::Filters::BEGIN@22
31122µs22µsTemplate::Filters::::replace_filter_factoryTemplate::Filters::replace_filter_factory
31117µs17µsTemplate::Filters::::CORE:regcompTemplate::Filters::CORE:regcomp (opcode)
11116µs45µsTemplate::Filters::::BEGIN@23Template::Filters::BEGIN@23
11115µs61µsTemplate::Filters::::BEGIN@27Template::Filters::BEGIN@27
11115µs60µsTemplate::Filters::::BEGIN@26Template::Filters::BEGIN@26
11113µs100µsTemplate::Filters::::BEGIN@25Template::Filters::BEGIN@25
11110µs10µsTemplate::Filters::::_initTemplate::Filters::_init
4116µs6µsTemplate::Filters::::CORE:substcontTemplate::Filters::CORE:substcont (opcode)
0000s0sTemplate::Filters::::__ANON__[:450]Template::Filters::__ANON__[:450]
0000s0sTemplate::Filters::::__ANON__[:468]Template::Filters::__ANON__[:468]
0000s0sTemplate::Filters::::__ANON__[:486]Template::Filters::__ANON__[:486]
0000s0sTemplate::Filters::::__ANON__[:524]Template::Filters::__ANON__[:524]
0000s0sTemplate::Filters::::__ANON__[:552]Template::Filters::__ANON__[:552]
0000s0sTemplate::Filters::::__ANON__[:55]Template::Filters::__ANON__[:55]
0000s0sTemplate::Filters::::__ANON__[:568]Template::Filters::__ANON__[:568]
0000s0sTemplate::Filters::::__ANON__[:56]Template::Filters::__ANON__[:56]
0000s0sTemplate::Filters::::__ANON__[:57]Template::Filters::__ANON__[:57]
0000s0sTemplate::Filters::::__ANON__[:58]Template::Filters::__ANON__[:58]
0000s0sTemplate::Filters::::__ANON__[:597]Template::Filters::__ANON__[:597]
0000s0sTemplate::Filters::::__ANON__[:59]Template::Filters::__ANON__[:59]
0000s0sTemplate::Filters::::__ANON__[:60]Template::Filters::__ANON__[:60]
0000s0sTemplate::Filters::::__ANON__[:61]Template::Filters::__ANON__[:61]
0000s0sTemplate::Filters::::__ANON__[:629]Template::Filters::__ANON__[:629]
0000s0sTemplate::Filters::::__ANON__[:63]Template::Filters::__ANON__[:63]
0000s0sTemplate::Filters::::__ANON__[:649]Template::Filters::__ANON__[:649]
0000s0sTemplate::Filters::::_dumpTemplate::Filters::_dump
0000s0sTemplate::Filters::::eval_filter_factoryTemplate::Filters::eval_filter_factory
0000s0sTemplate::Filters::::format_filter_factoryTemplate::Filters::format_filter_factory
0000s0sTemplate::Filters::::html_entity_filter_factoryTemplate::Filters::html_entity_filter_factory
0000s0sTemplate::Filters::::html_line_breakTemplate::Filters::html_line_break
0000s0sTemplate::Filters::::html_para_breakTemplate::Filters::html_para_break
0000s0sTemplate::Filters::::html_paragraphTemplate::Filters::html_paragraph
0000s0sTemplate::Filters::::indent_filter_factoryTemplate::Filters::indent_filter_factory
0000s0sTemplate::Filters::::perl_filter_factoryTemplate::Filters::perl_filter_factory
0000s0sTemplate::Filters::::redirect_filter_factoryTemplate::Filters::redirect_filter_factory
0000s0sTemplate::Filters::::remove_filter_factoryTemplate::Filters::remove_filter_factory
0000s0sTemplate::Filters::::repeat_filter_factoryTemplate::Filters::repeat_filter_factory
0000s0sTemplate::Filters::::stdout_filter_factoryTemplate::Filters::stdout_filter_factory
0000s0sTemplate::Filters::::storeTemplate::Filters::store
0000s0sTemplate::Filters::::truncate_filter_factoryTemplate::Filters::truncate_filter_factory
0000s0sTemplate::Filters::::use_apache_utilTemplate::Filters::use_apache_util
0000s0sTemplate::Filters::::use_html_entitiesTemplate::Filters::use_html_entities
0000s0sTemplate::Filters::::xml_filterTemplate::Filters::xml_filter
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#============================================================= -*-Perl-*-
2#
3# Template::Filters
4#
5# DESCRIPTION
6# Defines filter plugins as used by the FILTER directive.
7#
8# AUTHORS
9# Andy Wardley <abw@wardley.org>, with a number of filters contributed
10# by Leslie Michael Orchard <deus_x@nijacode.com>
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
20package Template::Filters;
21
22338µs249µs
# spent 40µs (31+9) within Template::Filters::BEGIN@22 which was called: # once (31µs+9µs) by Template::Config::load at line 22
use strict;
# spent 40µs making 1 call to Template::Filters::BEGIN@22 # spent 9µs making 1 call to strict::import
23334µs275µs
# spent 45µs (16+29) within Template::Filters::BEGIN@23 which was called: # once (16µs+29µs) by Template::Config::load at line 23
use warnings;
# spent 45µs making 1 call to Template::Filters::BEGIN@23 # spent 29µs making 1 call to warnings::import
243178µs2172µs
# spent 168µs (164+4) within Template::Filters::BEGIN@24 which was called: # once (164µs+4µs) by Template::Config::load at line 24
use locale;
# spent 168µs making 1 call to Template::Filters::BEGIN@24 # spent 4µs making 1 call to locale::import
25336µs2188µs
# spent 100µs (13+88) within Template::Filters::BEGIN@25 which was called: # once (13µs+88µs) by Template::Config::load at line 25
use base 'Template::Base';
# spent 100µs making 1 call to Template::Filters::BEGIN@25 # spent 88µs making 1 call to base::import
26336µs2105µs
# spent 60µs (15+45) within Template::Filters::BEGIN@26 which was called: # once (15µs+45µs) by Template::Config::load at line 26
use Template::Constants;
# spent 60µs making 1 call to Template::Filters::BEGIN@26 # spent 45µs making 1 call to Exporter::import
2733.21ms2106µs
# spent 61µs (15+46) within Template::Filters::BEGIN@27 which was called: # once (15µs+46µs) by Template::Config::load at line 27
use Scalar::Util 'blessed';
# spent 61µs making 1 call to Template::Filters::BEGIN@27 # spent 46µs making 1 call to Exporter::import
28
2911µsour $VERSION = 2.87;
3012µsour $AVAILABLE = { };
311400nsour $TRUNCATE_LENGTH = 32;
3211µsour $TRUNCATE_ADDON = '...';
33
34
35#------------------------------------------------------------------------
36# standard filters, defined in one of the following forms:
37# name => \&static_filter
38# name => [ \&subref, $is_dynamic ]
39# If the $is_dynamic flag is set then the sub-routine reference
40# is called to create a new filter each time it is requested; if
41# not set, then it is a single, static sub-routine which is returned
42# for every filter request for that name.
43#------------------------------------------------------------------------
44
45our $FILTERS = {
46 # static filters
47 'html' => \&html_filter,
48 'html_para' => \&html_paragraph,
49 'html_break' => \&html_para_break,
50 'html_para_break' => \&html_para_break,
51 'html_line_break' => \&html_line_break,
52 'xml' => \&xml_filter,
53 'uri' => \&uri_filter,
54 'url' => \&url_filter,
55 'upper' => sub { uc $_[0] },
56 'lower' => sub { lc $_[0] },
57 'ucfirst' => sub { ucfirst $_[0] },
58 'lcfirst' => sub { lcfirst $_[0] },
59 'stderr' => sub { print STDERR @_; return '' },
60 'trim' => sub { for ($_[0]) { s/^\s+//; s/\s+$// }; $_[0] },
61 'null' => sub { return '' },
62 'collapse' => sub { for ($_[0]) { s/^\s+//; s/\s+$//; s/\s+/ /g };
63 $_[0] },
64
65 # dynamic filters
66153µs 'html_entity' => [ \&html_entity_filter_factory, 1 ],
67 'indent' => [ \&indent_filter_factory, 1 ],
68 'format' => [ \&format_filter_factory, 1 ],
69 'truncate' => [ \&truncate_filter_factory, 1 ],
70 'repeat' => [ \&repeat_filter_factory, 1 ],
71 'replace' => [ \&replace_filter_factory, 1 ],
72 'remove' => [ \&remove_filter_factory, 1 ],
73 'eval' => [ \&eval_filter_factory, 1 ],
74 'evaltt' => [ \&eval_filter_factory, 1 ], # alias
75 'perl' => [ \&perl_filter_factory, 1 ],
76 'evalperl' => [ \&perl_filter_factory, 1 ], # alias
77 'redirect' => [ \&redirect_filter_factory, 1 ],
78 'file' => [ \&redirect_filter_factory, 1 ], # alias
79 'stdout' => [ \&stdout_filter_factory, 1 ],
80};
81
82# name of module implementing plugin filters
831700nsour $PLUGIN_FILTER = 'Template::Plugin::Filter';
84
- -
87#========================================================================
88# -- PUBLIC METHODS --
89#========================================================================
90
91#------------------------------------------------------------------------
92# fetch($name, \@args, $context)
93#
94# Attempts to instantiate or return a reference to a filter sub-routine
95# named by the first parameter, $name, with additional constructor
96# arguments passed by reference to a list as the second parameter,
97# $args. A reference to the calling Template::Context object is
98# passed as the third paramter.
99#
100# Returns a reference to a filter sub-routine or a pair of values
101# (undef, STATUS_DECLINED) or ($error, STATUS_ERROR) to decline to
102# deliver the filter or to indicate an error.
103#------------------------------------------------------------------------
104
105
# spent 2.81ms (2.78+22µs) within Template::Filters::fetch which was called 214 times, avg 13µs/call: # 214 times (2.78ms+22µs) by Template::Context::filter at line 228 of Template/Context.pm, avg 13µs/call
sub fetch {
106214209µs my ($self, $name, $args, $context) = @_;
10721494µs my ($factory, $is_dynamic, $filter, $error);
108
109 $self->debug("fetch($name, ",
110 defined $args ? ('[ ', join(', ', @$args), ' ]') : '<no args>', ', ',
111 defined $context ? $context : '<no context>',
112214183µs ')') if $self->{ DEBUG };
113
114 # allow $name to be specified as a reference to
115 # a plugin filter object; any other ref is
116 # assumed to be a coderef and hence already a filter;
117 # non-refs are assumed to be regular name lookups
118
119214149µs if (ref $name) {
120 if (blessed($name) && $name->isa($PLUGIN_FILTER)) {
121 $factory = $name->factory()
122 || return $self->error($name->error());
123 }
124 else {
125 return $name;
126 }
127 }
128 else {
129 return (undef, Template::Constants::STATUS_DECLINED)
130214421µs unless ($factory = $self->{ FILTERS }->{ $name }
131 || $FILTERS->{ $name });
132 }
133
134 # factory can be an [ $code, $dynamic ] or just $code
135214302µs if (ref $factory eq 'ARRAY') {
136 ($factory, $is_dynamic) = @$factory;
137 }
138 else {
139211143µs $is_dynamic = 0;
140 }
141
142214317µs if (ref $factory eq 'CODE') {
143214126µs if ($is_dynamic) {
144 # if the dynamic flag is set then the sub-routine is a
145 # factory which should be called to create the actual
146 # filter...
14732µs eval {
14839µs322µs ($filter, $error) = &$factory($context, $args ? @$args : ());
# spent 22µs making 3 calls to Template::Filters::replace_filter_factory, avg 7µs/call
149 };
15032µs $error ||= $@;
15133µs $error = "invalid FILTER for '$name' (not a CODE ref)"
152 unless $error || ref($filter) eq 'CODE';
153 }
154 else {
155 # ...otherwise, it's a static filter sub-routine
156211102µs $filter = $factory;
157 }
158 }
159 else {
160 $error = "invalid FILTER entry for '$name' (not a CODE ref)";
161 }
162
16321478µs if ($error) {
164 return $self->{ TOLERANT }
165 ? (undef, Template::Constants::STATUS_DECLINED)
166 : ($error, Template::Constants::STATUS_ERROR) ;
167 }
168 else {
1692141.23ms return $filter;
170 }
171}
172
173
174#------------------------------------------------------------------------
175# store($name, \&filter)
176#
177# Stores a new filter in the internal FILTERS hash. The first parameter
178# is the filter name, the second a reference to a subroutine or
179# array, as per the standard $FILTERS entries.
180#------------------------------------------------------------------------
181
182sub store {
183 my ($self, $name, $filter) = @_;
184
185 $self->debug("store($name, $filter)") if $self->{ DEBUG };
186
187 $self->{ FILTERS }->{ $name } = $filter;
188 return 1;
189}
190
191
192#========================================================================
193# -- PRIVATE METHODS --
194#========================================================================
195
196#------------------------------------------------------------------------
197# _init(\%config)
198#
199# Private initialisation method.
200#------------------------------------------------------------------------
201
202
# spent 10µs within Template::Filters::_init which was called: # once (10µs+0s) by Template::Base::new at line 65 of Template/Base.pm
sub _init {
20312µs my ($self, $params) = @_;
204
20513µs $self->{ FILTERS } = $params->{ FILTERS } || { };
20612µs $self->{ TOLERANT } = $params->{ TOLERANT } || 0;
20711µs $self->{ DEBUG } = ( $params->{ DEBUG } || 0 )
208 & Template::Constants::DEBUG_FILTERS;
209
210
21115µs return $self;
212}
213
- -
216#------------------------------------------------------------------------
217# _dump()
218#
219# Debug method
220#------------------------------------------------------------------------
221
222sub _dump {
223 my $self = shift;
224 my $output = "[Template::Filters] {\n";
225 my $format = " %-16s => %s\n";
226 my $key;
227
228 foreach $key (qw( TOLERANT )) {
229 my $val = $self->{ $key };
230 $val = '<undef>' unless defined $val;
231 $output .= sprintf($format, $key, $val);
232 }
233
234 my $filters = $self->{ FILTERS };
235 $filters = join('', map {
236 sprintf(" $format", $_, $filters->{ $_ });
237 } keys %$filters);
238 $filters = "{\n$filters }";
239
240 $output .= sprintf($format, 'FILTERS (local)' => $filters);
241
242 $filters = $FILTERS;
243 $filters = join('', map {
244 my $f = $filters->{ $_ };
245 my ($ref, $dynamic) = ref $f eq 'ARRAY' ? @$f : ($f, 0);
246 sprintf(" $format", $_, $dynamic ? 'dynamic' : 'static');
247 } sort keys %$filters);
248 $filters = "{\n$filters }";
249
250 $output .= sprintf($format, 'FILTERS (global)' => $filters);
251
252 $output .= '}';
253 return $output;
254}
255
256
257#========================================================================
258# -- STATIC FILTER SUBS --
259#========================================================================
260
261#------------------------------------------------------------------------
262# uri_filter() [% FILTER uri %]
263#
264# URI escape a string. This code is borrowed from Gisle Aas' URI::Escape
265# module, copyright 1995-2004. See RFC2396 for details.
266#-----------------------------------------------------------------------
267
268# cache of escaped characters
2691200nsour $URI_ESCAPES;
270
271
# spent 465µs (451+14) within Template::Filters::uri_filter which was called: # once (451µs+14µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 106 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt
sub uri_filter {
27211µs my $text = shift;
273
274 $URI_ESCAPES ||= {
2751361µs map { ( chr($_), sprintf("%%%02X", $_) ) } (0..255),
276 };
277
278113µs13µs if ($] >= 5.008 && utf8::is_utf8($text)) {
# spent 3µs making 1 call to utf8::is_utf8
279 utf8::encode($text);
280 }
281
282185µs512µs $text =~ s/([^A-Za-z0-9\-_.!~*'()])/$URI_ESCAPES->{$1}/eg;
# spent 6µs making 4 calls to Template::Filters::CORE:substcont, avg 2µs/call # spent 5µs making 1 call to Template::Filters::CORE:subst
283110µs $text;
284}
285
286#------------------------------------------------------------------------
287# url_filter() [% FILTER uri %]
288#
289# NOTE: the difference: url vs uri.
290# This implements the old-style, non-strict behaviour of the uri filter
291# which allows any valid URL characters to pass through so that
292# http://example.com/blah.html does not get the ':' and '/' characters
293# munged.
294#-----------------------------------------------------------------------
295
296
# spent 360µs (254+106) within Template::Filters::url_filter which was called 27 times, avg 13µs/call: # 25 times (233µs+101µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 510 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 13µs/call # 2 times (21µs+5µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc:111] at line 107 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc, avg 13µs/call
sub url_filter {
2972721µs my $text = shift;
298
299 $URI_ESCAPES ||= {
3002713µs map { ( chr($_), sprintf("%%%02X", $_) ) } (0..255),
301 };
302
30327152µs2756µs if ($] >= 5.008 && utf8::is_utf8($text)) {
# spent 56µs making 27 calls to utf8::is_utf8, avg 2µs/call
304 utf8::encode($text);
305 }
306
30727113µs2750µs $text =~ s/([^;\/?:@&=+\$,A-Za-z0-9\-_.!~*'()])/$URI_ESCAPES->{$1}/eg;
# spent 50µs making 27 calls to Template::Filters::CORE:subst, avg 2µs/call
3082783µs $text;
309}
310
311
312#------------------------------------------------------------------------
313# html_filter() [% FILTER html %]
314#
315# Convert any '<', '>' or '&' characters to the HTML equivalents, '&lt;',
316# '&gt;' and '&amp;', respectively.
317#------------------------------------------------------------------------
318
319
# spent 4.18ms (3.43+750µs) within Template::Filters::html_filter which was called 183 times, avg 23µs/call: # 101 times (2.32ms+454µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc:32] at line 18 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc, avg 28µs/call # 60 times (734µs+225µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/page-numbers.inc:31] at line 12 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/page-numbers.inc, avg 16µs/call # 5 times (113µs+18µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 10 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 26µs/call # 4 times (76µs+7µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 390 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt, avg 21µs/call # 4 times (41µs+8µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc:111] at line 77 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc, avg 12µs/call # 3 times (69µs+19µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc:32] at line 13 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/opac-facets.inc, avg 29µs/call # 2 times (24µs+10µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc:111] at line 103 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc, avg 17µs/call # 2 times (19µs+3µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc:111] at line 96 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc, avg 11µs/call # once (15µs+4µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc:111] at line 46 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/includes/masthead.inc # once (12µs+2µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 279 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt
sub html_filter {
320183274µs my $text = shift;
321183307µs for ($text) {
3221831.07ms183452µs s/&/&amp;/g;
# spent 452µs making 183 calls to Template::Filters::CORE:subst, avg 2µs/call
323183518µs18397µs s/</&lt;/g;
# spent 97µs making 183 calls to Template::Filters::CORE:subst, avg 528ns/call
324183667µs18384µs s/>/&gt;/g;
# spent 84µs making 183 calls to Template::Filters::CORE:subst, avg 460ns/call
325183828µs183118µs s/"/&quot;/g;
# spent 118µs making 183 calls to Template::Filters::CORE:subst, avg 642ns/call
326 }
327183752µs return $text;
328}
329
330
331#------------------------------------------------------------------------
332# xml_filter() [% FILTER xml %]
333#
334# Same as the html filter, but adds the conversion of ' to &apos; which
335# is native to XML.
336#------------------------------------------------------------------------
337
338sub xml_filter {
339 my $text = shift;
340 for ($text) {
341 s/&/&amp;/g;
342 s/</&lt;/g;
343 s/>/&gt;/g;
344 s/"/&quot;/g;
345 s/'/&apos;/g;
346 }
347 return $text;
348}
349
350
351#------------------------------------------------------------------------
352# html_paragraph() [% FILTER html_para %]
353#
354# Wrap each paragraph of text (delimited by two or more newlines) in the
355# <p>...</p> HTML tags.
356#------------------------------------------------------------------------
357
358sub html_paragraph {
359 my $text = shift;
360 return "<p>\n"
361 . join("\n</p>\n\n<p>\n", split(/(?:\r?\n){2,}/, $text))
362 . "</p>\n";
363}
364
365
366#------------------------------------------------------------------------
367# html_para_break() [% FILTER html_para_break %]
368#
369# Join each paragraph of text (delimited by two or more newlines) with
370# <br><br> HTML tags.
371#------------------------------------------------------------------------
372
373sub html_para_break {
374 my $text = shift;
375 $text =~ s|(\r?\n){2,}|$1<br />$1<br />$1|g;
376 return $text;
377}
378
379#------------------------------------------------------------------------
380# html_line_break() [% FILTER html_line_break %]
381#
382# replaces any newlines with <br> HTML tags.
383#------------------------------------------------------------------------
384
385sub html_line_break {
386 my $text = shift;
387 $text =~ s|(\r?\n)|<br />$1|g;
388 return $text;
389}
390
391#========================================================================
392# -- DYNAMIC FILTER FACTORIES --
393#========================================================================
394
395#------------------------------------------------------------------------
396# html_entity_filter_factory(\%options) [% FILTER html %]
397#
398# Dynamic version of the static html filter which attempts to locate the
399# Apache::Util or HTML::Entities modules to perform full entity encoding
400# of the text passed. Returns an exception if one or other of the
401# modules can't be located.
402#------------------------------------------------------------------------
403
404sub use_html_entities {
405 require HTML::Entities;
406 return ($AVAILABLE->{ HTML_ENTITY } = \&HTML::Entities::encode_entities);
407}
408
409sub use_apache_util {
410 require Apache::Util;
411 Apache::Util::escape_html(''); # TODO: explain this
412 return ($AVAILABLE->{ HTML_ENTITY } = \&Apache::Util::escape_html);
413}
414
415sub html_entity_filter_factory {
416 my $context = shift;
417 my $haz;
418
419 # if Apache::Util is installed then we use escape_html
420 $haz = $AVAILABLE->{ HTML_ENTITY }
421 || eval { use_apache_util() }
422 || eval { use_html_entities() }
423 || -1; # we use -1 for "not available" because it's a true value
424
425 return ref $haz eq 'CODE'
426 ? $haz
427 : (undef, Template::Exception->new(
428 html_entity => 'cannot locate Apache::Util or HTML::Entities' )
429 );
430}
431
432
433#------------------------------------------------------------------------
434# indent_filter_factory($pad) [% FILTER indent(pad) %]
435#
436# Create a filter to indent text by a fixed pad string or when $pad is
437# numerical, a number of space.
438#------------------------------------------------------------------------
439
440sub indent_filter_factory {
441 my ($context, $pad) = @_;
442 $pad = 4 unless defined $pad;
443 $pad = ' ' x $pad if $pad =~ /^\d+$/;
444
445 return sub {
446 my $text = shift;
447 $text = '' unless defined $text;
448 $text =~ s/^/$pad/mg;
449 return $text;
450 }
451}
452
453#------------------------------------------------------------------------
454# format_filter_factory() [% FILTER format(format) %]
455#
456# Create a filter to format text according to a printf()-like format
457# string.
458#------------------------------------------------------------------------
459
460sub format_filter_factory {
461 my ($context, $format) = @_;
462 $format = '%s' unless defined $format;
463
464 return sub {
465 my $text = shift;
466 $text = '' unless defined $text;
467 return join("\n", map{ sprintf($format, $_) } split(/\n/, $text));
468 }
469}
470
471
472#------------------------------------------------------------------------
473# repeat_filter_factory($n) [% FILTER repeat(n) %]
474#
475# Create a filter to repeat text n times.
476#------------------------------------------------------------------------
477
478sub repeat_filter_factory {
479 my ($context, $iter) = @_;
480 $iter = 1 unless defined $iter and length $iter;
481
482 return sub {
483 my $text = shift;
484 $text = '' unless defined $text;
485 return join('\n', $text) x $iter;
486 }
487}
488
489
490#------------------------------------------------------------------------
491# replace_filter_factory($s, $r) [% FILTER replace(search, replace) %]
492#
493# Create a filter to replace 'search' text with 'replace'
494#------------------------------------------------------------------------
495
496
# spent 22µs within Template::Filters::replace_filter_factory which was called 3 times, avg 7µs/call: # 3 times (22µs+0s) by Template::Filters::fetch at line 148, avg 7µs/call
sub replace_filter_factory {
49733µs my ($context, $search, $replace) = @_;
4983800ns $search = '' unless defined $search;
4993700ns $replace = '' unless defined $replace;
500
501
# spent 79µs (60+19) within Template::Filters::__ANON__[/usr/lib/perl5/Template/Filters.pm:506] which was called 3 times, avg 26µs/call: # once (41µs+5µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 275 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (13µs+10µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 267 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt # once (6µs+4µs) by Template::Document::__ANON__[/usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt:541] at line 271 of /usr/share/koha/opac/htdocs/opac-tmpl/prog/en-NZ/modules/opac-results.tt
return sub {
50232µs my $text = shift;
50331µs $text = '' unless defined $text;
504369µs619µs $text =~ s/$search/$replace/g;
# spent 17µs making 3 calls to Template::Filters::CORE:regcomp, avg 6µs/call # spent 2µs making 3 calls to Template::Filters::CORE:subst, avg 733ns/call
505316µs return $text;
506 }
507345µs}
508
509
510#------------------------------------------------------------------------
511# remove_filter_factory($text) [% FILTER remove(text) %]
512#
513# Create a filter to remove 'search' string from the input text.
514#------------------------------------------------------------------------
515
516sub remove_filter_factory {
517 my ($context, $search) = @_;
518
519 return sub {
520 my $text = shift;
521 $text = '' unless defined $text;
522 $text =~ s/$search//g;
523 return $text;
524 }
525}
526
527
528#------------------------------------------------------------------------
529# truncate_filter_factory($n) [% FILTER truncate(n) %]
530#
531# Create a filter to truncate text after n characters.
532#------------------------------------------------------------------------
533
534sub truncate_filter_factory {
535 my ($context, $len, $char) = @_;
536 $len = $TRUNCATE_LENGTH unless defined $len;
537 $char = $TRUNCATE_ADDON unless defined $char;
538
539 # Length of char is the minimum length
540 my $lchar = length $char;
541 if ($len < $lchar) {
542 $char = substr($char, 0, $len);
543 $lchar = $len;
544 }
545
546 return sub {
547 my $text = shift;
548 return $text if length $text <= $len;
549 return substr($text, 0, $len - $lchar) . $char;
550
551
552 }
553}
554
555
556#------------------------------------------------------------------------
557# eval_filter_factory [% FILTER eval %]
558#
559# Create a filter to evaluate template text.
560#------------------------------------------------------------------------
561
562sub eval_filter_factory {
563 my $context = shift;
564
565 return sub {
566 my $text = shift;
567 $context->process(\$text);
568 }
569}
570
571
572#------------------------------------------------------------------------
573# perl_filter_factory [% FILTER perl %]
574#
575# Create a filter to process Perl text iff the context EVAL_PERL flag
576# is set.
577#------------------------------------------------------------------------
578
579sub perl_filter_factory {
580 my $context = shift;
581 my $stash = $context->stash;
582
583 return (undef, Template::Exception->new('perl', 'EVAL_PERL is not set'))
584 unless $context->eval_perl();
585
586 return sub {
587 my $text = shift;
588 local($Template::Perl::context) = $context;
589 local($Template::Perl::stash) = $stash;
590 my $out = eval <<EOF;
591package Template::Perl;
592\$stash = \$context->stash();
593$text
594EOF
595 $context->throw($@) if $@;
596 return $out;
597 }
598}
599
600
601#------------------------------------------------------------------------
602# redirect_filter_factory($context, $file) [% FILTER redirect(file) %]
603#
604# Create a filter to redirect the block text to a file.
605#------------------------------------------------------------------------
606
607sub redirect_filter_factory {
608 my ($context, $file, $options) = @_;
609 my $outpath = $context->config->{ OUTPUT_PATH };
610
611 return (undef, Template::Exception->new('redirect',
612 'OUTPUT_PATH is not set'))
613 unless $outpath;
614
615 $context->throw('redirect', "relative filenames are not supported: $file")
616 if $file =~ m{(^|/)\.\./};
617
618 $options = { binmode => $options } unless ref $options;
619
620 sub {
621 my $text = shift;
622 my $outpath = $context->config->{ OUTPUT_PATH }
623 || return '';
624 $outpath .= "/$file";
625 my $error = Template::_output($outpath, \$text, $options);
626 die Template::Exception->new('redirect', $error)
627 if $error;
628 return '';
629 }
630}
631
632
633#------------------------------------------------------------------------
634# stdout_filter_factory($context, $binmode) [% FILTER stdout(binmode) %]
635#
636# Create a filter to print a block to stdout, with an optional binmode.
637#------------------------------------------------------------------------
638
639sub stdout_filter_factory {
640 my ($context, $options) = @_;
641
642 $options = { binmode => $options } unless ref $options;
643
644 sub {
645 my $text = shift;
646 binmode(STDOUT) if $options->{ binmode };
647 print STDOUT $text;
648 return '';
649 }
650}
651
652
653123µs1;
654
655__END__
 
# spent 17µs within Template::Filters::CORE:regcomp which was called 3 times, avg 6µs/call: # 3 times (17µs+0s) by Template::Filters::__ANON__[/usr/lib/perl5/Template/Filters.pm:506] at line 504, avg 6µs/call
sub Template::Filters::CORE:regcomp; # opcode
# spent 807µs within Template::Filters::CORE:subst which was called 763 times, avg 1µs/call: # 183 times (452µs+0s) by Template::Filters::html_filter at line 322, avg 2µs/call # 183 times (118µs+0s) by Template::Filters::html_filter at line 325, avg 642ns/call # 183 times (97µs+0s) by Template::Filters::html_filter at line 323, avg 528ns/call # 183 times (84µs+0s) by Template::Filters::html_filter at line 324, avg 460ns/call # 27 times (50µs+0s) by Template::Filters::url_filter at line 307, avg 2µs/call # 3 times (2µs+0s) by Template::Filters::__ANON__[/usr/lib/perl5/Template/Filters.pm:506] at line 504, avg 733ns/call # once (5µs+0s) by Template::Filters::uri_filter at line 282
sub Template::Filters::CORE:subst; # opcode
# spent 6µs within Template::Filters::CORE:substcont which was called 4 times, avg 2µs/call: # 4 times (6µs+0s) by Template::Filters::uri_filter at line 282, avg 2µs/call
sub Template::Filters::CORE:substcont; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.