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