Profile of Template/Plugin/String.pm

Filename	/usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Plugin/String.pm
Statements	Executed 25 statements in 1.91ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	17µs	27µs	Template::Plugin::String::::BEGIN@21Template::Plugin::String::BEGIN@21
1	1	1	11µs	43µs	Template::Plugin::String::::BEGIN@26Template::Plugin::String::BEGIN@26
1	1	1	9µs	46µs	Template::Plugin::String::::BEGIN@23Template::Plugin::String::BEGIN@23
1	1	1	9µs	16µs	Template::Plugin::String::::BEGIN@22Template::Plugin::String::BEGIN@22
1	1	1	8µs	8µs	Template::Plugin::String::::BEGIN@24Template::Plugin::String::BEGIN@24
1	1	1	7µs	7µs	Template::Plugin::String::::newTemplate::Plugin::String::new
0	0	0	0s	0s	Template::Plugin::String::::capitalTemplate::Plugin::String::capital
0	0	0	0s	0s	Template::Plugin::String::::centerTemplate::Plugin::String::center
0	0	0	0s	0s	Template::Plugin::String::::chompTemplate::Plugin::String::chomp
0	0	0	0s	0s	Template::Plugin::String::::chopTemplate::Plugin::String::chop
0	0	0	0s	0s	Template::Plugin::String::::collapseTemplate::Plugin::String::collapse
0	0	0	0s	0s	Template::Plugin::String::::copyTemplate::Plugin::String::copy
0	0	0	0s	0s	Template::Plugin::String::::equalsTemplate::Plugin::String::equals
0	0	0	0s	0s	Template::Plugin::String::::filterTemplate::Plugin::String::filter
0	0	0	0s	0s	Template::Plugin::String::::formatTemplate::Plugin::String::format
0	0	0	0s	0s	Template::Plugin::String::::leftTemplate::Plugin::String::left
0	0	0	0s	0s	Template::Plugin::String::::lengthTemplate::Plugin::String::length
0	0	0	0s	0s	Template::Plugin::String::::lowerTemplate::Plugin::String::lower
0	0	0	0s	0s	Template::Plugin::String::output_filter
0	0	0	0s	0s	Template::Plugin::String::::popTemplate::Plugin::String::pop
0	0	0	0s	0s	Template::Plugin::String::::pushTemplate::Plugin::String::push
0	0	0	0s	0s	Template::Plugin::String::::removeTemplate::Plugin::String::remove
0	0	0	0s	0s	Template::Plugin::String::::repeatTemplate::Plugin::String::repeat
0	0	0	0s	0s	Template::Plugin::String::::replaceTemplate::Plugin::String::replace
0	0	0	0s	0s	Template::Plugin::String::::rightTemplate::Plugin::String::right
0	0	0	0s	0s	Template::Plugin::String::::searchTemplate::Plugin::String::search
0	0	0	0s	0s	Template::Plugin::String::::shiftTemplate::Plugin::String::shift
0	0	0	0s	0s	Template::Plugin::String::::splitTemplate::Plugin::String::split
0	0	0	0s	0s	Template::Plugin::String::::substrTemplate::Plugin::String::substr
0	0	0	0s	0s	Template::Plugin::String::::textTemplate::Plugin::String::text
0	0	0	0s	0s	Template::Plugin::String::::throwTemplate::Plugin::String::throw
0	0	0	0s	0s	Template::Plugin::String::::trimTemplate::Plugin::String::trim
0	0	0	0s	0s	Template::Plugin::String::::truncateTemplate::Plugin::String::truncate
0	0	0	0s	0s	Template::Plugin::String::::unshiftTemplate::Plugin::String::unshift
0	0	0	0s	0s	Template::Plugin::String::::upperTemplate::Plugin::String::upper

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::Plugin::String
4					#
5					# DESCRIPTION
6					# Template Toolkit plugin to implement a basic String object.
7					#
8					# AUTHOR
9					# Andy Wardley <abw@wardley.org>
10					#
11					# COPYRIGHT
12					# Copyright (C) 2001-2007 Andy Wardley. All Rights Reserved.
13					#
14					# This module is free software; you can redistribute it and/or
15					# modify it under the same terms as Perl itself.
16					#
17					#============================================================================
18
19					package Template::Plugin::String;
20
21	2	46µs	2	36µs	# spent 27µs (17+10) within Template::Plugin::String::BEGIN@21 which was called: # once (17µs+10µs) by Template::Plugins::_load at line 21 use strict; # spent 27µs making 1 call to Template::Plugin::String::BEGIN@21 # spent 10µs making 1 call to strict::import
22	2	38µs	2	23µs	# spent 16µs (9+7) within Template::Plugin::String::BEGIN@22 which was called: # once (9µs+7µs) by Template::Plugins::_load at line 22 use warnings; # spent 16µs making 1 call to Template::Plugin::String::BEGIN@22 # spent 7µs making 1 call to warnings::import
23	2	66µs	2	83µs	# spent 46µs (9+37) within Template::Plugin::String::BEGIN@23 which was called: # once (9µs+37µs) by Template::Plugins::_load at line 23 use base 'Template::Plugin'; # spent 46µs making 1 call to Template::Plugin::String::BEGIN@23 # spent 37µs making 1 call to base::import
24	2	34µs	1	8µs	# spent 8µs within Template::Plugin::String::BEGIN@24 which was called: # once (8µs+0s) by Template::Plugins::_load at line 24 use Template::Exception; # spent 8µs making 1 call to Template::Plugin::String::BEGIN@24
25
26	1	42µs	1	32µs	# spent 43µs (11+32) within Template::Plugin::String::BEGIN@26 which was called: # once (11µs+32µs) by Template::Plugins::_load at line 27 use overload q\|""\| => "text", # spent 32µs making 1 call to overload::import
27	1	1.66ms	1	43µs	fallback => 1; # spent 43µs making 1 call to Template::Plugin::String::BEGIN@26
28
29	1	400ns			our $VERSION = 2.40;
30	1	300ns			our $ERROR = '';
31
32	1	2µs			centre = \center;
33	1	300ns			append = \push;
34	1	300ns			prepend = \unshift;
35
36					#------------------------------------------------------------------------
37
38					# spent 7µs within Template::Plugin::String::new which was called: # once (7µs+0s) by Template::Plugins::fetch at line 120 of Template/Plugins.pm sub new {
39	1	800ns			my ($class, @args) = @_;
40	1	600ns			my $context = ref $class ? undef : shift(@args);
41	1	900ns			my $config = @args && ref $args[-1] eq 'HASH' ? pop(@args) : { };
42
43	1	200ns			$class = ref($class) \|\| $class;
44
45					my $text = defined $config->{ text }
46					? $config->{ text }
47	1	600ns			: (@args ? shift(@args) : '');
48
49					# print STDERR "text: [$text]\n";
50					# print STDERR "class: [$class]\n";
51
52	1	2µs			my $self = bless {
53					text => $text,
54					filters => [ ],
55					_CONTEXT => $context,
56					}, $class;
57
58	1	300ns			my $filter = $config->{ filter } \|\| $config->{ filters };
59
60					# install any output filters specified as 'filter' or 'filters' option
61	1	100ns			$self->output_filter($filter)
62					if $filter;
63
64	1	4µs			return $self;
65					}
66
67
68					sub text {
69					my $self = shift;
70					return $self->{ text } unless @{ $self->{ filters } };
71
72					my $text = $self->{ text };
73					my $context = $self->{ _CONTEXT };
74
75					foreach my $dispatch (@{ $self->{ filters } }) {
76					my ($name, $args) = @$dispatch;
77					my $code = $context->filter($name, $args)
78					\|\| $self->throw($context->error());
79					$text = &$code($text);
80					}
81					return $text;
82					}
83
84
85					sub copy {
86					my $self = shift;
87					$self->new($self->{ text });
88					}
89
90
91					sub throw {
92					my $self = shift;
93
94					die (Template::Exception->new('String', join('', @_)));
95					}
96
97
98					#------------------------------------------------------------------------
99					# output_filter($filter)
100					#
101					# Install automatic output filter(s) for the string. $filter can a list:
102					# [ 'name1', 'name2' => [ ..args.. ], name4 => { ..args.. } ] or a hash
103					# { name1 => '', name2 => [ args ], name3 => { args } }
104					#------------------------------------------------------------------------
105
106					sub output_filter {
107					my ($self, $filter) = @_;
108					my ($name, $args, $dispatch);
109					my $filters = $self->{ filters };
110					my $count = 0;
111
112					if (ref $filter eq 'HASH') {
113					$filter = [ %$filter ];
114					}
115					elsif (ref $filter ne 'ARRAY') {
116					$filter = [ split(/\s\W+\s/, $filter) ];
117					}
118
119					while (@$filter) {
120					$name = shift @$filter;
121
122					# args may follow as a reference (or empty string, e.g. { foo => '' }
123					if (@$filter && (ref($filter->[0]) \|\| ! length $filter->[0])) {
124					$args = shift @$filter;
125					if ($args) {
126					$args = [ $args ] unless ref $args eq 'ARRAY';
127					}
128					else {
129					$args = [ ];
130					}
131					}
132					else {
133					$args = [ ];
134					}
135
136					# $self->DEBUG("adding output filter $name(@$args)\n");
137
138					push(@$filters, [ $name, $args ]);
139					$count++;
140					}
141
142					return '';
143					}
144
145
146					#------------------------------------------------------------------------
147
148					sub push {
149					my $self = shift;
150					$self->{ text } .= join('', @_);
151					return $self;
152					}
153
154
155					sub unshift {
156					my $self = shift;
157					$self->{ text } = join('', @_) . $self->{ text };
158					return $self;
159					}
160
161
162					sub pop {
163					my $self = shift;
164					my $strip = shift \|\| return $self;
165					$self->{ text } =~ s/$strip$//;
166					return $self;
167					}
168
169
170					sub shift {
171					my $self = shift;
172					my $strip = shift \|\| return $self;
173					$self->{ text } =~ s/^$strip//;
174					return $self;
175					}
176
177					#------------------------------------------------------------------------
178
179					sub center {
180					my ($self, $width) = @_;
181					my $text = $self->{ text };
182					my $len = length $text;
183					$width \|\|= 0;
184
185					if ($len < $width) {
186					my $lpad = int(($width - $len) / 2);
187					my $rpad = $width - $len - $lpad;
188					$self->{ text } = (' ' x $lpad) . $self->{ text } . (' ' x $rpad);
189					}
190
191					return $self;
192					}
193
194
195					sub left {
196					my ($self, $width) = @_;
197					my $len = length $self->{ text };
198					$width \|\|= 0;
199
200					$self->{ text } .= (' ' x ($width - $len))
201					if $width > $len;
202
203					return $self;
204					}
205
206
207					sub right {
208					my ($self, $width) = @_;
209					my $len = length $self->{ text };
210					$width \|\|= 0;
211
212					$self->{ text } = (' ' x ($width - $len)) . $self->{ text }
213					if $width > $len;
214
215					return $self;
216					}
217
218
219					sub format {
220					my ($self, $format) = @_;
221					$format = '%s' unless defined $format;
222					$self->{ text } = sprintf($format, $self->{ text });
223					return $self;
224					}
225
226
227					sub filter {
228					my ($self, $name, @args) = @_;
229
230					my $context = $self->{ _CONTEXT };
231
232					my $code = $context->filter($name, \@args)
233					\|\| $self->throw($context->error());
234					return &$code($self->{ text });
235					}
236
237
238					#------------------------------------------------------------------------
239
240					sub upper {
241					my $self = CORE::shift;
242					$self->{ text } = uc $self->{ text };
243					return $self;
244					}
245
246
247					sub lower {
248					my $self = CORE::shift;
249					$self->{ text } = lc $self->{ text };
250					return $self;
251					}
252
253
254					sub capital {
255					my $self = CORE::shift;
256					$self->{ text } =~ s/^(.)/\U$1/;
257					return $self;
258					}
259
260					#------------------------------------------------------------------------
261
262					sub chop {
263					my $self = CORE::shift;
264					chop $self->{ text };
265					return $self;
266					}
267
268
269					sub chomp {
270					my $self = CORE::shift;
271					chomp $self->{ text };
272					return $self;
273					}
274
275
276					sub trim {
277					my $self = CORE::shift;
278					for ($self->{ text }) {
279					s/^\s+//;
280					s/\s+$//;
281					}
282					return $self;
283					}
284
285
286					sub collapse {
287					my $self = CORE::shift;
288					for ($self->{ text }) {
289					s/^\s+//;
290					s/\s+$//;
291					s/\s+/ /g
292					}
293					return $self;
294
295					}
296
297					#------------------------------------------------------------------------
298
299					sub length {
300					my $self = CORE::shift;
301					return length $self->{ text };
302					}
303
304
305					sub truncate {
306					my ($self, $length, $suffix) = @_;
307					return $self unless defined $length;
308					$suffix \|\|= '';
309					return $self if CORE::length $self->{ text } <= $length;
310					$self->{ text } = CORE::substr($self->{ text }, 0,
311					$length - CORE::length($suffix)) . $suffix;
312					return $self;
313					}
314
315
316					sub substr {
317					my ($self, $offset, $length, $replacement) = @_;
318					$offset \|\|= 0;
319
320					if(defined $length) {
321					if (defined $replacement) {
322					my $removed = CORE::substr( $self->{text}, $offset, $length );
323					CORE::substr( $self->{text}, $offset, $length ) = $replacement;
324					return $removed;
325					}
326					else {
327					return CORE::substr( $self->{text}, $offset, $length );
328					}
329					}
330					else {
331					return CORE::substr( $self->{text}, $offset );
332					}
333					}
334
335
336					sub repeat {
337					my ($self, $n) = @_;
338					return $self unless defined $n;
339					$self->{ text } = $self->{ text } x $n;
340					return $self;
341					}
342
343
344					sub replace {
345					my ($self, $search, $replace) = @_;
346					return $self unless defined $search;
347					$replace = '' unless defined $replace;
348					$self->{ text } =~ s/$search/$replace/g;
349					return $self;
350					}
351
352
353					sub remove {
354					my ($self, $search) = @_;
355					$search = '' unless defined $search;
356					$self->{ text } =~ s/$search//g;
357					return $self;
358					}
359
360
361					sub split {
362					my $self = CORE::shift;
363					my $split = CORE::shift;
364					my $limit = CORE::shift \|\| 0;
365					$split = '\s+' unless defined $split;
366					return [ split($split, $self->{ text }, $limit) ];
367					}
368
369
370					sub search {
371					my ($self, $pattern) = @_;
372					return $self->{ text } =~ /$pattern/;
373					}
374
375
376					sub equals {
377					my ($self, $comparison) = @_;
378					return $self->{ text } eq $comparison;
379					}
380
381
382	1	4µs			1;
383
384					__END__