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
7 # Copyright 2000-2002 Katipo Communications
9 # This file is part of Koha.
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
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.
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.
25 # NOTE: I'm pretty sure this module is deprecated in favor of
29 #use warnings; FIXME - Bug 2505
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);
37 #use HTML::Template::Pro;
38 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
41 # set the version for version checking
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)]
52 &themelanguage &gettemplate setlanguagecookie getlanguagecookie pagination_bar
55 &output_html_with_http_headers &output_with_http_headers FormatData FormatNumber
61 C4::Output - Functions for managing templates
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/";
73 #---------------------------------------------------------------------------------------------------------
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');
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) {
86 $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
89 return ( $htdocs, $theme, $lang, $filename );
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' )
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' ),
111 my $current_lang = regex_lang_subtags($lang);
113 $bidi = get_bidi($current_lang->{script}) if $current_lang->{script};
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};
123 languages_loop => $languages_loop,
125 one_language_enabled => ($num_languages_enabled <= 1) ? 1 : 0, # deal with zero enabled langs as well
126 ) unless @$languages_loop<2;
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
137 my $_current_language = 'en';
138 sub _current_language {
139 return $_current_language;
142 #---------------------------------------------------------------------------------------------------------
145 my ( $htdocs, $tmpl, $interface, $query ) = @_;
146 ($query) or warn "no query in themelanguage";
148 # Set some defaults for language and theme
149 # First, check the user's preferences
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
159 if ($interface eq 'intranet') {
160 @languages = split ",", C4::Context->preference("language");
162 @languages = split ",", C4::Context->preference("opaclanguages");
165 @languages=($lang,@languages);
167 $lang = $languages[0];
169 my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
170 my $dbh = C4::Context->dbh;
172 if ( $interface eq "intranet" ) {
173 @themes = split " ", C4::Context->preference("template");
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");
183 # searches through the themes and languages. First template it find it returns.
184 # Priority is for getting the theme right.
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" ) {
197 last unless $la =~ /[-_]/;
202 $_current_language = $lang; # FIXME part of bad hack to paper over bug 4403
203 return ( $theme, $lang );
206 sub setlanguagecookie {
207 my ( $query, $language, $uri ) = @_;
208 my $cookie = $query->cookie(
209 -name => 'KohaOpacLanguage',
213 print $query->redirect(
219 sub getlanguagecookie {
222 if ($query->cookie('KohaOpacLanguage')){
223 $lang = $query->cookie('KohaOpacLanguage') ;
225 $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
228 $lang = substr($lang, 0, 2);
236 my $cur = GetCurrency;
237 my $cur_format = C4::Context->preference("CurrencyFormat");
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' => ','
249 } else { # US by default..
250 $num = new Number::Format(
251 'int_curr_symbol' => '',
252 'mon_thousands_sep' => ',',
253 'mon_decimal_point' => '.'
261 FormatData($data_hashref)
262 C<$data_hashref> is a ref to data to format
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
269 my $data_hashref=shift;
270 $$data_hashref{$_} = format_date( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
275 pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
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.
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.
283 C<$nb_pages> is the total number of pages available.
285 C<$current_page> is the current page number. This page number won't become a
288 This function returns HTML, without any language dependency.
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';
298 # how many pages to show before and after the current page?
299 my $pages_around = 2;
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";
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
312 my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ? '&' : '?' ) . $startfrom_name . '=';
313 my $pagination_bar = '';
315 # navigation bar useful only if more than one page to display !
316 if ( $nb_pages > 1 ) {
318 # link to first page?
319 if ( $current_page > 1 ) {
325 . '<<' . '</a>';
329 "\n" . ' <span class="inactive"><<</span>';
332 # link on previous page ?
333 if ( $current_page > 1 ) {
334 my $previous = $current_page - 1;
341 . '" rel="prev">' . '<' . '</a>';
345 "\n" . ' <span class="inactive"><</span>';
348 my $min_to_display = $current_page - $pages_around;
349 my $max_to_display = $current_page + $pages_around;
350 my $last_displayed_page = undef;
352 for my $page_number ( 1 .. $nb_pages ) {
355 or $page_number == $nb_pages
356 or ( $page_number >= $min_to_display
357 and $page_number <= $max_to_display )
360 if ( defined $last_displayed_page
361 and $last_displayed_page != $page_number - 1 )
364 "\n" . ' <span class="inactive">...</span>';
367 if ( $page_number == $current_page ) {
370 . '<span class="currentPage">'
379 . $page_number . '">'
380 . $page_number . '</a>';
382 $last_displayed_page = $page_number;
387 if ( $current_page < $nb_pages ) {
388 my $next = $current_page + 1;
390 $pagination_bar .= "\n"
394 . '" rel="next">' . '>' . '</a>';
398 "\n" . ' <span class="inactive">></span>';
402 if ( $current_page != $nb_pages ) {
403 $pagination_bar .= "\n"
408 . '>>' . '</a>';
412 "\n" . ' <span class="inactive">>></span>';
416 return $pagination_bar;
419 =item output_with_http_headers
421 &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
423 Outputs $data with the appropriate HTTP headers,
424 the authentication cookie $cookie and a Content-Type specified in
427 If applicable, $cookie can be undef, and it will not be sent.
429 $content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
431 $status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
435 sub output_with_http_headers($$$$;$) {
436 my ( $query, $cookie, $data, $content_type, $status ) = @_;
437 $status ||= '200 OK';
439 my %content_type_map = (
440 'html' => 'text/html',
441 'js' => 'text/javascript',
442 'json' => 'application/json',
444 # NOTE: not using application/atom+xml or application/rss+xml because of
445 # Internet Explorer 6; see bug 2078.
450 die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
452 type => $content_type_map{$content_type},
455 Pragma => 'no-cache',
456 'Cache-Control' => 'no-cache',
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';
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;
467 # We can't encode here, that will double encode our templates, and xslt
468 # We need to fix the encoding as it comes out of the database, or when we pass the variables to templates
470 # utf8::encode($data) if utf8::is_utf8($data);
472 print $query->header($options), $data;
475 sub output_html_with_http_headers ($$$;$) {
476 my ( $query, $cookie, $data, $status ) = @_;
477 $data =~ s/\&\;amp\; /\&\; /g;
478 output_with_http_headers( $query, $cookie, $data, 'html', $status );
482 my $x_req = $ENV{HTTP_X_REQUESTED_WITH};
483 return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ? 1 : 0;
486 END { } # module clean-up code here (global destructor)
495 Koha Development Team <http://koha-community.org/>