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