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
31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 # set the version for version checking
38 C4::Output - Functions for generating HTML for the Koha web interface
44 $str = &mklink("http://www.koha.org/", "Koha web page");
49 The functions in this module generate HTML, and return the result as a
59 @EXPORT = qw(&startpage &endpage
60 &mktablehdr &mktableft &mktablerow &mklink
61 &startmenu &endmenu &mkheadr
63 &mkform &mkform2 &bold
64 &gotopage &mkformnotable &mkform3
65 &getkeytableselectoptions
67 &themelanguage &gettemplate
69 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
71 # your exported package globals go here,
72 # as well as any optionally exported functions
74 @EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
77 # non-exported package globals go here
78 use vars qw(@more $stuff); # FIXME - These are never used
80 # initalize package globals, first exported ones
82 # FIXME - These are never used
87 # then the others (which are still accessible as $Some::Module::stuff)
88 # FIXME - These are never used
92 # all file-scoped lexicals must be created before
93 # the functions below that use them.
95 my $path = C4::Context->config('includes') ||
96 "/usr/local/www/hdl/htdocs/includes";
98 #---------------------------------------------------------------------------------------------------------
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 #---------------------------------------------------------------------------------------------------------
124 my ($htdocs, $tmpl) = @_;
126 my $dbh = C4::Context->dbh;
127 my @languages = split " ", C4::Context->preference("opaclanguages");
128 # language preference
129 my @themes = split " ", C4::Context->preference("opacthemes");
133 # searches through the themes and languages. First template it find it returns.
134 # Priority is for getting the theme right.
136 foreach my $th (@themes) {
137 foreach my $la (@languages) {
138 warn "File = $htdocs/$th/$la/$tmpl\n";
139 if (-e "$htdocs/$th/$la/$tmpl") {
146 if ($theme and $lang) {
147 return ($theme, $lang);
149 return ('default', 'en');
156 %values = &pathtotemplate(template => $template,
158 language => $language,
160 path => $includedir);
162 Finds a directory containing the desired template. The C<template>
163 argument specifies the template you're looking for (this should be the
164 name of the script you're using to generate an HTML page, without the
165 C<.pl> extension). Only the C<template> argument is required; the
168 C<theme> specifies the name of the theme to use. This will be used
169 only if it is allowed by the C<allowthemeoverride> system preference
170 option (in the C<systempreferences> table of the Koha database).
172 C<language> specifies the desired language. If not specified,
173 C<&pathtotemplate> will use the list of acceptable languages specified
174 by the browser, then C<all>, and finally C<en> as fallback options.
176 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
177 C<intranet> and C<opac> specify that you want a template for the
178 internal web site or the public OPAC, respectively. C<none> specifies
179 that the template you're looking for is at the top level of one of the
180 include directories. Any other value is taken as-is, as a subdirectory
181 of one of the include directories.
183 C<path> specifies an include directory.
185 C<&pathtotemplate> searches first in the directory given by the
186 C<path> argument, if any, then in the directories given by the
187 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
190 C<&pathtotemplate> returns a hash with the following keys:
196 The full pathname to the desired template.
198 =item C<foundlanguage>
200 The value is set to 1 if a template in the desired language was found,
205 The value is set to 1 if a template of the desired theme was found, or
210 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
212 Note that if a template of the desired language or theme cannot be
213 found, C<&pathtotemplate> will print a warning message. Unless you've
214 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
219 # FIXME - Fix POD: it doesn't look in the directory given by the
220 # 'includes' option in /etc/koha.conf.
223 my $template = $params{'template'};
224 my $themeor = $params{'theme'};
225 my $languageor = lc($params{'language'});
226 my $ptype = lc($params{'type'} or 'intranet');
228 # FIXME - Make sure $params{'template'} was given. Or else assume
231 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
232 elsif ($ptype eq 'none') {$type = ''; }
233 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
234 else {$type = $ptype . '/'; }
237 my $theme = C4::Context->preference("theme") || "default";
239 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
243 my @languageorder = getlanguageorder();
244 my $language = $languageor || shift(@languageorder);
246 #where to search for templates
247 my @tmpldirs = ("$path/templates", $path);
248 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
249 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
251 my ($etheme, $elanguage, $epath);
253 CHECK: foreach my $edir (@tmpldirs) {
254 foreach $etheme ($theme, 'all', 'default') {
255 foreach $elanguage ($language, @languageorder, 'all','en') {
256 # 'en' is the fallback-language
257 if (-e "$edir/$type$etheme/$elanguage/$template") {
258 $epath = "$edir/$type$etheme/$elanguage/$template";
266 warn "Could not find $template in @tmpldirs";
270 if ($language eq $elanguage) {
271 $returns{'foundlanguage'} = 1;
273 $returns{'foundlanguage'} = 0;
274 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
276 if ($theme eq $etheme) {
277 $returns{'foundtheme'} = 1;
279 $returns{'foundtheme'} = 0;
280 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
283 $returns{'path'} = $epath;
288 =item getlanguageorder
290 @languages = &getlanguageorder();
292 Returns the list of languages that the user will accept, and returns
293 them in order of decreasing preference. This is retrieved from the
294 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
295 the C<languageorder> setting from the C<systempreferences> table in
296 the Koha database. If neither is set, it defaults to C<en> (English).
300 sub getlanguageorder () {
303 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
304 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
305 } elsif (my $order = C4::Context->preference("languageorder")) {
306 @languageorder = split (/\s*,\s*/ ,lc($order));
307 } else { # here should be another elsif checking for apache's languageorder
308 @languageorder = ('en');
311 return (@languageorder);
319 Returns a string of HTML, the beginning of a new HTML document.
329 $str = &gotopage("//opac.koha.org/index.html");
332 Generates a snippet of HTML code that will redirect to the given URL
333 (which should not include the initial C<http:>), and returns it.
338 my ($target) = shift;
339 #print "<br>goto target = $target<br>";
340 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
346 @lines = &startmenu($type);
347 print join("", @lines);
349 Given a page type, or category, returns a set of lines of HTML which,
350 when concatenated, generate the menu at the top of the web page.
352 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
353 C<report>, C<circulation>, or something else, in which case the menu
354 will be for the catalog pages.
359 # edit the paths in here
361 if ($type eq 'issue') {
362 open (FILE,"$path/issues-top.inc") || die;
363 } elsif ($type eq 'opac') {
364 open (FILE,"$path/opac-top.inc") || die;
365 } elsif ($type eq 'member') {
366 open (FILE,"$path/members-top.inc") || die;
367 } elsif ($type eq 'acquisitions'){
368 open (FILE,"$path/acquisitions-top.inc") || die;
369 } elsif ($type eq 'report'){
370 open (FILE,"$path/reports-top.inc") || die;
371 } elsif ($type eq 'circulation') {
372 open (FILE,"$path/circulation-top.inc") || die;
374 open (FILE,"$path/cat-top.inc") || die;
379 # $string[$count]="<BLOCKQUOTE>";
385 @lines = &endmenu($type);
386 print join("", @lines);
388 Given a page type, or category, returns a set of lines of HTML which,
389 when concatenated, generate the menu at the bottom of the web page.
391 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
392 C<report>, C<circulation>, or something else, in which case the menu
393 will be for the catalog pages.
399 if ( ! defined $type ) { $type=''; }
400 # FIXME - It's bad form to die in a CGI script. It's even worse form
401 # to die without issuing an error message.
402 if ($type eq 'issue') {
403 open (FILE,"$path/issues-bottom.inc") || die;
404 } elsif ($type eq 'opac') {
405 open (FILE,"$path/opac-bottom.inc") || die;
406 } elsif ($type eq 'member') {
407 open (FILE,"$path/members-bottom.inc") || die;
408 } elsif ($type eq 'acquisitions') {
409 open (FILE,"$path/acquisitions-bottom.inc") || die;
410 } elsif ($type eq 'report') {
411 open (FILE,"$path/reports-bottom.inc") || die;
412 } elsif ($type eq 'circulation') {
413 open (FILE,"$path/circulation-bottom.inc") || die;
415 open (FILE,"$path/cat-bottom.inc") || die;
424 $str = &mktablehdr();
427 Returns a string of HTML, which generates the beginning of a table
433 return("<table border=0 cellspacing=0 cellpadding=5>\n");
438 $str = &mktablerow($columns, $color, @column_data, $bgimage);
441 Returns a string of HTML, which generates a row of data inside a table
442 (see also C<&mktablehdr>, C<&mktableft>).
444 C<$columns> specifies the number of columns in this row of data.
446 C<$color> specifies the background color for the row, e.g., C<"white">
449 C<@column_data> is an array of C<$columns> elements, each one a string
450 of HTML. These are the contents of the row.
452 The optional C<$bgimage> argument specifies the pathname to an image
453 to use as the background for each cell in the row. This pathname will
454 used as is in the output, so it should be relative to the HTTP
460 #the last item in data may be a backgroundimage
463 # should this be a foreach (1..$cols) loop?
465 my ($cols,$colour,@data)=@_;
467 my $string="<tr valign=top bgcolor=$colour>";
469 if (defined $data[$cols]) { # if there is a background image
470 $string.="<td background=\"$data[$cols]\">";
471 } else { # if there's no background image
474 if (! defined $data[$i]) {$data[$i]="";}
475 if ($data[$i] eq "") {
476 $string.=" </td>";
478 $string.="$data[$i]</td>";
482 $string=$string."</tr>\n";
491 Returns a string of HTML, which generates the end of a table
497 return("</table>\n");
500 # FIXME - This is never used.
502 my ($action,%inputs)=@_;
503 my $string="<form action=$action method=post>\n";
504 $string=$string.mktablehdr();
506 my @keys=sort keys %inputs;
510 while ( $i2<$count) {
511 my $value=$inputs{$keys[$i2]};
512 my @data=split('\t',$value);
513 #my $posn = shift(@data);
514 if ($data[0] eq 'hidden'){
515 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
518 if ($data[0] eq 'radio') {
519 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
520 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
522 if ($data[0] eq 'text') {
523 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
525 if ($data[0] eq 'textarea') {
526 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
528 if ($data[0] eq 'select') {
529 $text="<select name=$keys[$i2]>";
531 while ($data[$i] ne "") {
532 my $val = $data[$i+1];
533 $text = $text."<option value=$data[$i]>$val";
536 $text=$text."</select>";
538 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
539 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
543 #$string=$string.join("\n",@order);
544 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
545 $string=$string.mktableft;
546 $string=$string."</form>";
551 $str = &mkform3($action,
552 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
557 Takes a set of arguments that define an input form, generates an HTML
558 string for the form, and returns the string.
560 C<$action> is the action for the form, usually the URL of the script
561 that will process it.
563 The remaining arguments define the fields in the form. C<$fieldname>
564 is the field's name. This is for the script's benefit, and will not be
567 C<$fieldpos> is an integer; fields will be output in order of
568 increasing C<$fieldpos>. This number must be unique: if two fields
569 have the same C<$fieldpos>, one will be picked at random, and the
570 other will be ignored. See below for special considerations, however.
572 C<$fieldtype> specifies the type of the input field. It may be one of
579 Generates a hidden field, used to pass data to the script without
580 showing it to the user. C<$fieldvalue> is the value.
584 Generates a pair of radio buttons, with values C<$fieldvalue> and
585 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
590 Generates a one-line text input field. It initially contains
595 Generates a four-line text input area. The initial text (which, of
596 course, may not contain any tabs) is C<$fieldvalue>.
600 Generates a list of items, from which the user may choose one. This is
601 somewhat different from other input field types, and should be
603 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
604 where the C<text>N strings are the choices that will be presented to
605 the user, and C<label>N are the labels that will be passed to the
608 However, C<text0> should be an integer, since it will be used to
609 determine the order in which this field appears in the form. If any of
610 the C<label>Ns are empty, the rest of the list will be ignored.
617 my ($action, %inputs) = @_;
618 my $string = "<form action=\"$action\" method=\"post\">\n";
619 $string .= mktablehdr();
621 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
626 while ($i2 < $count) {
627 my $value=$inputs{$keys[$i2]};
628 # FIXME - Why use a tab-separated string? Why not just use an
630 my @data=split('\t',$value);
632 if ($data[0] eq 'hidden'){
633 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
636 if ($data[0] eq 'radio') {
637 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
638 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
640 # FIXME - Is 40 the right size in all cases?
641 if ($data[0] eq 'text') {
642 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
644 # FIXME - Is 40x4 the right size in all cases?
645 if ($data[0] eq 'textarea') {
646 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
648 if ($data[0] eq 'select') {
649 $text="<select name=$keys[$i2]>";
651 while ($data[$i] ne "") {
652 my $val = $data[$i+1];
653 $text = $text."<option value=$data[$i]>$val";
654 $i = $i+2; # FIXME - Use $i += 2.
656 $text=$text."</select>";
658 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
659 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
663 my $temp=join("\n",@order);
664 # FIXME - Use ".=". That's what it's for.
665 $string=$string.$temp;
666 $string=$string.mktablerow(1,'white','<input type=submit>');
667 $string=$string.mktableft;
668 $string=$string."</form>";
669 # FIXME - A return statement, while not strictly necessary, would be nice.
674 $str = &mkformnotable($action, @inputs);
677 Takes a set of arguments that define an input form, generates an HTML
678 string for the form, and returns the string. Unlike C<&mkform2> and
679 C<&mkform3>, it does not put the form inside a table.
681 C<$action> is the action for the form, usually the URL of the script
682 that will process it.
684 The remaining arguments define the fields in the form. Each is an
685 anonymous array, e.g.:
687 &mkformnotable("/cgi-bin/foo",
688 [ "hidden", "hiddenvar", "value" ],
689 [ "text", "username", "" ]);
691 The first element of each argument defines its type. The remaining
692 ones are type-dependent. The supported types are:
696 =item C<[ "hidden", $name, $value]>
698 Generates a hidden field, for passing information to a script without
699 showing it to the user. C<$name> is the name of the field, and
700 C<$value> is the value to pass.
702 =item C<[ "radio", $groupname, $value ]>
704 Generates a radio button. Its name (or button group name) is C<$name>.
705 C<$value> is the value associated with the button; this is both the
706 value that will be shown to the user, and that which will be passed on
707 to the C<$action> script.
709 =item C<[ "text", $name, $inittext ]>
711 Generates a text input field. C<$name> specifies its name, and
712 C<$inittext> specifies the text that the field should initially
715 =item C<[ "textarea", $name ]>
717 Creates a 40x4 text area, named C<$name>.
719 =item C<[ "reset", $name, $label ]>
721 Generates a reset button, with name C<$name>. C<$label> specifies the
724 =item C<[ "submit", $name, $label ]>
726 Generates a submit button, with name C<$name>. C<$label> specifies the
734 my ($action,@inputs)=@_;
735 my $string="<form action=$action method=post>\n";
737 for (my $i=0; $i<$count; $i++){
738 if ($inputs[$i][0] eq 'hidden'){
739 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
741 if ($inputs[$i][0] eq 'radio') {
742 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
744 if ($inputs[$i][0] eq 'text') {
745 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
747 if ($inputs[$i][0] eq 'textarea') {
748 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
750 if ($inputs[$i][0] eq 'reset'){
751 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
753 if ($inputs[$i][0] eq 'submit'){
754 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
757 $string=$string."</form>";
762 $str = &mkform2($action,
764 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
769 Takes a set of arguments that define an input form, generates an HTML
770 string for the form, and returns the string.
772 C<$action> is the action for the form, usually the URL of the script
773 that will process it.
775 The remaining arguments define the fields in the form. C<$fieldname>
776 is the field's name. This is for the script's benefit, and will not be
779 C<$fieldpos> is an integer; fields will be output in order of
780 increasing C<$fieldpos>. This number must be unique: if two fields
781 have the same C<$fieldpos>, one will be picked at random, and the
782 other will be ignored. See below for special considerations, however.
784 If C<$required> is the string C<R>, then the field is required, and
785 the label will have C< (Req.)> appended.
787 C<$label> is a string that will appear next to the input field.
789 C<$fieldtype> specifies the type of the input field. It may be one of
796 Generates a hidden field, used to pass data to the script without
797 showing it to the user. C<$value0> is its value.
801 Generates a pair of radio buttons, with values C<$value0> and
802 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
803 the user, next to the radio button.
807 Generates a one-line text input field. Its size may be specified by
808 C<$value0>. The default is 40. The initial text of the field may be
809 specified by C<$value1>.
813 Generates a text input area. C<$value0> may be a string of the form
814 "WWWxHHH", in which case the text input area will be WWW columns wide
815 and HHH rows tall. The size defaults to 40x4.
817 The initial text (which, of course, may not contain any tabs) may be
818 specified by C<$value1>.
822 Generates a list of items, from which the user may choose one. Here,
823 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
824 pair, the key specifies an internal label for a choice, and the value
825 specifies the description of the choice that will be shown the user.
827 If C<$value0> is the same as one of the keys that follows, then the
828 corresponding choice will initially be selected.
836 # no POD and no tests yet. Once tests are written,
837 # this function can be cleaned up with the following steps:
838 # turn the while loop into a foreach loop
839 # pull the nested if,elsif structure back up to the main level
840 # pull the code for the different kinds of inputs into separate
842 my ($action,%inputs)=@_;
843 my $string="<form action=$action method=post>\n";
844 $string=$string.mktablehdr();
847 while ( my ($key, $value) = each %inputs) {
848 my @data=split('\t',$value);
849 my $posn = shift(@data);
850 my $reqd = shift(@data);
851 my $ltext = shift(@data);
852 if ($data[0] eq 'hidden'){
853 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
856 if ($data[0] eq 'radio') {
857 $text="<input type=radio name=$key value=$data[1]>$data[1]
858 <input type=radio name=$key value=$data[2]>$data[2]";
859 } elsif ($data[0] eq 'text') {
864 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
865 } elsif ($data[0] eq 'textarea') {
866 my @size=split("x",$data[1]);
867 if ($data[1] eq "") {
871 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
872 } elsif ($data[0] eq 'select') {
873 $text="<select name=$key>";
876 while ($data[$i] ne "") {
877 my $val = $data[$i+1];
878 $text = $text."<option value=\"$data[$i]\"";
879 if ($data[$i] eq $sel) {
880 $text = $text." selected";
882 $text = $text.">$val";
885 $text=$text."</select>";
888 $ltext = $ltext." (Req)";
890 $order[$posn] =mktablerow(2,'white',$ltext,$text);
893 $string=$string.join("\n",@order);
894 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
895 $string=$string.mktableft;
896 $string=$string."</form>";
904 Returns a string of HTML, the end of an HTML document.
909 return("</body></html>\n");
914 $str = &mklink($url, $text);
917 Returns an HTML string, where C<$text> is a link to C<$url>.
923 my $string="<a href=\"$url\">$text</a>";
929 $str = &mkheadr($type, $text);
932 Takes a header type and header text, and returns a string of HTML,
933 where C<$text> is rendered with emphasis in a large font size (not an
936 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
937 Type 2 has no special tag at the end; Type 3 ends with a paragraph
944 # would it be better to make this more generic by accepting an optional
945 # argument with a closing tag instead of a numeric type?
950 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
953 $string="<FONT SIZE=6><em>$text</em></FONT>";
956 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
961 =item center and endcenter
963 print ¢er(), "This is a line of centered text.", &endcenter();
965 C<¢er> and C<&endcenter> take no arguments and return HTML tags
966 <CENTER> and </CENTER> respectively.
971 return ("<CENTER>\n");
975 return ("</CENTER>\n");
983 Returns a string of HTML that renders C<$text> in bold.
989 return("<b>$text</b>");
992 =item getkeytableselectoptions
994 $str = &getkeytableselectoptions($dbh, $tablename,
995 $keyfieldname, $descfieldname,
999 Builds an HTML selection box from a database table. Returns a string
1000 of HTML that implements this.
1002 C<$dbh> is a DBI::db database handle.
1004 C<$tablename> is the database table in which to look up the possible
1005 values for the selection box.
1007 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1008 internal label for the selection.
1010 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1011 option shown to the user.
1013 If C<$showkey> is true, then both the key and value will be shown to
1016 If the C<$default> argument is given, then if a value (from
1017 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1021 #---------------------------------------------
1022 # Create an HTML option list for a <SELECT> form tag by using
1023 # values from a DB file
1024 sub getkeytableselectoptions {
1029 # FIXME - Obsolete argument
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 $dbh = C4::Context->dbh;
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>