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 # FIXME - this is a horrible hack to cache
 138 # the current known-good language, temporarily
 139 # put in place to resolve bug 4403.  It is
 140 # used only by C4::XSLT::XSLTParse4Display;
 141 # the language is set via the usual call
 142 # to themelanguage.
 143 my $_current_language = 'en';
 144 sub _current_language {
 145     return $_current_language;
 146 }
 147
 148 #---------------------------------------------------------------------------------------------------------
 149 # FIXME - POD
 150 sub themelanguage {
 151     my ( $htdocs, $tmpl, $interface, $query ) = @_;
 152     ($query) or warn "no query in themelanguage";
 153
 154     # Set some defaults for language and theme
 155     # First, check the user's preferences
 156     my $lang;
 157     my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE };
 158     $lang = accept_language( $http_accept_language,
 159               getTranslatedLanguages($interface,'prog') )
 160       if $http_accept_language;
 161     # But, if there's a cookie set, obey it
 162     $lang = $query->cookie('KohaOpacLanguage') if (defined $query and $query->cookie('KohaOpacLanguage'));
 163     $lang =~ s/[^a-zA-Z_-]*//g;
 164     # Fall back to English
 165     my @languages;
 166     if ($interface eq 'intranet') {
 167         @languages = split ",", C4::Context->preference("language");
 168     } else {
 169         @languages = split ",", C4::Context->preference("opaclanguages");
 170     }
 171     if ($lang){
 172         @languages=($lang,@languages);
 173     } else {
 174         $lang = $languages[0];
 175     }
 176     my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
 177     my $dbh = C4::Context->dbh;
 178     my @themes;
 179     if ( $interface eq "intranet" ) {
 180         @themes    = split " ", C4::Context->preference("template");
 181     }
 182     else {
 183       # we are in the opac here, what im trying to do is let the individual user
 184       # set the theme they want to use.
 185       # and perhaps the them as well.
 186         #my $lang = $query->cookie('KohaOpacLanguage');
 187         @themes = split " ", C4::Context->preference("opacthemes");
 188     }
 189
 190  # searches through the themes and languages. First template it find it returns.
 191  # Priority is for getting the theme right.
 192     THEME:
 193     foreach my $th (@themes) {
 194         foreach my $la (@languages) {
 195             #for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
 196                 # warn "$htdocs/$th/$la/modules/$interface-"."tmpl";
 197                 #$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
 198                                 if ( -e "$htdocs/$th/$la/modules/$tmpl") {
 199                 #".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
 200                     $theme = $th;
 201                     $lang  = $la;
 202                     last THEME;
 203                 }
 204                 last unless $la =~ /[-_]/;
 205             #}
 206         }
 207     }
 208
 209     $_current_language = $lang; # FIXME part of bad hack to paper over bug 4403
 210     return ( $theme, $lang );
 211 }
 212
 213 sub setlanguagecookie {
 214     my ( $query, $language, $uri ) = @_;
 215     my $cookie = $query->cookie(
 216         -name    => 'KohaOpacLanguage',
 217         -value   => $language,
 218         -expires => ''
 219     );
 220     print $query->redirect(
 221         -uri    => $uri,
 222         -cookie => $cookie
 223     );
 224 }
 225
 226 sub getlanguagecookie {
 227     my ($query) = @_;
 228     my $lang;
 229     if ($query->cookie('KohaOpacLanguage')){
 230         $lang = $query->cookie('KohaOpacLanguage') ;
 231     }else{
 232         $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
 233
 234     }
 235     $lang = substr($lang, 0, 2);
 236
 237     return $lang;
 238 }
 239
 240 =item FormatNumber
 241 =cut
 242 sub FormatNumber{
 243 my $cur  =  GetCurrency;
 244 my $cur_format = C4::Context->preference("CurrencyFormat");
 245 my $num;
 246
 247 if ( $cur_format eq 'FR' ) {
 248     $num = new Number::Format(
 249         'decimal_fill'      => '2',
 250         'decimal_point'     => ',',
 251         'int_curr_symbol'   => $cur->{symbol},
 252         'mon_thousands_sep' => ' ',
 253         'thousands_sep'     => ' ',
 254         'mon_decimal_point' => ','
 255     );
 256 } else {  # US by default..
 257     $num = new Number::Format(
 258         'int_curr_symbol'   => '',
 259         'mon_thousands_sep' => ',',
 260         'mon_decimal_point' => '.'
 261     );
 262 }
 263 return $num;
 264 }
 265
 266 =item FormatData
 267
 268 FormatData($data_hashref)
 269 C<$data_hashref> is a ref to data to format
 270
 271 Format dates of data those dates are assumed to contain date in their noun
 272 Could be used in order to centralize all the formatting for HTML output
 273 =cut
 274
 275 sub FormatData{
 276                 my $data_hashref=shift;
 277         $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
 278 }
 279
 280 =item pagination_bar
 281
 282    pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
 283
 284 Build an HTML pagination bar based on the number of page to display, the
 285 current page and the url to give to each page link.
 286
 287 C<$base_url> is the URL for each page link. The
 288 C<$startfrom_name>=page_number is added at the end of the each URL.
 289
 290 C<$nb_pages> is the total number of pages available.
 291
 292 C<$current_page> is the current page number. This page number won't become a
 293 link.
 294
 295 This function returns HTML, without any language dependency.
 296
 297 =cut
 298
 299 sub pagination_bar {
 300         my $base_url = (@_ ? shift : $ENV{SCRIPT_NAME} . $ENV{QUERY_STRING}) or return undef;
 301     my $nb_pages       = (@_) ? shift : 1;
 302     my $current_page   = (@_) ? shift : undef;  # delay default until later
 303     my $startfrom_name = (@_) ? shift : 'page';
 304
 305     # how many pages to show before and after the current page?
 306     my $pages_around = 2;
 307
 308         my $delim = qr/\&(?:amp;)?|;/;          # "non memory" cluster: no backreference
 309         $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
 310     unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
 311         $current_page = ($1) ? $1 : 1;  # pull current page from param in URL, else default to 1
 312                 # $debug and    # FIXME: use C4::Debug;
 313                 # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1  2:$2  3:$3";
 314     }
 315         $base_url =~ s/($delim)+/$1/g;  # compress duplicate delims
 316         $base_url =~ s/$delim;//g;              # remove empties
 317         $base_url =~ s/$delim$//;               # remove trailing delim
 318
 319     my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&amp;' : '?' ) . $startfrom_name . '=';
 320     my $pagination_bar = '';
 321
 322     # navigation bar useful only if more than one page to display !
 323     if ( $nb_pages > 1 ) {
 324
 325         # link to first page?
 326         if ( $current_page > 1 ) {
 327             $pagination_bar .=
 328                 "\n" . '&nbsp;'
 329               . '<a href="'
 330               . $url
 331               . '1" rel="start">'
 332               . '&lt;&lt;' . '</a>';
 333         }
 334         else {
 335             $pagination_bar .=
 336               "\n" . '&nbsp;<span class="inactive">&lt;&lt;</span>';
 337         }
 338
 339         # link on previous page ?
 340         if ( $current_page > 1 ) {
 341             my $previous = $current_page - 1;
 342
 343             $pagination_bar .=
 344                 "\n" . '&nbsp;'
 345               . '<a href="'
 346               . $url
 347               . $previous
 348               . '" rel="prev">' . '&lt;' . '</a>';
 349         }
 350         else {
 351             $pagination_bar .=
 352               "\n" . '&nbsp;<span class="inactive">&lt;</span>';
 353         }
 354
 355         my $min_to_display      = $current_page - $pages_around;
 356         my $max_to_display      = $current_page + $pages_around;
 357         my $last_displayed_page = undef;
 358
 359         for my $page_number ( 1 .. $nb_pages ) {
 360             if (
 361                    $page_number == 1
 362                 or $page_number == $nb_pages
 363                 or (    $page_number >= $min_to_display
 364                     and $page_number <= $max_to_display )
 365               )
 366             {
 367                 if ( defined $last_displayed_page
 368                     and $last_displayed_page != $page_number - 1 )
 369                 {
 370                     $pagination_bar .=
 371                       "\n" . '&nbsp;<span class="inactive">...</span>';
 372                 }
 373
 374                 if ( $page_number == $current_page ) {
 375                     $pagination_bar .=
 376                         "\n" . '&nbsp;'
 377                       . '<span class="currentPage">'
 378                       . $page_number
 379                       . '</span>';
 380                 }
 381                 else {
 382                     $pagination_bar .=
 383                         "\n" . '&nbsp;'
 384                       . '<a href="'
 385                       . $url
 386                       . $page_number . '">'
 387                       . $page_number . '</a>';
 388                 }
 389                 $last_displayed_page = $page_number;
 390             }
 391         }
 392
 393         # link on next page?
 394         if ( $current_page < $nb_pages ) {
 395             my $next = $current_page + 1;
 396
 397             $pagination_bar .= "\n"
 398               . '&nbsp;<a href="'
 399               . $url
 400               . $next
 401               . '" rel="next">' . '&gt;' . '</a>';
 402         }
 403         else {
 404             $pagination_bar .=
 405               "\n" . '&nbsp;<span class="inactive">&gt;</span>';
 406         }
 407
 408         # link to last page?
 409         if ( $current_page != $nb_pages ) {
 410             $pagination_bar .= "\n"
 411               . '&nbsp;<a href="'
 412               . $url
 413               . $nb_pages
 414               . '" rel="last">'
 415               . '&gt;&gt;' . '</a>';
 416         }
 417         else {
 418             $pagination_bar .=
 419               "\n" . '&nbsp;<span class="inactive">&gt;&gt;</span>';
 420         }
 421     }
 422
 423     return $pagination_bar;
 424 }
 425
 426 =item output_with_http_headers
 427
 428    &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
 429
 430 Outputs $data with the appropriate HTTP headers,
 431 the authentication cookie $cookie and a Content-Type specified in
 432 $content_type.
 433
 434 If applicable, $cookie can be undef, and it will not be sent.
 435
 436 $content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
 437
 438 $status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
 439
 440 =cut
 441
 442 sub output_with_http_headers($$$$;$) {
 443     my ( $query, $cookie, $data, $content_type, $status ) = @_;
 444     $status ||= '200 OK';
 445
 446     my %content_type_map = (
 447         'html' => 'text/html',
 448         'js'   => 'text/javascript',
 449         'json' => 'application/json',
 450         'xml'  => 'text/xml',
 451         # NOTE: not using application/atom+xml or application/rss+xml because of
 452         # Internet Explorer 6; see bug 2078.
 453         'rss'  => 'text/xml',
 454         'atom' => 'text/xml'
 455     );
 456
 457     die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
 458     my $options = {
 459         type    => $content_type_map{$content_type},
 460         status  => $status,
 461         charset => 'UTF-8',
 462         Pragma          => 'no-cache',
 463         'Cache-Control' => 'no-cache',
 464     };
 465     $options->{cookie} = $cookie if $cookie;
 466     if ($content_type eq 'html') {  # guaranteed to be one of the content_type_map keys, else we'd have died
 467         $options->{'Content-Style-Type' } = 'text/css';
 468         $options->{'Content-Script-Type'} = 'text/javascript';
 469     }
 470     # remove SUDOC specific NSB NSE
 471     $data =~ s/\x{C2}\x{98}|\x{C2}\x{9C}/ /g;
 472     $data =~ s/\x{C2}\x{88}|\x{C2}\x{89}/ /g;
 473     print $query->header($options), $data;
 474 }
 475
 476 sub output_html_with_http_headers ($$$;$) {
 477     my ( $query, $cookie, $data, $status ) = @_;
 478     $data =~ s/\&amp\;amp\; /\&amp\; /g;
 479     output_with_http_headers( $query, $cookie, $data, 'html', $status );
 480 }
 481
 482 sub is_ajax () {
 483     my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
 484     return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
 485 }
 486
 487 END { }    # module clean-up code here (global destructor)
 488
 489 1;
 490 __END__
 491
 492 =back
 493
 494 =head1 AUTHOR
 495
 496 Koha Development Team <http://koha-community.org/>
 497
 498 =cut