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 #---------------------------------------------------------------------------------------------------------
102 my ($tmplbase, $opac) = @_;
106 $htdocs = C4::Context->config('opachtdocs');
108 $htdocs = C4::Context->config('intrahtdocs');
111 my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
113 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
114 die_on_bad_params => 0,
116 path => ["$htdocs/$theme/$lang/includes"]);
118 $template->param(themelang => "/$theme/$lang");
122 #---------------------------------------------------------------------------------------------------------
125 my ($htdocs, $tmpl) = @_;
127 # language preferences....
128 my $dbh = C4::Context->dbh;
129 my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opaclanguages'");
131 my ($lang) = $sth->fetchrow;
133 my @languages = split " ", $lang;
135 # theme preferences....
136 # FIXME - There's already a $sth in this scope
137 my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opacthemes'");
139 my ($theme) = $sth->fetchrow;
141 my @themes = split " ", $theme;
144 # FIXME - There are already $theme and $lang in this scope
145 # searches through the themes and languages. First template it find it returns.
146 # Priority is for getting the theme right.
148 foreach my $th (@themes) {
149 foreach my $la (@languages) {
150 warn "File = $htdocs/$th/$la/$tmpl\n";
151 if (-e "$htdocs/$th/$la/$tmpl") {
158 if ($theme and $lang) {
159 return ($theme, $lang);
161 return ('default', 'en');
168 %values = &pathtotemplate(template => $template,
170 language => $language,
172 path => $includedir);
174 Finds a directory containing the desired template. The C<template>
175 argument specifies the template you're looking for (this should be the
176 name of the script you're using to generate an HTML page, without the
177 C<.pl> extension). Only the C<template> argument is required; the
180 C<theme> specifies the name of the theme to use. This will be used
181 only if it is allowed by the C<allowthemeoverride> system preference
182 option (in the C<systempreferences> table of the Koha database).
184 C<language> specifies the desired language. If not specified,
185 C<&pathtotemplate> will use the list of acceptable languages specified
186 by the browser, then C<all>, and finally C<en> as fallback options.
188 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
189 C<intranet> and C<opac> specify that you want a template for the
190 internal web site or the public OPAC, respectively. C<none> specifies
191 that the template you're looking for is at the top level of one of the
192 include directories. Any other value is taken as-is, as a subdirectory
193 of one of the include directories.
195 C<path> specifies an include directory.
197 C<&pathtotemplate> searches first in the directory given by the
198 C<path> argument, if any, then in the directories given by the
199 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
202 C<&pathtotemplate> returns a hash with the following keys:
208 The full pathname to the desired template.
210 =item C<foundlanguage>
212 The value is set to 1 if a template in the desired language was found,
217 The value is set to 1 if a template of the desired theme was found, or
222 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
224 Note that if a template of the desired language or theme cannot be
225 found, C<&pathtotemplate> will print a warning message. Unless you've
226 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
233 my $template = $params{'template'};
234 my $themeor = $params{'theme'};
235 my $languageor = lc($params{'language'});
236 my $ptype = lc($params{'type'} or 'intranet');
238 # FIXME - Make sure $params{'template'} was given. Or else assume
241 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
242 elsif ($ptype eq 'none') {$type = ''; }
243 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
244 else {$type = $ptype . '/'; }
247 my %prefs= systemprefs();
248 my $theme= $prefs{'theme'} || 'default';
249 if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
250 my @languageorder = getlanguageorder();
251 my $language = $languageor || shift(@languageorder);
253 #where to search for templates
254 my @tmpldirs = ("$path/templates", $path);
255 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
256 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
258 my ($edir, $etheme, $elanguage, $epath);
260 # FIXME - Use 'foreach my $var (...)'
261 CHECK: foreach (@tmpldirs) {
263 foreach ($theme, 'all', 'default') {
265 foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
267 if (-e "$edir/$type$etheme/$elanguage/$template") {
268 $epath = "$edir/$type$etheme/$elanguage/$template";
276 warn "Could not find $template in @tmpldirs";
280 if ($language eq $elanguage) {
281 $returns{'foundlanguage'} = 1;
283 $returns{'foundlanguage'} = 0;
284 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
286 if ($theme eq $etheme) {
287 $returns{'foundtheme'} = 1;
289 $returns{'foundtheme'} = 0;
290 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
293 $returns{'path'} = $epath;
298 =item getlanguageorder
300 @languages = &getlanguageorder();
302 Returns the list of languages that the user will accept, and returns
303 them in order of decreasing preference. This is retrieved from the
304 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
305 the C<languageorder> setting from the C<systempreferences> table in
306 the Koha database. If neither is set, it defaults to C<en> (English).
310 sub getlanguageorder () {
312 my %prefs = systemprefs();
314 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
315 @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
316 } elsif ($prefs{'languageorder'}) {
317 @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
318 } else { # here should be another elsif checking for apache's languageorder
319 @languageorder = ('en');
322 return (@languageorder);
330 Returns a string of HTML, the beginning of a new HTML document.
340 $str = &gotopage("//opac.koha.org/index.html");
343 Generates a snippet of HTML code that will redirect to the given URL
344 (which should not include the initial C<http:>), and returns it.
349 my ($target) = shift;
350 #print "<br>goto target = $target<br>";
351 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
357 @lines = &startmenu($type);
358 print join("", @lines);
360 Given a page type, or category, returns a set of lines of HTML which,
361 when concatenated, generate the menu at the top of the web page.
363 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
364 C<report>, C<circulation>, or something else, in which case the menu
365 will be for the catalog pages.
370 # edit the paths in here
372 if ($type eq 'issue') {
373 open (FILE,"$path/issues-top.inc") || die;
374 } elsif ($type eq 'opac') {
375 open (FILE,"$path/opac-top.inc") || die;
376 } elsif ($type eq 'member') {
377 open (FILE,"$path/members-top.inc") || die;
378 } elsif ($type eq 'acquisitions'){
379 open (FILE,"$path/acquisitions-top.inc") || die;
380 } elsif ($type eq 'report'){
381 open (FILE,"$path/reports-top.inc") || die;
382 } elsif ($type eq 'circulation') {
383 open (FILE,"$path/circulation-top.inc") || die;
385 open (FILE,"$path/cat-top.inc") || die;
390 # $string[$count]="<BLOCKQUOTE>";
396 @lines = &endmenu($type);
397 print join("", @lines);
399 Given a page type, or category, returns a set of lines of HTML which,
400 when concatenated, generate the menu at the bottom of the web page.
402 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
403 C<report>, C<circulation>, or something else, in which case the menu
404 will be for the catalog pages.
410 if ( ! defined $type ) { $type=''; }
411 # FIXME - It's bad form to die in a CGI script. It's even worse form
412 # to die without issuing an error message.
413 if ($type eq 'issue') {
414 open (FILE,"$path/issues-bottom.inc") || die;
415 } elsif ($type eq 'opac') {
416 open (FILE,"$path/opac-bottom.inc") || die;
417 } elsif ($type eq 'member') {
418 open (FILE,"$path/members-bottom.inc") || die;
419 } elsif ($type eq 'acquisitions') {
420 open (FILE,"$path/acquisitions-bottom.inc") || die;
421 } elsif ($type eq 'report') {
422 open (FILE,"$path/reports-bottom.inc") || die;
423 } elsif ($type eq 'circulation') {
424 open (FILE,"$path/circulation-bottom.inc") || die;
426 open (FILE,"$path/cat-bottom.inc") || die;
435 $str = &mktablehdr();
438 Returns a string of HTML, which generates the beginning of a table
444 return("<table border=0 cellspacing=0 cellpadding=5>\n");
449 $str = &mktablerow($columns, $color, @column_data, $bgimage);
452 Returns a string of HTML, which generates a row of data inside a table
453 (see also C<&mktablehdr>, C<&mktableft>).
455 C<$columns> specifies the number of columns in this row of data.
457 C<$color> specifies the background color for the row, e.g., C<"white">
460 C<@column_data> is an array of C<$columns> elements, each one a string
461 of HTML. These are the contents of the row.
463 The optional C<$bgimage> argument specifies the pathname to an image
464 to use as the background for each cell in the row. This pathname will
465 used as is in the output, so it should be relative to the HTTP
471 #the last item in data may be a backgroundimage
474 # should this be a foreach (1..$cols) loop?
476 my ($cols,$colour,@data)=@_;
478 my $string="<tr valign=top bgcolor=$colour>";
480 if (defined $data[$cols]) { # if there is a background image
481 $string.="<td background=\"$data[$cols]\">";
482 } else { # if there's no background image
485 if (! defined $data[$i]) {$data[$i]="";}
486 if ($data[$i] eq "") {
487 $string.=" </td>";
489 $string.="$data[$i]</td>";
493 $string=$string."</tr>\n";
502 Returns a string of HTML, which generates the end of a table
508 return("</table>\n");
511 # FIXME - This is never used.
513 my ($action,%inputs)=@_;
514 my $string="<form action=$action method=post>\n";
515 $string=$string.mktablehdr();
517 my @keys=sort keys %inputs;
521 while ( $i2<$count) {
522 my $value=$inputs{$keys[$i2]};
523 my @data=split('\t',$value);
524 #my $posn = shift(@data);
525 if ($data[0] eq 'hidden'){
526 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
529 if ($data[0] eq 'radio') {
530 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
531 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
533 if ($data[0] eq 'text') {
534 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
536 if ($data[0] eq 'textarea') {
537 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
539 if ($data[0] eq 'select') {
540 $text="<select name=$keys[$i2]>";
542 while ($data[$i] ne "") {
543 my $val = $data[$i+1];
544 $text = $text."<option value=$data[$i]>$val";
547 $text=$text."</select>";
549 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
550 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
554 #$string=$string.join("\n",@order);
555 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
556 $string=$string.mktableft;
557 $string=$string."</form>";
562 $str = &mkform3($action,
563 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
568 Takes a set of arguments that define an input form, generates an HTML
569 string for the form, and returns the string.
571 C<$action> is the action for the form, usually the URL of the script
572 that will process it.
574 The remaining arguments define the fields in the form. C<$fieldname>
575 is the field's name. This is for the script's benefit, and will not be
578 C<$fieldpos> is an integer; fields will be output in order of
579 increasing C<$fieldpos>. This number must be unique: if two fields
580 have the same C<$fieldpos>, one will be picked at random, and the
581 other will be ignored. See below for special considerations, however.
583 C<$fieldtype> specifies the type of the input field. It may be one of
590 Generates a hidden field, used to pass data to the script without
591 showing it to the user. C<$fieldvalue> is the value.
595 Generates a pair of radio buttons, with values C<$fieldvalue> and
596 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
601 Generates a one-line text input field. It initially contains
606 Generates a four-line text input area. The initial text (which, of
607 course, may not contain any tabs) is C<$fieldvalue>.
611 Generates a list of items, from which the user may choose one. This is
612 somewhat different from other input field types, and should be
614 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
615 where the C<text>N strings are the choices that will be presented to
616 the user, and C<label>N are the labels that will be passed to the
619 However, C<text0> should be an integer, since it will be used to
620 determine the order in which this field appears in the form. If any of
621 the C<label>Ns are empty, the rest of the list will be ignored.
628 my ($action, %inputs) = @_;
629 my $string = "<form action=\"$action\" method=\"post\">\n";
630 $string .= mktablehdr();
632 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
637 while ($i2 < $count) {
638 my $value=$inputs{$keys[$i2]};
639 # FIXME - Why use a tab-separated string? Why not just use an
641 my @data=split('\t',$value);
643 if ($data[0] eq 'hidden'){
644 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
647 if ($data[0] eq 'radio') {
648 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
649 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
651 # FIXME - Is 40 the right size in all cases?
652 if ($data[0] eq 'text') {
653 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
655 # FIXME - Is 40x4 the right size in all cases?
656 if ($data[0] eq 'textarea') {
657 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
659 if ($data[0] eq 'select') {
660 $text="<select name=$keys[$i2]>";
662 while ($data[$i] ne "") {
663 my $val = $data[$i+1];
664 $text = $text."<option value=$data[$i]>$val";
665 $i = $i+2; # FIXME - Use $i += 2.
667 $text=$text."</select>";
669 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
670 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
674 my $temp=join("\n",@order);
675 # FIXME - Use ".=". That's what it's for.
676 $string=$string.$temp;
677 $string=$string.mktablerow(1,'white','<input type=submit>');
678 $string=$string.mktableft;
679 $string=$string."</form>";
680 # FIXME - A return statement, while not strictly necessary, would be nice.
685 $str = &mkformnotable($action, @inputs);
688 Takes a set of arguments that define an input form, generates an HTML
689 string for the form, and returns the string. Unlike C<&mkform2> and
690 C<&mkform3>, it does not put the form inside a table.
692 C<$action> is the action for the form, usually the URL of the script
693 that will process it.
695 The remaining arguments define the fields in the form. Each is an
696 anonymous array, e.g.:
698 &mkformnotable("/cgi-bin/foo",
699 [ "hidden", "hiddenvar", "value" ],
700 [ "text", "username", "" ]);
702 The first element of each argument defines its type. The remaining
703 ones are type-dependent. The supported types are:
707 =item C<[ "hidden", $name, $value]>
709 Generates a hidden field, for passing information to a script without
710 showing it to the user. C<$name> is the name of the field, and
711 C<$value> is the value to pass.
713 =item C<[ "radio", $groupname, $value ]>
715 Generates a radio button. Its name (or button group name) is C<$name>.
716 C<$value> is the value associated with the button; this is both the
717 value that will be shown to the user, and that which will be passed on
718 to the C<$action> script.
720 =item C<[ "text", $name, $inittext ]>
722 Generates a text input field. C<$name> specifies its name, and
723 C<$inittext> specifies the text that the field should initially
726 =item C<[ "textarea", $name ]>
728 Creates a 40x4 text area, named C<$name>.
730 =item C<[ "reset", $name, $label ]>
732 Generates a reset button, with name C<$name>. C<$label> specifies the
735 =item C<[ "submit", $name, $label ]>
737 Generates a submit button, with name C<$name>. C<$label> specifies the
745 my ($action,@inputs)=@_;
746 my $string="<form action=$action method=post>\n";
748 for (my $i=0; $i<$count; $i++){
749 if ($inputs[$i][0] eq 'hidden'){
750 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
752 if ($inputs[$i][0] eq 'radio') {
753 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
755 if ($inputs[$i][0] eq 'text') {
756 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
758 if ($inputs[$i][0] eq 'textarea') {
759 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
761 if ($inputs[$i][0] eq 'reset'){
762 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
764 if ($inputs[$i][0] eq 'submit'){
765 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
768 $string=$string."</form>";
773 $str = &mkform2($action,
774 $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
779 Takes a set of arguments that define an input form, generates an HTML
780 string for the form, and returns the string.
782 C<$action> is the action for the form, usually the URL of the script
783 that will process it.
785 The remaining arguments define the fields in the form. C<$fieldname>
786 is the field's name. This is for the script's benefit, and will not be
789 C<$fieldpos> is an integer; fields will be output in order of
790 increasing C<$fieldpos>. This number must be unique: if two fields
791 have the same C<$fieldpos>, one will be picked at random, and the
792 other will be ignored. See below for special considerations, however.
794 If C<$required> is the string C<R>, then the field is required, and
795 the label will have C< (Req.)> appended.
797 C<$label> is a string that will appear next to the input field.
799 C<$fieldtype> specifies the type of the input field. It may be one of
806 Generates a hidden field, used to pass data to the script without
807 showing it to the user. C<$value0> is its value.
811 Generates a pair of radio buttons, with values C<$value0> and
812 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
813 the user, next to the radio button.
817 Generates a one-line text input field. Its size may be specified by
818 C<$value0>. The default is 40. The initial text of the field may be
819 specified by C<$value1>.
823 Generates a text input area. C<$value0> may be a string of the form
824 "WWWxHHH", in which case the text input area will be WWW columns wide
825 and HHH rows tall. The size defaults to 40x4.
827 The initial text (which, of course, may not contain any tabs) may be
828 specified by C<$value1>.
832 Generates a list of items, from which the user may choose one. Here,
833 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
834 pair, the key specifies an internal label for a choice, and the value
835 specifies the description of the choice that will be shown the user.
837 If C<$value0> is the same as one of the keys that follows, then the
838 corresponding choice will initially be selected.
846 # no POD and no tests yet. Once tests are written,
847 # this function can be cleaned up with the following steps:
848 # turn the while loop into a foreach loop
849 # pull the nested if,elsif structure back up to the main level
850 # pull the code for the different kinds of inputs into separate
852 my ($action,%inputs)=@_;
853 my $string="<form action=$action method=post>\n";
854 $string=$string.mktablehdr();
857 while ( my ($key, $value) = each %inputs) {
858 my @data=split('\t',$value);
859 my $posn = shift(@data);
860 my $reqd = shift(@data);
861 my $ltext = shift(@data);
862 if ($data[0] eq 'hidden'){
863 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
866 if ($data[0] eq 'radio') {
867 $text="<input type=radio name=$key value=$data[1]>$data[1]
868 <input type=radio name=$key value=$data[2]>$data[2]";
869 } elsif ($data[0] eq 'text') {
874 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
875 } elsif ($data[0] eq 'textarea') {
876 my @size=split("x",$data[1]);
877 if ($data[1] eq "") {
881 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
882 } elsif ($data[0] eq 'select') {
883 $text="<select name=$key>";
886 while ($data[$i] ne "") {
887 my $val = $data[$i+1];
888 $text = $text."<option value=\"$data[$i]\"";
889 if ($data[$i] eq $sel) {
890 $text = $text." selected";
892 $text = $text.">$val";
895 $text=$text."</select>";
898 $ltext = $ltext." (Req)";
900 $order[$posn] =mktablerow(2,'white',$ltext,$text);
903 $string=$string.join("\n",@order);
904 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
905 $string=$string.mktableft;
906 $string=$string."</form>";
914 Returns a string of HTML, the end of an HTML document.
919 return("</body></html>\n");
924 $str = &mklink($url, $text);
927 Returns an HTML string, where C<$text> is a link to C<$url>.
933 my $string="<a href=\"$url\">$text</a>";
939 $str = &mkheadr($type, $text);
942 Takes a header type and header text, and returns a string of HTML,
943 where C<$text> is rendered with emphasis in a large font size (not an
946 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
947 Type 2 has no special tag at the end; Type 3 ends with a paragraph
954 # would it be better to make this more generic by accepting an optional
955 # argument with a closing tag instead of a numeric type?
960 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
963 $string="<FONT SIZE=6><em>$text</em></FONT>";
966 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
971 =item center and endcenter
973 print ¢er(), "This is a line of centered text.", &endcenter();
975 C<¢er> and C<&endcenter> take no arguments and return HTML tags
976 <CENTER> and </CENTER> respectively.
981 return ("<CENTER>\n");
985 return ("</CENTER>\n");
993 Returns a string of HTML that renders C<$text> in bold.
999 return("<b>$text</b>");
1002 =item getkeytableselectoptions
1004 $str = &getkeytableselectoptions($dbh, $tablename,
1005 $keyfieldname, $descfieldname,
1006 $showkey, $default);
1009 Builds an HTML selection box from a database table. Returns a string
1010 of HTML that implements this.
1012 C<$dbh> is a DBI::db database handle.
1014 C<$tablename> is the database table in which to look up the possible
1015 values for the selection box.
1017 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1018 internal label for the selection.
1020 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1021 option shown to the user.
1023 If C<$showkey> is true, then both the key and value will be shown to
1026 If the C<$default> argument is given, then if a value (from
1027 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1031 #---------------------------------------------
1032 # Create an HTML option list for a <SELECT> form tag by using
1033 # values from a DB file
1034 sub getkeytableselectoptions {
1039 $tablename, # name of table containing list of choices
1040 $keyfieldname, # column name of code to use in option list
1041 $descfieldname, # column name of descriptive field
1042 $showkey, # flag to show key in description
1043 $default, # optional default key
1045 my $selectclause; # return value
1049 $key, $desc, $orderfieldname,
1053 requireDBI($dbh,"getkeytableselectoptions");
1056 $orderfieldname=$keyfieldname;
1058 $orderfieldname=$descfieldname;
1060 $query= "select $keyfieldname,$descfieldname
1062 order by $orderfieldname ";
1063 print "<PRE>Query=$query </PRE>\n" if $debug;
1064 $sth=$dbh->prepare($query);
1066 while ( ($key, $desc) = $sth->fetchrow) {
1067 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1068 $selectclause.="<option";
1069 if (defined $default && $default eq $key) {
1070 $selectclause.=" selected";
1072 $selectclause.=" value='$key'>$desc\n";
1073 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1075 return $selectclause;
1076 } # sub getkeytableselectoptions
1078 #---------------------------------
1080 END { } # module clean-up code here (global destructor)