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
8 # Copyright 2000-2002 Katipo Communications
10 # This file is part of Koha.
12 # Koha is free software; you can redistribute it and/or modify it under the
13 # terms of the GNU General Public License as published by the Free Software
14 # Foundation; either version 2 of the License, or (at your option) any later
17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
19 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
21 # You should have received a copy of the GNU General Public License along with
22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
23 # Suite 330, Boston, MA 02111-1307 USA
29 use C4::Search; #for getting the systempreferences
31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 # set the version for version checking
38 C4::Output - Functions for generating HTML for the Koha web interface
44 $str = &mklink("http://www.koha.org/", "Koha web page");
49 The functions in this module generate HTML, and return the result as a
59 @EXPORT = qw(&startpage &endpage
60 &mktablehdr &mktableft &mktablerow &mklink
61 &startmenu &endmenu &mkheadr
63 &mkform &mkform2 &bold
64 &gotopage &mkformnotable &mkform3
65 &getkeytableselectoptions
68 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
70 # your exported package globals go here,
71 # as well as any optionally exported functions
73 @EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
76 # non-exported package globals go here
77 use vars qw(@more $stuff); # FIXME - These are never used
79 # initalize package globals, first exported ones
81 # FIXME - These are never used
86 # then the others (which are still accessible as $Some::Module::stuff)
87 # FIXME - These are never used
91 # all file-scoped lexicals must be created before
92 # the functions below that use them.
95 # Change this value to reflect where you will store your includes
97 # FIXME - Since this is used in several places, it ought to be put
98 # into a separate file. Better yet, put "use C4::Config;" inside the
99 # &import method of any package that requires the config file.
101 open (KC, "/etc/koha.conf");
105 if (/(.*)\s*=\s*(.*)/) {
109 $variable =~ s/^\s*//g;
110 $variable =~ s/\s*$//g;
113 $configfile{$variable}=$value;
118 my $path=$configfile{'includes'};
119 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
121 # make all your functions, whether exported or not;
125 $template = &picktemplate($includes, $base);
127 Returns the preferred template for a given page. C<$base> is the
128 basename of the script that will generate the page (with the C<.pl>
129 extension stripped off), and C<$includes> is the directory in which
130 HTML include files are located.
132 The preferred template is given by the C<template> entry in the
133 C<systempreferences> table in the Koha database. If
134 C<$includes>F</templates/preferred-template/>C<$base.tmpl> exists,
135 C<&picktemplate> returns the preferred template; otherwise, it returns
136 the string C<default>.
141 my ($includes, $base) = @_;
144 # FIXME - Instead of generating the list of possible templates, and
145 # then querying the database to see if, by chance, one of them has
146 # been selected, wouldn't it be better to query the database first,
147 # and then see whether the selected template file exists?
148 opendir (D, "$includes/templates");
149 my @dirlist=readdir D;
152 #(next) unless (/\.tmpl$/);
153 (next) unless (-e "$includes/templates/$_/$base");
156 my $sth=$dbh->prepare("select value from systempreferences where
157 variable='template'");
159 my ($preftemplate) = $sth->fetchrow;
162 if ($templates->{$preftemplate}) {
163 return $preftemplate;
172 my $template = $params{'template'};
173 my $themeor = $params{'theme'};
174 my $languageor = lc($params{'language'});
175 my $ptype = lc($params{'type'} or 'intranet');
178 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
179 elsif ($ptype eq 'none') {$type = ''; }
180 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
181 else {$type = $ptype . '/'; }
184 my %prefs= systemprefs();
185 my $theme= $prefs{'theme'} || 'default';
186 if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
187 my @languageorder = getlanguageorder();
188 my $language = $languageor || shift(@languageorder);
190 #where to search for templates
191 my @tmpldirs = ("$path/templates", $path);
192 unshift (@tmpldirs, $configfile{'templatedirectory'}) if $configfile{'templatedirectory'};
193 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
195 my ($edir, $etheme, $elanguage, $epath);
197 CHECK: foreach (@tmpldirs) {
199 foreach ($theme, 'all', 'default') {
201 foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
203 if (-e "$edir/$type$etheme/$elanguage/$template") {
204 $epath = "$edir/$type$etheme/$elanguage/$template";
212 warn "Could not find $template in @tmpldirs";
216 if ($language eq $elanguage) {
217 $returns{'foundlanguage'} = 1;
219 $returns{'foundlanguage'} = 0;
220 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
222 if ($theme eq $etheme) {
223 $returns{'foundtheme'} = 1;
225 $returns{'foundtheme'} = 0;
226 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
229 $returns{'path'} = $epath;
234 sub getlanguageorder () {
236 my %prefs = systemprefs();
238 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
239 @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
240 } elsif ($prefs{'languageorder'}) {
241 @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
242 } else { # here should be another elsif checking for apache's languageorder
243 @languageorder = ('en');
246 return (@languageorder);
255 my ($target) = shift;
256 #print "<br>goto target = $target<br>";
257 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
263 # edit the paths in here
265 if ($type eq 'issue') {
266 open (FILE,"$path/issues-top.inc") || die;
267 } elsif ($type eq 'opac') {
268 open (FILE,"$path/opac-top.inc") || die;
269 } elsif ($type eq 'member') {
270 open (FILE,"$path/members-top.inc") || die;
271 } elsif ($type eq 'acquisitions'){
272 open (FILE,"$path/acquisitions-top.inc") || die;
273 } elsif ($type eq 'report'){
274 open (FILE,"$path/reports-top.inc") || die;
275 } elsif ($type eq 'circulation') {
276 open (FILE,"$path/circulation-top.inc") || die;
278 open (FILE,"$path/cat-top.inc") || die;
283 # $string[$count]="<BLOCKQUOTE>";
289 @lines = &endmenu($type);
290 print join("", @lines);
292 Given a page type, or category, returns a set of lines of HTML which,
293 when concatenated, generate the menu at the bottom of the web page.
295 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
296 C<report>, C<circulation>, or something else, in which case the menu
297 will be for the catalog pages.
303 if ( ! defined $type ) { $type=''; }
304 # FIXME - It's bad form to die in a CGI script. It's even worse form
305 # to die without issuing an error message.
306 if ($type eq 'issue') {
307 open (FILE,"$path/issues-bottom.inc") || die;
308 } elsif ($type eq 'opac') {
309 open (FILE,"$path/opac-bottom.inc") || die;
310 } elsif ($type eq 'member') {
311 open (FILE,"$path/members-bottom.inc") || die;
312 } elsif ($type eq 'acquisitions') {
313 open (FILE,"$path/acquisitions-bottom.inc") || die;
314 } elsif ($type eq 'report') {
315 open (FILE,"$path/reports-bottom.inc") || die;
316 } elsif ($type eq 'circulation') {
317 open (FILE,"$path/circulation-bottom.inc") || die;
319 open (FILE,"$path/cat-bottom.inc") || die;
327 return("<table border=0 cellspacing=0 cellpadding=5>\n");
332 #the last item in data may be a backgroundimage
335 # should this be a foreach (1..$cols) loop?
337 my ($cols,$colour,@data)=@_;
339 my $string="<tr valign=top bgcolor=$colour>";
341 if (defined $data[$cols]) { # if there is a background image
342 $string.="<td background=\"$data[$cols]\">";
343 } else { # if there's no background image
346 if (! defined $data[$i]) {$data[$i]="";}
347 if ($data[$i] eq "") {
348 $string.=" </td>";
350 $string.="$data[$i]</td>";
354 $string=$string."</tr>\n";
359 return("</table>\n");
363 my ($action,%inputs)=@_;
364 my $string="<form action=$action method=post>\n";
365 $string=$string.mktablehdr();
367 my @keys=sort keys %inputs;
371 while ( $i2<$count) {
372 my $value=$inputs{$keys[$i2]};
373 my @data=split('\t',$value);
374 #my $posn = shift(@data);
375 if ($data[0] eq 'hidden'){
376 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
379 if ($data[0] eq 'radio') {
380 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
381 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
383 if ($data[0] eq 'text') {
384 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
386 if ($data[0] eq 'textarea') {
387 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
389 if ($data[0] eq 'select') {
390 $text="<select name=$keys[$i2]>";
392 while ($data[$i] ne "") {
393 my $val = $data[$i+1];
394 $text = $text."<option value=$data[$i]>$val";
397 $text=$text."</select>";
399 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
400 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
404 #$string=$string.join("\n",@order);
405 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
406 $string=$string.mktableft;
407 $string=$string."</form>";
411 my ($action, %inputs) = @_;
412 my $string = "<form action=\"$action\" method=\"post\">\n";
413 $string .= mktablehdr();
415 my @keys = sort(keys(%inputs));
419 while ($i2 < $count) {
420 my $value=$inputs{$keys[$i2]};
421 my @data=split('\t',$value);
423 if ($data[0] eq 'hidden'){
424 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
427 if ($data[0] eq 'radio') {
428 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
429 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
431 # FIXME - Is 40 the right size in all cases?
432 if ($data[0] eq 'text') {
433 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
435 # FIXME - Is 40x4 the right size in all cases?
436 if ($data[0] eq 'textarea') {
437 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
439 if ($data[0] eq 'select') {
440 $text="<select name=$keys[$i2]>";
442 while ($data[$i] ne "") {
443 my $val = $data[$i+1];
444 $text = $text."<option value=$data[$i]>$val";
445 $i = $i+2; # FIXME - Use $i += 2.
447 $text=$text."</select>";
449 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
450 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
454 my $temp=join("\n",@order);
455 # FIXME - Use ".=". That's what it's for.
456 $string=$string.$temp;
457 $string=$string.mktablerow(1,'white','<input type=submit>');
458 $string=$string.mktableft;
459 $string=$string."</form>";
460 # FIXME - A return statement, while not strictly necessary, would be nice.
465 my ($action,@inputs)=@_;
466 my $string="<form action=$action method=post>\n";
468 for (my $i=0; $i<$count; $i++){
469 if ($inputs[$i][0] eq 'hidden'){
470 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
472 if ($inputs[$i][0] eq 'radio') {
473 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
475 if ($inputs[$i][0] eq 'text') {
476 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
478 if ($inputs[$i][0] eq 'textarea') {
479 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
481 if ($inputs[$i][0] eq 'reset'){
482 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
484 if ($inputs[$i][0] eq 'submit'){
485 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
488 $string=$string."</form>";
493 $str = &mkform2($action,
494 $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
499 Takes a set of arguments that define an input form, generates an HTML
500 string for the form, and returns the string.
502 C<$action> is the action for the form, usually the URL of the script
503 that will process it.
505 The remaining arguments define the fields in the form. C<$fieldname>
506 is the field's name. This is for the script's benefit, and will not be
509 C<$fieldpos> is an integer; fields will be output in order of
510 increasing C<$fieldpos>. This number must be unique: if two fields
511 have the same C<$fieldpos>, one will be picked at random, and the
512 other will be ignored. See below for special considerations, however.
514 If C<$required> is the string C<R>, then the field is required, and
515 the label will have C< (Req.)> appended.
517 C<$label> is a string that will appear next to the input field.
519 C<$fieldtype> specifies the type of the input field. It may be one of
526 Generates a hidden field, used to pass data to the script without
527 showing it to the user. C<$value0> is its value.
531 Generates a pair of radio buttons, with values C<$value0> and
532 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
533 the user, next to the radio button.
537 Generates a one-line text input field. Its size may be specified by
538 C<$value0>. The default is 40. The initial text of the field may be
539 specified by C<$value1>.
543 Generates a text input area. C<$value0> may be a string of the form
544 "WWWxHHH", in which case the text input area will be WWW columns wide
545 and HHH rows tall. The size defaults to 40x4.
547 The initial text (which, of course, may not contain any tabs) may be
548 specified by C<$value1>.
552 Generates a list of items, from which the user may choose one. Here,
553 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
554 pair, the key specifies an internal label for a choice, and the value
555 specifies the description of the choice that will be shown the user.
557 If C<$value0> is the same as one of the keys that follows, then the
558 corresponding choice will initially be selected.
566 # no POD and no tests yet. Once tests are written,
567 # this function can be cleaned up with the following steps:
568 # turn the while loop into a foreach loop
569 # pull the nested if,elsif structure back up to the main level
570 # pull the code for the different kinds of inputs into separate
572 my ($action,%inputs)=@_;
573 my $string="<form action=$action method=post>\n";
574 $string=$string.mktablehdr();
577 while ( my ($key, $value) = each %inputs) {
578 my @data=split('\t',$value);
579 my $posn = shift(@data);
580 my $reqd = shift(@data);
581 my $ltext = shift(@data);
582 if ($data[0] eq 'hidden'){
583 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
586 if ($data[0] eq 'radio') {
587 $text="<input type=radio name=$key value=$data[1]>$data[1]
588 <input type=radio name=$key value=$data[2]>$data[2]";
589 } elsif ($data[0] eq 'text') {
594 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
595 } elsif ($data[0] eq 'textarea') {
596 my @size=split("x",$data[1]);
597 if ($data[1] eq "") {
601 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
602 } elsif ($data[0] eq 'select') {
603 $text="<select name=$key>";
606 while ($data[$i] ne "") {
607 my $val = $data[$i+1];
608 $text = $text."<option value=\"$data[$i]\"";
609 if ($data[$i] eq $sel) {
610 $text = $text." selected";
612 $text = $text.">$val";
615 $text=$text."</select>";
618 $ltext = $ltext." (Req)";
620 $order[$posn] =mktablerow(2,'white',$ltext,$text);
623 $string=$string.join("\n",@order);
624 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
625 $string=$string.mktableft;
626 $string=$string."</form>";
633 &endpage does not expect any arguments, it returns the string:
639 return("</body></html>\n");
646 &mklink expects two arguments, the url to link to and the text of the link.
647 It returns this string:
648 <a href="$url">$text</a>
649 where $url is the first argument and $text is the second.
655 my $string="<a href=\"$url\">$text</a>";
663 &mkeadr expects two strings, a type and the text to use in the header.
668 =item 1 ends with <br>
670 =item 2 no special ending tag
672 =item 3 ends with <p>
676 Other than this, the return value is the same:
677 <FONT SIZE=6><em>$text</em></FONT>$string
678 Where $test is the text passed in and $string is the tag generated from
685 # would it be better to make this more generic by accepting an optional
686 # argument with a closing tag instead of a numeric type?
691 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
694 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
697 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
704 =head2 ¢er and &endcenter
706 ¢er and &endcenter take no arguments and return html tags <CENTER> and
707 </CENTER> respectivley.
712 return ("<CENTER>\n");
716 return ("</CENTER>\n");
723 &bold requires that a single string be passed in by the caller. &bold
724 will return "<b>$text</b>" where $text is the string passed in.
730 return("<b>$text</b>");
733 #---------------------------------------------
734 # Create an HTML option list for a <SELECT> form tag by using
735 # values from a DB file
736 sub getkeytableselectoptions {
741 $tablename, # name of table containing list of choices
742 $keyfieldname, # column name of code to use in option list
743 $descfieldname, # column name of descriptive field
744 $showkey, # flag to show key in description
745 $default, # optional default key
747 my $selectclause; # return value
751 $key, $desc, $orderfieldname,
755 requireDBI($dbh,"getkeytableselectoptions");
758 $orderfieldname=$keyfieldname;
760 $orderfieldname=$descfieldname;
762 $query= "select $keyfieldname,$descfieldname
764 order by $orderfieldname ";
765 print "<PRE>Query=$query </PRE>\n" if $debug;
766 $sth=$dbh->prepare($query);
768 while ( ($key, $desc) = $sth->fetchrow) {
769 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
770 $selectclause.="<option";
771 if (defined $default && $default eq $key) {
772 $selectclause.=" selected";
774 $selectclause.=" value='$key'>$desc\n";
775 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
777 return $selectclause;
778 } # sub getkeytableselectoptions
780 #---------------------------------
782 END { } # module clean-up code here (global destructor)