← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Mon Aug 24 11:28:47 2009
Reported on Mon Aug 24 11:29:16 2009

File /home/chris/git/koha.git/C4/Output.pm
Statements Executed 180
Total Time 0.0106364 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118.09ms9.93msC4::Output::::output_with_http_headersC4::Output::output_with_http_headers
1111.94ms3.70msC4::Output::::themelanguageC4::Output::themelanguage
111171µs212msC4::Output::::gettemplateC4::Output::gettemplate
11139µs9.97msC4::Output::::output_html_with_http_headersC4::Output::output_html_with_http_headers
0000s0sC4::Output::::BEGINC4::Output::BEGIN
0000s0sC4::Output::::ENDC4::Output::END
0000s0sC4::Output::::is_ajaxC4::Output::is_ajax
0000s0sC4::Output::::pagination_barC4::Output::pagination_bar
0000s0sC4::Output::::setlanguagecookieC4::Output::setlanguagecookie
LineStmts.Exclusive
Time		Avg.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 with
21# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
22# Suite 330, Boston, MA 02111-1307 USA
23
24
25# NOTE: I'm pretty sure this module is deprecated in favor of
26# templates.
27
28332µs11µsuse strict;
# spent 13µs making 1 call to strict::import
29328µs9µsuse warnings;
# spent 25µs making 1 call to warnings::import
30
31337µs12µsuse C4::Context;
# spent 7µs making 1 call to C4::Context::import
323216µs72µsuse C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language );
# spent 84µs making 1 call to Exporter::import
33
343155µs52µsuse HTML::Template::Pro;
# spent 12µs making 1 call to UNIVERSAL::import
353106µs35µsuse vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 71µs making 1 call to vars::import
36
37BEGIN {
38 # set the version for version checking
391500ns500ns $VERSION = 3.03;
401600ns600ns require Exporter;
4117µs7µs @ISA = qw(Exporter);
421900ns900ns @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
4315µs5µs %EXPORT_TAGS = ( all =>[qw(&themelanguage &gettemplate setlanguagecookie pagination_bar
44 &output_with_http_headers &output_html_with_http_headers)],
45 ajax =>[qw(&output_with_http_headers is_ajax)],
46 html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
47 );
4811µs1µs push @EXPORT, qw(
49 &themelanguage &gettemplate setlanguagecookie pagination_bar
50 );
5111µs1µs push @EXPORT, qw(
52 &output_html_with_http_headers &output_with_http_headers
53 );
5411.77ms1.77ms}
55
56=head1 NAME
57
58C4::Output - Functions for managing templates
59
60=head1 FUNCTIONS
61
62=over 2
63
64=cut
65
66#FIXME: this is a quick fix to stop rc1 installing broken
67#Still trying to figure out the correct fix.
68118µs18µsmy $path = C4::Context->config('intrahtdocs') . "/prog/en/includes/";
# spent 1.33ms making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
69
70#---------------------------------------------------------------------------------------------------------
71# FIXME - POD
72
# spent 212ms (171µs+212) within C4::Output::gettemplate which was called # once (171µs+212ms) by C4::Auth::get_template_and_user at line 117 of /home/chris/git/koha.git/C4/Auth.pm
sub gettemplate {
7313µs3µs my ( $tmplbase, $interface, $query ) = @_;
741500ns500ns ($query) or warn "no query in gettemplate";
751400ns400ns my $htdocs;
76112µs12µs if ( $interface ne "intranet" ) {
# spent 531µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
77 $htdocs = C4::Context->config('opachtdocs');
78 }
79 else {
80 $htdocs = C4::Context->config('intrahtdocs');
81 }
82110µs10µs my $path = C4::Context->preference('intranet_includes') || 'includes';
# spent 523µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
83111µs11µs my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $interface, $query );
# spent 3.70ms making 1 call to C4::Output::themelanguage
84
85 # if the template doesn't exist, load the English one as a last resort
8614µs4µs my $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
8715µs5µs unless (-f $filename) {
88 $lang = 'en';
89 $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
90 }
91118µs18µs my $template = HTML::Template::Pro->new(
# spent 64µs making 1 call to HTML::Template::Pro::new
92 filename => $filename,
93 die_on_bad_params => 1,
94 global_vars => 1,
95 case_sensitive => 1,
96 loop_context_vars => 1, # enable: __first__, __last__, __inner__, __odd__, __counter__
97 path => ["$htdocs/$theme/$lang/$path"]
98 );
9913µs3µs my $themelang=( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
100 . "/$theme/$lang";
101128µs28µs $template->param(
# spent 1.12ms making 2 calls to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1], avg 559µs/call # spent 30µs making 1 call to HTML::Template::Pro::param
102 themelang => $themelang,
103 yuipath => (C4::Context->preference("yuipath") eq "local"?"$themelang/lib/yui":C4::Context->preference("yuipath")),
104 interface => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
105 theme => $theme,
106 lang => $lang
107 );
108
109 # Bidirectionality
110112µs12µs my $current_lang = regex_lang_subtags($lang);
# spent 388µs making 1 call to C4::Languages::regex_lang_subtags
1111400ns400ns my $bidi;
11211µs1µs $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
113 # Languages
114119µs19µs my $languages_loop = getTranslatedLanguages($interface,$theme,$lang);
# spent 206ms making 1 call to C4::Languages::getTranslatedLanguages
1151900ns900ns my $num_languages_enabled = 0;
11612µs2µs foreach my $lang (@$languages_loop) {
1174652µs1µs foreach my $sublang (@{ $lang->{'sublanguages_loop'} }) {
1185140µs782ns $num_languages_enabled++ if $sublang->{enabled};
119 }
120 }
121 $template->param(
122112µs12µs languages_loop => $languages_loop,
# spent 21µs making 1 call to HTML::Template::Pro::param
123 bidi => $bidi,
124 one_language_enabled => ($num_languages_enabled <= 1) ? 1 : 0, # deal with zero enabled langs as well
125 ) unless @$languages_loop<2;
126
12714µs4µs return $template;
128}
129
130#---------------------------------------------------------------------------------------------------------
131# FIXME - POD
132
# spent 3.70ms (1.94+1.75) within C4::Output::themelanguage which was called # once (1.94ms+1.75ms) by C4::Output::gettemplate at line 83
sub themelanguage {
13313µs3µs my ( $htdocs, $tmpl, $interface, $query ) = @_;
1341500ns500ns ($query) or warn "no query in themelanguage";
135
136 # Set some defaults for language and theme
137 # First, check the user's preferences
1381200ns200ns my $lang;
13912µs2µs my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE };
1401500ns500ns $lang = accept_language( $http_accept_language,
141 getTranslatedLanguages($interface,'prog') )
142 if $http_accept_language;
143 # But, if there's a cookie set, obey it
144112µs12µs $lang = $query->cookie('KohaOpacLanguage') if $query->cookie('KohaOpacLanguage');
# spent 264µs making 1 call to CGI::AUTOLOAD
145 # Fall back to English
1461300ns300ns my @languages;
14716µs6µs if ($interface eq 'intranet') {
148 @languages = split ",", C4::Context->preference("language");
149 } else {
150133µs33µs @languages = split ",", C4::Context->preference("opaclanguages");
# spent 643µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
151 }
15211µs1µs if ($lang){
153 @languages=($lang,@languages);
154 } else {
1551600ns600ns $lang = $languages[0];
156 }
1571500ns500ns my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
158110µs10µs my $dbh = C4::Context->dbh;
# spent 111µs making 1 call to C4::Context::dbh
1591300ns300ns my @themes;
16012µs2µs if ( $interface eq "intranet" ) {
161 @themes = split " ", C4::Context->preference("template");
162 }
163 else {
164 # we are in the opac here, what im trying to do is let the individual user
165 # set the theme they want to use.
166 # and perhaps the them as well.
167 #my $lang = $query->cookie('KohaOpacLanguage');
168111µs11µs @themes = split " ", C4::Context->preference("opacthemes");
# spent 541µs making 1 call to Memoize::__ANON__[(eval 0)[/usr/share/perl/5.10/Memoize.pm:73]:1]
169 }
170
171 # searches through the themes and languages. First template it find it returns.
172 # Priority is for getting the theme right.
173 THEME:
17411µs1µs foreach my $th (@themes) {
1751600ns600ns foreach my $la (@languages) {
176 #for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
177 # warn "$htdocs/$th/$la/modules/$interface-"."tmpl";
178 #$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
179121µs21µs if ( -e "$htdocs/$th/$la/modules/$tmpl") {
180 #".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
1811500ns500ns $theme = $th;
1821400ns400ns $lang = $la;
18312µs2µs last THEME;
184 }
185 last unless $la =~ /[-_]/;
186 #}
187 }
188 }
18915µs5µs return ( $theme, $lang );
190}
191
192sub setlanguagecookie {
193 my ( $query, $language, $uri ) = @_;
194 my $cookie = $query->cookie(
195 -name => 'KohaOpacLanguage',
196 -value => $language,
197 -expires => ''
198 );
199 print $query->redirect(
200 -uri => $uri,
201 -cookie => $cookie
202 );
203}
204
205=item pagination_bar
206
207 pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
208
209Build an HTML pagination bar based on the number of page to display, the
210current page and the url to give to each page link.
211
212C<$base_url> is the URL for each page link. The
213C<$startfrom_name>=page_number is added at the end of the each URL.
214
215C<$nb_pages> is the total number of pages available.
216
217C<$current_page> is the current page number. This page number won't become a
218link.
219
220This function returns HTML, without any language dependency.
221
222=cut
223
224sub pagination_bar {
225 my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return undef;
226 my $nb_pages = (@_) ? shift : 1;
227 my $current_page = (@_) ? shift : undef; # delay default until later
228 my $startfrom_name = (@_) ? shift : 'page';
229
230 # how many pages to show before and after the current page?
231 my $pages_around = 2;
232
233 my $delim = qr/\&(?:amp;)?|;/; # "non memory" cluster: no backreference
234 $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
235 unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
236 $current_page = ($1) ? $1 : 1; # pull current page from param in URL, else default to 1
237 # $debug and # FIXME: use C4::Debug;
238 # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1 2:$2 3:$3";
239 }
240 $base_url =~ s/($delim)+/$1/g; # compress duplicate delims
241 $base_url =~ s/$delim;//g; # remove empties
242 $base_url =~ s/$delim$//; # remove trailing delim
243
244 my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
245 my $pagination_bar = '';
246
247 # navigation bar useful only if more than one page to display !
248 if ( $nb_pages > 1 ) {
249
250 # link to first page?
251 if ( $current_page > 1 ) {
252 $pagination_bar .=
253 "\n" . '&nbsp;'
254 . '<a href="'
255 . $url
256 . '1" rel="start">'
257 . '&lt;&lt;' . '</a>';
258 }
259 else {
260 $pagination_bar .=
261 "\n" . '&nbsp;<span class="inactive">&lt;&lt;</span>';
262 }
263
264 # link on previous page ?
265 if ( $current_page > 1 ) {
266 my $previous = $current_page - 1;
267
268 $pagination_bar .=
269 "\n" . '&nbsp;'
270 . '<a href="'
271 . $url
272 . $previous
273 . '" rel="prev">' . '&lt;' . '</a>';
274 }
275 else {
276 $pagination_bar .=
277 "\n" . '&nbsp;<span class="inactive">&lt;</span>';
278 }
279
280 my $min_to_display = $current_page - $pages_around;
281 my $max_to_display = $current_page + $pages_around;
282 my $last_displayed_page = undef;
283
284 for my $page_number ( 1 .. $nb_pages ) {
285 if (
286 $page_number == 1
287 or $page_number == $nb_pages
288 or ( $page_number >= $min_to_display
289 and $page_number <= $max_to_display )
290 )
291 {
292 if ( defined $last_displayed_page
293 and $last_displayed_page != $page_number - 1 )
294 {
295 $pagination_bar .=
296 "\n" . '&nbsp;<span class="inactive">...</span>';
297 }
298
299 if ( $page_number == $current_page ) {
300 $pagination_bar .=
301 "\n" . '&nbsp;'
302 . '<span class="currentPage">'
303 . $page_number
304 . '</span>';
305 }
306 else {
307 $pagination_bar .=
308 "\n" . '&nbsp;'
309 . '<a href="'
310 . $url
311 . $page_number . '">'
312 . $page_number . '</a>';
313 }
314 $last_displayed_page = $page_number;
315 }
316 }
317
318 # link on next page?
319 if ( $current_page < $nb_pages ) {
320 my $next = $current_page + 1;
321
322 $pagination_bar .= "\n"
323 . '&nbsp;<a href="'
324 . $url
325 . $next
326 . '" rel="next">' . '&gt;' . '</a>';
327 }
328 else {
329 $pagination_bar .=
330 "\n" . '&nbsp;<span class="inactive">&gt;</span>';
331 }
332
333 # link to last page?
334 if ( $current_page != $nb_pages ) {
335 $pagination_bar .= "\n"
336 . '&nbsp;<a href="'
337 . $url
338 . $nb_pages
339 . '" rel="last">'
340 . '&gt;&gt;' . '</a>';
341 }
342 else {
343 $pagination_bar .=
344 "\n" . '&nbsp;<span class="inactive">&gt;&gt;</span>';
345 }
346 }
347
348 return $pagination_bar;
349}
350
351=item output_with_http_headers
352
353 &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
354
355Outputs $data with the appropriate HTTP headers,
356the authentication cookie $cookie and a Content-Type specified in
357$content_type.
358
359If applicable, $cookie can be undef, and it will not be sent.
360
361$content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
362
363$status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
364
365=cut
366
367
# spent 9.93ms (8.09+1.84) within C4::Output::output_with_http_headers which was called # once (8.09ms+1.84ms) by C4::Output::output_html_with_http_headers at line 400
sub output_with_http_headers($$$$;$) {
368120µs20µs my ( $query, $cookie, $data, $content_type, $status ) = @_;
3691900ns900ns $status ||= '200 OK';
370
37116µs6µs my %content_type_map = (
372 'html' => 'text/html',
373 'js' => 'text/javascript',
374 'json' => 'application/json',
375 'xml' => 'text/xml',
376 # NOTE: not using application/atom+xml or application/rss+xml because of
377 # Internet Explorer 6; see bug 2078.
378 'rss' => 'text/xml',
379 'atom' => 'text/xml'
380 );
381
3821800ns800ns die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
38315µs5µs my $options = {
384 type => $content_type_map{$content_type},
385 status => $status,
386 charset => 'UTF-8',
387 Pragma => 'no-cache',
388 'Cache-Control' => 'no-cache',
389 };
39016µs6µs $options->{cookie} = $cookie if $cookie;
39111µs1µs if ($content_type eq 'html') { # guaranteed to be one of the content_type_map keys, else we'd have died
39211µs1µs $options->{'Content-Style-Type' } = 'text/css';
39311µs1µs $options->{'Content-Script-Type'} = 'text/javascript';
394 }
39517.82ms7.82ms print $query->header($options), $data;
# spent 760µs making 1 call to CGI::AUTOLOAD
396}
397
398
# spent 9.97ms (39µs+9.93) within C4::Output::output_html_with_http_headers which was called # once (39µs+9.93ms) at line 91 of /home/chris/git/koha.git/opac/opac-main.pl
sub output_html_with_http_headers ($$$) {
399128µs28µs my ( $query, $cookie, $data ) = @_;
400110µs10µs output_with_http_headers( $query, $cookie, $data, 'html' );
# spent 9.93ms making 1 call to C4::Output::output_with_http_headers
401}
402
403sub is_ajax () {
404 my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
405 return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
406}
407
4081300ns300nsEND { } # module clean-up code here (global destructor)
409
41017µs7µs1;
411__END__
412
413=back
414
415=head1 AUTHOR
416
417Koha Developement team <info@koha.org>
418
419=cut
Report produced by the NYTProf 2.10 Perl profiler, developed by Tim Bunce and Adam Kaplan.