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 %values = &pathtotemplate(template => $template,
174 language => $language,
176 path => $includedir);
178 Finds a directory containing the desired template. The C<template>
179 argument specifies the template you're looking for (this should be the
180 name of the script you're using to generate an HTML page, without the
181 C<.pl> extension). Only the C<template> argument is required; the
184 C<theme> specifies the name of the theme to use. This will be used
185 only if it is allowed by the C<allowthemeoverride> system preference
186 option (in the C<systempreferences> table of the Koha database).
188 C<language> specifies the desired language. If not specified,
189 C<&pathtotemplate> will use the list of acceptable languages specified
190 by the browser, then C<all>, and finally C<en> as fallback options.
192 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
193 C<intranet> and C<opac> specify that you want a template for the
194 internal web site or the public OPAC, respectively. C<none> specifies
195 that the template you're looking for is at the top level of one of the
196 include directories. Any other value is taken as-is, as a subdirectory
197 of one of the include directories.
199 C<path> specifies an include directory.
201 C<&pathtotemplate> searches first in the directory given by the
202 C<path> argument, if any, then in the directories given by the
203 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
206 C<&pathtotemplate> returns a hash with the following keys:
212 The full pathname to the desired template.
214 =item C<foundlanguage>
216 The value is set to 1 if a template in the desired language was found,
221 The value is set to 1 if a template of the desired theme was found, or
226 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
228 Note that if a template of the desired language or theme cannot be
229 found, C<&pathtotemplate> will print a warning message. Unless you've
230 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
237 my $template = $params{'template'};
238 my $themeor = $params{'theme'};
239 my $languageor = lc($params{'language'});
240 my $ptype = lc($params{'type'} or 'intranet');
242 # FIXME - Make sure $params{'template'} was given. Or else assume
245 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
246 elsif ($ptype eq 'none') {$type = ''; }
247 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
248 else {$type = $ptype . '/'; }
251 my %prefs= systemprefs();
252 my $theme= $prefs{'theme'} || 'default';
253 if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
254 my @languageorder = getlanguageorder();
255 my $language = $languageor || shift(@languageorder);
257 #where to search for templates
258 my @tmpldirs = ("$path/templates", $path);
259 unshift (@tmpldirs, $configfile{'templatedirectory'}) if $configfile{'templatedirectory'};
260 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
262 my ($edir, $etheme, $elanguage, $epath);
264 # FIXME - Use 'foreach my $var (...)'
265 CHECK: foreach (@tmpldirs) {
267 foreach ($theme, 'all', 'default') {
269 foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
271 if (-e "$edir/$type$etheme/$elanguage/$template") {
272 $epath = "$edir/$type$etheme/$elanguage/$template";
280 warn "Could not find $template in @tmpldirs";
284 if ($language eq $elanguage) {
285 $returns{'foundlanguage'} = 1;
287 $returns{'foundlanguage'} = 0;
288 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
290 if ($theme eq $etheme) {
291 $returns{'foundtheme'} = 1;
293 $returns{'foundtheme'} = 0;
294 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
297 $returns{'path'} = $epath;
302 =item getlanguageorder
304 @languages = &getlanguageorder();
306 Returns the list of languages that the user will accept, and returns
307 them in order of decreasing preference. This is retrieved from the
308 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
309 the C<languageorder> setting from the C<systempreferences> table in
310 the Koha database. If neither is set, it defaults to C<en> (English).
314 sub getlanguageorder () {
316 my %prefs = systemprefs();
318 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
319 @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
320 } elsif ($prefs{'languageorder'}) {
321 @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
322 } else { # here should be another elsif checking for apache's languageorder
323 @languageorder = ('en');
326 return (@languageorder);
334 Returns a string of HTML, the beginning of a new HTML document.
344 $str = &gotopage("//opac.koha.org/index.html");
347 Generates a snippet of HTML code that will redirect to the given URL
348 (which should not include the initial C<http:>), and returns it.
353 my ($target) = shift;
354 #print "<br>goto target = $target<br>";
355 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
361 @lines = &startmenu($type);
362 print join("", @lines);
364 Given a page type, or category, returns a set of lines of HTML which,
365 when concatenated, generate the menu at the top of the web page.
367 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
368 C<report>, C<circulation>, or something else, in which case the menu
369 will be for the catalog pages.
374 # edit the paths in here
376 if ($type eq 'issue') {
377 open (FILE,"$path/issues-top.inc") || die;
378 } elsif ($type eq 'opac') {
379 open (FILE,"$path/opac-top.inc") || die;
380 } elsif ($type eq 'member') {
381 open (FILE,"$path/members-top.inc") || die;
382 } elsif ($type eq 'acquisitions'){
383 open (FILE,"$path/acquisitions-top.inc") || die;
384 } elsif ($type eq 'report'){
385 open (FILE,"$path/reports-top.inc") || die;
386 } elsif ($type eq 'circulation') {
387 open (FILE,"$path/circulation-top.inc") || die;
389 open (FILE,"$path/cat-top.inc") || die;
394 # $string[$count]="<BLOCKQUOTE>";
400 @lines = &endmenu($type);
401 print join("", @lines);
403 Given a page type, or category, returns a set of lines of HTML which,
404 when concatenated, generate the menu at the bottom of the web page.
406 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
407 C<report>, C<circulation>, or something else, in which case the menu
408 will be for the catalog pages.
414 if ( ! defined $type ) { $type=''; }
415 # FIXME - It's bad form to die in a CGI script. It's even worse form
416 # to die without issuing an error message.
417 if ($type eq 'issue') {
418 open (FILE,"$path/issues-bottom.inc") || die;
419 } elsif ($type eq 'opac') {
420 open (FILE,"$path/opac-bottom.inc") || die;
421 } elsif ($type eq 'member') {
422 open (FILE,"$path/members-bottom.inc") || die;
423 } elsif ($type eq 'acquisitions') {
424 open (FILE,"$path/acquisitions-bottom.inc") || die;
425 } elsif ($type eq 'report') {
426 open (FILE,"$path/reports-bottom.inc") || die;
427 } elsif ($type eq 'circulation') {
428 open (FILE,"$path/circulation-bottom.inc") || die;
430 open (FILE,"$path/cat-bottom.inc") || die;
439 $str = &mktablehdr();
442 Returns a string of HTML, which generates the beginning of a table
448 return("<table border=0 cellspacing=0 cellpadding=5>\n");
453 $str = &mktablerow($columns, $color, @column_data, $bgimage);
456 Returns a string of HTML, which generates a row of data inside a table
457 (see also C<&mktablehdr>, C<&mktableft>).
459 C<$columns> specifies the number of columns in this row of data.
461 C<$color> specifies the background color for the row, e.g., C<"white">
464 C<@column_data> is an array of C<$columns> elements, each one a string
465 of HTML. These are the contents of the row.
467 The optional C<$bgimage> argument specifies the pathname to an image
468 to use as the background for each cell in the row. This pathname will
469 used as is in the output, so it should be relative to the HTTP
475 #the last item in data may be a backgroundimage
478 # should this be a foreach (1..$cols) loop?
480 my ($cols,$colour,@data)=@_;
482 my $string="<tr valign=top bgcolor=$colour>";
484 if (defined $data[$cols]) { # if there is a background image
485 $string.="<td background=\"$data[$cols]\">";
486 } else { # if there's no background image
489 if (! defined $data[$i]) {$data[$i]="";}
490 if ($data[$i] eq "") {
491 $string.=" </td>";
493 $string.="$data[$i]</td>";
497 $string=$string."</tr>\n";
506 Returns a string of HTML, which generates the end of a table
512 return("</table>\n");
515 # FIXME - This is never used.
517 my ($action,%inputs)=@_;
518 my $string="<form action=$action method=post>\n";
519 $string=$string.mktablehdr();
521 my @keys=sort keys %inputs;
525 while ( $i2<$count) {
526 my $value=$inputs{$keys[$i2]};
527 my @data=split('\t',$value);
528 #my $posn = shift(@data);
529 if ($data[0] eq 'hidden'){
530 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
533 if ($data[0] eq 'radio') {
534 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
535 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
537 if ($data[0] eq 'text') {
538 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
540 if ($data[0] eq 'textarea') {
541 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
543 if ($data[0] eq 'select') {
544 $text="<select name=$keys[$i2]>";
546 while ($data[$i] ne "") {
547 my $val = $data[$i+1];
548 $text = $text."<option value=$data[$i]>$val";
551 $text=$text."</select>";
553 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
554 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
558 #$string=$string.join("\n",@order);
559 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
560 $string=$string.mktableft;
561 $string=$string."</form>";
566 $str = &mkform3($action,
567 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
572 Takes a set of arguments that define an input form, generates an HTML
573 string for the form, and returns the string.
575 C<$action> is the action for the form, usually the URL of the script
576 that will process it.
578 The remaining arguments define the fields in the form. C<$fieldname>
579 is the field's name. This is for the script's benefit, and will not be
582 C<$fieldpos> is an integer; fields will be output in order of
583 increasing C<$fieldpos>. This number must be unique: if two fields
584 have the same C<$fieldpos>, one will be picked at random, and the
585 other will be ignored. See below for special considerations, however.
587 C<$fieldtype> specifies the type of the input field. It may be one of
594 Generates a hidden field, used to pass data to the script without
595 showing it to the user. C<$fieldvalue> is the value.
599 Generates a pair of radio buttons, with values C<$fieldvalue> and
600 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
605 Generates a one-line text input field. It initially contains
610 Generates a four-line text input area. The initial text (which, of
611 course, may not contain any tabs) is C<$fieldvalue>.
615 Generates a list of items, from which the user may choose one. This is
616 somewhat different from other input field types, and should be
618 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
619 where the C<text>N strings are the choices that will be presented to
620 the user, and C<label>N are the labels that will be passed to the
623 However, C<text0> should be an integer, since it will be used to
624 determine the order in which this field appears in the form. If any of
625 the C<label>Ns are empty, the rest of the list will be ignored.
632 my ($action, %inputs) = @_;
633 my $string = "<form action=\"$action\" method=\"post\">\n";
634 $string .= mktablehdr();
636 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
641 while ($i2 < $count) {
642 my $value=$inputs{$keys[$i2]};
643 # FIXME - Why use a tab-separated string? Why not just use an
645 my @data=split('\t',$value);
647 if ($data[0] eq 'hidden'){
648 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
651 if ($data[0] eq 'radio') {
652 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
653 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
655 # FIXME - Is 40 the right size in all cases?
656 if ($data[0] eq 'text') {
657 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
659 # FIXME - Is 40x4 the right size in all cases?
660 if ($data[0] eq 'textarea') {
661 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
663 if ($data[0] eq 'select') {
664 $text="<select name=$keys[$i2]>";
666 while ($data[$i] ne "") {
667 my $val = $data[$i+1];
668 $text = $text."<option value=$data[$i]>$val";
669 $i = $i+2; # FIXME - Use $i += 2.
671 $text=$text."</select>";
673 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
674 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
678 my $temp=join("\n",@order);
679 # FIXME - Use ".=". That's what it's for.
680 $string=$string.$temp;
681 $string=$string.mktablerow(1,'white','<input type=submit>');
682 $string=$string.mktableft;
683 $string=$string."</form>";
684 # FIXME - A return statement, while not strictly necessary, would be nice.
689 $str = &mkformnotable($action, @inputs);
692 Takes a set of arguments that define an input form, generates an HTML
693 string for the form, and returns the string. Unlike C<&mkform2> and
694 C<&mkform3>, it does not put the form inside a table.
696 C<$action> is the action for the form, usually the URL of the script
697 that will process it.
699 The remaining arguments define the fields in the form. Each is an
700 anonymous array, e.g.:
702 &mkformnotable("/cgi-bin/foo",
703 [ "hidden", "hiddenvar", "value" ],
704 [ "text", "username", "" ]);
706 The first element of each argument defines its type. The remaining
707 ones are type-dependent. The supported types are:
711 =item C<[ "hidden", $name, $value]>
713 Generates a hidden field, for passing information to a script without
714 showing it to the user. C<$name> is the name of the field, and
715 C<$value> is the value to pass.
717 =item C<[ "radio", $groupname, $value ]>
719 Generates a radio button. Its name (or button group name) is C<$name>.
720 C<$value> is the value associated with the button; this is both the
721 value that will be shown to the user, and that which will be passed on
722 to the C<$action> script.
724 =item C<[ "text", $name, $inittext ]>
726 Generates a text input field. C<$name> specifies its name, and
727 C<$inittext> specifies the text that the field should initially
730 =item C<[ "textarea", $name ]>
732 Creates a 40x4 text area, named C<$name>.
734 =item C<[ "reset", $name, $label ]>
736 Generates a reset button, with name C<$name>. C<$label> specifies the
739 =item C<[ "submit", $name, $label ]>
741 Generates a submit button, with name C<$name>. C<$label> specifies the
749 my ($action,@inputs)=@_;
750 my $string="<form action=$action method=post>\n";
752 for (my $i=0; $i<$count; $i++){
753 if ($inputs[$i][0] eq 'hidden'){
754 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
756 if ($inputs[$i][0] eq 'radio') {
757 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
759 if ($inputs[$i][0] eq 'text') {
760 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
762 if ($inputs[$i][0] eq 'textarea') {
763 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
765 if ($inputs[$i][0] eq 'reset'){
766 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
768 if ($inputs[$i][0] eq 'submit'){
769 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
772 $string=$string."</form>";
777 $str = &mkform2($action,
778 $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
783 Takes a set of arguments that define an input form, generates an HTML
784 string for the form, and returns the string.
786 C<$action> is the action for the form, usually the URL of the script
787 that will process it.
789 The remaining arguments define the fields in the form. C<$fieldname>
790 is the field's name. This is for the script's benefit, and will not be
793 C<$fieldpos> is an integer; fields will be output in order of
794 increasing C<$fieldpos>. This number must be unique: if two fields
795 have the same C<$fieldpos>, one will be picked at random, and the
796 other will be ignored. See below for special considerations, however.
798 If C<$required> is the string C<R>, then the field is required, and
799 the label will have C< (Req.)> appended.
801 C<$label> is a string that will appear next to the input field.
803 C<$fieldtype> specifies the type of the input field. It may be one of
810 Generates a hidden field, used to pass data to the script without
811 showing it to the user. C<$value0> is its value.
815 Generates a pair of radio buttons, with values C<$value0> and
816 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
817 the user, next to the radio button.
821 Generates a one-line text input field. Its size may be specified by
822 C<$value0>. The default is 40. The initial text of the field may be
823 specified by C<$value1>.
827 Generates a text input area. C<$value0> may be a string of the form
828 "WWWxHHH", in which case the text input area will be WWW columns wide
829 and HHH rows tall. The size defaults to 40x4.
831 The initial text (which, of course, may not contain any tabs) may be
832 specified by C<$value1>.
836 Generates a list of items, from which the user may choose one. Here,
837 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
838 pair, the key specifies an internal label for a choice, and the value
839 specifies the description of the choice that will be shown the user.
841 If C<$value0> is the same as one of the keys that follows, then the
842 corresponding choice will initially be selected.
850 # no POD and no tests yet. Once tests are written,
851 # this function can be cleaned up with the following steps:
852 # turn the while loop into a foreach loop
853 # pull the nested if,elsif structure back up to the main level
854 # pull the code for the different kinds of inputs into separate
856 my ($action,%inputs)=@_;
857 my $string="<form action=$action method=post>\n";
858 $string=$string.mktablehdr();
861 while ( my ($key, $value) = each %inputs) {
862 my @data=split('\t',$value);
863 my $posn = shift(@data);
864 my $reqd = shift(@data);
865 my $ltext = shift(@data);
866 if ($data[0] eq 'hidden'){
867 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
870 if ($data[0] eq 'radio') {
871 $text="<input type=radio name=$key value=$data[1]>$data[1]
872 <input type=radio name=$key value=$data[2]>$data[2]";
873 } elsif ($data[0] eq 'text') {
878 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
879 } elsif ($data[0] eq 'textarea') {
880 my @size=split("x",$data[1]);
881 if ($data[1] eq "") {
885 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
886 } elsif ($data[0] eq 'select') {
887 $text="<select name=$key>";
890 while ($data[$i] ne "") {
891 my $val = $data[$i+1];
892 $text = $text."<option value=\"$data[$i]\"";
893 if ($data[$i] eq $sel) {
894 $text = $text." selected";
896 $text = $text.">$val";
899 $text=$text."</select>";
902 $ltext = $ltext." (Req)";
904 $order[$posn] =mktablerow(2,'white',$ltext,$text);
907 $string=$string.join("\n",@order);
908 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
909 $string=$string.mktableft;
910 $string=$string."</form>";
918 Returns a string of HTML, the end of an HTML document.
923 return("</body></html>\n");
928 $str = &mklink($url, $text);
931 Returns an HTML string, where C<$text> is a link to C<$url>.
937 my $string="<a href=\"$url\">$text</a>";
943 $str = &mkheadr($type, $text);
946 Takes a header type and header text, and returns a string of HTML,
947 where C<$text> is rendered with emphasis in a large font size (not an
950 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
951 Type 2 has no special tag at the end; Type 3 ends with a paragraph
958 # would it be better to make this more generic by accepting an optional
959 # argument with a closing tag instead of a numeric type?
964 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
967 $string="<FONT SIZE=6><em>$text</em></FONT>";
970 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
975 =item center and endcenter
977 print ¢er(), "This is a line of centered text.", &endcenter();
979 C<¢er> and C<&endcenter> take no arguments and return HTML tags
980 <CENTER> and </CENTER> respectively.
985 return ("<CENTER>\n");
989 return ("</CENTER>\n");
997 Returns a string of HTML that renders C<$text> in bold.
1003 return("<b>$text</b>");
1006 =item getkeytableselectoptions
1008 $str = &getkeytableselectoptions($dbh, $tablename,
1009 $keyfieldname, $descfieldname,
1010 $showkey, $default);
1013 Builds an HTML selection box from a database table. Returns a string
1014 of HTML that implements this.
1016 C<$dbh> is a DBI::db database handle.
1018 C<$tablename> is the database table in which to look up the possible
1019 values for the selection box.
1021 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1022 internal label for the selection.
1024 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1025 option shown to the user.
1027 If C<$showkey> is true, then both the key and value will be shown to
1030 If the C<$default> argument is given, then if a value (from
1031 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1035 #---------------------------------------------
1036 # Create an HTML option list for a <SELECT> form tag by using
1037 # values from a DB file
1038 sub getkeytableselectoptions {
1043 $tablename, # name of table containing list of choices
1044 $keyfieldname, # column name of code to use in option list
1045 $descfieldname, # column name of descriptive field
1046 $showkey, # flag to show key in description
1047 $default, # optional default key
1049 my $selectclause; # return value
1053 $key, $desc, $orderfieldname,
1057 requireDBI($dbh,"getkeytableselectoptions");
1060 $orderfieldname=$keyfieldname;
1062 $orderfieldname=$descfieldname;
1064 $query= "select $keyfieldname,$descfieldname
1066 order by $orderfieldname ";
1067 print "<PRE>Query=$query </PRE>\n" if $debug;
1068 $sth=$dbh->prepare($query);
1070 while ( ($key, $desc) = $sth->fetchrow) {
1071 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1072 $selectclause.="<option";
1073 if (defined $default && $default eq $key) {
1074 $selectclause.=" selected";
1076 $selectclause.=" value='$key'>$desc\n";
1077 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1079 return $selectclause;
1080 } # sub getkeytableselectoptions
1082 #---------------------------------
1084 END { } # module clean-up code here (global destructor)