← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:51 2015

Filename/mnt/catalyst/koha/C4/Output.pm
StatementsExecuted 36 statements in 5.47ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.68ms5.64msC4::Output::::BEGIN@35C4::Output::BEGIN@35
1111.72ms1.72msC4::Output::::CORE:printC4::Output::CORE:print (opcode)
111411µs428µsC4::Output::::BEGIN@28C4::Output::BEGIN@28
11145µs3.17msC4::Output::::output_with_http_headersC4::Output::output_with_http_headers
11121µs43µsC4::Output::::BEGIN@34C4::Output::BEGIN@34
11116µs16µsC4::Output::::BEGIN@40C4::Output::BEGIN@40
11111µs16µsC4::Output::::BEGIN@36C4::Output::BEGIN@36
11110µs47µsC4::Output::::BEGIN@31C4::Output::BEGIN@31
1118µs11µsC4::Output::::BEGIN@33C4::Output::BEGIN@33
1117µs56µsC4::Output::::BEGIN@38C4::Output::BEGIN@38
1114µs4µsC4::Output::::CORE:substC4::Output::CORE:subst (opcode)
1112µs2µsC4::Output::::ENDC4::Output::END
0000s0sC4::Output::::FormatDataC4::Output::FormatData
0000s0sC4::Output::::FormatNumberC4::Output::FormatNumber
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
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
28231µs2445µs
# spent 428µs (411+17) within C4::Output::BEGIN@28 which was called: # once (411µs+17µs) by C4::Service::BEGIN@50 at line 28
use strict;
# spent 428µs making 1 call to C4::Output::BEGIN@28 # spent 17µs making 1 call to strict::import
29#use warnings; FIXME - Bug 2505
30
31231µs285µs
# spent 47µs (10+37) within C4::Output::BEGIN@31 which was called: # once (10µs+37µs) by C4::Service::BEGIN@50 at line 31
use URI::Escape;
# spent 47µs making 1 call to C4::Output::BEGIN@31 # spent 37µs making 1 call to Exporter::import
32
33222µs213µs
# spent 11µs (8+2) within C4::Output::BEGIN@33 which was called: # once (8µs+2µs) by C4::Service::BEGIN@50 at line 33
use C4::Context;
# spent 11µs making 1 call to C4::Output::BEGIN@33 # spent 2µs making 1 call to C4::Context::import
34255µs265µs
# spent 43µs (21+22) within C4::Output::BEGIN@34 which was called: # once (21µs+22µs) by C4::Service::BEGIN@50 at line 34
use C4::Dates qw(format_date);
# spent 43µs making 1 call to C4::Output::BEGIN@34 # spent 22µs making 1 call to Exporter::import
3522.19ms25.74ms
# spent 5.64ms (4.68+960µs) within C4::Output::BEGIN@35 which was called: # once (4.68ms+960µs) by C4::Service::BEGIN@50 at line 35
use C4::Budgets qw(GetCurrency);
# spent 5.64ms making 1 call to C4::Output::BEGIN@35 # spent 101µs making 1 call to Exporter::import
36228µs222µs
# spent 16µs (11+5) within C4::Output::BEGIN@36 which was called: # once (11µs+5µs) by C4::Service::BEGIN@50 at line 36
use C4::Templates;
# spent 16µs making 1 call to C4::Output::BEGIN@36 # spent 5µs making 1 call to Class::Accessor::import
37
38275µs2106µs
# spent 56µs (7+50) within C4::Output::BEGIN@38 which was called: # once (7µs+50µs) by C4::Service::BEGIN@50 at line 38
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 56µs making 1 call to C4::Output::BEGIN@38 # spent 50µs making 1 call to vars::import
39
40
# spent 16µs within C4::Output::BEGIN@40 which was called: # once (16µs+0s) by C4::Service::BEGIN@50 at line 59
BEGIN {
41 # set the version for version checking
421800ns $VERSION = 3.07.00.049;
431500ns require Exporter;
44
4516µs @ISA = qw(Exporter);
461400ns @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
4714µs %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 );
521700ns push @EXPORT, qw(
53 setlanguagecookie getlanguagecookie pagination_bar parametrized_url
54 );
5514µs push @EXPORT, qw(
56 &output_html_with_http_headers &output_ajax_with_http_headers &output_with_http_headers FormatData FormatNumber
57 );
58
5911.26ms116µs}
# spent 16µs making 1 call to C4::Output::BEGIN@40
60
61=head1 NAME
62
63C4::Output - Functions for managing output, is slowly being deprecated
64
65=head1 FUNCTIONS
66
67=over 2
68=cut
69
70=item FormatNumber
71=cut
72sub FormatNumber{
73my $cur = GetCurrency;
74my $cur_format = C4::Context->preference("CurrencyFormat");
75my $num;
76
77if ( $cur_format eq 'FR' ) {
78 $num = new Number::Format(
79 'decimal_fill' => '2',
80 'decimal_point' => ',',
81 'int_curr_symbol' => $cur->{symbol},
82 'mon_thousands_sep' => ' ',
83 'thousands_sep' => ' ',
84 'mon_decimal_point' => ','
85 );
86} else { # US by default..
87 $num = new Number::Format(
88 'int_curr_symbol' => '',
89 'mon_thousands_sep' => ',',
90 'mon_decimal_point' => '.'
91 );
92}
93return $num;
94}
95
96=item FormatData
97
98FormatData($data_hashref)
99C<$data_hashref> is a ref to data to format
100
101Format dates of data those dates are assumed to contain date in their noun
102Could be used in order to centralize all the formatting for HTML output
103=cut
104
105sub FormatData{
106 my $data_hashref=shift;
107 $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
108}
109
110=item pagination_bar
111
112 pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
113
114Build an HTML pagination bar based on the number of page to display, the
115current page and the url to give to each page link.
116
117C<$base_url> is the URL for each page link. The
118C<$startfrom_name>=page_number is added at the end of the each URL.
119
120C<$nb_pages> is the total number of pages available.
121
122C<$current_page> is the current page number. This page number won't become a
123link.
124
125This function returns HTML, without any language dependency.
126
127=cut
128
129sub pagination_bar {
130 my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return;
131 my $nb_pages = (@_) ? shift : 1;
132 my $current_page = (@_) ? shift : undef; # delay default until later
133 my $startfrom_name = (@_) ? shift : 'page';
134
135 # how many pages to show before and after the current page?
136 my $pages_around = 2;
137
138 my $delim = qr/\&(?:amp;)?|;/; # "non memory" cluster: no backreference
139 $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
140 unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
141 $current_page = ($1) ? $1 : 1; # pull current page from param in URL, else default to 1
142 # $debug and # FIXME: use C4::Debug;
143 # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1 2:$2 3:$3";
144 }
145 $base_url =~ s/($delim)+/$1/g; # compress duplicate delims
146 $base_url =~ s/$delim;//g; # remove empties
147 $base_url =~ s/$delim$//; # remove trailing delim
148
149 my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
150 my $pagination_bar = '';
151
152 # navigation bar useful only if more than one page to display !
153 if ( $nb_pages > 1 ) {
154
155 # link to first page?
156 if ( $current_page > 1 ) {
157 $pagination_bar .=
158 "\n" . '&nbsp;'
159 . '<a href="'
160 . $url
161 . '1" rel="start">'
162 . '&lt;&lt;' . '</a>';
163 }
164 else {
165 $pagination_bar .=
166 "\n" . '&nbsp;<span class="inactive">&lt;&lt;</span>';
167 }
168
169 # link on previous page ?
170 if ( $current_page > 1 ) {
171 my $previous = $current_page - 1;
172
173 $pagination_bar .=
174 "\n" . '&nbsp;'
175 . '<a href="'
176 . $url
177 . $previous
178 . '" rel="prev">' . '&lt;' . '</a>';
179 }
180 else {
181 $pagination_bar .=
182 "\n" . '&nbsp;<span class="inactive">&lt;</span>';
183 }
184
185 my $min_to_display = $current_page - $pages_around;
186 my $max_to_display = $current_page + $pages_around;
187 my $last_displayed_page = undef;
188
189 for my $page_number ( 1 .. $nb_pages ) {
190 if (
191 $page_number == 1
192 or $page_number == $nb_pages
193 or ( $page_number >= $min_to_display
194 and $page_number <= $max_to_display )
195 )
196 {
197 if ( defined $last_displayed_page
198 and $last_displayed_page != $page_number - 1 )
199 {
200 $pagination_bar .=
201 "\n" . '&nbsp;<span class="inactive">...</span>';
202 }
203
204 if ( $page_number == $current_page ) {
205 $pagination_bar .=
206 "\n" . '&nbsp;'
207 . '<span class="currentPage">'
208 . $page_number
209 . '</span>';
210 }
211 else {
212 $pagination_bar .=
213 "\n" . '&nbsp;'
214 . '<a href="'
215 . $url
216 . $page_number . '">'
217 . $page_number . '</a>';
218 }
219 $last_displayed_page = $page_number;
220 }
221 }
222
223 # link on next page?
224 if ( $current_page < $nb_pages ) {
225 my $next = $current_page + 1;
226
227 $pagination_bar .= "\n"
228 . '&nbsp;<a href="'
229 . $url
230 . $next
231 . '" rel="next">' . '&gt;' . '</a>';
232 }
233 else {
234 $pagination_bar .=
235 "\n" . '&nbsp;<span class="inactive">&gt;</span>';
236 }
237
238 # link to last page?
239 if ( $current_page != $nb_pages ) {
240 $pagination_bar .= "\n"
241 . '&nbsp;<a href="'
242 . $url
243 . $nb_pages
244 . '" rel="last">'
245 . '&gt;&gt;' . '</a>';
246 }
247 else {
248 $pagination_bar .=
249 "\n" . '&nbsp;<span class="inactive">&gt;&gt;</span>';
250 }
251 }
252
253 return $pagination_bar;
254}
255
256=item output_with_http_headers
257
258 &output_with_http_headers($query, $cookie, $data, $content_type[, $status[, $extra_options]])
259
260Outputs $data with the appropriate HTTP headers,
261the authentication cookie $cookie and a Content-Type specified in
262$content_type.
263
264If applicable, $cookie can be undef, and it will not be sent.
265
266$content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
267
268$status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
269
270$extra_options is hashref. If the key 'force_no_caching' is present and has
271a true value, the HTTP headers include directives to force there to be no
272caching whatsoever.
273
274=cut
275
276
# spent 3.17ms (45µs+3.12) within C4::Output::output_with_http_headers which was called: # once (45µs+3.12ms) by C4::Service::return_error at line 130 of C4/Service.pm
sub output_with_http_headers {
2771900ns my ( $query, $cookie, $data, $content_type, $status, $extra_options ) = @_;
2781300ns $status ||= '200 OK';
279
2801400ns $extra_options //= {};
281
28214µs my %content_type_map = (
283 'html' => 'text/html',
284 'js' => 'text/javascript',
285 'json' => 'application/json',
286 'xml' => 'text/xml',
287 # NOTE: not using application/atom+xml or application/rss+xml because of
288 # Internet Explorer 6; see bug 2078.
289 'rss' => 'text/xml',
290 'atom' => 'text/xml'
291 );
292
2931600ns die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
2941300ns my $cache_policy = 'no-cache';
2951400ns $cache_policy .= ', no-store, max-age=0' if $extra_options->{force_no_caching};
29613µs my $options = {
297 type => $content_type_map{$content_type},
298 status => $status,
299 charset => 'UTF-8',
300 Pragma => 'no-cache',
301 'Cache-Control' => $cache_policy,
302 };
3031400ns $options->{expires} = 'now' if $extra_options->{force_no_caching};
304
30515µs181µs $options->{cookie} = $cookie if $cookie;
# spent 81µs making 1 call to CGI::Cookie::as_string
3061400ns if ($content_type eq 'html') { # guaranteed to be one of the content_type_map keys, else we'd have died
307 $options->{'Content-Style-Type' } = 'text/css';
308 $options->{'Content-Script-Type'} = 'text/javascript';
309 }
310
311# We can't encode here, that will double encode our templates, and xslt
312# We need to fix the encoding as it comes out of the database, or when we pass the variables to templates
313
314# utf8::encode($data) if utf8::is_utf8($data);
315
31617µs14µs $data =~ s/\&amp\;amp\; /\&amp\; /g;
# spent 4µs making 1 call to C4::Output::CORE:subst
31711.74ms22.34ms print $query->header($options), $data;
# spent 1.72ms making 1 call to C4::Output::CORE:print # spent 618µs making 1 call to CGI::AUTOLOAD
318}
319
320sub output_html_with_http_headers {
321 my ( $query, $cookie, $data, $status, $extra_options ) = @_;
322 output_with_http_headers( $query, $cookie, $data, 'html', $status, $extra_options );
323}
324
325
326sub output_ajax_with_http_headers {
327 my ( $query, $js ) = @_;
328 print $query->header(
329 -type => 'text/javascript',
330 -charset => 'UTF-8',
331 -Pragma => 'no-cache',
332 -'Cache-Control' => 'no-cache',
333 -expires => '-1d',
334 ), $js;
335}
336
337sub is_ajax {
338 my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
339 return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
340}
341
342sub parametrized_url {
343 my $url = shift || ''; # ie page.pl?ln={LANG}
344 my $vars = shift || {}; # ie { LANG => en }
345 my $ret = $url;
346 while ( my ($key,$val) = each %$vars) {
347 my $val_url = URI::Escape::uri_escape_utf8($val);
348 $ret =~ s/\{$key\}/$val_url/g;
349 }
350 $ret =~ s/\{[^\{]*\}//g; # remove not defined vars
351 return $ret;
352}
353
35413µs
# spent 2µs within C4::Output::END which was called: # once (2µs+0s) by main::RUNTIME at line 131 of C4/Service.pm
END { } # module clean-up code here (global destructor)
355
35613µs1;
357__END__
 
# spent 1.72ms within C4::Output::CORE:print which was called: # once (1.72ms+0s) by C4::Output::output_with_http_headers at line 317
sub C4::Output::CORE:print; # opcode
# spent 4µs within C4::Output::CORE:subst which was called: # once (4µs+0s) by C4::Output::output_with_http_headers at line 316
sub C4::Output::CORE:subst; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.