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 C4::Context;
  32 use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language );
  33 use C4::Dates qw(format_date);
  34 use C4::Budgets qw(GetCurrency);
  35
  36 use HTML::Template::Pro;
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  38
  39 BEGIN {
  40     # set the version for version checking
  41     $VERSION = 3.03;
  42     require Exporter;
  43     @ISA    = qw(Exporter);
  44         @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
  45         %EXPORT_TAGS = ( all =>[qw(&themelanguage &gettemplate setlanguagecookie pagination_bar
  46                                                                 &output_with_http_headers &output_html_with_http_headers)],
  47                                         ajax =>[qw(&output_with_http_headers is_ajax)],
  48                                         html =>[qw(&output_with_http_headers &output_html_with_http_headers)]
  49                                 );
  50     push @EXPORT, qw(
  51         &themelanguage &gettemplate setlanguagecookie getlanguagecookie pagination_bar
  52     );
  53     push @EXPORT, qw(
  54         &output_html_with_http_headers &output_with_http_headers FormatData FormatNumber
  55     );
  56 }
  57
  58 =head1 NAME
  59
  60 C4::Output - Functions for managing templates
  61
  62 =head1 FUNCTIONS
  63
  64 =over 2
  65
  66 =cut
  67
  68 #FIXME: this is a quick fix to stop rc1 installing broken
  69 #Still trying to figure out the correct fix.
  70 my $path = C4::Context->config('intrahtdocs') . "/prog/en/includes/";
  71
  72 #---------------------------------------------------------------------------------------------------------
  73 # FIXME - POD
  74
  75 sub _get_template_file {
  76     my ( $tmplbase, $interface, $query ) = @_;
  77     my $htdocs = C4::Context->config( $interface ne 'intranet' ? 'opachtdocs' : 'intrahtdocs' );
  78     my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $interface, $query );
  79     my $opacstylesheet = C4::Context->preference('opacstylesheet');
  80
  81     # if the template doesn't exist, load the English one as a last resort
  82     my $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
  83     unless (-f $filename) {
  84         $lang = 'en';
  85         $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
  86     }
  87
  88     return ( $htdocs, $theme, $lang, $filename );
  89 }
  90
  91 sub gettemplate {
  92     my ( $tmplbase, $interface, $query ) = @_;
  93     ($query) or warn "no query in gettemplate";
  94     my $path = C4::Context->preference('intranet_includes') || 'includes';
  95     my $opacstylesheet = C4::Context->preference('opacstylesheet');
  96     my ( $htdocs, $theme, $lang, $filename ) = _get_template_file( $tmplbase, $interface, $query );
  97
  98     my $template       = HTML::Template::Pro->new(
  99         filename          => $filename,
 100         die_on_bad_params => 1,
 101         global_vars       => 1,
 102         case_sensitive    => 1,
 103         loop_context_vars => 1, # enable: __first__, __last__, __inner__, __odd__, __counter__
 104         path              => ["$htdocs/$theme/$lang/$path"]
 105     );
 106     my $themelang=( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
 107           . "/$theme/$lang";
 108     $template->param(
 109         themelang => $themelang,
 110         yuipath   => (C4::Context->preference("yuipath") eq "local"?"$themelang/lib/yui":C4::Context->preference("yuipath")),
 111         interface => ( $interface ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
 112         theme     => $theme,
 113         lang      => $lang
 114     );
 115
 116     # Bidirectionality
 117     my $current_lang = regex_lang_subtags($lang);
 118     my $bidi;
 119     $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
 120     # Languages
 121     my $languages_loop = getTranslatedLanguages($interface,$theme,$lang);
 122     my $num_languages_enabled = 0;
 123     foreach my $lang (@$languages_loop) {
 124         foreach my $sublang (@{ $lang->{'sublanguages_loop'} }) {
 125             $num_languages_enabled++ if $sublang->{enabled};
 126          }
 127     }
 128     $template->param(
 129             languages_loop       => $languages_loop,
 130             bidi                 => $bidi,
 131             one_language_enabled => ($num_languages_enabled <= 1) ? 1 : 0, # deal with zero enabled langs as well
 132     ) unless @$languages_loop<2;
 133
 134     return $template;
 135 }
 136
 137 #---------------------------------------------------------------------------------------------------------
 138 # FIXME - POD
 139 sub themelanguage {
 140     my ( $htdocs, $tmpl, $interface, $query ) = @_;
 141     ($query) or warn "no query in themelanguage";
 142
 143     # Set some defaults for language and theme
 144     # First, check the user's preferences
 145     my $lang;
 146     my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE };
 147     $lang = accept_language( $http_accept_language,
 148               getTranslatedLanguages($interface,'prog') )
 149       if $http_accept_language;
 150     # But, if there's a cookie set, obey it
 151     $lang = $query->cookie('KohaOpacLanguage') if (defined $query and $query->cookie('KohaOpacLanguage'));
 152     # Fall back to English
 153     my @languages;
 154     if ($interface eq 'intranet') {
 155         @languages = split ",", C4::Context->preference("language");
 156     } else {
 157         @languages = split ",", C4::Context->preference("opaclanguages");
 158     }
 159     if ($lang){
 160         @languages=($lang,@languages);
 161     } else {
 162         $lang = $languages[0];
 163     }
 164     my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
 165     my $dbh = C4::Context->dbh;
 166     my @themes;
 167     if ( $interface eq "intranet" ) {
 168         @themes    = split " ", C4::Context->preference("template");
 169     }
 170     else {
 171       # we are in the opac here, what im trying to do is let the individual user
 172       # set the theme they want to use.
 173       # and perhaps the them as well.
 174         #my $lang = $query->cookie('KohaOpacLanguage');
 175         @themes = split " ", C4::Context->preference("opacthemes");
 176     }
 177
 178  # searches through the themes and languages. First template it find it returns.
 179  # Priority is for getting the theme right.
 180     THEME:
 181     foreach my $th (@themes) {
 182         foreach my $la (@languages) {
 183             #for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
 184                 # warn "$htdocs/$th/$la/modules/$interface-"."tmpl";
 185                 #$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
 186                                 if ( -e "$htdocs/$th/$la/modules/$tmpl") {
 187                 #".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
 188                     $theme = $th;
 189                     $lang  = $la;
 190                     last THEME;
 191                 }
 192                 last unless $la =~ /[-_]/;
 193             #}
 194         }
 195     }
 196     return ( $theme, $lang );
 197 }
 198
 199 sub setlanguagecookie {
 200     my ( $query, $language, $uri ) = @_;
 201     my $cookie = $query->cookie(
 202         -name    => 'KohaOpacLanguage',
 203         -value   => $language,
 204         -expires => ''
 205     );
 206     print $query->redirect(
 207         -uri    => $uri,
 208         -cookie => $cookie
 209     );
 210 }
 211
 212 sub getlanguagecookie {
 213     my ($query) = @_;
 214     my $lang;
 215     if ($query->cookie('KohaOpacLanguage')){
 216         $lang = $query->cookie('KohaOpacLanguage') ;
 217     }else{
 218         $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
 219
 220     }
 221     $lang = substr($lang, 0, 2);
 222
 223     return $lang;
 224 }
 225
 226 =item FormatNumber
 227 =cut
 228 sub FormatNumber{
 229 my $cur  =  GetCurrency;
 230 my $cur_format = C4::Context->preference("CurrencyFormat");
 231 my $num;
 232
 233 if ( $cur_format eq 'FR' ) {
 234     $num = new Number::Format(
 235         'decimal_fill'      => '2',
 236         'decimal_point'     => ',',
 237         'int_curr_symbol'   => $cur->{symbol},
 238         'mon_thousands_sep' => ' ',
 239         'thousands_sep'     => ' ',
 240         'mon_decimal_point' => ','
 241     );
 242 } else {  # US by default..
 243     $num = new Number::Format(
 244         'int_curr_symbol'   => '',
 245         'mon_thousands_sep' => ',',
 246         'mon_decimal_point' => '.'
 247     );
 248 }
 249 return $num;
 250 }
 251
 252 =item FormatData
 253
 254 FormatData($data_hashref)
 255 C<$data_hashref> is a ref to data to format
 256
 257 Format dates of data those dates are assumed to contain date in their noun
 258 Could be used in order to centralize all the formatting for HTML output
 259 =cut
 260
 261 sub FormatData{
 262                 my $data_hashref=shift;
 263         $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
 264 }
 265
 266 =item pagination_bar
 267
 268    pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
 269
 270 Build an HTML pagination bar based on the number of page to display, the
 271 current page and the url to give to each page link.
 272
 273 C<$base_url> is the URL for each page link. The
 274 C<$startfrom_name>=page_number is added at the end of the each URL.
 275
 276 C<$nb_pages> is the total number of pages available.
 277
 278 C<$current_page> is the current page number. This page number won't become a
 279 link.
 280
 281 This function returns HTML, without any language dependency.
 282
 283 =cut
 284
 285 sub pagination_bar {
 286         my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return undef;
 287     my $nb_pages       = (@_) ? shift : 1;
 288     my $current_page   = (@_) ? shift : undef;  # delay default until later
 289     my $startfrom_name = (@_) ? shift : 'page';
 290
 291     # how many pages to show before and after the current page?
 292     my $pages_around = 2;
 293
 294         my $delim = qr/\&(?:amp;)?|;/;          # "non memory" cluster: no backreference
 295         $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
 296     unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
 297         $current_page = ($1) ? $1 : 1;  # pull current page from param in URL, else default to 1
 298                 # $debug and    # FIXME: use C4::Debug;
 299                 # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1  2:$2  3:$3";
 300     }
 301         $base_url =~ s/($delim)+/$1/g;  # compress duplicate delims
 302         $base_url =~ s/$delim;//g;              # remove empties
 303         $base_url =~ s/$delim$//;               # remove trailing delim
 304
 305     my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
 306     my $pagination_bar = '';
 307
 308     # navigation bar useful only if more than one page to display !
 309     if ( $nb_pages > 1 ) {
 310
 311         # link to first page?
 312         if ( $current_page > 1 ) {
 313             $pagination_bar .=
 314                 "\n" . '&nbsp;'
 315               . '<a href="'
 316               . $url
 317               . '1" rel="start">'
 318               . '&lt;&lt;' . '</a>';
 319         }
 320         else {
 321             $pagination_bar .=
 322               "\n" . '&nbsp;<span class="inactive">&lt;&lt;</span>';
 323         }
 324
 325         # link on previous page ?
 326         if ( $current_page > 1 ) {
 327             my $previous = $current_page - 1;
 328
 329             $pagination_bar .=
 330                 "\n" . '&nbsp;'
 331               . '<a href="'
 332               . $url
 333               . $previous
 334               . '" rel="prev">' . '&lt;' . '</a>';
 335         }
 336         else {
 337             $pagination_bar .=
 338               "\n" . '&nbsp;<span class="inactive">&lt;</span>';
 339         }
 340
 341         my $min_to_display      = $current_page - $pages_around;
 342         my $max_to_display      = $current_page + $pages_around;
 343         my $last_displayed_page = undef;
 344
 345         for my $page_number ( 1 .. $nb_pages ) {
 346             if (
 347                    $page_number == 1
 348                 or $page_number == $nb_pages
 349                 or (    $page_number >= $min_to_display
 350                     and $page_number <= $max_to_display )
 351               )
 352             {
 353                 if ( defined $last_displayed_page
 354                     and $last_displayed_page != $page_number - 1 )
 355                 {
 356                     $pagination_bar .=
 357                       "\n" . '&nbsp;<span class="inactive">...</span>';
 358                 }
 359
 360                 if ( $page_number == $current_page ) {
 361                     $pagination_bar .=
 362                         "\n" . '&nbsp;'
 363                       . '<span class="currentPage">'
 364                       . $page_number
 365                       . '</span>';
 366                 }
 367                 else {
 368                     $pagination_bar .=
 369                         "\n" . '&nbsp;'
 370                       . '<a href="'
 371                       . $url
 372                       . $page_number . '">'
 373                       . $page_number . '</a>';
 374                 }
 375                 $last_displayed_page = $page_number;
 376             }
 377         }
 378
 379         # link on next page?
 380         if ( $current_page < $nb_pages ) {
 381             my $next = $current_page + 1;
 382
 383             $pagination_bar .= "\n"
 384               . '&nbsp;<a href="'
 385               . $url
 386               . $next
 387               . '" rel="next">' . '&gt;' . '</a>';
 388         }
 389         else {
 390             $pagination_bar .=
 391               "\n" . '&nbsp;<span class="inactive">&gt;</span>';
 392         }
 393
 394         # link to last page?
 395         if ( $current_page != $nb_pages ) {
 396             $pagination_bar .= "\n"
 397               . '&nbsp;<a href="'
 398               . $url
 399               . $nb_pages
 400               . '" rel="last">'
 401               . '&gt;&gt;' . '</a>';
 402         }
 403         else {
 404             $pagination_bar .=
 405               "\n" . '&nbsp;<span class="inactive">&gt;&gt;</span>';
 406         }
 407     }
 408
 409     return $pagination_bar;
 410 }
 411
 412 =item output_with_http_headers
 413
 414    &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
 415
 416 Outputs $data with the appropriate HTTP headers,
 417 the authentication cookie $cookie and a Content-Type specified in
 418 $content_type.
 419
 420 If applicable, $cookie can be undef, and it will not be sent.
 421
 422 $content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
 423
 424 $status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
 425
 426 =cut
 427
 428 sub output_with_http_headers($$$$;$) {
 429     my ( $query, $cookie, $data, $content_type, $status ) = @_;
 430     $status ||= '200 OK';
 431
 432     my %content_type_map = (
 433         'html' => 'text/html',
 434         'js'   => 'text/javascript',
 435         'json' => 'application/json',
 436         'xml'  => 'text/xml',
 437         # NOTE: not using application/atom+xml or application/rss+xml because of
 438         # Internet Explorer 6; see bug 2078.
 439         'rss'  => 'text/xml',
 440         'atom' => 'text/xml'
 441     );
 442
 443     die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
 444     my $options = {
 445         type    => $content_type_map{$content_type},
 446         status  => $status,
 447         charset => 'UTF-8',
 448         Pragma          => 'no-cache',
 449         'Cache-Control' => 'no-cache',
 450     };
 451     $options->{cookie} = $cookie if $cookie;
 452     if ($content_type eq 'html') {  # guaranteed to be one of the content_type_map keys, else we'd have died
 453         $options->{'Content-Style-Type' } = 'text/css';
 454         $options->{'Content-Script-Type'} = 'text/javascript';
 455     }
 456     # remove SUDOC specific NSB NSE
 457     $data =~ s/\x{C2}\x{98}|\x{C2}\x{9C}/ /g;
 458     $data =~ s/\x{C2}\x{88}|\x{C2}\x{89}/ /g;
 459     print $query->header($options), $data;
 460 }
 461
 462 sub output_html_with_http_headers ($$$;$) {
 463     my ( $query, $cookie, $data, $status ) = @_;
 464     $data =~ s/\&amp\;amp\; /\&amp\; /;
 465     output_with_http_headers( $query, $cookie, $data, 'html', $status );
 466 }
 467
 468 sub is_ajax () {
 469     my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
 470     return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
 471 }
 472
 473 END { }    # module clean-up code here (global destructor)
 474
 475 1;
 476 __END__
 477
 478 =back
 479
 480 =head1 AUTHOR
 481
 482 Koha Developement team <info@koha.org>
 483
 484 =cut