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) = @_;
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");
101 #---------------------------------------------------------------------------------------------------------
104 my ($htdocs, $tmpl) = @_;
106 my $dbh = C4::Context->dbh;
107 my @languages = split " ", C4::Context->preference("opaclanguages");
108 # language preference
109 my @themes = split " ", C4::Context->preference("opacthemes");
113 # searches through the themes and languages. First template it find it returns.
114 # Priority is for getting the theme right.
116 foreach my $th (@themes) {
117 foreach my $la (@languages) {
118 warn "File = $htdocs/$th/$la/$tmpl\n";
119 if (-e "$htdocs/$th/$la/$tmpl") {
126 if ($theme and $lang) {
127 return ($theme, $lang);
129 return ('default', 'en');
136 %values = &pathtotemplate(template => $template,
138 language => $language,
140 path => $includedir);
142 Finds a directory containing the desired template. The C<template>
143 argument specifies the template you're looking for (this should be the
144 name of the script you're using to generate an HTML page, without the
145 C<.pl> extension). Only the C<template> argument is required; the
148 C<theme> specifies the name of the theme to use. This will be used
149 only if it is allowed by the C<allowthemeoverride> system preference
150 option (in the C<systempreferences> table of the Koha database).
152 C<language> specifies the desired language. If not specified,
153 C<&pathtotemplate> will use the list of acceptable languages specified
154 by the browser, then C<all>, and finally C<en> as fallback options.
156 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
157 C<intranet> and C<opac> specify that you want a template for the
158 internal web site or the public OPAC, respectively. C<none> specifies
159 that the template you're looking for is at the top level of one of the
160 include directories. Any other value is taken as-is, as a subdirectory
161 of one of the include directories.
163 C<path> specifies an include directory.
165 C<&pathtotemplate> searches first in the directory given by the
166 C<path> argument, if any, then in the directories given by the
167 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
170 C<&pathtotemplate> returns a hash with the following keys:
176 The full pathname to the desired template.
178 =item C<foundlanguage>
180 The value is set to 1 if a template in the desired language was found,
185 The value is set to 1 if a template of the desired theme was found, or
190 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
192 Note that if a template of the desired language or theme cannot be
193 found, C<&pathtotemplate> will print a warning message. Unless you've
194 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
199 # FIXME - Fix POD: it doesn't look in the directory given by the
200 # 'includes' option in /etc/koha.conf.
203 my $template = $params{'template'};
204 my $themeor = $params{'theme'};
205 my $languageor = lc($params{'language'});
206 my $ptype = lc($params{'type'} or 'intranet');
208 # FIXME - Make sure $params{'template'} was given. Or else assume
211 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
212 elsif ($ptype eq 'none') {$type = ''; }
213 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
214 else {$type = $ptype . '/'; }
217 my $theme = C4::Context->preference("theme") || "default";
219 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
223 my @languageorder = getlanguageorder();
224 my $language = $languageor || shift(@languageorder);
226 #where to search for templates
227 my @tmpldirs = ("$path/templates", $path);
228 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
229 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
231 my ($etheme, $elanguage, $epath);
233 CHECK: foreach my $edir (@tmpldirs) {
234 foreach $etheme ($theme, 'all', 'default') {
235 foreach $elanguage ($language, @languageorder, 'all','en') {
236 # 'en' is the fallback-language
237 if (-e "$edir/$type$etheme/$elanguage/$template") {
238 $epath = "$edir/$type$etheme/$elanguage/$template";
246 warn "Could not find $template in @tmpldirs";
250 if ($language eq $elanguage) {
251 $returns{'foundlanguage'} = 1;
253 $returns{'foundlanguage'} = 0;
254 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
256 if ($theme eq $etheme) {
257 $returns{'foundtheme'} = 1;
259 $returns{'foundtheme'} = 0;
260 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
263 $returns{'path'} = $epath;
268 =item getlanguageorder
270 @languages = &getlanguageorder();
272 Returns the list of languages that the user will accept, and returns
273 them in order of decreasing preference. This is retrieved from the
274 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
275 the C<languageorder> setting from the C<systempreferences> table in
276 the Koha database. If neither is set, it defaults to C<en> (English).
280 sub getlanguageorder () {
283 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
284 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
285 } elsif (my $order = C4::Context->preference("languageorder")) {
286 @languageorder = split (/\s*,\s*/ ,lc($order));
287 } else { # here should be another elsif checking for apache's languageorder
288 @languageorder = ('en');
291 return (@languageorder);
299 Returns a string of HTML, the beginning of a new HTML document.
309 $str = &gotopage("//opac.koha.org/index.html");
312 Generates a snippet of HTML code that will redirect to the given URL
313 (which should not include the initial C<http:>), and returns it.
318 my ($target) = shift;
319 #print "<br>goto target = $target<br>";
320 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
326 @lines = &startmenu($type);
327 print join("", @lines);
329 Given a page type, or category, returns a set of lines of HTML which,
330 when concatenated, generate the menu at the top of the web page.
332 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
333 C<report>, C<circulation>, or something else, in which case the menu
334 will be for the catalog pages.
339 # edit the paths in here
341 if ($type eq 'issue') {
342 open (FILE,"$path/issues-top.inc") || die;
343 } elsif ($type eq 'opac') {
344 open (FILE,"$path/opac-top.inc") || die;
345 } elsif ($type eq 'member') {
346 open (FILE,"$path/members-top.inc") || die;
347 } elsif ($type eq 'acquisitions'){
348 open (FILE,"$path/acquisitions-top.inc") || die;
349 } elsif ($type eq 'report'){
350 open (FILE,"$path/reports-top.inc") || die;
351 } elsif ($type eq 'circulation') {
352 open (FILE,"$path/circulation-top.inc") || die;
354 open (FILE,"$path/cat-top.inc") || die;
359 # $string[$count]="<BLOCKQUOTE>";
365 @lines = &endmenu($type);
366 print join("", @lines);
368 Given a page type, or category, returns a set of lines of HTML which,
369 when concatenated, generate the menu at the bottom of the web page.
371 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
372 C<report>, C<circulation>, or something else, in which case the menu
373 will be for the catalog pages.
379 if ( ! defined $type ) { $type=''; }
380 # FIXME - It's bad form to die in a CGI script. It's even worse form
381 # to die without issuing an error message.
382 if ($type eq 'issue') {
383 open (FILE,"$path/issues-bottom.inc") || die;
384 } elsif ($type eq 'opac') {
385 open (FILE,"$path/opac-bottom.inc") || die;
386 } elsif ($type eq 'member') {
387 open (FILE,"$path/members-bottom.inc") || die;
388 } elsif ($type eq 'acquisitions') {
389 open (FILE,"$path/acquisitions-bottom.inc") || die;
390 } elsif ($type eq 'report') {
391 open (FILE,"$path/reports-bottom.inc") || die;
392 } elsif ($type eq 'circulation') {
393 open (FILE,"$path/circulation-bottom.inc") || die;
395 open (FILE,"$path/cat-bottom.inc") || die;
404 $str = &mktablehdr();
407 Returns a string of HTML, which generates the beginning of a table
413 return("<table border=0 cellspacing=0 cellpadding=5>\n");
418 $str = &mktablerow($columns, $color, @column_data, $bgimage);
421 Returns a string of HTML, which generates a row of data inside a table
422 (see also C<&mktablehdr>, C<&mktableft>).
424 C<$columns> specifies the number of columns in this row of data.
426 C<$color> specifies the background color for the row, e.g., C<"white">
429 C<@column_data> is an array of C<$columns> elements, each one a string
430 of HTML. These are the contents of the row.
432 The optional C<$bgimage> argument specifies the pathname to an image
433 to use as the background for each cell in the row. This pathname will
434 used as is in the output, so it should be relative to the HTTP
440 #the last item in data may be a backgroundimage
443 # should this be a foreach (1..$cols) loop?
445 my ($cols,$colour,@data)=@_;
447 my $string="<tr valign=top bgcolor=$colour>";
449 if (defined $data[$cols]) { # if there is a background image
450 $string.="<td background=\"$data[$cols]\">";
451 } else { # if there's no background image
454 if (! defined $data[$i]) {$data[$i]="";}
455 if ($data[$i] eq "") {
456 $string.=" </td>";
458 $string.="$data[$i]</td>";
462 $string .= "</tr>\n";
471 Returns a string of HTML, which generates the end of a table
477 return("</table>\n");
480 # FIXME - This is never used.
482 my ($action,%inputs)=@_;
483 my $string="<form action=$action method=post>\n";
484 $string .= mktablehdr();
486 my @keys=sort keys %inputs;
490 while ( $i2<$count) {
491 my $value=$inputs{$keys[$i2]};
492 my @data=split('\t',$value);
493 #my $posn = shift(@data);
494 if ($data[0] eq 'hidden'){
495 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
498 if ($data[0] eq 'radio') {
499 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
500 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
502 if ($data[0] eq 'text') {
503 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
505 if ($data[0] eq 'textarea') {
506 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
508 if ($data[0] eq 'select') {
509 $text="<select name=$keys[$i2]>";
511 while ($data[$i] ne "") {
512 my $val = $data[$i+1];
513 $text .= "<option value=$data[$i]>$val";
516 $text .= "</select>";
518 $string .= mktablerow(2,'white',$keys[$i2],$text);
519 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
523 #$string=$string.join("\n",@order);
524 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
525 $string .= mktableft;
526 $string .= "</form>";
531 $str = &mkform3($action,
532 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
537 Takes a set of arguments that define an input form, generates an HTML
538 string for the form, and returns the string.
540 C<$action> is the action for the form, usually the URL of the script
541 that will process it.
543 The remaining arguments define the fields in the form. C<$fieldname>
544 is the field's name. This is for the script's benefit, and will not be
547 C<$fieldpos> is an integer; fields will be output in order of
548 increasing C<$fieldpos>. This number must be unique: if two fields
549 have the same C<$fieldpos>, one will be picked at random, and the
550 other will be ignored. See below for special considerations, however.
552 C<$fieldtype> specifies the type of the input field. It may be one of
559 Generates a hidden field, used to pass data to the script without
560 showing it to the user. C<$fieldvalue> is the value.
564 Generates a pair of radio buttons, with values C<$fieldvalue> and
565 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
570 Generates a one-line text input field. It initially contains
575 Generates a four-line text input area. The initial text (which, of
576 course, may not contain any tabs) is C<$fieldvalue>.
580 Generates a list of items, from which the user may choose one. This is
581 somewhat different from other input field types, and should be
583 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
584 where the C<text>N strings are the choices that will be presented to
585 the user, and C<label>N are the labels that will be passed to the
588 However, C<text0> should be an integer, since it will be used to
589 determine the order in which this field appears in the form. If any of
590 the C<label>Ns are empty, the rest of the list will be ignored.
597 my ($action, %inputs) = @_;
598 my $string = "<form action=\"$action\" method=\"post\">\n";
599 $string .= mktablehdr();
601 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
606 while ($i2 < $count) {
607 my $value=$inputs{$keys[$i2]};
608 # FIXME - Why use a tab-separated string? Why not just use an
610 my @data=split('\t',$value);
612 if ($data[0] eq 'hidden'){
613 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
616 if ($data[0] eq 'radio') {
617 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
618 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
620 # FIXME - Is 40 the right size in all cases?
621 if ($data[0] eq 'text') {
622 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
624 # FIXME - Is 40x4 the right size in all cases?
625 if ($data[0] eq 'textarea') {
626 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
628 if ($data[0] eq 'select') {
629 $text="<select name=$keys[$i2]>";
631 while ($data[$i] ne "") {
632 my $val = $data[$i+1];
633 $text .= "<option value=$data[$i]>$val";
636 $text .= "</select>";
638 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
639 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
643 my $temp=join("\n",@order);
645 $string .= mktablerow(1,'white','<input type=submit>');
646 $string .= mktableft;
647 $string .= "</form>";
648 # FIXME - A return statement, while not strictly necessary, would be nice.
653 $str = &mkformnotable($action, @inputs);
656 Takes a set of arguments that define an input form, generates an HTML
657 string for the form, and returns the string. Unlike C<&mkform2> and
658 C<&mkform3>, it does not put the form inside a table.
660 C<$action> is the action for the form, usually the URL of the script
661 that will process it.
663 The remaining arguments define the fields in the form. Each is an
664 anonymous array, e.g.:
666 &mkformnotable("/cgi-bin/foo",
667 [ "hidden", "hiddenvar", "value" ],
668 [ "text", "username", "" ]);
670 The first element of each argument defines its type. The remaining
671 ones are type-dependent. The supported types are:
675 =item C<[ "hidden", $name, $value]>
677 Generates a hidden field, for passing information to a script without
678 showing it to the user. C<$name> is the name of the field, and
679 C<$value> is the value to pass.
681 =item C<[ "radio", $groupname, $value ]>
683 Generates a radio button. Its name (or button group name) is C<$name>.
684 C<$value> is the value associated with the button; this is both the
685 value that will be shown to the user, and that which will be passed on
686 to the C<$action> script.
688 =item C<[ "text", $name, $inittext ]>
690 Generates a text input field. C<$name> specifies its name, and
691 C<$inittext> specifies the text that the field should initially
694 =item C<[ "textarea", $name ]>
696 Creates a 40x4 text area, named C<$name>.
698 =item C<[ "reset", $name, $label ]>
700 Generates a reset button, with name C<$name>. C<$label> specifies the
703 =item C<[ "submit", $name, $label ]>
705 Generates a submit button, with name C<$name>. C<$label> specifies the
713 my ($action,@inputs)=@_;
714 my $string="<form action=$action method=post>\n";
716 for (my $i=0; $i<$count; $i++){
717 if ($inputs[$i][0] eq 'hidden'){
718 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
720 if ($inputs[$i][0] eq 'radio') {
721 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
723 if ($inputs[$i][0] eq 'text') {
724 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
726 if ($inputs[$i][0] eq 'textarea') {
727 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
729 if ($inputs[$i][0] eq 'reset'){
730 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
732 if ($inputs[$i][0] eq 'submit'){
733 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
736 $string .= "</form>";
741 $str = &mkform2($action,
743 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
748 Takes a set of arguments that define an input form, generates an HTML
749 string for the form, and returns the string.
751 C<$action> is the action for the form, usually the URL of the script
752 that will process it.
754 The remaining arguments define the fields in the form. C<$fieldname>
755 is the field's name. This is for the script's benefit, and will not be
758 C<$fieldpos> is an integer; fields will be output in order of
759 increasing C<$fieldpos>. This number must be unique: if two fields
760 have the same C<$fieldpos>, one will be picked at random, and the
761 other will be ignored. See below for special considerations, however.
763 If C<$required> is the string C<R>, then the field is required, and
764 the label will have C< (Req.)> appended.
766 C<$label> is a string that will appear next to the input field.
768 C<$fieldtype> specifies the type of the input field. It may be one of
775 Generates a hidden field, used to pass data to the script without
776 showing it to the user. C<$value0> is its value.
780 Generates a pair of radio buttons, with values C<$value0> and
781 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
782 the user, next to the radio button.
786 Generates a one-line text input field. Its size may be specified by
787 C<$value0>. The default is 40. The initial text of the field may be
788 specified by C<$value1>.
792 Generates a text input area. C<$value0> may be a string of the form
793 "WWWxHHH", in which case the text input area will be WWW columns wide
794 and HHH rows tall. The size defaults to 40x4.
796 The initial text (which, of course, may not contain any tabs) may be
797 specified by C<$value1>.
801 Generates a list of items, from which the user may choose one. Here,
802 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
803 pair, the key specifies an internal label for a choice, and the value
804 specifies the description of the choice that will be shown the user.
806 If C<$value0> is the same as one of the keys that follows, then the
807 corresponding choice will initially be selected.
815 # No tests yet. Once tests are written,
816 # this function can be cleaned up with the following steps:
817 # turn the while loop into a foreach loop
818 # pull the nested if,elsif structure back up to the main level
819 # pull the code for the different kinds of inputs into separate
821 my ($action,%inputs)=@_;
822 my $string="<form action=$action method=post>\n";
823 $string .= mktablehdr();
826 while ( my ($key, $value) = each %inputs) {
827 my @data=split('\t',$value);
828 my $posn = shift(@data);
829 my $reqd = shift(@data);
830 my $ltext = shift(@data);
831 if ($data[0] eq 'hidden'){
832 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
835 if ($data[0] eq 'radio') {
836 $text="<input type=radio name=$key value=$data[1]>$data[1]
837 <input type=radio name=$key value=$data[2]>$data[2]";
838 } elsif ($data[0] eq 'text') {
843 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
844 } elsif ($data[0] eq 'textarea') {
845 my @size=split("x",$data[1]);
846 if ($data[1] eq "") {
850 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
851 } elsif ($data[0] eq 'select') {
852 $text="<select name=$key>";
855 while ($data[$i] ne "") {
856 my $val = $data[$i+1];
857 $text .= "<option value=\"$data[$i]\"";
858 if ($data[$i] eq $sel) {
859 $text .= " selected";
864 $text .= "</select>";
869 $order[$posn] =mktablerow(2,'white',$ltext,$text);
872 $string .= join("\n",@order);
873 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
874 $string .= mktableft;
875 $string .= "</form>";
883 Returns a string of HTML, the end of an HTML document.
888 return("</body></html>\n");
893 $str = &mklink($url, $text);
896 Returns an HTML string, where C<$text> is a link to C<$url>.
902 my $string="<a href=\"$url\">$text</a>";
908 $str = &mkheadr($type, $text);
911 Takes a header type and header text, and returns a string of HTML,
912 where C<$text> is rendered with emphasis in a large font size (not an
915 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
916 Type 2 has no special tag at the end; Type 3 ends with a paragraph
923 # would it be better to make this more generic by accepting an optional
924 # argument with a closing tag instead of a numeric type?
929 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
932 $string="<FONT SIZE=6><em>$text</em></FONT>";
935 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
940 =item center and endcenter
942 print ¢er(), "This is a line of centered text.", &endcenter();
944 C<¢er> and C<&endcenter> take no arguments and return HTML tags
945 <CENTER> and </CENTER> respectively.
950 return ("<CENTER>\n");
954 return ("</CENTER>\n");
962 Returns a string of HTML that renders C<$text> in bold.
968 return("<b>$text</b>");
971 =item getkeytableselectoptions
973 $str = &getkeytableselectoptions($dbh, $tablename,
974 $keyfieldname, $descfieldname,
978 Builds an HTML selection box from a database table. Returns a string
979 of HTML that implements this.
981 C<$dbh> is a DBI::db database handle.
983 C<$tablename> is the database table in which to look up the possible
984 values for the selection box.
986 C<$keyfieldname> is field in C<$tablename>. It will be used as the
987 internal label for the selection.
989 C<$descfieldname> is a field in C<$tablename>. It will be used as the
990 option shown to the user.
992 If C<$showkey> is true, then both the key and value will be shown to
995 If the C<$default> argument is given, then if a value (from
996 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1000 #---------------------------------------------
1001 # Create an HTML option list for a <SELECT> form tag by using
1002 # values from a DB file
1003 sub getkeytableselectoptions {
1008 # FIXME - Obsolete argument
1009 $tablename, # name of table containing list of choices
1010 $keyfieldname, # column name of code to use in option list
1011 $descfieldname, # column name of descriptive field
1012 $showkey, # flag to show key in description
1013 $default, # optional default key
1015 my $selectclause; # return value
1019 $key, $desc, $orderfieldname,
1023 $dbh = C4::Context->dbh;
1026 $orderfieldname=$keyfieldname;
1028 $orderfieldname=$descfieldname;
1030 $query= "select $keyfieldname,$descfieldname
1032 order by $orderfieldname ";
1033 print "<PRE>Query=$query </PRE>\n" if $debug;
1034 $sth=$dbh->prepare($query);
1036 while ( ($key, $desc) = $sth->fetchrow) {
1037 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1038 $selectclause.="<option";
1039 if (defined $default && $default eq $key) {
1040 $selectclause.=" selected";
1042 $selectclause.=" value='$key'>$desc\n";
1043 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1045 return $selectclause;
1046 } # sub getkeytableselectoptions
1048 #---------------------------------
1050 END { } # module clean-up code here (global destructor)
1059 Koha Developement team <info@koha.org>