← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Fri Jul 18 13:58:34 2008
Reported on Fri Jul 18 13:58:41 2008

File/usr/local/lib/perl/5.8.8/HTML/Template/Pro.pm
Statements Executed324
Total Time0.000337 seconds

Subroutines — ordered by inclusive time then name
CallsInclusive
Time		Subroutine
160.00062HTML::Template::Pro::param
10.00009HTML::Template::Pro::new
00HTML::Template::Pro::BEGIN
00HTML::Template::Pro::__ANON__[:36]
00HTML::Template::Pro::__ANON__[:40]
00HTML::Template::Pro::__ANON__[:41]
00HTML::Template::Pro::__ANON__[:42]
00HTML::Template::Pro::__ANON__[:43]
00HTML::Template::Pro::__ANON__[:44]
00HTML::Template::Pro::__ANON__[:45]
00HTML::Template::Pro::__ANON__[:46]
00HTML::Template::Pro::__ANON__[:47]
00HTML::Template::Pro::__ANON__[:48]
00HTML::Template::Pro::__ANON__[:51]
00HTML::Template::Pro::__ANON__[:52]
00HTML::Template::Pro::__ANON__[:54]
00HTML::Template::Pro::__ANON__[:55]
00HTML::Template::Pro::__ANON__[:58]
00HTML::Template::Pro::_call_filters
00HTML::Template::Pro::_find_file
00HTML::Template::Pro::_get_filepath
00HTML::Template::Pro::_load_template
00HTML::Template::Pro::_lowercase_keys
00HTML::Template::Pro::clear_params
00HTML::Template::Pro::new_array_ref
00HTML::Template::Pro::new_file
00HTML::Template::Pro::new_filehandle
00HTML::Template::Pro::new_scalar_ref
00HTML::Template::Pro::output
00HTML::Template::Pro::register_function

