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
26 # NOTE: I'm pretty sure this module is deprecated in favor of
33 use HTML::Template::Pro;
35 use vars qw($VERSION @ISA @EXPORT);
37 # set the version for version checking
38 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
42 C4::Output - Functions for managing templates
52 &themelanguage &gettemplate setlanguagecookie pagination_bar
59 &output_html_with_http_headers
63 #FIXME: this is a quick fix to stop rc1 installing broken
64 #Still trying to figure out the correct fix.
65 my $path = C4::Context->config('intrahtdocs') . "/default/en/includes/";
67 #---------------------------------------------------------------------------------------------------------
70 my ( $tmplbase, $opac, $query ) = @_;
72 warn "no query in gettemplate";
75 if ( $opac ne "intranet" ) {
76 $htdocs = C4::Context->config('opachtdocs');
79 $htdocs = C4::Context->config('intrahtdocs');
81 my $path = C4::Context->preference('intranet_includes') || 'includes';
83 # warn "PATH : $path";
84 my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $opac, $query );
85 my $opacstylesheet = C4::Context->preference('opacstylesheet');
86 my $template = HTML::Template::Pro->new(
87 filename => "$htdocs/$theme/$lang/$tmplbase",
88 die_on_bad_params => 1,
91 path => ["$htdocs/$theme/$lang/$path"]
95 themelang => ( $opac ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
97 interface => ( $opac ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
99 opacstylesheet => $opacstylesheet,
100 opaccolorstylesheet => C4::Context->preference('opaccolorstylesheet'),
101 opacsmallimage => C4::Context->preference('opacsmallimage'),
108 #---------------------------------------------------------------------------------------------------------
111 my ( $htdocs, $tmpl, $section, $query ) = @_;
116 my $dbh = C4::Context->dbh;
119 if ( $section eq "intranet" ) {
120 @languages = split " ", C4::Context->preference("opaclanguages");
121 @themes = split " ", C4::Context->preference("template");
125 # we are in the opac here, what im trying to do is let the individual user
126 # set the theme they want to use.
127 # and perhaps the them as well.
128 my $lang = $query->cookie('KohaOpacLanguage');
131 push @languages, $lang;
132 @themes = split " ", C4::Context->preference("opacthemes");
135 @languages = split " ", C4::Context->preference("opaclanguages");
136 @themes = split " ", C4::Context->preference("opacthemes");
140 my ( $theme, $lang );
142 # searches through the themes and languages. First template it find it returns.
143 # Priority is for getting the theme right.
145 foreach my $th (@themes) {
146 foreach my $la (@languages) {
147 for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
148 $la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
149 if ( -e "$htdocs/$th/$la/$tmpl" ) {
154 last unless $la =~ /[-_]/;
158 if ( $theme and $lang ) {
159 return ( $theme, $lang );
162 return ( 'prog', 'en' );
166 sub setlanguagecookie {
167 my ( $query, $language, $uri ) = @_;
168 my $cookie = $query->cookie(
169 -name => 'KohaOpacLanguage',
173 print $query->redirect(
181 pagination_bar($base_url, $nb_pages, $current_page, $startfrom_name)
183 Build an HTML pagination bar based on the number of page to display, the
184 current page and the url to give to each page link.
186 C<$base_url> is the URL for each page link. The
187 C<$startfrom_name>=page_number is added at the end of the each URL.
189 C<$nb_pages> is the total number of pages available.
191 C<$current_page> is the current page number. This page number won't become a
194 This function returns HTML, without any language dependency.
199 my ( $base_url, $nb_pages, $current_page, $startfrom_name ) = @_;
201 # how many pages to show before and after the current page?
202 my $pages_around = 2;
205 $base_url . ( $base_url =~ m/&/ ? '&' : '?' ) . $startfrom_name . '=';
207 my $pagination_bar = '';
209 # current page detection
210 if ( not defined $current_page ) {
214 # navigation bar useful only if more than one page to display !
215 if ( $nb_pages > 1 ) {
217 # link to first page?
218 if ( $current_page > 1 ) {
224 . '<<' . '</a>';
228 "\n" . ' <span class="inactive"><<</span>';
231 # link on previous page ?
232 if ( $current_page > 1 ) {
233 my $previous = $current_page - 1;
240 . '" rel="prev">' . '<' . '</a>';
244 "\n" . ' <span class="inactive"><</span>';
247 my $min_to_display = $current_page - $pages_around;
248 my $max_to_display = $current_page + $pages_around;
249 my $last_displayed_page = undef;
251 for my $page_number ( 1 .. $nb_pages ) {
254 or $page_number == $nb_pages
255 or ( $page_number >= $min_to_display
256 and $page_number <= $max_to_display )
259 if ( defined $last_displayed_page
260 and $last_displayed_page != $page_number - 1 )
263 "\n" . ' <span class="inactive">...</span>';
266 if ( $page_number == $current_page ) {
269 . '<span class="currentPage">'
278 . $page_number . '">'
279 . $page_number . '</a>';
281 $last_displayed_page = $page_number;
286 if ( $current_page < $nb_pages ) {
287 my $next = $current_page + 1;
289 $pagination_bar .= "\n"
293 . '" rel="next">' . '>' . '</a>';
297 "\n" . ' <span class="inactive">></span>';
301 if ( $current_page != $nb_pages ) {
302 $pagination_bar .= "\n"
307 . '>>' . '</a>';
311 "\n" . ' <span class="inactive">>></span>';
315 return $pagination_bar;
321 &guesscharset($output)
323 "Guesses" the charset from the some HTML that would be output.
325 C<$output> is the HTML page to be output. If it contains a META tag
326 with a Content-Type, the tag will be scanned for a language code.
327 This code is returned if it is found; undef is returned otherwise.
329 This function only does sloppy guessing; it will be confused by
330 unexpected things like SGML comments. What it basically does is to
331 grab something that looks like a META tag and scan it.
335 sub guesscharset ($) {
338 local($`, $&, $', $1, $2, $3);
339 # FIXME... These regular expressions will miss a lot of valid tags!
340 if ($html =~ /<meta\s+http-equiv=(["']?)Content-Type\1\s+content=(["'])text\/html\s*;\s*charset=([^\2\s\r\n]+)\2\s*(?:\/?)>/is) {
342 } elsif ($html =~ /<meta\s+content=(["'])text\/html\s*;\s*charset=([^\1\s\r\n]+)\1\s+http-equiv=(["']?)Content-Type\3\s*(?:\/?)>/is) {
350 my $charset = guesscharset($html);
351 return defined $charset? "text/html; charset=$charset": "text/html";
354 =item output_html_with_http_headers
356 &output_html_with_http_headers($query, $cookie, $html)
358 Outputs the HTML page $html with the appropriate HTTP headers,
359 with the authentication cookie $cookie and a Content-Type that
360 corresponds to the HTML page $html.
364 sub output_html_with_http_headers ($$$) {
365 my($query, $cookie, $html) = @_;
366 print $query->header(
367 -type => guesstype($html),
372 END { } # module clean-up code here (global destructor)
381 Koha Developement team <info@koha.org>