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