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 with
21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
22 # Suite 330, Boston, MA 02111-1307 USA
25 # NOTE: I'm pretty sure this module is deprecated in favor of
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);
35 use HTML
::Template
::Pro
;
36 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
39 # set the version for version checking
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)]
50 &themelanguage &gettemplate setlanguagecookie getlanguagecookie pagination_bar
53 &output_html_with_http_headers &output_with_http_headers FormatData FormatNumber
59 C4::Output - Functions for managing templates
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/";
71 #---------------------------------------------------------------------------------------------------------
74 my ( $tmplbase, $interface, $query ) = @_;
75 ($query) or warn "no query in gettemplate";
77 if ( $interface ne "intranet" ) {
78 $htdocs = C4
::Context
->config('opachtdocs');
81 $htdocs = C4
::Context
->config('intrahtdocs');
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');
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) {
91 $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
93 my $template = HTML
::Template
::Pro
->new(
94 filename
=> $filename,
95 die_on_bad_params
=> 1,
98 loop_context_vars
=> 1, # enable: __first__, __last__, __inner__, __odd__, __counter__
99 path
=> ["$htdocs/$theme/$lang/$path"]
101 my $themelang=( $interface ne 'intranet' ?
'/opac-tmpl' : '/intranet-tmpl' )
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' ),
112 my $current_lang = regex_lang_subtags
($lang);
114 $bidi = get_bidi
($current_lang->{script
}) if $current_lang->{script
};
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
};
124 languages_loop
=> $languages_loop,
126 one_language_enabled
=> ($num_languages_enabled <= 1) ?
1 : 0, # deal with zero enabled langs as well
127 ) unless @
$languages_loop<2;
132 #---------------------------------------------------------------------------------------------------------
135 my ( $htdocs, $tmpl, $interface, $query ) = @_;
136 ($query) or warn "no query in themelanguage";
138 # Set some defaults for language and theme
139 # First, check the user's preferences
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
149 if ($interface eq 'intranet') {
150 @languages = split ",", C4
::Context
->preference("language");
152 @languages = split ",", C4
::Context
->preference("opaclanguages");
155 @languages=($lang,@languages);
157 $lang = $languages[0];
159 my $theme = 'prog'; # in the event of theme failure default to 'prog' -fbcit
160 my $dbh = C4
::Context
->dbh;
162 if ( $interface eq "intranet" ) {
163 @themes = split " ", C4
::Context
->preference("template");
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");
173 # searches through the themes and languages. First template it find it returns.
174 # Priority is for getting the theme right.
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" ) {
187 last unless $la =~ /[-_]/;
191 return ( $theme, $lang );
194 sub setlanguagecookie
{
195 my ( $query, $language, $uri ) = @_;
196 my $cookie = $query->cookie(
197 -name
=> 'KohaOpacLanguage',
201 print $query->redirect(
207 sub getlanguagecookie
{
210 if ($query->cookie('KohaOpacLanguage')){
211 $lang = $query->cookie('KohaOpacLanguage') ;
213 $lang = $ENV{HTTP_ACCEPT_LANGUAGE
};
216 $lang = substr($lang, 0, 2);
224 my $cur = GetCurrency
;
225 my $cur_format = C4
::Context
->preference("CurrencyFormat");
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' => ','
237 } else { # US by default..
238 $num = new Number
::Format
(
239 'int_curr_symbol' => '',
240 'mon_thousands_sep' => ',',
241 'mon_decimal_point' => '.'
249 FormatData($data_hashref)
250 C<$data_hashref> is a ref to data to format
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
257 my $data_hashref=shift;
258 $$data_hashref{$_} = format_date
( $$data_hashref{$_} ) for grep{/date/} keys (%$data_hashref);
263 pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
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.
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.
271 C<$nb_pages> is the total number of pages available.
273 C<$current_page> is the current page number. This page number won't become a
276 This function returns HTML, without any language dependency.
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';
286 # how many pages to show before and after the current page?
287 my $pages_around = 2;
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";
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
300 my $url = $base_url . (($base_url =~ m/$delim/ or $base_url =~ m/\?/) ?
'&' : '?' ) . $startfrom_name . '=';
301 my $pagination_bar = '';
303 # navigation bar useful only if more than one page to display !
304 if ( $nb_pages > 1 ) {
306 # link to first page?
307 if ( $current_page > 1 ) {
313 . '<<' . '</a>';
317 "\n" . ' <span class="inactive"><<</span>';
320 # link on previous page ?
321 if ( $current_page > 1 ) {
322 my $previous = $current_page - 1;
329 . '" rel="prev">' . '<' . '</a>';
333 "\n" . ' <span class="inactive"><</span>';
336 my $min_to_display = $current_page - $pages_around;
337 my $max_to_display = $current_page + $pages_around;
338 my $last_displayed_page = undef;
340 for my $page_number ( 1 .. $nb_pages ) {
343 or $page_number == $nb_pages
344 or ( $page_number >= $min_to_display
345 and $page_number <= $max_to_display )
348 if ( defined $last_displayed_page
349 and $last_displayed_page != $page_number - 1 )
352 "\n" . ' <span class="inactive">...</span>';
355 if ( $page_number == $current_page ) {
358 . '<span class="currentPage">'
367 . $page_number . '">'
368 . $page_number . '</a>';
370 $last_displayed_page = $page_number;
375 if ( $current_page < $nb_pages ) {
376 my $next = $current_page + 1;
378 $pagination_bar .= "\n"
382 . '" rel="next">' . '>' . '</a>';
386 "\n" . ' <span class="inactive">></span>';
390 if ( $current_page != $nb_pages ) {
391 $pagination_bar .= "\n"
396 . '>>' . '</a>';
400 "\n" . ' <span class="inactive">>></span>';
404 return $pagination_bar;
407 =item output_with_http_headers
409 &output_with_http_headers($query, $cookie, $data, $content_type[, $status])
411 Outputs $data with the appropriate HTTP headers,
412 the authentication cookie $cookie and a Content-Type specified in
415 If applicable, $cookie can be undef, and it will not be sent.
417 $content_type is one of the following: 'html', 'js', 'json', 'xml', 'rss', or 'atom'.
419 $status is an HTTP status message, like '403 Authentication Required'. It defaults to '200 OK'.
423 sub output_with_http_headers
($$$$;$) {
424 my ( $query, $cookie, $data, $content_type, $status ) = @_;
425 $status ||= '200 OK';
427 my %content_type_map = (
428 'html' => 'text/html',
429 'js' => 'text/javascript',
430 'json' => 'application/json',
432 # NOTE: not using application/atom+xml or application/rss+xml because of
433 # Internet Explorer 6; see bug 2078.
438 die "Unknown content type '$content_type'" if ( !defined( $content_type_map{$content_type} ) );
440 type
=> $content_type_map{$content_type},
443 Pragma
=> 'no-cache',
444 'Cache-Control' => 'no-cache',
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';
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;
457 sub output_html_with_http_headers
($$$) {
458 my ( $query, $cookie, $data ) = @_;
459 output_with_http_headers
( $query, $cookie, $data, 'html' );
463 my $x_req = $ENV{HTTP_X_REQUESTED_WITH
};
464 return ( $x_req and $x_req =~ /XMLHttpRequest/i ) ?
1 : 0;
467 END { } # module clean-up code here (global destructor)
476 Koha Developement team <info@koha.org>