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
31 # FIXME - Get rid of this, and use C4::Context->preference
33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
35 # set the version for version checking
40 C4::Output - Functions for generating HTML for the Koha web interface
46 $str = &mklink("http://www.koha.org/", "Koha web page");
51 The functions in this module generate HTML, and return the result as a
61 @EXPORT = qw(&startpage &endpage
62 &mktablehdr &mktableft &mktablerow &mklink
63 &startmenu &endmenu &mkheadr
65 &mkform &mkform2 &bold
66 &gotopage &mkformnotable &mkform3
67 &getkeytableselectoptions
69 &themelanguage &gettemplate
71 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
73 # your exported package globals go here,
74 # as well as any optionally exported functions
76 @EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
79 # non-exported package globals go here
80 use vars qw(@more $stuff); # FIXME - These are never used
82 # initalize package globals, first exported ones
84 # FIXME - These are never used
89 # then the others (which are still accessible as $Some::Module::stuff)
90 # FIXME - These are never used
94 # all file-scoped lexicals must be created before
95 # the functions below that use them.
97 my $path = C4::Context->config('includes') ||
98 "/usr/local/www/hdl/htdocs/includes";
100 #---------------------------------------------------------------------------------------------------------
103 my ($tmplbase, $opac) = @_;
107 $htdocs = C4::Context->config('opachtdocs');
109 $htdocs = C4::Context->config('intrahtdocs');
112 my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
114 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
115 die_on_bad_params => 0,
117 path => ["$htdocs/$theme/$lang/includes"]);
119 $template->param(themelang => "/$theme/$lang");
123 #---------------------------------------------------------------------------------------------------------
126 my ($htdocs, $tmpl) = @_;
128 my $dbh = C4::Context->dbh;
129 my @languages = split " ", C4::Context->preference("opaclanguages");
130 # language preference
131 my @themes = split " ", C4::Context->preference("opacthemes");
135 # searches through the themes and languages. First template it find it returns.
136 # Priority is for getting the theme right.
138 foreach my $th (@themes) {
139 foreach my $la (@languages) {
140 warn "File = $htdocs/$th/$la/$tmpl\n";
141 if (-e "$htdocs/$th/$la/$tmpl") {
148 if ($theme and $lang) {
149 return ($theme, $lang);
151 return ('default', 'en');
158 %values = &pathtotemplate(template => $template,
160 language => $language,
162 path => $includedir);
164 Finds a directory containing the desired template. The C<template>
165 argument specifies the template you're looking for (this should be the
166 name of the script you're using to generate an HTML page, without the
167 C<.pl> extension). Only the C<template> argument is required; the
170 C<theme> specifies the name of the theme to use. This will be used
171 only if it is allowed by the C<allowthemeoverride> system preference
172 option (in the C<systempreferences> table of the Koha database).
174 C<language> specifies the desired language. If not specified,
175 C<&pathtotemplate> will use the list of acceptable languages specified
176 by the browser, then C<all>, and finally C<en> as fallback options.
178 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
179 C<intranet> and C<opac> specify that you want a template for the
180 internal web site or the public OPAC, respectively. C<none> specifies
181 that the template you're looking for is at the top level of one of the
182 include directories. Any other value is taken as-is, as a subdirectory
183 of one of the include directories.
185 C<path> specifies an include directory.
187 C<&pathtotemplate> searches first in the directory given by the
188 C<path> argument, if any, then in the directories given by the
189 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
192 C<&pathtotemplate> returns a hash with the following keys:
198 The full pathname to the desired template.
200 =item C<foundlanguage>
202 The value is set to 1 if a template in the desired language was found,
207 The value is set to 1 if a template of the desired theme was found, or
212 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
214 Note that if a template of the desired language or theme cannot be
215 found, C<&pathtotemplate> will print a warning message. Unless you've
216 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
221 # FIXME - Fix POD: it doesn't look in the directory given by the
222 # 'includes' option in /etc/koha.conf.
225 my $template = $params{'template'};
226 my $themeor = $params{'theme'};
227 my $languageor = lc($params{'language'});
228 my $ptype = lc($params{'type'} or 'intranet');
230 # FIXME - Make sure $params{'template'} was given. Or else assume
233 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
234 elsif ($ptype eq 'none') {$type = ''; }
235 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
236 else {$type = $ptype . '/'; }
239 my $theme = C4::Context->preference("theme") || "default";
241 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
245 my @languageorder = getlanguageorder();
246 my $language = $languageor || shift(@languageorder);
248 #where to search for templates
249 my @tmpldirs = ("$path/templates", $path);
250 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
251 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
253 my ($etheme, $elanguage, $epath);
255 CHECK: foreach my $edir (@tmpldirs) {
256 foreach $etheme ($theme, 'all', 'default') {
257 foreach $elanguage ($language, @languageorder, 'all','en') {
258 # 'en' is the fallback-language
259 if (-e "$edir/$type$etheme/$elanguage/$template") {
260 $epath = "$edir/$type$etheme/$elanguage/$template";
268 warn "Could not find $template in @tmpldirs";
272 if ($language eq $elanguage) {
273 $returns{'foundlanguage'} = 1;
275 $returns{'foundlanguage'} = 0;
276 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
278 if ($theme eq $etheme) {
279 $returns{'foundtheme'} = 1;
281 $returns{'foundtheme'} = 0;
282 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
285 $returns{'path'} = $epath;
290 =item getlanguageorder
292 @languages = &getlanguageorder();
294 Returns the list of languages that the user will accept, and returns
295 them in order of decreasing preference. This is retrieved from the
296 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
297 the C<languageorder> setting from the C<systempreferences> table in
298 the Koha database. If neither is set, it defaults to C<en> (English).
302 sub getlanguageorder () {
305 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
306 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
307 } elsif (my $order = C4::Context->preference("languageorder")) {
308 @languageorder = split (/\s*,\s*/ ,lc($order));
309 } else { # here should be another elsif checking for apache's languageorder
310 @languageorder = ('en');
313 return (@languageorder);
321 Returns a string of HTML, the beginning of a new HTML document.
331 $str = &gotopage("//opac.koha.org/index.html");
334 Generates a snippet of HTML code that will redirect to the given URL
335 (which should not include the initial C<http:>), and returns it.
340 my ($target) = shift;
341 #print "<br>goto target = $target<br>";
342 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
348 @lines = &startmenu($type);
349 print join("", @lines);
351 Given a page type, or category, returns a set of lines of HTML which,
352 when concatenated, generate the menu at the top of the web page.
354 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
355 C<report>, C<circulation>, or something else, in which case the menu
356 will be for the catalog pages.
361 # edit the paths in here
363 if ($type eq 'issue') {
364 open (FILE,"$path/issues-top.inc") || die;
365 } elsif ($type eq 'opac') {
366 open (FILE,"$path/opac-top.inc") || die;
367 } elsif ($type eq 'member') {
368 open (FILE,"$path/members-top.inc") || die;
369 } elsif ($type eq 'acquisitions'){
370 open (FILE,"$path/acquisitions-top.inc") || die;
371 } elsif ($type eq 'report'){
372 open (FILE,"$path/reports-top.inc") || die;
373 } elsif ($type eq 'circulation') {
374 open (FILE,"$path/circulation-top.inc") || die;
376 open (FILE,"$path/cat-top.inc") || die;
381 # $string[$count]="<BLOCKQUOTE>";
387 @lines = &endmenu($type);
388 print join("", @lines);
390 Given a page type, or category, returns a set of lines of HTML which,
391 when concatenated, generate the menu at the bottom of the web page.
393 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
394 C<report>, C<circulation>, or something else, in which case the menu
395 will be for the catalog pages.
401 if ( ! defined $type ) { $type=''; }
402 # FIXME - It's bad form to die in a CGI script. It's even worse form
403 # to die without issuing an error message.
404 if ($type eq 'issue') {
405 open (FILE,"$path/issues-bottom.inc") || die;
406 } elsif ($type eq 'opac') {
407 open (FILE,"$path/opac-bottom.inc") || die;
408 } elsif ($type eq 'member') {
409 open (FILE,"$path/members-bottom.inc") || die;
410 } elsif ($type eq 'acquisitions') {
411 open (FILE,"$path/acquisitions-bottom.inc") || die;
412 } elsif ($type eq 'report') {
413 open (FILE,"$path/reports-bottom.inc") || die;
414 } elsif ($type eq 'circulation') {
415 open (FILE,"$path/circulation-bottom.inc") || die;
417 open (FILE,"$path/cat-bottom.inc") || die;
426 $str = &mktablehdr();
429 Returns a string of HTML, which generates the beginning of a table
435 return("<table border=0 cellspacing=0 cellpadding=5>\n");
440 $str = &mktablerow($columns, $color, @column_data, $bgimage);
443 Returns a string of HTML, which generates a row of data inside a table
444 (see also C<&mktablehdr>, C<&mktableft>).
446 C<$columns> specifies the number of columns in this row of data.
448 C<$color> specifies the background color for the row, e.g., C<"white">
451 C<@column_data> is an array of C<$columns> elements, each one a string
452 of HTML. These are the contents of the row.
454 The optional C<$bgimage> argument specifies the pathname to an image
455 to use as the background for each cell in the row. This pathname will
456 used as is in the output, so it should be relative to the HTTP
462 #the last item in data may be a backgroundimage
465 # should this be a foreach (1..$cols) loop?
467 my ($cols,$colour,@data)=@_;
469 my $string="<tr valign=top bgcolor=$colour>";
471 if (defined $data[$cols]) { # if there is a background image
472 $string.="<td background=\"$data[$cols]\">";
473 } else { # if there's no background image
476 if (! defined $data[$i]) {$data[$i]="";}
477 if ($data[$i] eq "") {
478 $string.=" </td>";
480 $string.="$data[$i]</td>";
484 $string=$string."</tr>\n";
493 Returns a string of HTML, which generates the end of a table
499 return("</table>\n");
502 # FIXME - This is never used.
504 my ($action,%inputs)=@_;
505 my $string="<form action=$action method=post>\n";
506 $string=$string.mktablehdr();
508 my @keys=sort keys %inputs;
512 while ( $i2<$count) {
513 my $value=$inputs{$keys[$i2]};
514 my @data=split('\t',$value);
515 #my $posn = shift(@data);
516 if ($data[0] eq 'hidden'){
517 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
520 if ($data[0] eq 'radio') {
521 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
522 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
524 if ($data[0] eq 'text') {
525 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
527 if ($data[0] eq 'textarea') {
528 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
530 if ($data[0] eq 'select') {
531 $text="<select name=$keys[$i2]>";
533 while ($data[$i] ne "") {
534 my $val = $data[$i+1];
535 $text = $text."<option value=$data[$i]>$val";
538 $text=$text."</select>";
540 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
541 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
545 #$string=$string.join("\n",@order);
546 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
547 $string=$string.mktableft;
548 $string=$string."</form>";
553 $str = &mkform3($action,
554 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
559 Takes a set of arguments that define an input form, generates an HTML
560 string for the form, and returns the string.
562 C<$action> is the action for the form, usually the URL of the script
563 that will process it.
565 The remaining arguments define the fields in the form. C<$fieldname>
566 is the field's name. This is for the script's benefit, and will not be
569 C<$fieldpos> is an integer; fields will be output in order of
570 increasing C<$fieldpos>. This number must be unique: if two fields
571 have the same C<$fieldpos>, one will be picked at random, and the
572 other will be ignored. See below for special considerations, however.
574 C<$fieldtype> specifies the type of the input field. It may be one of
581 Generates a hidden field, used to pass data to the script without
582 showing it to the user. C<$fieldvalue> is the value.
586 Generates a pair of radio buttons, with values C<$fieldvalue> and
587 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
592 Generates a one-line text input field. It initially contains
597 Generates a four-line text input area. The initial text (which, of
598 course, may not contain any tabs) is C<$fieldvalue>.
602 Generates a list of items, from which the user may choose one. This is
603 somewhat different from other input field types, and should be
605 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
606 where the C<text>N strings are the choices that will be presented to
607 the user, and C<label>N are the labels that will be passed to the
610 However, C<text0> should be an integer, since it will be used to
611 determine the order in which this field appears in the form. If any of
612 the C<label>Ns are empty, the rest of the list will be ignored.
619 my ($action, %inputs) = @_;
620 my $string = "<form action=\"$action\" method=\"post\">\n";
621 $string .= mktablehdr();
623 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
628 while ($i2 < $count) {
629 my $value=$inputs{$keys[$i2]};
630 # FIXME - Why use a tab-separated string? Why not just use an
632 my @data=split('\t',$value);
634 if ($data[0] eq 'hidden'){
635 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
638 if ($data[0] eq 'radio') {
639 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
640 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
642 # FIXME - Is 40 the right size in all cases?
643 if ($data[0] eq 'text') {
644 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
646 # FIXME - Is 40x4 the right size in all cases?
647 if ($data[0] eq 'textarea') {
648 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
650 if ($data[0] eq 'select') {
651 $text="<select name=$keys[$i2]>";
653 while ($data[$i] ne "") {
654 my $val = $data[$i+1];
655 $text = $text."<option value=$data[$i]>$val";
656 $i = $i+2; # FIXME - Use $i += 2.
658 $text=$text."</select>";
660 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
661 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
665 my $temp=join("\n",@order);
666 # FIXME - Use ".=". That's what it's for.
667 $string=$string.$temp;
668 $string=$string.mktablerow(1,'white','<input type=submit>');
669 $string=$string.mktableft;
670 $string=$string."</form>";
671 # FIXME - A return statement, while not strictly necessary, would be nice.
676 $str = &mkformnotable($action, @inputs);
679 Takes a set of arguments that define an input form, generates an HTML
680 string for the form, and returns the string. Unlike C<&mkform2> and
681 C<&mkform3>, it does not put the form inside a table.
683 C<$action> is the action for the form, usually the URL of the script
684 that will process it.
686 The remaining arguments define the fields in the form. Each is an
687 anonymous array, e.g.:
689 &mkformnotable("/cgi-bin/foo",
690 [ "hidden", "hiddenvar", "value" ],
691 [ "text", "username", "" ]);
693 The first element of each argument defines its type. The remaining
694 ones are type-dependent. The supported types are:
698 =item C<[ "hidden", $name, $value]>
700 Generates a hidden field, for passing information to a script without
701 showing it to the user. C<$name> is the name of the field, and
702 C<$value> is the value to pass.
704 =item C<[ "radio", $groupname, $value ]>
706 Generates a radio button. Its name (or button group name) is C<$name>.
707 C<$value> is the value associated with the button; this is both the
708 value that will be shown to the user, and that which will be passed on
709 to the C<$action> script.
711 =item C<[ "text", $name, $inittext ]>
713 Generates a text input field. C<$name> specifies its name, and
714 C<$inittext> specifies the text that the field should initially
717 =item C<[ "textarea", $name ]>
719 Creates a 40x4 text area, named C<$name>.
721 =item C<[ "reset", $name, $label ]>
723 Generates a reset button, with name C<$name>. C<$label> specifies the
726 =item C<[ "submit", $name, $label ]>
728 Generates a submit button, with name C<$name>. C<$label> specifies the
736 my ($action,@inputs)=@_;
737 my $string="<form action=$action method=post>\n";
739 for (my $i=0; $i<$count; $i++){
740 if ($inputs[$i][0] eq 'hidden'){
741 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
743 if ($inputs[$i][0] eq 'radio') {
744 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
746 if ($inputs[$i][0] eq 'text') {
747 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
749 if ($inputs[$i][0] eq 'textarea') {
750 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
752 if ($inputs[$i][0] eq 'reset'){
753 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
755 if ($inputs[$i][0] eq 'submit'){
756 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
759 $string=$string."</form>";
764 $str = &mkform2($action,
765 $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
770 Takes a set of arguments that define an input form, generates an HTML
771 string for the form, and returns the string.
773 C<$action> is the action for the form, usually the URL of the script
774 that will process it.
776 The remaining arguments define the fields in the form. C<$fieldname>
777 is the field's name. This is for the script's benefit, and will not be
780 C<$fieldpos> is an integer; fields will be output in order of
781 increasing C<$fieldpos>. This number must be unique: if two fields
782 have the same C<$fieldpos>, one will be picked at random, and the
783 other will be ignored. See below for special considerations, however.
785 If C<$required> is the string C<R>, then the field is required, and
786 the label will have C< (Req.)> appended.
788 C<$label> is a string that will appear next to the input field.
790 C<$fieldtype> specifies the type of the input field. It may be one of
797 Generates a hidden field, used to pass data to the script without
798 showing it to the user. C<$value0> is its value.
802 Generates a pair of radio buttons, with values C<$value0> and
803 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
804 the user, next to the radio button.
808 Generates a one-line text input field. Its size may be specified by
809 C<$value0>. The default is 40. The initial text of the field may be
810 specified by C<$value1>.
814 Generates a text input area. C<$value0> may be a string of the form
815 "WWWxHHH", in which case the text input area will be WWW columns wide
816 and HHH rows tall. The size defaults to 40x4.
818 The initial text (which, of course, may not contain any tabs) may be
819 specified by C<$value1>.
823 Generates a list of items, from which the user may choose one. Here,
824 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
825 pair, the key specifies an internal label for a choice, and the value
826 specifies the description of the choice that will be shown the user.
828 If C<$value0> is the same as one of the keys that follows, then the
829 corresponding choice will initially be selected.
837 # no POD and no tests yet. Once tests are written,
838 # this function can be cleaned up with the following steps:
839 # turn the while loop into a foreach loop
840 # pull the nested if,elsif structure back up to the main level
841 # pull the code for the different kinds of inputs into separate
843 my ($action,%inputs)=@_;
844 my $string="<form action=$action method=post>\n";
845 $string=$string.mktablehdr();
848 while ( my ($key, $value) = each %inputs) {
849 my @data=split('\t',$value);
850 my $posn = shift(@data);
851 my $reqd = shift(@data);
852 my $ltext = shift(@data);
853 if ($data[0] eq 'hidden'){
854 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
857 if ($data[0] eq 'radio') {
858 $text="<input type=radio name=$key value=$data[1]>$data[1]
859 <input type=radio name=$key value=$data[2]>$data[2]";
860 } elsif ($data[0] eq 'text') {
865 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
866 } elsif ($data[0] eq 'textarea') {
867 my @size=split("x",$data[1]);
868 if ($data[1] eq "") {
872 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
873 } elsif ($data[0] eq 'select') {
874 $text="<select name=$key>";
877 while ($data[$i] ne "") {
878 my $val = $data[$i+1];
879 $text = $text."<option value=\"$data[$i]\"";
880 if ($data[$i] eq $sel) {
881 $text = $text." selected";
883 $text = $text.">$val";
886 $text=$text."</select>";
889 $ltext = $ltext." (Req)";
891 $order[$posn] =mktablerow(2,'white',$ltext,$text);
894 $string=$string.join("\n",@order);
895 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
896 $string=$string.mktableft;
897 $string=$string."</form>";
905 Returns a string of HTML, the end of an HTML document.
910 return("</body></html>\n");
915 $str = &mklink($url, $text);
918 Returns an HTML string, where C<$text> is a link to C<$url>.
924 my $string="<a href=\"$url\">$text</a>";
930 $str = &mkheadr($type, $text);
933 Takes a header type and header text, and returns a string of HTML,
934 where C<$text> is rendered with emphasis in a large font size (not an
937 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
938 Type 2 has no special tag at the end; Type 3 ends with a paragraph
945 # would it be better to make this more generic by accepting an optional
946 # argument with a closing tag instead of a numeric type?
951 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
954 $string="<FONT SIZE=6><em>$text</em></FONT>";
957 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
962 =item center and endcenter
964 print ¢er(), "This is a line of centered text.", &endcenter();
966 C<¢er> and C<&endcenter> take no arguments and return HTML tags
967 <CENTER> and </CENTER> respectively.
972 return ("<CENTER>\n");
976 return ("</CENTER>\n");
984 Returns a string of HTML that renders C<$text> in bold.
990 return("<b>$text</b>");
993 =item getkeytableselectoptions
995 $str = &getkeytableselectoptions($dbh, $tablename,
996 $keyfieldname, $descfieldname,
1000 Builds an HTML selection box from a database table. Returns a string
1001 of HTML that implements this.
1003 C<$dbh> is a DBI::db database handle.
1005 C<$tablename> is the database table in which to look up the possible
1006 values for the selection box.
1008 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1009 internal label for the selection.
1011 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1012 option shown to the user.
1014 If C<$showkey> is true, then both the key and value will be shown to
1017 If the C<$default> argument is given, then if a value (from
1018 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1022 #---------------------------------------------
1023 # Create an HTML option list for a <SELECT> form tag by using
1024 # values from a DB file
1025 sub getkeytableselectoptions {
1030 $tablename, # name of table containing list of choices
1031 $keyfieldname, # column name of code to use in option list
1032 $descfieldname, # column name of descriptive field
1033 $showkey, # flag to show key in description
1034 $default, # optional default key
1036 my $selectclause; # return value
1040 $key, $desc, $orderfieldname,
1044 requireDBI($dbh,"getkeytableselectoptions");
1047 $orderfieldname=$keyfieldname;
1049 $orderfieldname=$descfieldname;
1051 $query= "select $keyfieldname,$descfieldname
1053 order by $orderfieldname ";
1054 print "<PRE>Query=$query </PRE>\n" if $debug;
1055 $sth=$dbh->prepare($query);
1057 while ( ($key, $desc) = $sth->fetchrow) {
1058 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1059 $selectclause.="<option";
1060 if (defined $default && $default eq $key) {
1061 $selectclause.=" selected";
1063 $selectclause.=" value='$key'>$desc\n";
1064 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1066 return $selectclause;
1067 } # sub getkeytableselectoptions
1069 #---------------------------------
1071 END { } # module clean-up code here (global destructor)
1080 Koha Developement team <info@koha.org>