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
67 &themelanguage &gettemplate
69 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
71 # your exported package globals go here,
72 # as well as any optionally exported functions
74 @EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
77 # non-exported package globals go here
78 use vars qw(@more $stuff); # FIXME - These are never used
80 # initalize package globals, first exported ones
82 # FIXME - These are never used
87 # then the others (which are still accessible as $Some::Module::stuff)
88 # FIXME - These are never used
92 # all file-scoped lexicals must be created before
93 # the functions below that use them.
96 # Change this value to reflect where you will store your includes
98 # FIXME - Since this is used in several places, it ought to be put
99 # into a separate file. Better yet, put "use C4::Config;" inside the
100 # &import method of any package that requires the config file.
102 my $configfile=configfile();
104 my $path=$configfile->{'includes'};
105 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
107 #---------------------------------------------------------------------------------------------------------
109 my ($tmplbase, $opac) = @_;
113 $htdocs = $configfile->{'opachtdocs'};
115 $htdocs = $configfile->{'intrahtdocs'};
118 my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
120 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
121 die_on_bad_params => 0,
123 path => ["$htdocs/$theme/$lang/includes"]);
125 $template->param(themelang => "/$theme/$lang");
129 #---------------------------------------------------------------------------------------------------------
131 my ($htdocs, $tmpl) = @_;
133 # language preferences....
135 my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opaclanguages'");
137 my ($lang) = $sth->fetchrow;
139 my @languages = split " ", $lang;
141 # theme preferences....
142 my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opacthemes'");
144 my ($theme) = $sth->fetchrow;
146 my @themes = split " ", $theme;
151 # searches through the themes and languages. First template it find it returns.
152 # Priority is for getting the theme right.
154 foreach my $th (@themes) {
155 foreach my $la (@languages) {
156 warn "File = $htdocs/$th/$la/$tmpl\n";
157 if (-e "$htdocs/$th/$la/$tmpl") {
164 if ($theme and $lang) {
165 return ($theme, $lang);
167 return ('default', 'en');
174 %values = &pathtotemplate(template => $template,
176 language => $language,
178 path => $includedir);
180 Finds a directory containing the desired template. The C<template>
181 argument specifies the template you're looking for (this should be the
182 name of the script you're using to generate an HTML page, without the
183 C<.pl> extension). Only the C<template> argument is required; the
186 C<theme> specifies the name of the theme to use. This will be used
187 only if it is allowed by the C<allowthemeoverride> system preference
188 option (in the C<systempreferences> table of the Koha database).
190 C<language> specifies the desired language. If not specified,
191 C<&pathtotemplate> will use the list of acceptable languages specified
192 by the browser, then C<all>, and finally C<en> as fallback options.
194 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
195 C<intranet> and C<opac> specify that you want a template for the
196 internal web site or the public OPAC, respectively. C<none> specifies
197 that the template you're looking for is at the top level of one of the
198 include directories. Any other value is taken as-is, as a subdirectory
199 of one of the include directories.
201 C<path> specifies an include directory.
203 C<&pathtotemplate> searches first in the directory given by the
204 C<path> argument, if any, then in the directories given by the
205 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
208 C<&pathtotemplate> returns a hash with the following keys:
214 The full pathname to the desired template.
216 =item C<foundlanguage>
218 The value is set to 1 if a template in the desired language was found,
223 The value is set to 1 if a template of the desired theme was found, or
228 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
230 Note that if a template of the desired language or theme cannot be
231 found, C<&pathtotemplate> will print a warning message. Unless you've
232 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
239 my $template = $params{'template'};
240 my $themeor = $params{'theme'};
241 my $languageor = lc($params{'language'});
242 my $ptype = lc($params{'type'} or 'intranet');
244 # FIXME - Make sure $params{'template'} was given. Or else assume
247 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
248 elsif ($ptype eq 'none') {$type = ''; }
249 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
250 else {$type = $ptype . '/'; }
253 my %prefs= systemprefs();
254 my $theme= $prefs{'theme'} || 'default';
255 if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
256 my @languageorder = getlanguageorder();
257 my $language = $languageor || shift(@languageorder);
259 #where to search for templates
260 my @tmpldirs = ("$path/templates", $path);
261 unshift (@tmpldirs, $configfile->{'templatedirectory'}) if $configfile->{'templatedirectory'};
262 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
264 my ($edir, $etheme, $elanguage, $epath);
266 # FIXME - Use 'foreach my $var (...)'
267 CHECK: foreach (@tmpldirs) {
269 foreach ($theme, 'all', 'default') {
271 foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
273 if (-e "$edir/$type$etheme/$elanguage/$template") {
274 $epath = "$edir/$type$etheme/$elanguage/$template";
282 warn "Could not find $template in @tmpldirs";
286 if ($language eq $elanguage) {
287 $returns{'foundlanguage'} = 1;
289 $returns{'foundlanguage'} = 0;
290 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
292 if ($theme eq $etheme) {
293 $returns{'foundtheme'} = 1;
295 $returns{'foundtheme'} = 0;
296 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
299 $returns{'path'} = $epath;
304 =item getlanguageorder
306 @languages = &getlanguageorder();
308 Returns the list of languages that the user will accept, and returns
309 them in order of decreasing preference. This is retrieved from the
310 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
311 the C<languageorder> setting from the C<systempreferences> table in
312 the Koha database. If neither is set, it defaults to C<en> (English).
316 sub getlanguageorder () {
318 my %prefs = systemprefs();
320 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
321 @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
322 } elsif ($prefs{'languageorder'}) {
323 @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
324 } else { # here should be another elsif checking for apache's languageorder
325 @languageorder = ('en');
328 return (@languageorder);
336 Returns a string of HTML, the beginning of a new HTML document.
346 $str = &gotopage("//opac.koha.org/index.html");
349 Generates a snippet of HTML code that will redirect to the given URL
350 (which should not include the initial C<http:>), and returns it.
355 my ($target) = shift;
356 #print "<br>goto target = $target<br>";
357 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
363 @lines = &startmenu($type);
364 print join("", @lines);
366 Given a page type, or category, returns a set of lines of HTML which,
367 when concatenated, generate the menu at the top of the web page.
369 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
370 C<report>, C<circulation>, or something else, in which case the menu
371 will be for the catalog pages.
376 # edit the paths in here
378 if ($type eq 'issue') {
379 open (FILE,"$path/issues-top.inc") || die;
380 } elsif ($type eq 'opac') {
381 open (FILE,"$path/opac-top.inc") || die;
382 } elsif ($type eq 'member') {
383 open (FILE,"$path/members-top.inc") || die;
384 } elsif ($type eq 'acquisitions'){
385 open (FILE,"$path/acquisitions-top.inc") || die;
386 } elsif ($type eq 'report'){
387 open (FILE,"$path/reports-top.inc") || die;
388 } elsif ($type eq 'circulation') {
389 open (FILE,"$path/circulation-top.inc") || die;
391 open (FILE,"$path/cat-top.inc") || die;
396 # $string[$count]="<BLOCKQUOTE>";
402 @lines = &endmenu($type);
403 print join("", @lines);
405 Given a page type, or category, returns a set of lines of HTML which,
406 when concatenated, generate the menu at the bottom of the web page.
408 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
409 C<report>, C<circulation>, or something else, in which case the menu
410 will be for the catalog pages.
416 if ( ! defined $type ) { $type=''; }
417 # FIXME - It's bad form to die in a CGI script. It's even worse form
418 # to die without issuing an error message.
419 if ($type eq 'issue') {
420 open (FILE,"$path/issues-bottom.inc") || die;
421 } elsif ($type eq 'opac') {
422 open (FILE,"$path/opac-bottom.inc") || die;
423 } elsif ($type eq 'member') {
424 open (FILE,"$path/members-bottom.inc") || die;
425 } elsif ($type eq 'acquisitions') {
426 open (FILE,"$path/acquisitions-bottom.inc") || die;
427 } elsif ($type eq 'report') {
428 open (FILE,"$path/reports-bottom.inc") || die;
429 } elsif ($type eq 'circulation') {
430 open (FILE,"$path/circulation-bottom.inc") || die;
432 open (FILE,"$path/cat-bottom.inc") || die;
441 $str = &mktablehdr();
444 Returns a string of HTML, which generates the beginning of a table
450 return("<table border=0 cellspacing=0 cellpadding=5>\n");
455 $str = &mktablerow($columns, $color, @column_data, $bgimage);
458 Returns a string of HTML, which generates a row of data inside a table
459 (see also C<&mktablehdr>, C<&mktableft>).
461 C<$columns> specifies the number of columns in this row of data.
463 C<$color> specifies the background color for the row, e.g., C<"white">
466 C<@column_data> is an array of C<$columns> elements, each one a string
467 of HTML. These are the contents of the row.
469 The optional C<$bgimage> argument specifies the pathname to an image
470 to use as the background for each cell in the row. This pathname will
471 used as is in the output, so it should be relative to the HTTP
477 #the last item in data may be a backgroundimage
480 # should this be a foreach (1..$cols) loop?
482 my ($cols,$colour,@data)=@_;
484 my $string="<tr valign=top bgcolor=$colour>";
486 if (defined $data[$cols]) { # if there is a background image
487 $string.="<td background=\"$data[$cols]\">";
488 } else { # if there's no background image
491 if (! defined $data[$i]) {$data[$i]="";}
492 if ($data[$i] eq "") {
493 $string.=" </td>";
495 $string.="$data[$i]</td>";
499 $string=$string."</tr>\n";
508 Returns a string of HTML, which generates the end of a table
514 return("</table>\n");
517 # FIXME - This is never used.
519 my ($action,%inputs)=@_;
520 my $string="<form action=$action method=post>\n";
521 $string=$string.mktablehdr();
523 my @keys=sort keys %inputs;
527 while ( $i2<$count) {
528 my $value=$inputs{$keys[$i2]};
529 my @data=split('\t',$value);
530 #my $posn = shift(@data);
531 if ($data[0] eq 'hidden'){
532 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
535 if ($data[0] eq 'radio') {
536 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
537 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
539 if ($data[0] eq 'text') {
540 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
542 if ($data[0] eq 'textarea') {
543 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
545 if ($data[0] eq 'select') {
546 $text="<select name=$keys[$i2]>";
548 while ($data[$i] ne "") {
549 my $val = $data[$i+1];
550 $text = $text."<option value=$data[$i]>$val";
553 $text=$text."</select>";
555 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
556 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
560 #$string=$string.join("\n",@order);
561 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
562 $string=$string.mktableft;
563 $string=$string."</form>";
568 $str = &mkform3($action,
569 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
574 Takes a set of arguments that define an input form, generates an HTML
575 string for the form, and returns the string.
577 C<$action> is the action for the form, usually the URL of the script
578 that will process it.
580 The remaining arguments define the fields in the form. C<$fieldname>
581 is the field's name. This is for the script's benefit, and will not be
584 C<$fieldpos> is an integer; fields will be output in order of
585 increasing C<$fieldpos>. This number must be unique: if two fields
586 have the same C<$fieldpos>, one will be picked at random, and the
587 other will be ignored. See below for special considerations, however.
589 C<$fieldtype> specifies the type of the input field. It may be one of
596 Generates a hidden field, used to pass data to the script without
597 showing it to the user. C<$fieldvalue> is the value.
601 Generates a pair of radio buttons, with values C<$fieldvalue> and
602 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
607 Generates a one-line text input field. It initially contains
612 Generates a four-line text input area. The initial text (which, of
613 course, may not contain any tabs) is C<$fieldvalue>.
617 Generates a list of items, from which the user may choose one. This is
618 somewhat different from other input field types, and should be
620 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
621 where the C<text>N strings are the choices that will be presented to
622 the user, and C<label>N are the labels that will be passed to the
625 However, C<text0> should be an integer, since it will be used to
626 determine the order in which this field appears in the form. If any of
627 the C<label>Ns are empty, the rest of the list will be ignored.
634 my ($action, %inputs) = @_;
635 my $string = "<form action=\"$action\" method=\"post\">\n";
636 $string .= mktablehdr();
638 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
643 while ($i2 < $count) {
644 my $value=$inputs{$keys[$i2]};
645 # FIXME - Why use a tab-separated string? Why not just use an
647 my @data=split('\t',$value);
649 if ($data[0] eq 'hidden'){
650 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
653 if ($data[0] eq 'radio') {
654 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
655 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
657 # FIXME - Is 40 the right size in all cases?
658 if ($data[0] eq 'text') {
659 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
661 # FIXME - Is 40x4 the right size in all cases?
662 if ($data[0] eq 'textarea') {
663 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
665 if ($data[0] eq 'select') {
666 $text="<select name=$keys[$i2]>";
668 while ($data[$i] ne "") {
669 my $val = $data[$i+1];
670 $text = $text."<option value=$data[$i]>$val";
671 $i = $i+2; # FIXME - Use $i += 2.
673 $text=$text."</select>";
675 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
676 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
680 my $temp=join("\n",@order);
681 # FIXME - Use ".=". That's what it's for.
682 $string=$string.$temp;
683 $string=$string.mktablerow(1,'white','<input type=submit>');
684 $string=$string.mktableft;
685 $string=$string."</form>";
686 # FIXME - A return statement, while not strictly necessary, would be nice.
691 $str = &mkformnotable($action, @inputs);
694 Takes a set of arguments that define an input form, generates an HTML
695 string for the form, and returns the string. Unlike C<&mkform2> and
696 C<&mkform3>, it does not put the form inside a table.
698 C<$action> is the action for the form, usually the URL of the script
699 that will process it.
701 The remaining arguments define the fields in the form. Each is an
702 anonymous array, e.g.:
704 &mkformnotable("/cgi-bin/foo",
705 [ "hidden", "hiddenvar", "value" ],
706 [ "text", "username", "" ]);
708 The first element of each argument defines its type. The remaining
709 ones are type-dependent. The supported types are:
713 =item C<[ "hidden", $name, $value]>
715 Generates a hidden field, for passing information to a script without
716 showing it to the user. C<$name> is the name of the field, and
717 C<$value> is the value to pass.
719 =item C<[ "radio", $groupname, $value ]>
721 Generates a radio button. Its name (or button group name) is C<$name>.
722 C<$value> is the value associated with the button; this is both the
723 value that will be shown to the user, and that which will be passed on
724 to the C<$action> script.
726 =item C<[ "text", $name, $inittext ]>
728 Generates a text input field. C<$name> specifies its name, and
729 C<$inittext> specifies the text that the field should initially
732 =item C<[ "textarea", $name ]>
734 Creates a 40x4 text area, named C<$name>.
736 =item C<[ "reset", $name, $label ]>
738 Generates a reset button, with name C<$name>. C<$label> specifies the
741 =item C<[ "submit", $name, $label ]>
743 Generates a submit button, with name C<$name>. C<$label> specifies the
751 my ($action,@inputs)=@_;
752 my $string="<form action=$action method=post>\n";
754 for (my $i=0; $i<$count; $i++){
755 if ($inputs[$i][0] eq 'hidden'){
756 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
758 if ($inputs[$i][0] eq 'radio') {
759 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
761 if ($inputs[$i][0] eq 'text') {
762 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
764 if ($inputs[$i][0] eq 'textarea') {
765 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
767 if ($inputs[$i][0] eq 'reset'){
768 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
770 if ($inputs[$i][0] eq 'submit'){
771 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
774 $string=$string."</form>";
779 $str = &mkform2($action,
780 $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
785 Takes a set of arguments that define an input form, generates an HTML
786 string for the form, and returns the string.
788 C<$action> is the action for the form, usually the URL of the script
789 that will process it.
791 The remaining arguments define the fields in the form. C<$fieldname>
792 is the field's name. This is for the script's benefit, and will not be
795 C<$fieldpos> is an integer; fields will be output in order of
796 increasing C<$fieldpos>. This number must be unique: if two fields
797 have the same C<$fieldpos>, one will be picked at random, and the
798 other will be ignored. See below for special considerations, however.
800 If C<$required> is the string C<R>, then the field is required, and
801 the label will have C< (Req.)> appended.
803 C<$label> is a string that will appear next to the input field.
805 C<$fieldtype> specifies the type of the input field. It may be one of
812 Generates a hidden field, used to pass data to the script without
813 showing it to the user. C<$value0> is its value.
817 Generates a pair of radio buttons, with values C<$value0> and
818 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
819 the user, next to the radio button.
823 Generates a one-line text input field. Its size may be specified by
824 C<$value0>. The default is 40. The initial text of the field may be
825 specified by C<$value1>.
829 Generates a text input area. C<$value0> may be a string of the form
830 "WWWxHHH", in which case the text input area will be WWW columns wide
831 and HHH rows tall. The size defaults to 40x4.
833 The initial text (which, of course, may not contain any tabs) may be
834 specified by C<$value1>.
838 Generates a list of items, from which the user may choose one. Here,
839 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
840 pair, the key specifies an internal label for a choice, and the value
841 specifies the description of the choice that will be shown the user.
843 If C<$value0> is the same as one of the keys that follows, then the
844 corresponding choice will initially be selected.
852 # no POD and no tests yet. Once tests are written,
853 # this function can be cleaned up with the following steps:
854 # turn the while loop into a foreach loop
855 # pull the nested if,elsif structure back up to the main level
856 # pull the code for the different kinds of inputs into separate
858 my ($action,%inputs)=@_;
859 my $string="<form action=$action method=post>\n";
860 $string=$string.mktablehdr();
863 while ( my ($key, $value) = each %inputs) {
864 my @data=split('\t',$value);
865 my $posn = shift(@data);
866 my $reqd = shift(@data);
867 my $ltext = shift(@data);
868 if ($data[0] eq 'hidden'){
869 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
872 if ($data[0] eq 'radio') {
873 $text="<input type=radio name=$key value=$data[1]>$data[1]
874 <input type=radio name=$key value=$data[2]>$data[2]";
875 } elsif ($data[0] eq 'text') {
880 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
881 } elsif ($data[0] eq 'textarea') {
882 my @size=split("x",$data[1]);
883 if ($data[1] eq "") {
887 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
888 } elsif ($data[0] eq 'select') {
889 $text="<select name=$key>";
892 while ($data[$i] ne "") {
893 my $val = $data[$i+1];
894 $text = $text."<option value=\"$data[$i]\"";
895 if ($data[$i] eq $sel) {
896 $text = $text." selected";
898 $text = $text.">$val";
901 $text=$text."</select>";
904 $ltext = $ltext." (Req)";
906 $order[$posn] =mktablerow(2,'white',$ltext,$text);
909 $string=$string.join("\n",@order);
910 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
911 $string=$string.mktableft;
912 $string=$string."</form>";
920 Returns a string of HTML, the end of an HTML document.
925 return("</body></html>\n");
930 $str = &mklink($url, $text);
933 Returns an HTML string, where C<$text> is a link to C<$url>.
939 my $string="<a href=\"$url\">$text</a>";
945 $str = &mkheadr($type, $text);
948 Takes a header type and header text, and returns a string of HTML,
949 where C<$text> is rendered with emphasis in a large font size (not an
952 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
953 Type 2 has no special tag at the end; Type 3 ends with a paragraph
960 # would it be better to make this more generic by accepting an optional
961 # argument with a closing tag instead of a numeric type?
966 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
969 $string="<FONT SIZE=6><em>$text</em></FONT>";
972 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
977 =item center and endcenter
979 print ¢er(), "This is a line of centered text.", &endcenter();
981 C<¢er> and C<&endcenter> take no arguments and return HTML tags
982 <CENTER> and </CENTER> respectively.
987 return ("<CENTER>\n");
991 return ("</CENTER>\n");
999 Returns a string of HTML that renders C<$text> in bold.
1005 return("<b>$text</b>");
1008 =item getkeytableselectoptions
1010 $str = &getkeytableselectoptions($dbh, $tablename,
1011 $keyfieldname, $descfieldname,
1012 $showkey, $default);
1015 Builds an HTML selection box from a database table. Returns a string
1016 of HTML that implements this.
1018 C<$dbh> is a DBI::db database handle.
1020 C<$tablename> is the database table in which to look up the possible
1021 values for the selection box.
1023 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1024 internal label for the selection.
1026 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1027 option shown to the user.
1029 If C<$showkey> is true, then both the key and value will be shown to
1032 If the C<$default> argument is given, then if a value (from
1033 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1037 #---------------------------------------------
1038 # Create an HTML option list for a <SELECT> form tag by using
1039 # values from a DB file
1040 sub getkeytableselectoptions {
1045 $tablename, # name of table containing list of choices
1046 $keyfieldname, # column name of code to use in option list
1047 $descfieldname, # column name of descriptive field
1048 $showkey, # flag to show key in description
1049 $default, # optional default key
1051 my $selectclause; # return value
1055 $key, $desc, $orderfieldname,
1059 requireDBI($dbh,"getkeytableselectoptions");
1062 $orderfieldname=$keyfieldname;
1064 $orderfieldname=$descfieldname;
1066 $query= "select $keyfieldname,$descfieldname
1068 order by $orderfieldname ";
1069 print "<PRE>Query=$query </PRE>\n" if $debug;
1070 $sth=$dbh->prepare($query);
1072 while ( ($key, $desc) = $sth->fetchrow) {
1073 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1074 $selectclause.="<option";
1075 if (defined $default && $default eq $key) {
1076 $selectclause.=" selected";
1078 $selectclause.=" value='$key'>$desc\n";
1079 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1081 return $selectclause;
1082 } # sub getkeytableselectoptions
1084 #---------------------------------
1086 END { } # module clean-up code here (global destructor)