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);
36 use HTML
::Template
::Pro
;
37 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
40 # set the version for version checking
44 @EXPORT_OK = qw(&is_ajax ajax_fail); # More stuff should go here instead
45 %EXPORT_TAGS = ( all
=>[qw(&themelanguage &gettemplate setlanguagecookie pagination_bar
46 &output_with_http_headers &output_html_with_http_headers)],
47 ajax
=>[qw(&output_with_http_headers is_ajax)],
48 html
=>[qw(&output_with_http_headers &output_html_with_http_headers)]
51 &themelanguage &gettemplate setlanguagecookie getlanguagecookie pagination_bar
54 &output_html_with_http_headers &output_with_http_headers FormatData FormatNumber
60 C4::Output - Functions for managing templates
68 #FIXME: this is a quick fix to stop rc1 installing broken
69 #Still trying to figure out the correct fix.
70 my $path = C4
::Context
->config('intrahtdocs') . "/prog/en/includes/";
72 #---------------------------------------------------------------------------------------------------------
75 sub _get_template_file
{
76 my ( $tmplbase, $interface, $query ) = @_;
77 my $htdocs = C4
::Context
->config( $interface ne 'intranet' ?
'opachtdocs' : 'intrahtdocs' );
78 my ( $theme, $lang ) = themelanguage
( $htdocs, $tmplbase, $interface, $query );
79 my $opacstylesheet = C4
::Context
->preference('opacstylesheet');
81 # if the template doesn't exist, load the English one as a last resort
82 my $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
83 unless (-f
$filename) {
85 $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
88 return ( $htdocs, $theme, $lang, $filename );
92 my ( $tmplbase, $interface, $query ) = @_;
93 ($query) or warn "no query in gettemplate";
94 my $path = C4
::Context
->preference('intranet_includes') || 'includes';
95 my $opacstylesheet = C4
::Context
->preference('opacstylesheet');
96 my ( $htdocs, $theme, $lang, $filename ) = _get_template_file
( $tmplbase, $interface, $query );
98 my $template = HTML
::Template
::Pro
->new(
99 filename
=> $filename,
100 die_on_bad_params
=> 1,
103 loop_context_vars
=> 1, # enable: __first__, __last__, __inner__, __odd__, __counter__
104 path
=> ["$htdocs/$theme/$lang/$path"]
106 my $themelang=( $interface ne 'intranet' ?
'/opac-tmpl' : '/intranet-tmpl' )
109 themelang
=> $themelang,
110 yuipath
=> (C4
::Context
->preference("yuipath") eq "local"?
"$themelang/lib/yui":C4
::Context
->preference("yuipath")),
111 interface
=> ( $interface ne 'intranet' ?
'/opac-tmpl' : '/intranet-tmpl' ),
117 my $current_lang = regex_lang_subtags
($lang);
119 $bidi = get_bidi
($current_lang->{script
}) if $current_lang->{script
};
121 my $languages_loop = getTranslatedLanguages
($interface,$theme,$lang);
122 my $num_languages_enabled = 0;
123 foreach my $lang (@
$languages_loop) {
124 foreach my $sublang (@
{ $lang->{'sublanguages_loop'} }) {
125 $num_languages_enabled++ if $sublang->{enabled
};
129 languages_loop
=> $languages_loop,
131 one_language_enabled
=> ($num_languages_enabled <= 1) ?
1 : 0, # deal with zero enabled langs as well
132 ) unless @
$languages_loop<2;
137 # FIXME - this is a horrible hack to cache
138 # the current known-good language, temporarily
139 # put in place to resolve bug 4403. It is
140 # used only by C4::XSLT::XSLTParse4Display;
141 # the language is set via the usual call
143 my $_current_language = 'en';
144 sub _current_language
{
145 return $_current_language;
148 #---------------------------------------------------------------------------------------------------------
151 my ( $htdocs, $tmpl, $interface, $query ) = @_;
152 ($query) or warn "no query in themelanguage";
154 # Set some defaults for language and theme
155 # First, check the user's preferences
157 my $http_accept_language = $ENV{ HTTP_ACCEPT_LANGUAGE
};
158 $lang = accept_language
( $http_accept_language,
159 getTranslatedLanguages
($interface,'prog') )
160 if $http_accept_language;
161 # But, if there's a cookie set, obey it
162 $lang = $query->cookie('KohaOpacLanguage') if (defined $query and $query->cookie('KohaOpacLanguage'));
163 # Fall back to English
165 if ($interface eq 'intranet') {
166 @languages = split ",", C4
::Context
->preference("language");
168 @languages = split ",", C4
::Context
->preference("opaclanguages");
171 @languages=($lang,@languages);
173 $lang = $languages[0];
175 my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
176 my $dbh = C4
::Context
->dbh;
178 if ( $interface eq "intranet" ) {
179 @themes = split " ", C4
::Context
->preference("template");
182 # we are in the opac here, what im trying to do is let the individual user
183 # set the theme they want to use.
184 # and perhaps the them as well.
185 #my $lang = $query->cookie('KohaOpacLanguage');
186 @themes = split " ", C4
::Context
->preference("opacthemes");
189 # searches through the themes and languages. First template it find it returns.
190 # Priority is for getting the theme right.
192 foreach my $th (@themes) {
193 foreach my $la (@languages) {
194 #for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
195 # warn "$htdocs/$th/$la/modules/$interface-"."tmpl";
196 #$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
197 if ( -e
"$htdocs/$th/$la/modules/$tmpl") {
198 #".($interface eq 'intranet'?"modules":"")."/$tmpl" ) {
203 last unless $la =~ /[-_]/;
208 $_current_language = $lang; # FIXME part of bad hack to paper over bug 4403
209 return ( $theme, $lang );
212 sub setlanguagecookie
{
213 my ( $query, $language, $uri ) = @_;
214 my $cookie = $query->cookie(
215 -name
=> 'KohaOpacLanguage',
219 print $query->redirect(
225 sub getlanguagecookie
{
228 if ($query->cookie('KohaOpacLanguage')){
229 $lang = $query->cookie('KohaOpacLanguage') ;
231 $lang = $ENV{HTTP_ACCEPT_LANGUAGE
};
234 $lang = substr($lang, 0, 2);
242 my $cur = GetCurrency
;
243 my $cur_format = C4
::Context
->preference("CurrencyFormat");
246 if ( $cur_format eq 'FR' ) {
247 $num = new Number
::Format
(
248 'decimal_fill' => '2',
249 'decimal_point' => ',',
250 'int_curr_symbol' => $cur->{symbol
},
251 'mon_thousands_sep' => ' ',
252 'thousands_sep' => ' ',
253 'mon_decimal_point' => ','
255 } else { # US by default..
256 $num = new Number
::Format
(
257 'int_curr_symbol' => '',
258 'mon_thousands_sep' => ',',
259 'mon_decimal_point' => '.'
267 FormatData($data_hashref)
268 C<$data_hashref> is a ref to data to format
270 Format dates of data those dates are assumed to contain date in their noun
271 Could be used in order to centralize all the formatting for HTML output
275 my $data_hashref=shift;
276 $$data_hashref{$_} = format_date
( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
281 pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
283 Build an HTML pagination bar based on the number of page to display, the
284 current page and the url to give to each page link.
286 C<$base_url> is the URL for each page link. The
287 C<$startfrom_name>=page_number is added at the end of the each URL.
289 C<$nb_pages> is the total number of pages available.
291 C<$current_page> is the current page number. This page number won't become a
294 This function returns HTML, without any language dependency.
299 my $base_url = (@_ ?
shift : $ENV{SCRIPT_NAME
} . $ENV{QUERY_STRING
}) or return undef;
300 my $nb_pages = (@_) ?
shift : 1;
301 my $current_page = (@_) ?
shift : undef; # delay default until later
302 my $startfrom_name = (@_) ?
shift : 'page';
304 # how many pages to show before and after the current page?
305 my $pages_around = 2;
307 my $delim = qr/\&(?:amp;)?|;/; # "non memory" cluster: no backreference
308 $base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
309 unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
310 $current_page = ($1) ?
$1 : 1; # pull current page from param in URL, else default to 1
311 # $debug and # FIXME: use C4::Debug;
312 # warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1 2:$2 3:$3";
314 $base_url =~ s/($delim)+/$1/g; # compress duplicate delims
315 $base_url =~ s/$delim;//g; # remove empties
316 $base_url =~ s/$delim$//; # remove trailing delim
318 my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ?
'&' : '?' ) . $startfrom_name . '=';
319 my $pagination_bar = '';
321 # navigation bar useful only if more than one page to display !
322 if ( $nb_pages > 1 ) {
324 # link to first page?
325 if ( $current_page > 1 ) {
331 . '<<' . '</a>';
335 "\n" . ' <span class="inactive"><<</span>';
338 # link on previous page ?
339 if ( $current_page > 1 ) {
340 my $previous = $current_page - 1;
347 . '" rel="prev">' . '<' . '</a>';
351 "\n" . ' <span class="inactive"><</span>';
354 my $min_to_display = $current_page - $pages_around;
355 my $max_to_display = $current_page + $pages_around;
356 my $last_displayed_page = undef;
358 for my $page_number ( 1 .. $nb_pages ) {
361 or $page_number == $nb_pages
362 or ( $page_number >= $min_to_display
363 and $page_number <= $max_to_display )
366 if ( defined $last_displayed_page
367 and $last_displayed_page != $page_number - 1 )
370 "\n" . ' <span class="inactive">...</span>';
373 if ( $page_number == $current_page ) {
376 . '<span class="currentPage">'
385 . $page_number . '">'
386 . $page_number . '</a>';
388 $last_displayed_page = $page_number;
393 if ( $current_page < $nb_pages ) {
394 my $next = $current_page + 1;
396 $pagination_bar .= "\n"
400 . '" rel="next">' . '>' . '</a>';
404 "\n" . ' <span class="inactive">></span>';
408 if ( $current_page != $nb_pages ) {
409 $pagination_bar .= "\n"
414 . '>>' . '</a>';
418 "\n" . ' <span class="inactive">>></span>';
422 return $pagination_bar;
425 =item output_with_http_headers
427 &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
429 Outputs $data with the appropriate HTTP headers,
430 the authentication cookie $cookie and a Content-Type specified in
433 If applicable, $cookie can be undef, and it will not be sent.
435 $content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
437 $status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
441 sub output_with_http_headers
($$$$;$) {
442 my ( $query, $cookie, $data, $content_type, $status ) = @_;
443 $status ||= '200 OK';
445 my %content_type_map = (
446 'html' => 'text/html',
447 'js' => 'text/javascript',
448 'json' => 'application/json',
450 # NOTE: not using application/atom+xml or application/rss+xml because of
451 # Internet Explorer 6; see bug 2078.
456 die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
458 type
=> $content_type_map{$content_type},
461 Pragma
=> 'no-cache',
462 'Cache-Control' => 'no-cache',
464 $options->{cookie
} = $cookie if $cookie;
465 if ($content_type eq 'html') { # guaranteed to be one of the content_type_map keys, else we'd have died
466 $options->{'Content-Style-Type' } = 'text/css';
467 $options->{'Content-Script-Type'} = 'text/javascript';
469 # remove SUDOC specific NSB NSE
470 $data =~ s/\x{C2}\x{98}|\x{C2}\x{9C}/ /g;
471 $data =~ s/\x{C2}\x{88}|\x{C2}\x{89}/ /g;
472 print $query->header($options), $data;
475 sub output_html_with_http_headers
($$$;$) {
476 my ( $query, $cookie, $data, $status ) = @_;
477 $data =~ s/\&\;amp\; /\&\; /;
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 Developement team <info@koha.org>