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