Profile of C4/Output.pm

Filename	/home/vagrant/kohaclone/C4/Output.pm
Statements	Executed 18 statements in 2.05ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	2.37ms	23.2ms	C4::Output::::BEGIN@34C4::Output::BEGIN@34
1	1	1	30µs	43µs	C4::Output::::BEGIN@28C4::Output::BEGIN@28
1	1	1	23µs	23µs	C4::Output::::BEGIN@38C4::Output::BEGIN@38
1	1	1	22µs	78µs	C4::Output::::BEGIN@31C4::Output::BEGIN@31
1	1	1	13µs	21µs	C4::Output::::BEGIN@33C4::Output::BEGIN@33
1	1	1	13µs	61µs	C4::Output::::BEGIN@36C4::Output::BEGIN@36
0	0	0	0s	0s	C4::Output::::ENDC4::Output::END
0	0	0	0s	0s	C4::Output::::is_ajaxC4::Output::is_ajax
0	0	0	0s	0s	C4::Output::output_ajax_with_http_headers
0	0	0	0s	0s	C4::Output::output_html_with_http_headers
0	0	0	0s	0s	C4::Output::::output_with_http_headersC4::Output::output_with_http_headers
0	0	0	0s	0s	C4::Output::::pagination_barC4::Output::pagination_bar
0	0	0	0s	0s	C4::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
1					package 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
12					# under the terms of the GNU General Public License as published by
13					# the Free Software Foundation; either version 3 of the License, or
14					# (at your option) any later version.
15					#
16					# Koha is distributed in the hope that it will be useful, but
17					# WITHOUT ANY WARRANTY; without even the implied warranty of
18					# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19					# GNU General Public License for more details.
20					#
21					# You should have received a copy of the GNU General Public License
22					# along with Koha; if not, see <http://www.gnu.org/licenses>.
23
24
25					# NOTE: I'm pretty sure this module is deprecated in favor of
26					# templates.
27
28	2	57µs	2	56µs	# spent 43µs (30+13) within C4::Output::BEGIN@28 which was called: # once (30µs+13µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_plack_2epl::BEGIN@5 at line 28 use strict; # spent 43µs making 1 call to C4::Output::BEGIN@28 # spent 13µs making 1 call to strict::import
29					#use warnings; FIXME - Bug 2505
30
31	2	99µs	2	133µs	# spent 78µs (22+56) within C4::Output::BEGIN@31 which was called: # once (22µs+56µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_plack_2epl::BEGIN@5 at line 31 use URI::Escape; # spent 78µs making 1 call to C4::Output::BEGIN@31 # spent 56µs making 1 call to Exporter::import
32
33	2	40µs	2	28µs	# spent 21µs (13+7) within C4::Output::BEGIN@33 which was called: # once (13µs+7µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_plack_2epl::BEGIN@5 at line 33 use C4::Context; # spent 21µs making 1 call to C4::Output::BEGIN@33 # spent 7µs making 1 call to C4::Context::import
34	2	606µs	2	23.2ms	# spent 23.2ms (2.37+20.8) within C4::Output::BEGIN@34 which was called: # once (2.37ms+20.8ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_plack_2epl::BEGIN@5 at line 34 use C4::Templates; # spent 23.2ms making 1 call to C4::Output::BEGIN@34 # spent 8µs making 1 call to Class::Accessor::import
35
36	2	152µs	2	108µs	# spent 61µs (13+47) within C4::Output::BEGIN@36 which was called: # once (13µs+47µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_plack_2epl::BEGIN@5 at line 36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # spent 61µs making 1 call to C4::Output::BEGIN@36 # spent 47µs making 1 call to vars::import
37
38					# spent 23µs within C4::Output::BEGIN@38 which was called: # once (23µs+0s) by CGI::Compile::ROOT::home_vagrant_kohaclone_plack_2epl::BEGIN@5 at line 57 BEGIN {
39					# set the version for version checking
40	1	2µs			$VERSION = 3.07.00.049;
41	1	900ns			require Exporter;
42
43	1	10µs			@ISA = qw(Exporter);
44	1	500ns			@EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
45	1	4µs			%EXPORT_TAGS = ( all =>[qw(setlanguagecookie pagination_bar parametrized_url
46					&output_with_http_headers &output_ajax_with_http_headers &output_html_with_http_headers)],
47					ajax =>[qw(&output_with_http_headers &output_ajax_with_http_headers is_ajax)],
48					html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
49					);
50	1	1µs			push @EXPORT, qw(
51					setlanguagecookie getlanguagecookie pagination_bar parametrized_url
52					);
53	1	5µs			push @EXPORT, qw(
54					&output_html_with_http_headers &output_ajax_with_http_headers &output_with_http_headers
55					);
56
57	1	1.07ms	1	23µs	} # spent 23µs making 1 call to C4::Output::BEGIN@38
58
59					=head1 NAME
60
61					C4::Output - Functions for managing output, is slowly being deprecated
62
63					=head1 FUNCTIONS
64
65					=over 2
66					=cut
67
68					=item pagination_bar
69
70					pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
71
72					Build an HTML pagination bar based on the number of page to display, the
73					current page and the url to give to each page link.
74
75					C<$base_url> is the URL for each page link. The
76					C<$startfrom_name>=page_number is added at the end of the each URL.
77
78					C<$nb_pages> is the total number of pages available.
79
80					C<$current_page> is the current page number. This page number won't become a
81					link.
82
83					This function returns HTML, without any language dependency.
84
85					=cut
86
87					sub pagination_bar {
88					my $base_url = (@_ ? shift : return);
89					my $nb_pages = (@_) ? shift : 1;
90					my $current_page = (@_) ? shift : undef; # delay default until later
91					my $startfrom_name = (@_) ? shift : 'page';
92					my $additional_parameters = shift \|\| {};
93
94					# how many pages to show before and after the current page?
95					my $pages_around = 2;
96
97					my $delim = qr/\&(?:amp;)?\|;/; # "non memory" cluster: no backreference
98					$base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
99					unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
100					$current_page = ($1) ? $1 : 1; # pull current page from param in URL, else default to 1
101					# $debug and # FIXME: use C4::Debug;
102					# warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1 2:$2 3:$3";
103					}
104					$base_url =~ s/($delim)+/$1/g; # compress duplicate delims
105					$base_url =~ s/$delim;//g; # remove empties
106					$base_url =~ s/$delim$//; # remove trailing delim
107
108					my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&' : '?' ) . $startfrom_name . '=';
109					my $url_suffix;
110					while ( my ( $k, $v ) = each %$additional_parameters ) {
111					$url_suffix .= '&' . $k . '=' . $v;
112					}
113					my $pagination_bar = '';
114
115					# navigation bar useful only if more than one page to display !
116					if ( $nb_pages > 1 ) {
117
118					# link to first page?
119					if ( $current_page > 1 ) {
120					$pagination_bar .=
121					"\n" . ' '
122					. '<a href="'
123					. $url
124					. '1'
125					. $url_suffix
126					. '"rel="start">'
127					. '<<' . '</a>';
128					}
129					else {
130					$pagination_bar .=
131					"\n" . ' <span class="inactive"><<</span>';
132					}
133
134					# link on previous page ?
135					if ( $current_page > 1 ) {
136					my $previous = $current_page - 1;
137
138					$pagination_bar .=
139					"\n" . ' '
140					. '<a href="'
141					. $url
142					. $previous
143					. $url_suffix
144					. '" rel="prev">' . '<' . '</a>';
145					}
146					else {
147					$pagination_bar .=
148					"\n" . ' <span class="inactive"><</span>';
149					}
150
151					my $min_to_display = $current_page - $pages_around;
152					my $max_to_display = $current_page + $pages_around;
153					my $last_displayed_page = undef;
154
155					for my $page_number ( 1 .. $nb_pages ) {
156					if (
157					$page_number == 1
158					or $page_number == $nb_pages
159					or ( $page_number >= $min_to_display
160					and $page_number <= $max_to_display )
161					)
162					{
163					if ( defined $last_displayed_page
164					and $last_displayed_page != $page_number - 1 )
165					{
166					$pagination_bar .=
167					"\n" . ' <span class="inactive">...</span>';
168					}
169
170					if ( $page_number == $current_page ) {
171					$pagination_bar .=
172					"\n" . ' '
173					. '<span class="currentPage">'
174					. $page_number
175					. '</span>';
176					}
177					else {
178					$pagination_bar .=
179					"\n" . ' '
180					. '<a href="'
181					. $url
182					. $page_number
183					. $url_suffix
184					. '">'
185					. $page_number . '</a>';
186					}
187					$last_displayed_page = $page_number;
188					}
189					}
190
191					# link on next page?
192					if ( $current_page < $nb_pages ) {
193					my $next = $current_page + 1;
194
195					$pagination_bar .= "\n"
196					. ' <a href="'
197					. $url
198					. $next
199					. $url_suffix
200					. '" rel="next">' . '>' . '</a>';
201					}
202					else {
203					$pagination_bar .=
204					"\n" . ' <span class="inactive">></span>';
205					}
206
207					# link to last page?
208					if ( $current_page != $nb_pages ) {
209					$pagination_bar .= "\n"
210					. ' <a href="'
211					. $url
212					. $nb_pages
213					. $url_suffix
214					. '" rel="last">'
215					. '>>' . '</a>';
216					}
217					else {
218					$pagination_bar .=
219					"\n" . ' <span class="inactive">>></span>';
220					}
221					}
222
223					return $pagination_bar;
224					}
225
226					=item output_with_http_headers
227
228					&output_with_http_headers($query, $cookie, $data, $content_type[, $status[, $extra_options]])
229
230					Outputs $data with the appropriate HTTP headers,
231					the authentication cookie $cookie and a Content-Type specified in
232					$content_type.
233
234					If applicable, $cookie can be undef, and it will not be sent.
235
236					$content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
237
238					$status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
239
240					$extra_options is hashref. If the key 'force_no_caching' is present and has
241					a true value, the HTTP headers include directives to force there to be no
242					caching whatsoever.
243
244					=cut
245
246					sub output_with_http_headers {
247					my ( $query, $cookie, $data, $content_type, $status, $extra_options ) = @_;
248					$status \|\|= '200 OK';
249
250					$extra_options //= {};
251
252					my %content_type_map = (
253					'html' => 'text/html',
254					'js' => 'text/javascript',
255					'json' => 'application/json',
256					'xml' => 'text/xml',
257					# NOTE: not using application/atom+xml or application/rss+xml because of
258					# Internet Explorer 6; see bug 2078.
259					'rss' => 'text/xml',
260					'atom' => 'text/xml'
261					);
262
263					die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
264					my $cache_policy = 'no-cache';
265					$cache_policy .= ', no-store, max-age=0' if $extra_options->{force_no_caching};
266					my $options = {
267					type => $content_type_map{$content_type},
268					status => $status,
269					charset => 'UTF-8',
270					Pragma => 'no-cache',
271					'Cache-Control' => $cache_policy,
272					};
273					$options->{expires} = 'now' if $extra_options->{force_no_caching};
274
275					$options->{cookie} = $cookie if $cookie;
276					if ($content_type eq 'html') { # guaranteed to be one of the content_type_map keys, else we'd have died
277					$options->{'Content-Style-Type' } = 'text/css';
278					$options->{'Content-Script-Type'} = 'text/javascript';
279					}
280
281					# We can't encode here, that will double encode our templates, and xslt
282					# We need to fix the encoding as it comes out of the database, or when we pass the variables to templates
283
284					$data =~ s/\&amp\;amp\; /\&amp\; /g;
285					print $query->header($options), $data;
286					}
287
288					sub output_html_with_http_headers {
289					my ( $query, $cookie, $data, $status, $extra_options ) = @_;
290					output_with_http_headers( $query, $cookie, $data, 'html', $status, $extra_options );
291					}
292
293
294					sub output_ajax_with_http_headers {
295					my ( $query, $js ) = @_;
296					print $query->header(
297					-type => 'text/javascript',
298					-charset => 'UTF-8',
299					-Pragma => 'no-cache',
300					-'Cache-Control' => 'no-cache',
301					-expires => '-1d',
302					), $js;
303					}
304
305					sub is_ajax {
306					my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
307					return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
308					}
309
310					sub parametrized_url {
311					my $url = shift \|\| ''; # ie page.pl?ln={LANG}
312					my $vars = shift \|\| {}; # ie { LANG => en }
313					my $ret = $url;
314					while ( my ($key,$val) = each %$vars) {
315					my $val_url = URI::Escape::uri_escape_utf8($val);
316					$ret =~ s/\{$key\}/$val_url/g;
317					}
318					$ret =~ s/\{[^\{]*\}//g; # remove not defined vars
319					return $ret;
320					}
321
322					END { } # module clean-up code here (global destructor)
323
324	1	4µs			1;
325					__END__