LineStmts.Exclusive
Time		Avg.Code
1package HTML::Template::Pro;
2
3use 5.005;
4use strict;
5use integer; # no floating point math so far!
6require DynaLoader;
7use File::Spec; # generate paths that work on all platforms
8use Carp;
9use vars qw($VERSION @ISA);
10@ISA = qw(DynaLoader);
11
12$VERSION = '0.68';
13
14bootstrap HTML::Template::Pro $VERSION;
15
16## when HTML::Template is not loaded,
17## all calls to HTML::Template will be sent to HTML::Template::Pro,
18## otherwise native HTML::Template will be used
19push @HTML::Template::ISA, qw/HTML::Template::Pro/;
20push @HTML::Template::Expr::ISA, qw/HTML::Template::Pro/;
21
22# Preloaded methods go here.
23
24# internal mallocs -- required
25_init();
26# internal frees -- it is better to comment it:
27# when process terminates, memory is freed anyway
28# but END {} can be called between calls (as SpeedyCGI does)
29# END {_done()}
30
31# initialize preset function table
32use vars qw(%FUNC);
33%FUNC =
34 (
35 # commented sin,cos,log,tan,... are built-in
36 'sprintf' => sub { sprintf(shift, @_); },
37 'substr' => sub {
38 return substr($_[0], $_[1]) if @_ == 2;
39 return substr($_[0], $_[1], $_[2]);
40 },
41 'lc' => sub { lc($_[0]); },
42 'lcfirst' => sub { lcfirst($_[0]); },
43 'uc' => sub { uc($_[0]); },
44 'ucfirst' => sub { ucfirst($_[0]); },
45 'length' => sub { length($_[0]); },
46 'defined' => sub { defined($_[0]); },
47 'abs' => sub { abs($_[0]); },
48 'atan2' => sub { atan2($_[0], $_[1]); },
49# 'cos' => sub { cos($_[0]); },
50# 'exp' => sub { exp($_[0]); },
51 'hex' => sub { hex($_[0]); },
52 'int' => sub { int($_[0]); },
53# 'log' => sub { log($_[0]); },
54 'oct' => sub { oct($_[0]); },
55 'rand' => sub { rand($_[0]); },
56# 'sin' => sub { sin($_[0]); },
57# 'sqrt' => sub { sqrt($_[0]); },
58 'srand' => sub { srand($_[0]); },
59 );
60
61
# spent 0.00009s within HTML::Template::Pro::new which was called: # 1 times (0.00009s) by C4::Output::gettemplate at line 91 of C4/Output.pm
sub new {
62190.000073e-06 my $class=shift;
63 my %param;
64 my $options={param_map=>\%param,
65 functions => {},
66 filter => [],
67 # ---- supported -------
68 debug => 0,
69 max_includes => 10,
70 global_vars => 0,
71 no_includes => 0,
72 search_path_on_include => 0,
73 loop_context_vars => 0,
74 path => [],
75 associate => [],
76 case_sensitive => 0,
77 #in expr only
78 strict => 1,
79 # ---- unsupported distinct -------
80 #die_on_bad_params => 1,
81 die_on_bad_params => 0,
82 # ---- unsupported -------
83# vanguard_compatibility_mode => 0,
84#=============================================
85# The following options are harmless caching-specific.
86# They are ignored silently because there is nothing to cache.
87#=============================================
88# stack_debug => 0,
89# timing => 0,
90# cache => 0,
91# blind_cache => 0,
92# file_cache => 0,
93# file_cache_dir => '',
94# file_cache_dir_mode => 0700,
95# cache_debug => 0,
96# shared_cache_debug => 0,
97# memory_debug => 0,
98# shared_cache => 0,
99# double_cache => 0,
100# double_file_cache => 0,
101# ipc_key => 'TMPL',
102# ipc_mode => 0666,
103# ipc_segment_size => 65536,
104# ipc_max_size => 0,
105#============================================
106 @_};
107
108 # associate should be an array if it's not already
109 if (ref($options->{associate}) ne 'ARRAY') {
110 $options->{associate} = [ $options->{associate} ];
111 }
112 # path should be an array if it's not already
113 if (ref($options->{path}) ne 'ARRAY') {
114 $options->{path} = [ $options->{path} ];
115 }
116 # filter should be an array if it's not already
117 if (ref($options->{filter}) ne 'ARRAY') {
118 $options->{filter} = [ $options->{filter} ];
119 }
120
121 # make sure objects in associate area support param()
122 foreach my $object (@{$options->{associate}}) {
123 defined($object->can('param')) or
124 croak("HTML::Template->new called with associate option, containing object of type " . ref($object) . " which lacks a param() method!");
125 }
126
127 # check for syntax errors:
128 my $source_count = 0;
129 exists($options->{filename}) and $source_count++;
130 exists($options->{filehandle}) and $source_count++;
131 exists($options->{arrayref}) and $source_count++;
132 exists($options->{scalarref}) and $source_count++;
133 if ($source_count != 1) {
134 croak("HTML::Template->new called with multiple (or no) template sources specified! A valid call to new() has exactly one filename => 'file' OR exactly one scalarref => \\\$scalar OR exactly one arrayref => \\\@array OR exactly one filehandle => \*FH");
135 }
136 if ($options->{arrayref}) {
137 die "bad value of arrayref" unless UNIVERSAL::isa($_[0], 'ARRAY');
138 my $template=join('',@{$options->{arrayref}});
139 $options->{scalarref}=\$template;
140 }
141 if ($options->{filehandle}) {
142 local $/; # enable "slurp" mode
143 local *FH=$options->{filehandle};
144 my $template=<FH>;
145 $options->{scalarref}=\$template;
146 }
147
148 # merging built_in funcs with user-defined funcs
149 $options->{expr_func}={%FUNC, %{$options->{functions}}};
150
151 # hack to be fully compatible with HTML::Template;
152 # caused serious memory leak. it should be done on XS level, if needed.
153 # &safe_circular_reference($options,'options') ???
154 #$options->{options}=$options;
155 bless $options,$class;
156 $options->_call_filters($options->{scalarref}) if $options->{scalarref} and @{$options->{filter}};
157 return $options; # == $self
158}
159
160# a few shortcuts to new(), of possible use...
161sub new_file {
162 my $pkg = shift; return $pkg->new('filename', @_);
163}
164sub new_filehandle {
165 my $pkg = shift; return $pkg->new('filehandle', @_);
166}
167sub new_array_ref {
168 my $pkg = shift; return $pkg->new('arrayref', @_);
169}
170sub new_scalar_ref {
171 my $pkg = shift; return $pkg->new('scalarref', @_);
172}
173
174sub output {
175 my $self=shift;
176 my %oparam=(@_);
177
178 # emulation of the associate magic
179 if (scalar(@{$self->{associate}})) {
180 foreach my $associated_object (reverse @{$self->{associate}}) {
181 foreach my $param ($associated_object->param()) {
182 $self->param($param, scalar $associated_object->param($param))
183 unless $self->param($param);
184 }
185 }
186 }
187
188 if ($oparam{print_to}) {
189 exec_tmpl($self,$oparam{print_to});
190 } else {
191 return exec_tmpl_string($self);
192 }
193}
194
195sub clear_params {
196 my $self = shift;
197 %{$self->{param_map}}=();
198}
199
200
# spent 0.00062s within HTML::Template::Pro::param which was called 16 times, avg 0.00004s/call: # 1 times (0.00003s) by C4::Output::gettemplate at line 118 of C4/Output.pm # 1 times (0.00006s) by C4::Output::gettemplate at line 101 of C4/Output.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 237 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 238 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 246 of C4/Auth.pm # 1 times (0.00009s) by C4::Auth::get_template_and_user at line 252 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 233 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 234 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 241 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 245 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 239 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 236 of C4/Auth.pm # 1 times (0.00003s) by C4::Auth::get_template_and_user at line 231 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 232 of C4/Auth.pm # 1 times (0.00002s) by C4::Auth::get_template_and_user at line 343 of C4/Auth.pm # 1 times (0.00022s) by C4::Auth::get_template_and_user at line 297 of C4/Auth.pm
sub param {
201640.000061e-06 my $self = shift;
202 #my $options = $self->{options};
203 my $param_map = $self->{param_map};
204 # compatibility with HTML::Template
205 # the one-parameter case - could be a parameter value request or a
206 # hash-ref.
207 if (scalar @_==0) {
208 return keys (%$param_map);
209 } elsif (scalar @_==1) {
210 if (ref($_[0]) and UNIVERSAL::isa($_[0], 'HASH')) {
211 # ref to hash of params --- simply dereference it
212 return $self->param(%{$_[0]});
213 } else {
214 my $key=$self->{case_sensitive} ? $_[0] : lc($_[0]);
215 return $param_map->{$key} || $param_map->{$_[0]};
216 }
217 }
218 # loop below is obvious but wrong for perl
219 # while (@_) {$param_map->{shift(@_)}=shift(@_);}
220160.000018e-07 if ($self->{case_sensitive}) {
221 while (@_) {
2222250.000199e-07 my $key=shift;
223 my $val=shift;
224 $param_map->{$key}=$val;
225 }
226 } else {
227 while (@_) {
228 my $key=shift;
229 my $val=shift;
230 if (ref($val)) {
231 if (UNIVERSAL::isa($val, 'ARRAY')) {
232 $param_map->{lc($key)}=[map {_lowercase_keys($_)} @$val];
233 } elsif (UNIVERSAL::isa($val, 'CODE')) {
234 $param_map->{lc($key)}=&$val();
235 } else {
236 $param_map->{lc($key)}=$val;
237 }
238 } else {
239 $param_map->{lc($key)}=$val;
240 }
241 }
242 }
243}
244
245sub register_function {
246 my($self, $name, $sub) = @_;
247 croak("HTML::Template::Pro : last arg of register_function must be subroutine reference\n")
248 unless ref($sub) eq 'CODE';
249 if (ref $self) {
250 # per object call
251 $self->{expr_func}->{$name} = $sub;
252 } else {
253 # per class call
254 $FUNC{$name} = $sub;
255 }
256}
257
258sub _lowercase_keys {
259 my $orighash=shift;
260 my $newhash={};
261 my ($key,$val);
262 unless (UNIVERSAL::isa($orighash, 'HASH')) {
263 Carp::carp "HTML::Template::Pro:_lowercase_keys:in param_tree: found strange parameter $orighash while hash was expected";
264 return;
265 }
266 while (($key,$val)=each %$orighash) {
267 if (ref($val)) {
268 if (UNIVERSAL::isa($val, 'ARRAY')) {
269 $newhash->{lc($key)}=[map {_lowercase_keys($_)} @$val];
270 } elsif (UNIVERSAL::isa($val, 'CODE')) {
271 $newhash->{lc($key)}=&$val();
272 } else {
273 $newhash->{lc($key)}=$val;
274 }
275 } else {
276 $newhash->{lc($key)}=$val;
277 }
278 }
279 return $newhash;
280}
281
282# sub _load_file {
283# my $filepath=shift;
284# open my $fh, $filepath or die $!;
285# local $/; # enable localized slurp mode
286# my $content = <$fh>;
287# close $fh;
288# return $content;
289# }
290
291## HTML::Template based
292
293## callback function called inside C code
294sub _get_filepath {
295 my ($self, $filename, $last_visited_file) = @_;
296 # look for the included file...
297 my $filepath;
298 if ((not defined $last_visited_file) or $self->{search_path_on_include}) {
299 $filepath = $self->_find_file($filename);
300 } else {
301 $filepath = $self->_find_file($filename,
302 [File::Spec->splitdir($last_visited_file)]
303 );
304 }
305 carp "HTML::Template::Pro:template $filename not found!" unless $filepath;
306 return $filepath;
307}
308
309sub _find_file {
310 my ($options, $filename, $extra_path) = @_;
311 my $filepath;
312
313 # first check for a full path
314 return File::Spec->canonpath($filename)
315 if (File::Spec->file_name_is_absolute($filename) and (-e $filename));
316
317 # try the extra_path if one was specified
318 if (defined($extra_path)) {
319 $extra_path->[$#{$extra_path}] = $filename;
320 $filepath = File::Spec->canonpath(File::Spec->catfile(@$extra_path));
321 return File::Spec->canonpath($filepath) if -e $filepath;
322 }
323
324 # try pre-prending HTML_Template_Root
325 if (exists($ENV{HTML_TEMPLATE_ROOT}) and defined($ENV{HTML_TEMPLATE_ROOT})) {
326 $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $filename);
327 return File::Spec->canonpath($filepath) if -e $filepath;
328 }
329
330 # try "path" option list..
331 foreach my $path (@{$options->{path}}) {
332 $filepath = File::Spec->catfile($path, $filename);
333 return File::Spec->canonpath($filepath) if -e $filepath;
334 }
335
336 # try even a relative path from the current directory...
337 return File::Spec->canonpath($filename) if -e $filename;
338
339 # try "path" option list with HTML_TEMPLATE_ROOT prepended...
340 if (exists($ENV{HTML_TEMPLATE_ROOT})) {
341 foreach my $path (@{$options->{path}}) {
342 $filepath = File::Spec->catfile($ENV{HTML_TEMPLATE_ROOT}, $path, $filename);
343 return File::Spec->canonpath($filepath) if -e $filepath;
344 }
345 }
346
347 return undef;
348}
349
350sub _load_template {
351 my $self = shift;
352 my $filepath=shift;
353 my $template = "";
354 confess("HTML::Template->new() : Cannot open file $filepath : $!")
355 unless defined(open(TEMPLATE, $filepath));
356 # read into scalar
357 while (read(TEMPLATE, $template, 10240, length($template))) {}
358 close(TEMPLATE);
359 $self->_call_filters(\$template) if @{$self->{filter}};
360 return \$template;
361}
362
363# handle calling user defined filters
364sub _call_filters {
365 my $self = shift;
366 my $template_ref = shift;
367 my $options = $self;#->{options};
368
369 my ($format, $sub);
370 foreach my $filter (@{$options->{filter}}) {
371 croak("HTML::Template->new() : bad value set for filter parameter - must be a code ref or a hash ref.")
372 unless ref $filter;
373
374 # translate into CODE->HASH
375 $filter = { 'format' => 'scalar', 'sub' => $filter }
376 if (ref $filter eq 'CODE');
377
378 if (ref $filter eq 'HASH') {
379 $format = $filter->{'format'};
380 $sub = $filter->{'sub'};
381
382 # check types and values
383 croak("HTML::Template->new() : bad value set for filter parameter - hash must contain \"format\" key and \"sub\" key.")
384 unless defined $format and defined $sub;
385 croak("HTML::Template->new() : bad value set for filter parameter - \"format\" must be either 'array' or 'scalar'")
386 unless $format eq 'array' or $format eq 'scalar';
387 croak("HTML::Template->new() : bad value set for filter parameter - \"sub\" must be a code ref")
388 unless ref $sub and ref $sub eq 'CODE';
389
390 # catch errors
391 eval {
392 if ($format eq 'scalar') {
393 # call
394 $sub->($template_ref);
395 } else {
396 # modulate
397 my @array = map { $_."\n" } split("\n", $$template_ref);
398 # call
399 $sub->(\@array);
400 # demodulate
401 $$template_ref = join("", @array);
402 }
403 };
404 croak("HTML::Template->new() : fatal error occured during filter call: $@") if $@;
405 } else {
406 croak("HTML::Template->new() : bad value set for filter parameter - must be code ref or hash ref");
407 }
408 }
409 # all done
410 return $template_ref;
411}
412
4131;
414__END__
415
416=head1 NAME
417
418HTML::Template::Pro - Perl/XS module to use HTML Templates from CGI scripts
419
420=head1 SYNOPSIS
421
422It is moved out and split.
423
424See L<HTML::Template::SYNTAX/SYNOPSIS> for introduction
425to HTML::Template and syntax of template files.
426
427See L<HTML::Template::PerlInterface/SYNOPSIS> for perl interface
428of HTML::Template, HTML::Template::Expr and HTML::Template::Pro.
429
430=head1 DESCRIPTION
431
432Original HTML::Template is written by Sam Tregar, sam@tregar.com
433with contributions of many people mentioned there.
434Their efforts caused HTML::Template to be mature html tempate engine
435which separate perl code and html design.
436Yet powerful, HTML::Template is slow, especially if mod_perl isn't
437available or in case of disk usage and memory limitations.
438
439HTML::Template::Pro is a fast lightweight C/Perl+XS reimplementation
440of HTML::Template (as of 2.8) and HTML::Template::Expr (as of 0.0.5).
441It is not intended to be a complete replacement,
442but to be a fast implementation of HTML::Template if you don't need
443quering, the extended facility of HTML::Template.
444Designed for heavy upload, resource limitations, abcence of mod_perl.
445
446HTML::Template::Pro has complete support of filters and HTML::Template::Expr's
447tag EXPR="<expression>", including user-defined functions.
448
449HTML::Template work cycle uses 2 steps. First, it loads and parse template.
450Then it accepts param() calls until you call output().
451output() is its second phase where it produces a page from the parsed tree
452of template, obtained in the 1st step.
453
454HTML::Template::Pro loads, parse and outputs template on fly,
455when you call $tmpl->output(), in one pass. The corresponding code is
456written in C and glued to Perl using Perl+XS. As a result,
457comparing to HTML::Template in ordinary calls, it runs
45810-25 times faster. Comparing to HTML::Template with all caching enabled
459under mod_perl, it still 1-3 times faster. At that HTML::Template caching
460requires considerable amount of memory (per process, shareable, or on disk)
461to be permanently filled with parsed trees, whereas HTML::Template::Pro
462don't consumes memory for caches and use mmap() for reading templates on disk.
463
464Introduction to HTML::Template and syntax of template files is described
465in L<HTML::Template::SYNTAX>.
466Perl interface of HTML::Template and HTML::Template::Pro is described
467in L<HTML::Template::PerlInterface>.
468
469=head1 SEE ALSO
470
471L<HTML::Template::SYNTAX>, L<HTML::Template::PerlInterface>.
472
473Progect page is http://html-tmpl-pro.sourceforge.net
474 (and http://sourceforge.net/projects/html-tmpl-pro)
475
476Original modules are L<HTML::Template>, L<HTML::Template::Expr>.
477Their progect page is http://html-template.sourceforge.net
478
479=head1 BUGS
480
481See L<HTML::Template::PerlInterface/BUGS>
482
483=head1 AUTHOR
484
485I. Vlasenko, E<lt>viy@altlinux.orgE<gt>
486
487with contributions of
488Bruni Emiliano, <info@ebruni.it>
489Stanislav Yadykin, <tosick at altlinux.ru>
490Viacheslav Sheveliov <slavash at aha.ru>
491
492=head1 COPYRIGHT AND LICENSE
493
494Copyright (C) 2005 by I. Yu. Vlasenko.
495Pieces of code in Pro.pm and documentation of HTML::Template are
496copyright (C) 2000-2002 Sam Tregar (sam@tregar.com)
497
498The template syntax, interface conventions and a large piece of documentation
499of HTML::Template::Pro are based on CPAN module HTML::Template
500by Sam Tregar, sam@tregar.com.
501
502This library is free software; you can redistribute it and/or modify
503it under the same terms as Perl itself, either Perl version 5.8.4 or,
504at your option, any later version of Perl 5 you may have available.
505
506=cut
Report produced by the NYTProf 2.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.