← 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 11:58:52 2013
Reported on Tue Oct 15 12:01:16 2013

Filename/usr/share/koha/lib/C4/Output.pm
StatementsExecuted 43 statements in 27.6ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11124.7ms24.7msC4::Output::::CORE:printC4::Output::CORE:print (opcode)
1113.93ms8.54msC4::Output::::BEGIN@35C4::Output::BEGIN@35
1111.93ms43.9msC4::Output::::BEGIN@36C4::Output::BEGIN@36
1111.81ms8.54msC4::Output::::BEGIN@34C4::Output::BEGIN@34
1111.15ms1.48msC4::Output::::BEGIN@31C4::Output::BEGIN@31
111240µs27.3msC4::Output::::output_with_http_headersC4::Output::output_with_http_headers
11149µs49µsC4::Output::::CORE:substC4::Output::CORE:subst (opcode)
11130µs30µsC4::Output::::BEGIN@40C4::Output::BEGIN@40
11121µs27µsC4::Output::::BEGIN@28C4::Output::BEGIN@28
11114µs18µsC4::Output::::BEGIN@33C4::Output::BEGIN@33
11113µs104µsC4::Output::::BEGIN@38C4::Output::BEGIN@38
1114µs4µsC4::Output::::ENDC4::Output::END
0000s0sC4::Output::::FormatDataC4::Output::FormatData
0000s0sC4::Output::::FormatNumberC4::Output::FormatNumber
0000s0sC4::Output::::_current_languageC4::Output::_current_language
0000s0sC4::Output::::_get_template_fileC4::Output::_get_template_file
0000s0sC4::Output::::getlanguagecookieC4::Output::getlanguagecookie
0000s0sC4::Output::::gettemplateC4::Output::gettemplate
0000s0sC4::Output::::is_ajaxC4::Output::is_ajax
0000s0sC4::Output::::output_ajax_with_http_headersC4::Output::output_ajax_with_http_headers
0000s0sC4::Output::::output_html_with_http_headersC4::Output::output_html_with_http_headers
0000s0sC4::Output::::pagination_barC4::Output::pagination_bar
0000s0sC4::Output::::parametrized_urlC4::Output::parametrized_url
0000s0sC4::Output::::setlanguagecookieC4::Output::setlanguagecookie
0000s0sC4::Output::::themelanguageC4::Output::themelanguage
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Output;
2
3#package to deal with marking up output
4#You will need to edit parts of this pm
5#set the value of path to be where your html lives
6
7# Copyright 2000-2002 Katipo Communications
8#
9# This file is part of Koha.
10#
11# Koha is free software; you can redistribute it and/or modify it under the
12# terms of the GNU General Public License as published by the Free Software
13# Foundation; either version 2 of the License, or (at your option) any later
14# version.
15#
16# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
17# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
18# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License along
21# with Koha; if not, write to the Free Software Foundation, Inc.,
22# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23
24
25# NOTE: I'm pretty sure this module is deprecated in favor of
26# templates.
27
28332µs233µs
# spent 27µs (21+6) within C4::Output::BEGIN@28 which was called: # once (21µs+6µs) by main::BEGIN@45 at line 28
use strict;
# spent 27µs making 1 call to C4::Output::BEGIN@28 # spent 6µs making 1 call to strict::import
29#use warnings; FIXME - Bug 2505
30
313132µs21.61ms
# spent 1.48ms (1.15+327µs) within C4::Output::BEGIN@31 which was called: # once (1.15ms+327µs) by main::BEGIN@45 at line 31
use URI::Escape;
# spent 1.48ms making 1 call to C4::Output::BEGIN@31 # spent 128µs making 1 call to Exporter::import
32
33331µs221µs
# spent 18µs (14+3) within C4::Output::BEGIN@33 which was called: # once (14µs+3µs) by main::BEGIN@45 at line 33
use C4::Context;
# spent 18µs making 1 call to C4::Output::BEGIN@33 # spent 3µs making 1 call to C4::Context::import
343143µs28.60ms
# spent 8.54ms (1.81+6.73) within C4::Output::BEGIN@34 which was called: # once (1.81ms+6.73ms) by main::BEGIN@45 at line 34
use C4::Dates qw(format_date);
# spent 8.54ms making 1 call to C4::Output::BEGIN@34 # spent 61µs making 1 call to Exporter::import
353151µs28.70ms
# spent 8.54ms (3.93+4.61) within C4::Output::BEGIN@35 which was called: # once (3.93ms+4.61ms) by main::BEGIN@45 at line 35
use C4::Budgets qw(GetCurrency);
# spent 8.54ms making 1 call to C4::Output::BEGIN@35 # spent 164µs making 1 call to Exporter::import
363146µs243.9ms
# spent 43.9ms (1.93+42.0) within C4::Output::BEGIN@36 which was called: # once (1.93ms+42.0ms) by main::BEGIN@45 at line 36
use C4::Templates;
# spent 43.9ms making 1 call to C4::Output::BEGIN@36 # spent 7µs making 1 call to Class::Accessor::import
37
383114µs2195µs
# spent 104µs (13+91) within C4::Output::BEGIN@38 which was called: # once (13µs+91µs) by main::BEGIN@45 at line 38
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 104µs making 1 call to C4::Output::BEGIN@38 # spent 91µs making 1 call to vars::import
39
40
# spent 30µs within C4::Output::BEGIN@40 which was called: # once (30µs+0s) by main::BEGIN@45 at line 59
BEGIN {
41 # set the version for version checking
42730µs $VERSION = 3.07.00.049;
43 require Exporter;
44
45 @ISA = qw(Exporter);
46 @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
47 %EXPORT_TAGS = ( all =>[qw(setlanguagecookie pagination_bar parametrized_url
48 &output_with_http_headers &output_ajax_with_http_headers &output_html_with_http_headers)],
49 ajax =>[qw(&output_with_http_headers &output_ajax_with_http_headers is_ajax)],
50 html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
51 );
52 push @EXPORT, qw(
53 setlanguagecookie getlanguagecookie pagination_bar parametrized_url
54 );
55 push @EXPORT, qw(
56 &output_html_with_http_headers &output_ajax_with_http_headers &output_with_http_headers FormatData FormatNumber
57 );
58
5911.94ms130µs}
# spent 30µs making 1 call to C4::Output::BEGIN@40
60
61=head1 NAME
62
- -
70#FIXME: this is a quick fix to stop rc1 installing broken
71#Still trying to figure out the correct fix.
72110µs124µsmy $path = C4::Context->config('intrahtdocs') . "/prog/en/includes/";
# spent 24µs making 1 call to C4::Context::config
73
74#---------------------------------------------------------------------------------------------------------
75# FIXME - POD
76
77sub _get_template_file {
78 my ( $tmplbase, $interface, $query ) = @_;
79 my $htdocs = C4::Context->config( $interface ne 'intranet' ? 'opachtdocs' : 'intrahtdocs' );
80 my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $interface, $query );
81 my $opacstylesheet = C4::Context->preference('opacstylesheet');
82
83 # if the template doesn't exist, load the English one as a last resort
84 my $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
85 unless (-f $filename) {
86 $lang = 'en';
87 $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
88 }
89
90 return ( $htdocs, $theme, $lang, $filename );
91}
92
93sub gettemplate {
94 my ( $tmplbase, $interface, $query ) = @_;
95 ($query) or warn "no query in gettemplate";
96 my $path = C4::Context->preference('intranet_includes') || 'includes';
97 my $opacstylesheet = C4::Context->preference('opacstylesheet');
98 $tmplbase =~ s/\.tmpl$/.tt/;
99 my ( $htdocs, $theme, $lang, $filename ) = _get_template_file( $tmplbase, $interface, $query );
100 my $template = C4::Templates->new( $interface, $filename, $tmplbase);
101 my $themelang=( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
102 . "/$theme/en";
103 $template->param(
104 themelang => $themelang,
105 yuipath => (C4::Context->preference("yuipath") eq "local"?"$themelang/lib/yui":C4::Context->preference("yuipath")),
106 interface => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
107 theme => $theme,
108 lang => $lang
109 );
110
111 # Bidirectionality
112 my $current_lang = regex_lang_subtags($lang);
113 my $bidi;
114 $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
115 # Languages
116 my $languages_loop = getTranslatedLanguages($interface,$theme,$lang);
117 my $num_languages_enabled = 0;
118 foreach my $lang (@$languages_loop) {
119 foreach my $sublang (@{ $lang->{'sublanguages_loop'} }) {
120 $num_languages_enabled++ if $sublang->{enabled};
121 }
122 }
123 $template->param(
124 languages_loop => $languages_loop,
125 bidi => $bidi,
126 one_language_enabled => ($num_languages_enabled <= 1) ? 1 : 0, # deal with zero enabled langs as well
127 ) unless @$languages_loop<2;
128
129 return $template;
130}
131
132# FIXME - this is a horrible hack to cache
133# the current known-good language, temporarily
134# put in place to resolve bug 4403. It is
135# used only by C4::XSLT::XSLTParse4Display;
136# the language is set via the usual call
137# to themelanguage.
1381300nsmy $_current_language = 'en';
139sub _current_language {
140 return $_current_language;
141}
142
143#---------------------------------------------------------------------------------------------------------
144# FIXME - POD
145sub themelanguage {
146 my ( $htdocs, $tmpl, $interface, $query ) = @_;
147 ($query) or warn "no query in themelanguage";
148
149 # Set some defaults for language and theme
150 # First, check the user's preferences
151 my $lang;
152 my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE };
153# $lang = accept_language( $http_accept_language,
154# getTranslatedLanguages($interface,'prog') )
155# if $http_accept_language;
156 # But, if there's a cookie set, obey it
157 $lang = $query->cookie('KohaOpacLanguage') if (defined $query and $query->cookie('KohaOpacLanguage'));
158 # Fall back to English
159 my @languages;
160 if ($interface eq 'intranet') {
161 @languages = split ",", C4::Context->preference("language");
162 } else {
163 @languages = split ",", C4::Context->preference("opaclanguages");
164 }
165 if ($lang){
166 @languages=($lang,@languages);
167 } else {
168 $lang = $languages[0];
169 }
170 my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
171 my $dbh = C4::Context->dbh;
172 my @themes;
173 if ( $interface eq "intranet" ) {
174 @themes = split " ", C4::Context->preference("template");
175 }
176 else {
177 # we are in the opac here, what im trying to do is let the individual user
178 # set the theme they want to use.
179 # and perhaps the them as well.
180 #my $lang = $query->cookie('KohaOpacLanguage');
181 @themes = split " ", C4::Context->preference("opacthemes");
182 }
183
184 # searches through the themes and languages. First template it find it returns.
185 # Priority is for getting the theme right.
186 THEME:
187 foreach my $th (@themes) {
188 foreach my $la (@languages) {
189 #for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
190 # warn "$htdocs/$th/$la/modules/$interface-"."tmpl";
191 #$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
192 if ( -e "$htdocs/$th/$la/modules/$tmpl") {
193 #".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
194 $theme = $th;
195 $lang = $la;
196 last THEME;
197 }
198 last unless $la =~ /[-_]/;
199 #}
200 }
201 }
202
203 $_current_language = $lang; # FIXME part of bad hack to paper over bug 4403
204 return ( $theme, $lang );
205}
206
207sub setlanguagecookie {
208 my ( $query, $language, $uri ) = @_;
209 my $cookie = $query->cookie(
210 -name => 'KohaOpacLanguage',
211 -value => $language,
212 -expires => ''
213 );
214 print $query->redirect(
215 -uri => $uri,
216 -cookie => $cookie
217 );
218}
219
220sub getlanguagecookie {
221 my ($query) = @_;
222 my $lang;
223 if ($query->cookie('KohaOpacLanguage')){
224 $lang = $query->cookie('KohaOpacLanguage') ;
225 }else{
226 $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
227
228 }
229 $lang = substr($lang, 0, 2);
230
231 return $lang;
232}
233
234=item FormatNumber
235
236sub FormatNumber{
237my $cur = GetCurrency;
238my $cur_format = C4::Context->preference("CurrencyFormat");
239my $num;
240
241if ( $cur_format eq 'FR' ) {
242 $num = new Number::Format(
243 'decimal_fill' => '2',
244 'decimal_point' => ',',
245 'int_curr_symbol' => $cur->{symbol},
246 'mon_thousands_sep' => ' ',
247 'thousands_sep' => ' ',
248 'mon_decimal_point' => ','
249 );
250} else { # US by default..
251 $num = new Number::Format(
252 'int_curr_symbol' => '',
253 'mon_thousands_sep' => ',',
254 'mon_decimal_point' => '.'
255 );
256}
257return $num;
258}
259
260=item FormatData
261
- -
269sub FormatData{
270 my $data_hashref=shift;
271 $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
272}
273
274=item pagination_bar
275
- -
293sub pagination_bar {
294 my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return;
295 my $nb_pages = (@_) ? shift : 1;
296 my $current_page = (@_) ? shift : undef; # delay default until later
297 my $startfrom_name = (@_) ? shift : 'page';
298
299 # how many pages to show before and after the current page?
300 my $pages_around = 2;
301
302 my $delim = qr/\&(?:amp;)?|;/; # "non memory" cluster: no backreference
303 $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
304 unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
305 $current_page = ($1) ? $1 : 1; # pull current page from param in URL, else default to 1
306 # $debug and # FIXME: use C4::Debug;
307 # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1 2:$2 3:$3";
308 }
309 $base_url =~ s/($delim)+/$1/g; # compress duplicate delims
310 $base_url =~ s/$delim;//g; # remove empties
311 $base_url =~ s/$delim$//; # remove trailing delim
312
313 my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
314 my $pagination_bar = '';
315
316 # navigation bar useful only if more than one page to display !
317 if ( $nb_pages > 1 ) {
318
319 # link to first page?
320 if ( $current_page > 1 ) {
321 $pagination_bar .=
322 "\n" . '&nbsp;'
323 . '<a href="'
324 . $url
325 . '1" rel="start">'
326 . '&lt;&lt;' . '</a>';
327 }
328 else {
329 $pagination_bar .=
330 "\n" . '&nbsp;<span class="inactive">&lt;&lt;</span>';
331 }
332
333 # link on previous page ?
334 if ( $current_page > 1 ) {
335 my $previous = $current_page - 1;
336
337 $pagination_bar .=
338 "\n" . '&nbsp;'
339 . '<a href="'
340 . $url
341 . $previous
342 . '" rel="prev">' . '&lt;' . '</a>';
343 }
344 else {
345 $pagination_bar .=
346 "\n" . '&nbsp;<span class="inactive">&lt;</span>';
347 }
348
349 my $min_to_display = $current_page - $pages_around;
350 my $max_to_display = $current_page + $pages_around;
351 my $last_displayed_page = undef;
352
353 for my $page_number ( 1 .. $nb_pages ) {
354 if (
355 $page_number == 1
356 or $page_number == $nb_pages
357 or ( $page_number >= $min_to_display
358 and $page_number <= $max_to_display )
359 )
360 {
361 if ( defined $last_displayed_page
362 and $last_displayed_page != $page_number - 1 )
363 {
364 $pagination_bar .=
365 "\n" . '&nbsp;<span class="inactive">...</span>';
366 }
367
368 if ( $page_number == $current_page ) {
369 $pagination_bar .=
370 "\n" . '&nbsp;'
371 . '<span class="currentPage">'
372 . $page_number
373 . '</span>';
374 }
375 else {
376 $pagination_bar .=
377 "\n" . '&nbsp;'
378 . '<a href="'
379 . $url
380 . $page_number . '">'
381 . $page_number . '</a>';
382 }
383 $last_displayed_page = $page_number;
384 }
385 }
386
387 # link on next page?
388 if ( $current_page < $nb_pages ) {
389 my $next = $current_page + 1;
390
391 $pagination_bar .= "\n"
392 . '&nbsp;<a href="'
393 . $url
394 . $next
395 . '" rel="next">' . '&gt;' . '</a>';
396 }
397 else {
398 $pagination_bar .=
399 "\n" . '&nbsp;<span class="inactive">&gt;</span>';
400 }
401
402 # link to last page?
403 if ( $current_page != $nb_pages ) {
404 $pagination_bar .= "\n"
405 . '&nbsp;<a href="'
406 . $url
407 . $nb_pages
408 . '" rel="last">'
409 . '&gt;&gt;' . '</a>';
410 }
411 else {
412 $pagination_bar .=
413 "\n" . '&nbsp;<span class="inactive">&gt;&gt;</span>';
414 }
415 }
416
417 return $pagination_bar;
418}
419
420=item output_with_http_headers
421
- -
436
# spent 27.3ms (240µs+27.0) within C4::Output::output_with_http_headers which was called: # once (240µs+27.0ms) by main::RUNTIME at line 898 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
sub output_with_http_headers {
437924.9ms my ( $query, $cookie, $data, $content_type, $status ) = @_;
438 $status ||= '200 OK';
439
440 my %content_type_map = (
441 'html' => 'text/html',
442 'js' => 'text/javascript',
443 'json' => 'application/json',
444 'xml' => 'text/xml',
445 # NOTE: not using application/atom+xml or application/rss+xml because of
446 # Internet Explorer 6; see bug 2078.
447 'rss' => 'text/xml',
448 'atom' => 'text/xml'
449 );
450
451 die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
452 my $options = {
453 type => $content_type_map{$content_type},
454 status => $status,
455 charset => 'UTF-8',
456 Pragma => 'no-cache',
457 'Cache-Control' => 'no-cache',
458 };
459 $options->{cookie} = $cookie if $cookie;
46022µs if ($content_type eq 'html') { # guaranteed to be one of the content_type_map keys, else we'd have died
461 $options->{'Content-Style-Type' } = 'text/css';
462 $options->{'Content-Script-Type'} = 'text/javascript';
463 }
464
465# We can't encode here, that will double encode our templates, and xslt
466# We need to fix the encoding as it comes out of the database, or when we pass the variables to templates
467
468# utf8::encode($data) if utf8::is_utf8($data);
469
470149µs $data =~ s/\&amp\;amp\; /\&amp\; /g;
# spent 49µs making 1 call to C4::Output::CORE:subst
471225.4ms print $query->header($options), $data;
# spent 24.7ms making 1 call to C4::Output::CORE:print # spent 711µs making 1 call to CGI::AUTOLOAD
472}
473
474sub output_html_with_http_headers {
475 my ( $query, $cookie, $data, $status ) = @_;
476 output_with_http_headers( $query, $cookie, $data, 'html', $status );
477}
478
479
480sub output_ajax_with_http_headers {
481 my ( $query, $js ) = @_;
482 print $query->header(
483 -type => 'text/javascript',
484 -charset => 'UTF-8',
485 -Pragma => 'no-cache',
486 -'Cache-Control' => 'no-cache',
487 -expires => '-1d',
488 ), $js;
489}
490
491sub is_ajax {
492 my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
493 return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
494}
495
496sub parametrized_url {
497 my $url = shift || ''; # ie page.pl?ln={LANG}
498 my $vars = shift || {}; # ie { LANG => en }
499 my $ret = $url;
500 while ( my ($key,$val) = each %$vars) {
501 my $val_url = URI::Escape::uri_escape_utf8($val);
502 $ret =~ s/\{$key\}/$val_url/g;
503 }
504 $ret =~ s/\{[^\{]*\}//g; # remove not defined vars
505 return $ret;
506}
507
50815µs
# spent 4µs within C4::Output::END which was called: # once (4µs+0s) by main::RUNTIME at line 0 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
END { } # module clean-up code here (global destructor)
509
510110µs1;
511__END__
 
# spent 24.7ms within C4::Output::CORE:print which was called: # once (24.7ms+0s) by C4::Output::output_with_http_headers at line 471
sub C4::Output::CORE:print; # opcode
# spent 49µs within C4::Output::CORE:subst which was called: # once (49µs+0s) by C4::Output::output_with_http_headers at line 470
sub C4::Output::CORE:subst; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.