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 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
  28 use strict;
  29 #use warnings; FIXME - Bug 2505
  30
  31 use URI::Escape;
  32
  33 use C4::Context;
  34 use C4::Dates qw(format_date);
  35 use C4::Budgets qw(GetCurrency);
  36 use C4::Templates;
  37
  38 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  39
  40 BEGIN {
  41     # set the version for version checking
  42     $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
  59 }
  60
  61 =head1 NAME
  62
  63 C4::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
  72 sub FormatNumber{
  73 my $cur  =  GetCurrency;
  74 my $cur_format = C4::Context->preference("CurrencyFormat");
  75 my $num;
  76
  77 if ( $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 }
  93 return $num;
  94 }
  95
  96 =item FormatData
  97
  98 FormatData($data_hashref)
  99 C<$data_hashref> is a ref to data to format
 100
 101 Format dates of data those dates are assumed to contain date in their noun
 102 Could be used in order to centralize all the formatting for HTML output
 103 =cut
 104
 105 sub 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
 114 Build an HTML pagination bar based on the number of page to display, the
 115 current page and the url to give to each page link.
 116
 117 C<$base_url> is the URL for each page link. The
 118 C<$startfrom_name>=page_number is added at the end of the each URL.
 119
 120 C<$nb_pages> is the total number of pages available.
 121
 122 C<$current_page> is the current page number. This page number won't become a
 123 link.
 124
 125 This function returns HTML, without any language dependency.
 126
 127 =cut
 128
 129 sub 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
 260 Outputs $data with the appropriate HTTP headers,
 261 the authentication cookie $cookie and a Content-Type specified in
 262 $content_type.
 263
 264 If 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
 271 a true value, the HTTP headers include directives to force there to be no
 272 caching whatsoever.
 273
 274 =cut
 275
 276 sub output_with_http_headers {
 277     my ( $query, $cookie, $data, $content_type, $status, $extra_options ) = @_;
 278     $status ||= '200 OK';
 279
 280     $extra_options //= {};
 281
 282     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
 293     die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
 294     my $cache_policy = 'no-cache';
 295     $cache_policy .= ', no-store, max-age=0' if $extra_options->{force_no_caching};
 296     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     };
 303     $options->{expires} = 'now' if $extra_options->{force_no_caching};
 304
 305     $options->{cookie} = $cookie if $cookie;
 306     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
 316     $data =~ s/\&amp\;amp\; /\&amp\; /g;
 317     print $query->header($options), $data;
 318 }
 319
 320 sub 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
 326 sub 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
 337 sub is_ajax {
 338     my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
 339     return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
 340 }
 341
 342 sub 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
 354 END { }    # module clean-up code here (global destructor)
 355
 356 1;
 357 __END__
 358
 359 =back
 360
 361 =head1 AUTHOR
 362
 363 Koha Development Team <http://koha-community.org/>
 364
 365 =cut