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
30 use C4::Search; #for getting the systempreferences
32 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
34 # set the version for version checking
39 C4::Output - Functions for generating HTML for the Koha web interface
45 $str = &mklink("http://www.koha.org/", "Koha web page");
50 The functions in this module generate HTML, and return the result as a
60 @EXPORT = qw(&startpage &endpage
61 &mktablehdr &mktableft &mktablerow &mklink
62 &startmenu &endmenu &mkheadr
64 &mkform &mkform2 &bold
65 &gotopage &mkformnotable &mkform3
66 &getkeytableselectoptions
68 &themelanguage &gettemplate
70 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
72 # your exported package globals go here,
73 # as well as any optionally exported functions
75 @EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
78 # non-exported package globals go here
79 use vars qw(@more $stuff); # FIXME - These are never used
81 # initalize package globals, first exported ones
83 # FIXME - These are never used
88 # then the others (which are still accessible as $Some::Module::stuff)
89 # FIXME - These are never used
93 # all file-scoped lexicals must be created before
94 # the functions below that use them.
96 my $path = C4::Context->config('includes') ||
97 "/usr/local/www/hdl/htdocs/includes";
99 #---------------------------------------------------------------------------------------------------------
101 my ($tmplbase, $opac) = @_;
105 $htdocs = C4::Context->config('opachtdocs');
107 $htdocs = C4::Context->config('intrahtdocs');
110 my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
112 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
113 die_on_bad_params => 0,
115 path => ["$htdocs/$theme/$lang/includes"]);
117 $template->param(themelang => "/$theme/$lang");
121 #---------------------------------------------------------------------------------------------------------
123 my ($htdocs, $tmpl) = @_;
125 # language preferences....
127 my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opaclanguages'");
129 my ($lang) = $sth->fetchrow;
131 my @languages = split " ", $lang;
133 # theme preferences....
134 my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opacthemes'");
136 my ($theme) = $sth->fetchrow;
138 my @themes = split " ", $theme;
143 # searches through the themes and languages. First template it find it returns.
144 # Priority is for getting the theme right.
146 foreach my $th (@themes) {
147 foreach my $la (@languages) {
148 warn "File = $htdocs/$th/$la/$tmpl\n";
149 if (-e "$htdocs/$th/$la/$tmpl") {
156 if ($theme and $lang) {
157 return ($theme, $lang);
159 return ('default', 'en');
166 %values = &pathtotemplate(template => $template,
168 language => $language,
170 path => $includedir);
172 Finds a directory containing the desired template. The C<template>
173 argument specifies the template you're looking for (this should be the
174 name of the script you're using to generate an HTML page, without the
175 C<.pl> extension). Only the C<template> argument is required; the
178 C<theme> specifies the name of the theme to use. This will be used
179 only if it is allowed by the C<allowthemeoverride> system preference
180 option (in the C<systempreferences> table of the Koha database).
182 C<language> specifies the desired language. If not specified,
183 C<&pathtotemplate> will use the list of acceptable languages specified
184 by the browser, then C<all>, and finally C<en> as fallback options.
186 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
187 C<intranet> and C<opac> specify that you want a template for the
188 internal web site or the public OPAC, respectively. C<none> specifies
189 that the template you're looking for is at the top level of one of the
190 include directories. Any other value is taken as-is, as a subdirectory
191 of one of the include directories.
193 C<path> specifies an include directory.
195 C<&pathtotemplate> searches first in the directory given by the
196 C<path> argument, if any, then in the directories given by the
197 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
200 C<&pathtotemplate> returns a hash with the following keys:
206 The full pathname to the desired template.
208 =item C<foundlanguage>
210 The value is set to 1 if a template in the desired language was found,
215 The value is set to 1 if a template of the desired theme was found, or
220 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
222 Note that if a template of the desired language or theme cannot be
223 found, C<&pathtotemplate> will print a warning message. Unless you've
224 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
231 my $template = $params{'template'};
232 my $themeor = $params{'theme'};
233 my $languageor = lc($params{'language'});
234 my $ptype = lc($params{'type'} or 'intranet');
236 # FIXME - Make sure $params{'template'} was given. Or else assume
239 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
240 elsif ($ptype eq 'none') {$type = ''; }
241 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
242 else {$type = $ptype . '/'; }
245 my %prefs= systemprefs();
246 my $theme= $prefs{'theme'} || 'default';
247 if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
248 my @languageorder = getlanguageorder();
249 my $language = $languageor || shift(@languageorder);
251 #where to search for templates
252 my @tmpldirs = ("$path/templates", $path);
253 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
254 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
256 my ($edir, $etheme, $elanguage, $epath);
258 # FIXME - Use 'foreach my $var (...)'
259 CHECK: foreach (@tmpldirs) {
261 foreach ($theme, 'all', 'default') {
263 foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
265 if (-e "$edir/$type$etheme/$elanguage/$template") {
266 $epath = "$edir/$type$etheme/$elanguage/$template";
274 warn "Could not find $template in @tmpldirs";
278 if ($language eq $elanguage) {
279 $returns{'foundlanguage'} = 1;
281 $returns{'foundlanguage'} = 0;
282 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
284 if ($theme eq $etheme) {
285 $returns{'foundtheme'} = 1;
287 $returns{'foundtheme'} = 0;
288 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
291 $returns{'path'} = $epath;
296 =item getlanguageorder
298 @languages = &getlanguageorder();
300 Returns the list of languages that the user will accept, and returns
301 them in order of decreasing preference. This is retrieved from the
302 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
303 the C<languageorder> setting from the C<systempreferences> table in
304 the Koha database. If neither is set, it defaults to C<en> (English).
308 sub getlanguageorder () {
310 my %prefs = systemprefs();
312 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
313 @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
314 } elsif ($prefs{'languageorder'}) {
315 @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
316 } else { # here should be another elsif checking for apache's languageorder
317 @languageorder = ('en');
320 return (@languageorder);
328 Returns a string of HTML, the beginning of a new HTML document.
338 $str = &gotopage("//opac.koha.org/index.html");
341 Generates a snippet of HTML code that will redirect to the given URL
342 (which should not include the initial C<http:>), and returns it.
347 my ($target) = shift;
348 #print "<br>goto target = $target<br>";
349 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
355 @lines = &startmenu($type);
356 print join("", @lines);
358 Given a page type, or category, returns a set of lines of HTML which,
359 when concatenated, generate the menu at the top of the web page.
361 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
362 C<report>, C<circulation>, or something else, in which case the menu
363 will be for the catalog pages.
368 # edit the paths in here
370 if ($type eq 'issue') {
371 open (FILE,"$path/issues-top.inc") || die;
372 } elsif ($type eq 'opac') {
373 open (FILE,"$path/opac-top.inc") || die;
374 } elsif ($type eq 'member') {
375 open (FILE,"$path/members-top.inc") || die;
376 } elsif ($type eq 'acquisitions'){
377 open (FILE,"$path/acquisitions-top.inc") || die;
378 } elsif ($type eq 'report'){
379 open (FILE,"$path/reports-top.inc") || die;
380 } elsif ($type eq 'circulation') {
381 open (FILE,"$path/circulation-top.inc") || die;
383 open (FILE,"$path/cat-top.inc") || die;
388 # $string[$count]="<BLOCKQUOTE>";
394 @lines = &endmenu($type);
395 print join("", @lines);
397 Given a page type, or category, returns a set of lines of HTML which,
398 when concatenated, generate the menu at the bottom of the web page.
400 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
401 C<report>, C<circulation>, or something else, in which case the menu
402 will be for the catalog pages.
408 if ( ! defined $type ) { $type=''; }
409 # FIXME - It's bad form to die in a CGI script. It's even worse form
410 # to die without issuing an error message.
411 if ($type eq 'issue') {
412 open (FILE,"$path/issues-bottom.inc") || die;
413 } elsif ($type eq 'opac') {
414 open (FILE,"$path/opac-bottom.inc") || die;
415 } elsif ($type eq 'member') {
416 open (FILE,"$path/members-bottom.inc") || die;
417 } elsif ($type eq 'acquisitions') {
418 open (FILE,"$path/acquisitions-bottom.inc") || die;
419 } elsif ($type eq 'report') {
420 open (FILE,"$path/reports-bottom.inc") || die;
421 } elsif ($type eq 'circulation') {
422 open (FILE,"$path/circulation-bottom.inc") || die;
424 open (FILE,"$path/cat-bottom.inc") || die;
433 $str = &mktablehdr();
436 Returns a string of HTML, which generates the beginning of a table
442 return("<table border=0 cellspacing=0 cellpadding=5>\n");
447 $str = &mktablerow($columns, $color, @column_data, $bgimage);
450 Returns a string of HTML, which generates a row of data inside a table
451 (see also C<&mktablehdr>, C<&mktableft>).
453 C<$columns> specifies the number of columns in this row of data.
455 C<$color> specifies the background color for the row, e.g., C<"white">
458 C<@column_data> is an array of C<$columns> elements, each one a string
459 of HTML. These are the contents of the row.
461 The optional C<$bgimage> argument specifies the pathname to an image
462 to use as the background for each cell in the row. This pathname will
463 used as is in the output, so it should be relative to the HTTP
469 #the last item in data may be a backgroundimage
472 # should this be a foreach (1..$cols) loop?
474 my ($cols,$colour,@data)=@_;
476 my $string="<tr valign=top bgcolor=$colour>";
478 if (defined $data[$cols]) { # if there is a background image
479 $string.="<td background=\"$data[$cols]\">";
480 } else { # if there's no background image
483 if (! defined $data[$i]) {$data[$i]="";}
484 if ($data[$i] eq "") {
485 $string.=" </td>";
487 $string.="$data[$i]</td>";
491 $string=$string."</tr>\n";
500 Returns a string of HTML, which generates the end of a table
506 return("</table>\n");
509 # FIXME - This is never used.
511 my ($action,%inputs)=@_;
512 my $string="<form action=$action method=post>\n";
513 $string=$string.mktablehdr();
515 my @keys=sort keys %inputs;
519 while ( $i2<$count) {
520 my $value=$inputs{$keys[$i2]};
521 my @data=split('\t',$value);
522 #my $posn = shift(@data);
523 if ($data[0] eq 'hidden'){
524 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
527 if ($data[0] eq 'radio') {
528 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
529 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
531 if ($data[0] eq 'text') {
532 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
534 if ($data[0] eq 'textarea') {
535 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
537 if ($data[0] eq 'select') {
538 $text="<select name=$keys[$i2]>";
540 while ($data[$i] ne "") {
541 my $val = $data[$i+1];
542 $text = $text."<option value=$data[$i]>$val";
545 $text=$text."</select>";
547 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
548 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
552 #$string=$string.join("\n",@order);
553 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
554 $string=$string.mktableft;
555 $string=$string."</form>";
560 $str = &mkform3($action,
561 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
566 Takes a set of arguments that define an input form, generates an HTML
567 string for the form, and returns the string.
569 C<$action> is the action for the form, usually the URL of the script
570 that will process it.
572 The remaining arguments define the fields in the form. C<$fieldname>
573 is the field's name. This is for the script's benefit, and will not be
576 C<$fieldpos> is an integer; fields will be output in order of
577 increasing C<$fieldpos>. This number must be unique: if two fields
578 have the same C<$fieldpos>, one will be picked at random, and the
579 other will be ignored. See below for special considerations, however.
581 C<$fieldtype> specifies the type of the input field. It may be one of
588 Generates a hidden field, used to pass data to the script without
589 showing it to the user. C<$fieldvalue> is the value.
593 Generates a pair of radio buttons, with values C<$fieldvalue> and
594 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
599 Generates a one-line text input field. It initially contains
604 Generates a four-line text input area. The initial text (which, of
605 course, may not contain any tabs) is C<$fieldvalue>.
609 Generates a list of items, from which the user may choose one. This is
610 somewhat different from other input field types, and should be
612 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
613 where the C<text>N strings are the choices that will be presented to
614 the user, and C<label>N are the labels that will be passed to the
617 However, C<text0> should be an integer, since it will be used to
618 determine the order in which this field appears in the form. If any of
619 the C<label>Ns are empty, the rest of the list will be ignored.
626 my ($action, %inputs) = @_;
627 my $string = "<form action=\"$action\" method=\"post\">\n";
628 $string .= mktablehdr();
630 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
635 while ($i2 < $count) {
636 my $value=$inputs{$keys[$i2]};
637 # FIXME - Why use a tab-separated string? Why not just use an
639 my @data=split('\t',$value);
641 if ($data[0] eq 'hidden'){
642 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
645 if ($data[0] eq 'radio') {
646 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
647 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
649 # FIXME - Is 40 the right size in all cases?
650 if ($data[0] eq 'text') {
651 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
653 # FIXME - Is 40x4 the right size in all cases?
654 if ($data[0] eq 'textarea') {
655 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
657 if ($data[0] eq 'select') {
658 $text="<select name=$keys[$i2]>";
660 while ($data[$i] ne "") {
661 my $val = $data[$i+1];
662 $text = $text."<option value=$data[$i]>$val";
663 $i = $i+2; # FIXME - Use $i += 2.
665 $text=$text."</select>";
667 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
668 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
672 my $temp=join("\n",@order);
673 # FIXME - Use ".=". That's what it's for.
674 $string=$string.$temp;
675 $string=$string.mktablerow(1,'white','<input type=submit>');
676 $string=$string.mktableft;
677 $string=$string."</form>";
678 # FIXME - A return statement, while not strictly necessary, would be nice.
683 $str = &mkformnotable($action, @inputs);
686 Takes a set of arguments that define an input form, generates an HTML
687 string for the form, and returns the string. Unlike C<&mkform2> and
688 C<&mkform3>, it does not put the form inside a table.
690 C<$action> is the action for the form, usually the URL of the script
691 that will process it.
693 The remaining arguments define the fields in the form. Each is an
694 anonymous array, e.g.:
696 &mkformnotable("/cgi-bin/foo",
697 [ "hidden", "hiddenvar", "value" ],
698 [ "text", "username", "" ]);
700 The first element of each argument defines its type. The remaining
701 ones are type-dependent. The supported types are:
705 =item C<[ "hidden", $name, $value]>
707 Generates a hidden field, for passing information to a script without
708 showing it to the user. C<$name> is the name of the field, and
709 C<$value> is the value to pass.
711 =item C<[ "radio", $groupname, $value ]>
713 Generates a radio button. Its name (or button group name) is C<$name>.
714 C<$value> is the value associated with the button; this is both the
715 value that will be shown to the user, and that which will be passed on
716 to the C<$action> script.
718 =item C<[ "text", $name, $inittext ]>
720 Generates a text input field. C<$name> specifies its name, and
721 C<$inittext> specifies the text that the field should initially
724 =item C<[ "textarea", $name ]>
726 Creates a 40x4 text area, named C<$name>.
728 =item C<[ "reset", $name, $label ]>
730 Generates a reset button, with name C<$name>. C<$label> specifies the
733 =item C<[ "submit", $name, $label ]>
735 Generates a submit button, with name C<$name>. C<$label> specifies the
743 my ($action,@inputs)=@_;
744 my $string="<form action=$action method=post>\n";
746 for (my $i=0; $i<$count; $i++){
747 if ($inputs[$i][0] eq 'hidden'){
748 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
750 if ($inputs[$i][0] eq 'radio') {
751 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
753 if ($inputs[$i][0] eq 'text') {
754 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
756 if ($inputs[$i][0] eq 'textarea') {
757 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
759 if ($inputs[$i][0] eq 'reset'){
760 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
762 if ($inputs[$i][0] eq 'submit'){
763 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
766 $string=$string."</form>";
771 $str = &mkform2($action,
772 $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
777 Takes a set of arguments that define an input form, generates an HTML
778 string for the form, and returns the string.
780 C<$action> is the action for the form, usually the URL of the script
781 that will process it.
783 The remaining arguments define the fields in the form. C<$fieldname>
784 is the field's name. This is for the script's benefit, and will not be
787 C<$fieldpos> is an integer; fields will be output in order of
788 increasing C<$fieldpos>. This number must be unique: if two fields
789 have the same C<$fieldpos>, one will be picked at random, and the
790 other will be ignored. See below for special considerations, however.
792 If C<$required> is the string C<R>, then the field is required, and
793 the label will have C< (Req.)> appended.
795 C<$label> is a string that will appear next to the input field.
797 C<$fieldtype> specifies the type of the input field. It may be one of
804 Generates a hidden field, used to pass data to the script without
805 showing it to the user. C<$value0> is its value.
809 Generates a pair of radio buttons, with values C<$value0> and
810 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
811 the user, next to the radio button.
815 Generates a one-line text input field. Its size may be specified by
816 C<$value0>. The default is 40. The initial text of the field may be
817 specified by C<$value1>.
821 Generates a text input area. C<$value0> may be a string of the form
822 "WWWxHHH", in which case the text input area will be WWW columns wide
823 and HHH rows tall. The size defaults to 40x4.
825 The initial text (which, of course, may not contain any tabs) may be
826 specified by C<$value1>.
830 Generates a list of items, from which the user may choose one. Here,
831 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
832 pair, the key specifies an internal label for a choice, and the value
833 specifies the description of the choice that will be shown the user.
835 If C<$value0> is the same as one of the keys that follows, then the
836 corresponding choice will initially be selected.
844 # no POD and no tests yet. Once tests are written,
845 # this function can be cleaned up with the following steps:
846 # turn the while loop into a foreach loop
847 # pull the nested if,elsif structure back up to the main level
848 # pull the code for the different kinds of inputs into separate
850 my ($action,%inputs)=@_;
851 my $string="<form action=$action method=post>\n";
852 $string=$string.mktablehdr();
855 while ( my ($key, $value) = each %inputs) {
856 my @data=split('\t',$value);
857 my $posn = shift(@data);
858 my $reqd = shift(@data);
859 my $ltext = shift(@data);
860 if ($data[0] eq 'hidden'){
861 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
864 if ($data[0] eq 'radio') {
865 $text="<input type=radio name=$key value=$data[1]>$data[1]
866 <input type=radio name=$key value=$data[2]>$data[2]";
867 } elsif ($data[0] eq 'text') {
872 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
873 } elsif ($data[0] eq 'textarea') {
874 my @size=split("x",$data[1]);
875 if ($data[1] eq "") {
879 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
880 } elsif ($data[0] eq 'select') {
881 $text="<select name=$key>";
884 while ($data[$i] ne "") {
885 my $val = $data[$i+1];
886 $text = $text."<option value=\"$data[$i]\"";
887 if ($data[$i] eq $sel) {
888 $text = $text." selected";
890 $text = $text.">$val";
893 $text=$text."</select>";
896 $ltext = $ltext." (Req)";
898 $order[$posn] =mktablerow(2,'white',$ltext,$text);
901 $string=$string.join("\n",@order);
902 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
903 $string=$string.mktableft;
904 $string=$string."</form>";
912 Returns a string of HTML, the end of an HTML document.
917 return("</body></html>\n");
922 $str = &mklink($url, $text);
925 Returns an HTML string, where C<$text> is a link to C<$url>.
931 my $string="<a href=\"$url\">$text</a>";
937 $str = &mkheadr($type, $text);
940 Takes a header type and header text, and returns a string of HTML,
941 where C<$text> is rendered with emphasis in a large font size (not an
944 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
945 Type 2 has no special tag at the end; Type 3 ends with a paragraph
952 # would it be better to make this more generic by accepting an optional
953 # argument with a closing tag instead of a numeric type?
958 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
961 $string="<FONT SIZE=6><em>$text</em></FONT>";
964 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
969 =item center and endcenter
971 print ¢er(), "This is a line of centered text.", &endcenter();
973 C<¢er> and C<&endcenter> take no arguments and return HTML tags
974 <CENTER> and </CENTER> respectively.
979 return ("<CENTER>\n");
983 return ("</CENTER>\n");
991 Returns a string of HTML that renders C<$text> in bold.
997 return("<b>$text</b>");
1000 =item getkeytableselectoptions
1002 $str = &getkeytableselectoptions($dbh, $tablename,
1003 $keyfieldname, $descfieldname,
1004 $showkey, $default);
1007 Builds an HTML selection box from a database table. Returns a string
1008 of HTML that implements this.
1010 C<$dbh> is a DBI::db database handle.
1012 C<$tablename> is the database table in which to look up the possible
1013 values for the selection box.
1015 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1016 internal label for the selection.
1018 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1019 option shown to the user.
1021 If C<$showkey> is true, then both the key and value will be shown to
1024 If the C<$default> argument is given, then if a value (from
1025 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1029 #---------------------------------------------
1030 # Create an HTML option list for a <SELECT> form tag by using
1031 # values from a DB file
1032 sub getkeytableselectoptions {
1037 $tablename, # name of table containing list of choices
1038 $keyfieldname, # column name of code to use in option list
1039 $descfieldname, # column name of descriptive field
1040 $showkey, # flag to show key in description
1041 $default, # optional default key
1043 my $selectclause; # return value
1047 $key, $desc, $orderfieldname,
1051 requireDBI($dbh,"getkeytableselectoptions");
1054 $orderfieldname=$keyfieldname;
1056 $orderfieldname=$descfieldname;
1058 $query= "select $keyfieldname,$descfieldname
1060 order by $orderfieldname ";
1061 print "<PRE>Query=$query </PRE>\n" if $debug;
1062 $sth=$dbh->prepare($query);
1064 while ( ($key, $desc) = $sth->fetchrow) {
1065 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1066 $selectclause.="<option";
1067 if (defined $default && $default eq $key) {
1068 $selectclause.=" selected";
1070 $selectclause.=" value='$key'>$desc\n";
1071 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1073 return $selectclause;
1074 } # sub getkeytableselectoptions
1076 #---------------------------------
1078 END { } # module clean-up code here (global destructor)