Bug 28572: Remove C4::Debug
[koha.git] / C4 / Output.pm
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 use Modern::Perl;
29
30 use URI::Escape;
31 use Scalar::Util qw( looks_like_number );
32
33 use C4::Auth qw(get_template_and_user);
34 use C4::Context;
35 use C4::Templates;
36
37 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
38
39 BEGIN {
40     require Exporter;
41
42  @ISA    = qw(Exporter);
43     @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
44     %EXPORT_TAGS = ( all =>[qw(setlanguagecookie pagination_bar parametrized_url
45                                 &output_with_http_headers &output_ajax_with_http_headers &output_html_with_http_headers)],
46                     ajax =>[qw(&output_with_http_headers &output_ajax_with_http_headers is_ajax)],
47                     html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
48                 );
49     push @EXPORT, qw(
50         setlanguagecookie getlanguagecookie pagination_bar parametrized_url
51     );
52     push @EXPORT, qw(
53         &output_html_with_http_headers &output_ajax_with_http_headers &output_with_http_headers
54         &output_and_exit_if_error &output_and_exit &output_error
55     );
56
57 }
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
67 =item pagination_bar
68
69    pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
70
71 Build an HTML pagination bar based on the number of page to display, the
72 current page and the url to give to each page link.
73
74 C<$base_url> is the URL for each page link. The
75 C<$startfrom_name>=page_number is added at the end of the each URL.
76
77 C<$nb_pages> is the total number of pages available.
78
79 C<$current_page> is the current page number. This page number won't become a
80 link.
81
82 This function returns HTML, without any language dependency.
83
84 =cut
85
86 sub pagination_bar {
87     my $base_url = (@_ ? shift : return);
88     my $nb_pages       = (@_) ? shift : 1;
89     my $current_page   = (@_) ? shift : undef;  # delay default until later
90     my $startfrom_name = (@_) ? shift : 'page';
91     my $additional_parameters = shift || {};
92
93     $current_page = looks_like_number($current_page) ? $current_page : undef;
94     $nb_pages     = looks_like_number($nb_pages)     ? $nb_pages     : undef;
95
96     # how many pages to show before and after the current page?
97     my $pages_around = 2;
98
99         my $delim = qr/\&(?:amp;)?|;/;          # "non memory" cluster: no backreference
100         $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
101     unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
102         $current_page = ($1) ? $1 : 1;  # pull current page from param in URL, else default to 1
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/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
109     my $url_suffix;
110     while ( my ( $k, $v ) = each %$additional_parameters ) {
111         $url_suffix .= '&amp;' . URI::Escape::uri_escape_utf8($k) . '=' . URI::Escape::uri_escape_utf8($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" . '&nbsp;'
122               . '<a href="'
123               . $url
124               . '1'
125               . $url_suffix
126               . '"rel="start">'
127               . '&lt;&lt;' . '</a>';
128         }
129         else {
130             $pagination_bar .=
131               "\n" . '&nbsp;<span class="inactive">&lt;&lt;</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" . '&nbsp;'
140               . '<a href="'
141               . $url
142               . $previous
143               . $url_suffix
144               . '" rel="prev">' . '&lt;' . '</a>';
145         }
146         else {
147             $pagination_bar .=
148               "\n" . '&nbsp;<span class="inactive">&lt;</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" . '&nbsp;<span class="inactive">...</span>';
168                 }
169
170                 if ( $page_number == $current_page ) {
171                     $pagination_bar .=
172                         "\n" . '&nbsp;'
173                       . '<span class="currentPage">'
174                       . $page_number
175                       . '</span>';
176                 }
177                 else {
178                     $pagination_bar .=
179                         "\n" . '&nbsp;'
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               . '&nbsp;<a href="'
197               . $url
198               . $next
199               . $url_suffix
200               . '" rel="next">' . '&gt;' . '</a>';
201         }
202         else {
203             $pagination_bar .=
204               "\n" . '&nbsp;<span class="inactive">&gt;</span>';
205         }
206
207         # link to last page?
208         if ( $current_page != $nb_pages ) {
209             $pagination_bar .= "\n"
210               . '&nbsp;<a href="'
211               . $url
212               . $nb_pages
213               . $url_suffix
214               . '" rel="last">'
215               . '&gt;&gt;' . '</a>';
216         }
217         else {
218             $pagination_bar .=
219               "\n" . '&nbsp;<span class="inactive">&gt;&gt;</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', 'opensearchdescription', '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         'opensearchdescription' => 'application/opensearchdescription+xml',
262     );
263
264     die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
265     my $cache_policy = 'no-cache';
266     $cache_policy .= ', no-store, max-age=0' if $extra_options->{force_no_caching};
267     my $options = {
268         type              => $content_type_map{$content_type},
269         status            => $status,
270         charset           => 'UTF-8',
271         Pragma            => 'no-cache',
272         'Cache-Control'   => $cache_policy,
273         'X-Frame-Options' => 'SAMEORIGIN',
274     };
275     $options->{expires} = 'now' if $extra_options->{force_no_caching};
276     $options->{'Access-Control-Allow-Origin'} = C4::Context->preference('AccessControlAllowOrigin')
277         if C4::Context->preference('AccessControlAllowOrigin');
278
279     $options->{cookie} = $cookie if $cookie;
280     if ($content_type eq 'html') {  # guaranteed to be one of the content_type_map keys, else we'd have died
281         $options->{'Content-Style-Type' } = 'text/css';
282         $options->{'Content-Script-Type'} = 'text/javascript';
283     }
284
285 # We can't encode here, that will double encode our templates, and xslt
286 # We need to fix the encoding as it comes out of the database, or when we pass the variables to templates
287
288     $data =~ s/\&amp\;amp\; /\&amp\; /g;
289     print $query->header($options), $data;
290 }
291
292 sub output_html_with_http_headers {
293     my ( $query, $cookie, $data, $status, $extra_options ) = @_;
294     output_with_http_headers( $query, $cookie, $data, 'html', $status, $extra_options );
295 }
296
297
298 sub output_ajax_with_http_headers {
299     my ( $query, $js ) = @_;
300     print $query->header(
301         -type            => 'text/javascript',
302         -charset         => 'UTF-8',
303         -Pragma          => 'no-cache',
304         -'Cache-Control' => 'no-cache',
305         -expires         => '-1d',
306     ), $js;
307 }
308
309 sub is_ajax {
310     my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
311     return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
312 }
313
314 =item output_and_exit_if_error
315
316     output_and_exit_if_error( $query, $cookie, $template, $params );
317
318 To executed at the beginning of scripts to stop the script at this point if
319 some errors are found.
320
321 Tests for module 'members':
322 * patron is not defined (we are looking for a patron that does no longer exist/never existed)
323 * The logged in user cannot see patron's infos (feature 'cannot_see_patron_infos')
324
325 Others will be added here depending on the needs (for instance biblio does not exist will be useful).
326
327 =cut
328
329 sub output_and_exit_if_error {
330     my ( $query, $cookie, $template, $params ) = @_;
331     my $error;
332     if ( $params and exists $params->{module} ) {
333         if ( $params->{module} eq 'members' ) {
334             my $logged_in_user = $params->{logged_in_user};
335             my $current_patron = $params->{current_patron};
336             if ( not $current_patron ) {
337                 $error = 'unknown_patron';
338             }
339             elsif( not $logged_in_user->can_see_patron_infos( $current_patron ) ) {
340                 $error = 'cannot_see_patron_infos';
341             }
342         } elsif ( $params->{module} eq 'cataloguing' ) {
343             # We are testing the record to avoid additem to fetch the Koha::Biblio
344             # But in the long term we will want to get a biblio in parameter
345             $error = 'unknown_biblio' unless $params->{record};
346         }
347     }
348
349     output_and_exit( $query, $cookie, $template, $error ) if $error;
350     return;
351 }
352
353 =item output_and_exit
354
355     output_and_exit( $query, $cookie, $template, $error );
356
357     $error is a blocking error like biblionumber not found or so.
358     We should output the error and exit.
359
360 =cut
361
362 sub output_and_exit {
363     my ( $query, $cookie, $template, $error ) = @_;
364     $template->param( blocking_error => $error );
365     output_html_with_http_headers ( $query, $cookie, $template->output );
366     exit;
367 }
368
369 sub output_error {
370     my ( $query, $error ) = @_;
371     my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
372         {
373             template_name   => 'errors/errorpage.tt',
374             query           => $query,
375             type            => 'intranet',
376             authnotrequired => 1,
377         }
378     );
379     my $admin = C4::Context->preference('KohaAdminEmailAddress');
380     $template->param (
381         admin => $admin,
382         errno => $error,
383     );
384     output_with_http_headers $query, $cookie, $template->output, 'html', '404 Not Found';
385 }
386
387 sub parametrized_url {
388     my $url = shift || ''; # ie page.pl?ln={LANG}
389     my $vars = shift || {}; # ie { LANG => en }
390     my $ret = $url;
391     while ( my ($key,$val) = each %$vars) {
392         my $val_url = URI::Escape::uri_escape_utf8( $val // q{} );
393         $ret =~ s/\{$key\}/$val_url/g;
394     }
395     $ret =~ s/\{[^\{]*\}//g; # remove remaining vars
396     return $ret;
397 }
398
399 END { }    # module clean-up code here (global destructor)
400
401 1;
402 __END__
403
404 =back
405
406 =head1 AUTHOR
407
408 Koha Development Team <http://koha-community.org/>
409
410 =cut