5 #package to deal with marking up output
6 #You will need to edit parts of this pm
7 #set the value of path to be where your html lives
10 # Copyright 2000-2002 Katipo Communications
12 # This file is part of Koha.
14 # Koha is free software; you can redistribute it and/or modify it under the
15 # terms of the GNU General Public License as published by the Free Software
16 # Foundation; either version 2 of the License, or (at your option) any later
19 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
20 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
21 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
23 # You should have received a copy of the GNU General Public License along with
24 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
25 # Suite 330, Boston, MA 02111-1307 USA
27 # NOTE: I'm pretty sure this module is deprecated in favor of
36 use vars qw($VERSION @ISA @EXPORT);
38 # set the version for version checking
43 C4::Output - Functions for generating HTML for the Koha web interface
49 $str = &mklink("http://www.koha.org/", "Koha web page");
54 The functions in this module generate HTML, and return the result as a
64 @EXPORT = qw(&startpage &endpage
65 &mktablehdr &mktableft &mktablerow &mklink
66 &startmenu &endmenu &mkheadr
68 &mkform &mkform2 &bold
69 &gotopage &mkformnotable &mkform3
70 &getkeytableselectoptions
72 &themelanguage &gettemplate
75 my $path = C4::Context->config('includes') ||
76 "/usr/local/www/hdl/htdocs/includes";
78 #---------------------------------------------------------------------------------------------------------
81 my ($tmplbase, $opac) = @_;
84 if ($opac ne "intranet") {
85 $htdocs = C4::Context->config('opachtdocs');
87 $htdocs = C4::Context->config('intrahtdocs');
90 my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
92 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
93 die_on_bad_params => 0,
95 path => ["$htdocs/$theme/$lang/includes"]);
97 $template->param(themelang => "/$theme/$lang",
103 #---------------------------------------------------------------------------------------------------------
106 my ($htdocs, $tmpl) = @_;
108 my $dbh = C4::Context->dbh;
109 my @languages = split " ", C4::Context->preference("opaclanguages");
110 # language preference
111 my @themes = split " ", C4::Context->preference("opacthemes");
115 # searches through the themes and languages. First template it find it returns.
116 # Priority is for getting the theme right.
118 foreach my $th (@themes) {
119 foreach my $la (@languages) {
120 # warn "File = $htdocs/$th/$la/$tmpl\n";
121 if (-e "$htdocs/$th/$la/$tmpl") {
128 if ($theme and $lang) {
129 return ($theme, $lang);
131 return ('default', 'en');
138 %values = &pathtotemplate(template => $template,
140 language => $language,
142 path => $includedir);
144 Finds a directory containing the desired template. The C<template>
145 argument specifies the template you're looking for (this should be the
146 name of the script you're using to generate an HTML page, without the
147 C<.pl> extension). Only the C<template> argument is required; the
150 C<theme> specifies the name of the theme to use. This will be used
151 only if it is allowed by the C<allowthemeoverride> system preference
152 option (in the C<systempreferences> table of the Koha database).
154 C<language> specifies the desired language. If not specified,
155 C<&pathtotemplate> will use the list of acceptable languages specified
156 by the browser, then C<all>, and finally C<en> as fallback options.
158 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
159 C<intranet> and C<opac> specify that you want a template for the
160 internal web site or the public OPAC, respectively. C<none> specifies
161 that the template you're looking for is at the top level of one of the
162 include directories. Any other value is taken as-is, as a subdirectory
163 of one of the include directories.
165 C<path> specifies an include directory.
167 C<&pathtotemplate> searches first in the directory given by the
168 C<path> argument, if any, then in the directories given by the
169 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
172 C<&pathtotemplate> returns a hash with the following keys:
178 The full pathname to the desired template.
180 =item C<foundlanguage>
182 The value is set to 1 if a template in the desired language was found,
187 The value is set to 1 if a template of the desired theme was found, or
192 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
194 Note that if a template of the desired language or theme cannot be
195 found, C<&pathtotemplate> will print a warning message. Unless you've
196 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
201 # FIXME - Fix POD: it doesn't look in the directory given by the
202 # 'includes' option in /etc/koha.conf.
205 my $template = $params{'template'};
206 my $themeor = $params{'theme'};
207 my $languageor = lc($params{'language'});
208 my $ptype = lc($params{'type'} or 'intranet');
210 # FIXME - Make sure $params{'template'} was given. Or else assume
213 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
214 elsif ($ptype eq 'none') {$type = ''; }
215 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
216 else {$type = $ptype . '/'; }
219 my $theme = C4::Context->preference("theme") || "default";
221 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
225 my @languageorder = getlanguageorder();
226 my $language = $languageor || shift(@languageorder);
228 #where to search for templates
229 my @tmpldirs = ("$path/templates", $path);
230 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
231 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
233 my ($etheme, $elanguage, $epath);
235 CHECK: foreach my $edir (@tmpldirs) {
236 foreach $etheme ($theme, 'all', 'default') {
237 foreach $elanguage ($language, @languageorder, 'all','en') {
238 # 'en' is the fallback-language
239 if (-e "$edir/$type$etheme/$elanguage/$template") {
240 $epath = "$edir/$type$etheme/$elanguage/$template";
248 warn "Could not find $template in @tmpldirs";
252 if ($language eq $elanguage) {
253 $returns{'foundlanguage'} = 1;
255 $returns{'foundlanguage'} = 0;
256 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
258 if ($theme eq $etheme) {
259 $returns{'foundtheme'} = 1;
261 $returns{'foundtheme'} = 0;
262 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
265 $returns{'path'} = $epath;
270 =item getlanguageorder
272 @languages = &getlanguageorder();
274 Returns the list of languages that the user will accept, and returns
275 them in order of decreasing preference. This is retrieved from the
276 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
277 the C<languageorder> setting from the C<systempreferences> table in
278 the Koha database. If neither is set, it defaults to C<en> (English).
282 sub getlanguageorder () {
285 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
286 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
287 } elsif (my $order = C4::Context->preference("languageorder")) {
288 @languageorder = split (/\s*,\s*/ ,lc($order));
289 } else { # here should be another elsif checking for apache's languageorder
290 @languageorder = ('en');
293 return (@languageorder);
301 Returns a string of HTML, the beginning of a new HTML document.
311 $str = &gotopage("//opac.koha.org/index.html");
314 Generates a snippet of HTML code that will redirect to the given URL
315 (which should not include the initial C<http:>), and returns it.
320 my ($target) = shift;
321 #print "<br>goto target = $target<br>";
322 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
328 @lines = &startmenu($type);
329 print join("", @lines);
331 Given a page type, or category, returns a set of lines of HTML which,
332 when concatenated, generate the menu at the top of the web page.
334 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
335 C<report>, C<circulation>, or something else, in which case the menu
336 will be for the catalog pages.
341 # edit the paths in here
343 if ($type eq 'issue') {
344 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
345 } elsif ($type eq 'opac') {
346 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
347 } elsif ($type eq 'member') {
348 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
349 } elsif ($type eq 'acquisitions'){
350 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
351 } elsif ($type eq 'report'){
352 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
353 } elsif ($type eq 'circulation') {
354 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
356 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
361 # $string[$count]="<BLOCKQUOTE>";
367 @lines = &endmenu($type);
368 print join("", @lines);
370 Given a page type, or category, returns a set of lines of HTML which,
371 when concatenated, generate the menu at the bottom of the web page.
373 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
374 C<report>, C<circulation>, or something else, in which case the menu
375 will be for the catalog pages.
381 if ( ! defined $type ) { $type=''; }
382 # FIXME - It's bad form to die in a CGI script. It's even worse form
383 # to die without issuing an error message.
384 if ($type eq 'issue') {
385 open (FILE,"<$path/issues-bottom.inc") || die;
386 } elsif ($type eq 'opac') {
387 open (FILE,"<$path/opac-bottom.inc") || die;
388 } elsif ($type eq 'member') {
389 open (FILE,"<$path/members-bottom.inc") || die;
390 } elsif ($type eq 'acquisitions') {
391 open (FILE,"<$path/acquisitions-bottom.inc") || die;
392 } elsif ($type eq 'report') {
393 open (FILE,"<$path/reports-bottom.inc") || die;
394 } elsif ($type eq 'circulation') {
395 open (FILE,"<$path/circulation-bottom.inc") || die;
397 open (FILE,"<$path/cat-bottom.inc") || die;
406 $str = &mktablehdr();
409 Returns a string of HTML, which generates the beginning of a table
415 return("<table border=0 cellspacing=0 cellpadding=5>\n");
420 $str = &mktablerow($columns, $color, @column_data, $bgimage);
423 Returns a string of HTML, which generates a row of data inside a table
424 (see also C<&mktablehdr>, C<&mktableft>).
426 C<$columns> specifies the number of columns in this row of data.
428 C<$color> specifies the background color for the row, e.g., C<"white">
431 C<@column_data> is an array of C<$columns> elements, each one a string
432 of HTML. These are the contents of the row.
434 The optional C<$bgimage> argument specifies the pathname to an image
435 to use as the background for each cell in the row. This pathname will
436 used as is in the output, so it should be relative to the HTTP
442 #the last item in data may be a backgroundimage
445 # should this be a foreach (1..$cols) loop?
447 my ($cols,$colour,@data)=@_;
449 my $string="<tr valign=top bgcolor=$colour>";
451 if (defined $data[$cols]) { # if there is a background image
452 $string.="<td background=\"$data[$cols]\">";
453 } else { # if there's no background image
456 if (! defined $data[$i]) {$data[$i]="";}
457 if ($data[$i] eq "") {
458 $string.=" </td>";
460 $string.="$data[$i]</td>";
464 $string .= "</tr>\n";
473 Returns a string of HTML, which generates the end of a table
479 return("</table>\n");
482 # FIXME - This is never used.
484 my ($action,%inputs)=@_;
485 my $string="<form action=$action method=post>\n";
486 $string .= mktablehdr();
488 my @keys=sort keys %inputs;
492 while ( $i2<$count) {
493 my $value=$inputs{$keys[$i2]};
494 my @data=split('\t',$value);
495 #my $posn = shift(@data);
496 if ($data[0] eq 'hidden'){
497 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
500 if ($data[0] eq 'radio') {
501 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
502 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
504 if ($data[0] eq 'text') {
505 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
507 if ($data[0] eq 'textarea') {
508 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
510 if ($data[0] eq 'select') {
511 $text="<select name=$keys[$i2]>";
513 while ($data[$i] ne "") {
514 my $val = $data[$i+1];
515 $text .= "<option value=$data[$i]>$val";
518 $text .= "</select>";
520 $string .= mktablerow(2,'white',$keys[$i2],$text);
521 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
525 #$string=$string.join("\n",@order);
526 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
527 $string .= mktableft;
528 $string .= "</form>";
533 $str = &mkform3($action,
534 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
539 Takes a set of arguments that define an input form, generates an HTML
540 string for the form, and returns the string.
542 C<$action> is the action for the form, usually the URL of the script
543 that will process it.
545 The remaining arguments define the fields in the form. C<$fieldname>
546 is the field's name. This is for the script's benefit, and will not be
549 C<$fieldpos> is an integer; fields will be output in order of
550 increasing C<$fieldpos>. This number must be unique: if two fields
551 have the same C<$fieldpos>, one will be picked at random, and the
552 other will be ignored. See below for special considerations, however.
554 C<$fieldtype> specifies the type of the input field. It may be one of
561 Generates a hidden field, used to pass data to the script without
562 showing it to the user. C<$fieldvalue> is the value.
566 Generates a pair of radio buttons, with values C<$fieldvalue> and
567 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
572 Generates a one-line text input field. It initially contains
577 Generates a four-line text input area. The initial text (which, of
578 course, may not contain any tabs) is C<$fieldvalue>.
582 Generates a list of items, from which the user may choose one. This is
583 somewhat different from other input field types, and should be
585 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
586 where the C<text>N strings are the choices that will be presented to
587 the user, and C<label>N are the labels that will be passed to the
590 However, C<text0> should be an integer, since it will be used to
591 determine the order in which this field appears in the form. If any of
592 the C<label>Ns are empty, the rest of the list will be ignored.
599 my ($action, %inputs) = @_;
600 my $string = "<form action=\"$action\" method=\"post\">\n";
601 $string .= mktablehdr();
603 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
608 while ($i2 < $count) {
609 my $value=$inputs{$keys[$i2]};
610 # FIXME - Why use a tab-separated string? Why not just use an
612 my @data=split('\t',$value);
614 if ($data[0] eq 'hidden'){
615 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
618 if ($data[0] eq 'radio') {
619 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
620 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
622 # FIXME - Is 40 the right size in all cases?
623 if ($data[0] eq 'text') {
624 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
626 # FIXME - Is 40x4 the right size in all cases?
627 if ($data[0] eq 'textarea') {
628 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
630 if ($data[0] eq 'select') {
631 $text="<select name=$keys[$i2]>";
633 while ($data[$i] ne "") {
634 my $val = $data[$i+1];
635 $text .= "<option value=$data[$i]>$val";
638 $text .= "</select>";
640 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
641 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
645 my $temp=join("\n",@order);
647 $string .= mktablerow(1,'white','<input type=submit>');
648 $string .= mktableft;
649 $string .= "</form>";
650 # FIXME - A return statement, while not strictly necessary, would be nice.
655 $str = &mkformnotable($action, @inputs);
658 Takes a set of arguments that define an input form, generates an HTML
659 string for the form, and returns the string. Unlike C<&mkform2> and
660 C<&mkform3>, it does not put the form inside a table.
662 C<$action> is the action for the form, usually the URL of the script
663 that will process it.
665 The remaining arguments define the fields in the form. Each is an
666 anonymous array, e.g.:
668 &mkformnotable("/cgi-bin/foo",
669 [ "hidden", "hiddenvar", "value" ],
670 [ "text", "username", "" ]);
672 The first element of each argument defines its type. The remaining
673 ones are type-dependent. The supported types are:
677 =item C<[ "hidden", $name, $value]>
679 Generates a hidden field, for passing information to a script without
680 showing it to the user. C<$name> is the name of the field, and
681 C<$value> is the value to pass.
683 =item C<[ "radio", $groupname, $value ]>
685 Generates a radio button. Its name (or button group name) is C<$name>.
686 C<$value> is the value associated with the button; this is both the
687 value that will be shown to the user, and that which will be passed on
688 to the C<$action> script.
690 =item C<[ "text", $name, $inittext ]>
692 Generates a text input field. C<$name> specifies its name, and
693 C<$inittext> specifies the text that the field should initially
696 =item C<[ "textarea", $name ]>
698 Creates a 40x4 text area, named C<$name>.
700 =item C<[ "reset", $name, $label ]>
702 Generates a reset button, with name C<$name>. C<$label> specifies the
705 =item C<[ "submit", $name, $label ]>
707 Generates a submit button, with name C<$name>. C<$label> specifies the
715 my ($action,@inputs)=@_;
716 my $string="<form action=$action method=post>\n";
718 for (my $i=0; $i<$count; $i++){
719 if ($inputs[$i][0] eq 'hidden'){
720 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
722 if ($inputs[$i][0] eq 'radio') {
723 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
725 if ($inputs[$i][0] eq 'text') {
726 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
728 if ($inputs[$i][0] eq 'textarea') {
729 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
731 if ($inputs[$i][0] eq 'reset'){
732 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
734 if ($inputs[$i][0] eq 'submit'){
735 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
738 $string .= "</form>";
743 $str = &mkform2($action,
745 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
750 Takes a set of arguments that define an input form, generates an HTML
751 string for the form, and returns the string.
753 C<$action> is the action for the form, usually the URL of the script
754 that will process it.
756 The remaining arguments define the fields in the form. C<$fieldname>
757 is the field's name. This is for the script's benefit, and will not be
760 C<$fieldpos> is an integer; fields will be output in order of
761 increasing C<$fieldpos>. This number must be unique: if two fields
762 have the same C<$fieldpos>, one will be picked at random, and the
763 other will be ignored. See below for special considerations, however.
765 If C<$required> is the string C<R>, then the field is required, and
766 the label will have C< (Req.)> appended.
768 C<$label> is a string that will appear next to the input field.
770 C<$fieldtype> specifies the type of the input field. It may be one of
777 Generates a hidden field, used to pass data to the script without
778 showing it to the user. C<$value0> is its value.
782 Generates a pair of radio buttons, with values C<$value0> and
783 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
784 the user, next to the radio button.
788 Generates a one-line text input field. Its size may be specified by
789 C<$value0>. The default is 40. The initial text of the field may be
790 specified by C<$value1>.
794 Generates a text input area. C<$value0> may be a string of the form
795 "WWWxHHH", in which case the text input area will be WWW columns wide
796 and HHH rows tall. The size defaults to 40x4.
798 The initial text (which, of course, may not contain any tabs) may be
799 specified by C<$value1>.
803 Generates a list of items, from which the user may choose one. Here,
804 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
805 pair, the key specifies an internal label for a choice, and the value
806 specifies the description of the choice that will be shown the user.
808 If C<$value0> is the same as one of the keys that follows, then the
809 corresponding choice will initially be selected.
817 # No tests yet. Once tests are written,
818 # this function can be cleaned up with the following steps:
819 # turn the while loop into a foreach loop
820 # pull the nested if,elsif structure back up to the main level
821 # pull the code for the different kinds of inputs into separate
823 my ($action,%inputs)=@_;
824 my $string="<form action=$action method=post>\n";
825 $string .= mktablehdr();
828 while ( my ($key, $value) = each %inputs) {
829 my @data=split('\t',$value);
830 my $posn = shift(@data);
831 my $reqd = shift(@data);
832 my $ltext = shift(@data);
833 if ($data[0] eq 'hidden'){
834 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
837 if ($data[0] eq 'radio') {
838 $text="<input type=radio name=$key value=$data[1]>$data[1]
839 <input type=radio name=$key value=$data[2]>$data[2]";
840 } elsif ($data[0] eq 'text') {
845 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
846 } elsif ($data[0] eq 'textarea') {
847 my @size=split("x",$data[1]);
848 if ($data[1] eq "") {
852 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
853 } elsif ($data[0] eq 'select') {
854 $text="<select name=$key>";
857 while ($data[$i] ne "") {
858 my $val = $data[$i+1];
859 $text .= "<option value=\"$data[$i]\"";
860 if ($data[$i] eq $sel) {
861 $text .= " selected";
866 $text .= "</select>";
871 $order[$posn] =mktablerow(2,'white',$ltext,$text);
874 $string .= join("\n",@order);
875 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
876 $string .= mktableft;
877 $string .= "</form>";
885 Returns a string of HTML, the end of an HTML document.
890 return("</body></html>\n");
895 $str = &mklink($url, $text);
898 Returns an HTML string, where C<$text> is a link to C<$url>.
904 my $string="<a href=\"$url\">$text</a>";
910 $str = &mkheadr($type, $text);
913 Takes a header type and header text, and returns a string of HTML,
914 where C<$text> is rendered with emphasis in a large font size (not an
917 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
918 Type 2 has no special tag at the end; Type 3 ends with a paragraph
925 # would it be better to make this more generic by accepting an optional
926 # argument with a closing tag instead of a numeric type?
931 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
934 $string="<FONT SIZE=6><em>$text</em></FONT>";
937 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
942 =item center and endcenter
944 print ¢er(), "This is a line of centered text.", &endcenter();
946 C<¢er> and C<&endcenter> take no arguments and return HTML tags
947 <CENTER> and </CENTER> respectively.
952 return ("<CENTER>\n");
956 return ("</CENTER>\n");
964 Returns a string of HTML that renders C<$text> in bold.
970 return("<b>$text</b>");
973 =item getkeytableselectoptions
975 $str = &getkeytableselectoptions($dbh, $tablename,
976 $keyfieldname, $descfieldname,
980 Builds an HTML selection box from a database table. Returns a string
981 of HTML that implements this.
983 C<$dbh> is a DBI::db database handle.
985 C<$tablename> is the database table in which to look up the possible
986 values for the selection box.
988 C<$keyfieldname> is field in C<$tablename>. It will be used as the
989 internal label for the selection.
991 C<$descfieldname> is a field in C<$tablename>. It will be used as the
992 option shown to the user.
994 If C<$showkey> is true, then both the key and value will be shown to
997 If the C<$default> argument is given, then if a value (from
998 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1002 #---------------------------------------------
1003 # Create an HTML option list for a <SELECT> form tag by using
1004 # values from a DB file
1005 sub getkeytableselectoptions {
1010 # FIXME - Obsolete argument
1011 $tablename, # name of table containing list of choices
1012 $keyfieldname, # column name of code to use in option list
1013 $descfieldname, # column name of descriptive field
1014 $showkey, # flag to show key in description
1015 $default, # optional default key
1017 my $selectclause; # return value
1021 $key, $desc, $orderfieldname,
1025 $dbh = C4::Context->dbh;
1028 $orderfieldname=$keyfieldname;
1030 $orderfieldname=$descfieldname;
1032 $query= "select $keyfieldname,$descfieldname
1034 order by $orderfieldname ";
1035 print "<PRE>Query=$query </PRE>\n" if $debug;
1036 $sth=$dbh->prepare($query);
1038 while ( ($key, $desc) = $sth->fetchrow) {
1039 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1040 $selectclause.="<option";
1041 if (defined $default && $default eq $key) {
1042 $selectclause.=" selected";
1044 $selectclause.=" value='$key'>$desc\n";
1045 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1047 return $selectclause;
1048 } # sub getkeytableselectoptions
1050 #---------------------------------
1052 END { } # module clean-up code here (global destructor)
1061 Koha Developement team <info@koha.org>