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 warn "==>".C4::Context->preference("opaclanguages");
109 # language preference
110 my @themes = split " ", C4::Context->preference("opacthemes");
114 # searches through the themes and languages. First template it find it returns.
115 # Priority is for getting the theme right.
117 foreach my $th (@themes) {
118 foreach my $la (@languages) {
119 # warn "File = $htdocs/$th/$la/$tmpl\n";
120 if (-e "$htdocs/$th/$la/$tmpl") {
127 if ($theme and $lang) {
129 return ($theme, $lang);
132 return ('default', 'en');
139 %values = &pathtotemplate(template => $template,
141 language => $language,
143 path => $includedir);
145 Finds a directory containing the desired template. The C<template>
146 argument specifies the template you're looking for (this should be the
147 name of the script you're using to generate an HTML page, without the
148 C<.pl> extension). Only the C<template> argument is required; the
151 C<theme> specifies the name of the theme to use. This will be used
152 only if it is allowed by the C<allowthemeoverride> system preference
153 option (in the C<systempreferences> table of the Koha database).
155 C<language> specifies the desired language. If not specified,
156 C<&pathtotemplate> will use the list of acceptable languages specified
157 by the browser, then C<all>, and finally C<en> as fallback options.
159 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
160 C<intranet> and C<opac> specify that you want a template for the
161 internal web site or the public OPAC, respectively. C<none> specifies
162 that the template you're looking for is at the top level of one of the
163 include directories. Any other value is taken as-is, as a subdirectory
164 of one of the include directories.
166 C<path> specifies an include directory.
168 C<&pathtotemplate> searches first in the directory given by the
169 C<path> argument, if any, then in the directories given by the
170 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
173 C<&pathtotemplate> returns a hash with the following keys:
179 The full pathname to the desired template.
181 =item C<foundlanguage>
183 The value is set to 1 if a template in the desired language was found,
188 The value is set to 1 if a template of the desired theme was found, or
193 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
195 Note that if a template of the desired language or theme cannot be
196 found, C<&pathtotemplate> will print a warning message. Unless you've
197 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
202 # FIXME - Fix POD: it doesn't look in the directory given by the
203 # 'includes' option in /etc/koha.conf.
206 my $template = $params{'template'};
207 my $themeor = $params{'theme'};
208 my $languageor = lc($params{'language'});
209 my $ptype = lc($params{'type'} or 'intranet');
211 # FIXME - Make sure $params{'template'} was given. Or else assume
214 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
215 elsif ($ptype eq 'none') {$type = ''; }
216 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
217 else {$type = $ptype . '/'; }
220 my $theme = C4::Context->preference("theme") || "default";
222 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
226 my @languageorder = getlanguageorder();
227 my $language = $languageor || shift(@languageorder);
229 #where to search for templates
230 my @tmpldirs = ("$path/templates", $path);
231 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
232 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
234 my ($etheme, $elanguage, $epath);
236 CHECK: foreach my $edir (@tmpldirs) {
237 foreach $etheme ($theme, 'all', 'default') {
238 foreach $elanguage ($language, @languageorder, 'all','en') {
239 # 'en' is the fallback-language
240 if (-e "$edir/$type$etheme/$elanguage/$template") {
241 $epath = "$edir/$type$etheme/$elanguage/$template";
249 warn "Could not find $template in @tmpldirs";
253 if ($language eq $elanguage) {
254 $returns{'foundlanguage'} = 1;
256 $returns{'foundlanguage'} = 0;
257 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
259 if ($theme eq $etheme) {
260 $returns{'foundtheme'} = 1;
262 $returns{'foundtheme'} = 0;
263 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
266 $returns{'path'} = $epath;
271 =item getlanguageorder
273 @languages = &getlanguageorder();
275 Returns the list of languages that the user will accept, and returns
276 them in order of decreasing preference. This is retrieved from the
277 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
278 the C<languageorder> setting from the C<systempreferences> table in
279 the Koha database. If neither is set, it defaults to C<en> (English).
283 sub getlanguageorder () {
286 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
287 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
288 } elsif (my $order = C4::Context->preference("languageorder")) {
289 @languageorder = split (/\s*,\s*/ ,lc($order));
290 } else { # here should be another elsif checking for apache's languageorder
291 @languageorder = ('en');
294 return (@languageorder);
302 Returns a string of HTML, the beginning of a new HTML document.
312 $str = &gotopage("//opac.koha.org/index.html");
315 Generates a snippet of HTML code that will redirect to the given URL
316 (which should not include the initial C<http:>), and returns it.
321 my ($target) = shift;
322 #print "<br>goto target = $target<br>";
323 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
329 @lines = &startmenu($type);
330 print join("", @lines);
332 Given a page type, or category, returns a set of lines of HTML which,
333 when concatenated, generate the menu at the top of the web page.
335 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
336 C<report>, C<circulation>, or something else, in which case the menu
337 will be for the catalog pages.
342 # edit the paths in here
344 if ($type eq 'issue') {
345 open (FILE,"$path/issues-top.inc") || die;
346 } elsif ($type eq 'opac') {
347 open (FILE,"$path/opac-top.inc") || die;
348 } elsif ($type eq 'member') {
349 open (FILE,"$path/members-top.inc") || die;
350 } elsif ($type eq 'acquisitions'){
351 open (FILE,"$path/acquisitions-top.inc") || die;
352 } elsif ($type eq 'report'){
353 open (FILE,"$path/reports-top.inc") || die;
354 } elsif ($type eq 'circulation') {
355 open (FILE,"$path/circulation-top.inc") || die;
357 open (FILE,"$path/cat-top.inc") || die;
362 # $string[$count]="<BLOCKQUOTE>";
368 @lines = &endmenu($type);
369 print join("", @lines);
371 Given a page type, or category, returns a set of lines of HTML which,
372 when concatenated, generate the menu at the bottom of the web page.
374 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
375 C<report>, C<circulation>, or something else, in which case the menu
376 will be for the catalog pages.
382 if ( ! defined $type ) { $type=''; }
383 # FIXME - It's bad form to die in a CGI script. It's even worse form
384 # to die without issuing an error message.
385 if ($type eq 'issue') {
386 open (FILE,"$path/issues-bottom.inc") || die;
387 } elsif ($type eq 'opac') {
388 open (FILE,"$path/opac-bottom.inc") || die;
389 } elsif ($type eq 'member') {
390 open (FILE,"$path/members-bottom.inc") || die;
391 } elsif ($type eq 'acquisitions') {
392 open (FILE,"$path/acquisitions-bottom.inc") || die;
393 } elsif ($type eq 'report') {
394 open (FILE,"$path/reports-bottom.inc") || die;
395 } elsif ($type eq 'circulation') {
396 open (FILE,"$path/circulation-bottom.inc") || die;
398 open (FILE,"$path/cat-bottom.inc") || die;
407 $str = &mktablehdr();
410 Returns a string of HTML, which generates the beginning of a table
416 return("<table border=0 cellspacing=0 cellpadding=5>\n");
421 $str = &mktablerow($columns, $color, @column_data, $bgimage);
424 Returns a string of HTML, which generates a row of data inside a table
425 (see also C<&mktablehdr>, C<&mktableft>).
427 C<$columns> specifies the number of columns in this row of data.
429 C<$color> specifies the background color for the row, e.g., C<"white">
432 C<@column_data> is an array of C<$columns> elements, each one a string
433 of HTML. These are the contents of the row.
435 The optional C<$bgimage> argument specifies the pathname to an image
436 to use as the background for each cell in the row. This pathname will
437 used as is in the output, so it should be relative to the HTTP
443 #the last item in data may be a backgroundimage
446 # should this be a foreach (1..$cols) loop?
448 my ($cols,$colour,@data)=@_;
450 my $string="<tr valign=top bgcolor=$colour>";
452 if (defined $data[$cols]) { # if there is a background image
453 $string.="<td background=\"$data[$cols]\">";
454 } else { # if there's no background image
457 if (! defined $data[$i]) {$data[$i]="";}
458 if ($data[$i] eq "") {
459 $string.=" </td>";
461 $string.="$data[$i]</td>";
465 $string .= "</tr>\n";
474 Returns a string of HTML, which generates the end of a table
480 return("</table>\n");
483 # FIXME - This is never used.
485 my ($action,%inputs)=@_;
486 my $string="<form action=$action method=post>\n";
487 $string .= mktablehdr();
489 my @keys=sort keys %inputs;
493 while ( $i2<$count) {
494 my $value=$inputs{$keys[$i2]};
495 my @data=split('\t',$value);
496 #my $posn = shift(@data);
497 if ($data[0] eq 'hidden'){
498 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
501 if ($data[0] eq 'radio') {
502 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
503 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
505 if ($data[0] eq 'text') {
506 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
508 if ($data[0] eq 'textarea') {
509 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
511 if ($data[0] eq 'select') {
512 $text="<select name=$keys[$i2]>";
514 while ($data[$i] ne "") {
515 my $val = $data[$i+1];
516 $text .= "<option value=$data[$i]>$val";
519 $text .= "</select>";
521 $string .= mktablerow(2,'white',$keys[$i2],$text);
522 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
526 #$string=$string.join("\n",@order);
527 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
528 $string .= mktableft;
529 $string .= "</form>";
534 $str = &mkform3($action,
535 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
540 Takes a set of arguments that define an input form, generates an HTML
541 string for the form, and returns the string.
543 C<$action> is the action for the form, usually the URL of the script
544 that will process it.
546 The remaining arguments define the fields in the form. C<$fieldname>
547 is the field's name. This is for the script's benefit, and will not be
550 C<$fieldpos> is an integer; fields will be output in order of
551 increasing C<$fieldpos>. This number must be unique: if two fields
552 have the same C<$fieldpos>, one will be picked at random, and the
553 other will be ignored. See below for special considerations, however.
555 C<$fieldtype> specifies the type of the input field. It may be one of
562 Generates a hidden field, used to pass data to the script without
563 showing it to the user. C<$fieldvalue> is the value.
567 Generates a pair of radio buttons, with values C<$fieldvalue> and
568 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
573 Generates a one-line text input field. It initially contains
578 Generates a four-line text input area. The initial text (which, of
579 course, may not contain any tabs) is C<$fieldvalue>.
583 Generates a list of items, from which the user may choose one. This is
584 somewhat different from other input field types, and should be
586 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
587 where the C<text>N strings are the choices that will be presented to
588 the user, and C<label>N are the labels that will be passed to the
591 However, C<text0> should be an integer, since it will be used to
592 determine the order in which this field appears in the form. If any of
593 the C<label>Ns are empty, the rest of the list will be ignored.
600 my ($action, %inputs) = @_;
601 my $string = "<form action=\"$action\" method=\"post\">\n";
602 $string .= mktablehdr();
604 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
609 while ($i2 < $count) {
610 my $value=$inputs{$keys[$i2]};
611 # FIXME - Why use a tab-separated string? Why not just use an
613 my @data=split('\t',$value);
615 if ($data[0] eq 'hidden'){
616 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
619 if ($data[0] eq 'radio') {
620 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
621 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
623 # FIXME - Is 40 the right size in all cases?
624 if ($data[0] eq 'text') {
625 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
627 # FIXME - Is 40x4 the right size in all cases?
628 if ($data[0] eq 'textarea') {
629 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
631 if ($data[0] eq 'select') {
632 $text="<select name=$keys[$i2]>";
634 while ($data[$i] ne "") {
635 my $val = $data[$i+1];
636 $text .= "<option value=$data[$i]>$val";
639 $text .= "</select>";
641 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
642 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
646 my $temp=join("\n",@order);
648 $string .= mktablerow(1,'white','<input type=submit>');
649 $string .= mktableft;
650 $string .= "</form>";
651 # FIXME - A return statement, while not strictly necessary, would be nice.
656 $str = &mkformnotable($action, @inputs);
659 Takes a set of arguments that define an input form, generates an HTML
660 string for the form, and returns the string. Unlike C<&mkform2> and
661 C<&mkform3>, it does not put the form inside a table.
663 C<$action> is the action for the form, usually the URL of the script
664 that will process it.
666 The remaining arguments define the fields in the form. Each is an
667 anonymous array, e.g.:
669 &mkformnotable("/cgi-bin/foo",
670 [ "hidden", "hiddenvar", "value" ],
671 [ "text", "username", "" ]);
673 The first element of each argument defines its type. The remaining
674 ones are type-dependent. The supported types are:
678 =item C<[ "hidden", $name, $value]>
680 Generates a hidden field, for passing information to a script without
681 showing it to the user. C<$name> is the name of the field, and
682 C<$value> is the value to pass.
684 =item C<[ "radio", $groupname, $value ]>
686 Generates a radio button. Its name (or button group name) is C<$name>.
687 C<$value> is the value associated with the button; this is both the
688 value that will be shown to the user, and that which will be passed on
689 to the C<$action> script.
691 =item C<[ "text", $name, $inittext ]>
693 Generates a text input field. C<$name> specifies its name, and
694 C<$inittext> specifies the text that the field should initially
697 =item C<[ "textarea", $name ]>
699 Creates a 40x4 text area, named C<$name>.
701 =item C<[ "reset", $name, $label ]>
703 Generates a reset button, with name C<$name>. C<$label> specifies the
706 =item C<[ "submit", $name, $label ]>
708 Generates a submit button, with name C<$name>. C<$label> specifies the
716 my ($action,@inputs)=@_;
717 my $string="<form action=$action method=post>\n";
719 for (my $i=0; $i<$count; $i++){
720 if ($inputs[$i][0] eq 'hidden'){
721 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
723 if ($inputs[$i][0] eq 'radio') {
724 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
726 if ($inputs[$i][0] eq 'text') {
727 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
729 if ($inputs[$i][0] eq 'textarea') {
730 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
732 if ($inputs[$i][0] eq 'reset'){
733 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
735 if ($inputs[$i][0] eq 'submit'){
736 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
739 $string .= "</form>";
744 $str = &mkform2($action,
746 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
751 Takes a set of arguments that define an input form, generates an HTML
752 string for the form, and returns the string.
754 C<$action> is the action for the form, usually the URL of the script
755 that will process it.
757 The remaining arguments define the fields in the form. C<$fieldname>
758 is the field's name. This is for the script's benefit, and will not be
761 C<$fieldpos> is an integer; fields will be output in order of
762 increasing C<$fieldpos>. This number must be unique: if two fields
763 have the same C<$fieldpos>, one will be picked at random, and the
764 other will be ignored. See below for special considerations, however.
766 If C<$required> is the string C<R>, then the field is required, and
767 the label will have C< (Req.)> appended.
769 C<$label> is a string that will appear next to the input field.
771 C<$fieldtype> specifies the type of the input field. It may be one of
778 Generates a hidden field, used to pass data to the script without
779 showing it to the user. C<$value0> is its value.
783 Generates a pair of radio buttons, with values C<$value0> and
784 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
785 the user, next to the radio button.
789 Generates a one-line text input field. Its size may be specified by
790 C<$value0>. The default is 40. The initial text of the field may be
791 specified by C<$value1>.
795 Generates a text input area. C<$value0> may be a string of the form
796 "WWWxHHH", in which case the text input area will be WWW columns wide
797 and HHH rows tall. The size defaults to 40x4.
799 The initial text (which, of course, may not contain any tabs) may be
800 specified by C<$value1>.
804 Generates a list of items, from which the user may choose one. Here,
805 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
806 pair, the key specifies an internal label for a choice, and the value
807 specifies the description of the choice that will be shown the user.
809 If C<$value0> is the same as one of the keys that follows, then the
810 corresponding choice will initially be selected.
818 # No tests yet. Once tests are written,
819 # this function can be cleaned up with the following steps:
820 # turn the while loop into a foreach loop
821 # pull the nested if,elsif structure back up to the main level
822 # pull the code for the different kinds of inputs into separate
824 my ($action,%inputs)=@_;
825 my $string="<form action=$action method=post>\n";
826 $string .= mktablehdr();
829 while ( my ($key, $value) = each %inputs) {
830 my @data=split('\t',$value);
831 my $posn = shift(@data);
832 my $reqd = shift(@data);
833 my $ltext = shift(@data);
834 if ($data[0] eq 'hidden'){
835 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
838 if ($data[0] eq 'radio') {
839 $text="<input type=radio name=$key value=$data[1]>$data[1]
840 <input type=radio name=$key value=$data[2]>$data[2]";
841 } elsif ($data[0] eq 'text') {
846 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
847 } elsif ($data[0] eq 'textarea') {
848 my @size=split("x",$data[1]);
849 if ($data[1] eq "") {
853 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
854 } elsif ($data[0] eq 'select') {
855 $text="<select name=$key>";
858 while ($data[$i] ne "") {
859 my $val = $data[$i+1];
860 $text .= "<option value=\"$data[$i]\"";
861 if ($data[$i] eq $sel) {
862 $text .= " selected";
867 $text .= "</select>";
872 $order[$posn] =mktablerow(2,'white',$ltext,$text);
875 $string .= join("\n",@order);
876 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
877 $string .= mktableft;
878 $string .= "</form>";
886 Returns a string of HTML, the end of an HTML document.
891 return("</body></html>\n");
896 $str = &mklink($url, $text);
899 Returns an HTML string, where C<$text> is a link to C<$url>.
905 my $string="<a href=\"$url\">$text</a>";
911 $str = &mkheadr($type, $text);
914 Takes a header type and header text, and returns a string of HTML,
915 where C<$text> is rendered with emphasis in a large font size (not an
918 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
919 Type 2 has no special tag at the end; Type 3 ends with a paragraph
926 # would it be better to make this more generic by accepting an optional
927 # argument with a closing tag instead of a numeric type?
932 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
935 $string="<FONT SIZE=6><em>$text</em></FONT>";
938 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
943 =item center and endcenter
945 print ¢er(), "This is a line of centered text.", &endcenter();
947 C<¢er> and C<&endcenter> take no arguments and return HTML tags
948 <CENTER> and </CENTER> respectively.
953 return ("<CENTER>\n");
957 return ("</CENTER>\n");
965 Returns a string of HTML that renders C<$text> in bold.
971 return("<b>$text</b>");
974 =item getkeytableselectoptions
976 $str = &getkeytableselectoptions($dbh, $tablename,
977 $keyfieldname, $descfieldname,
981 Builds an HTML selection box from a database table. Returns a string
982 of HTML that implements this.
984 C<$dbh> is a DBI::db database handle.
986 C<$tablename> is the database table in which to look up the possible
987 values for the selection box.
989 C<$keyfieldname> is field in C<$tablename>. It will be used as the
990 internal label for the selection.
992 C<$descfieldname> is a field in C<$tablename>. It will be used as the
993 option shown to the user.
995 If C<$showkey> is true, then both the key and value will be shown to
998 If the C<$default> argument is given, then if a value (from
999 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1003 #---------------------------------------------
1004 # Create an HTML option list for a <SELECT> form tag by using
1005 # values from a DB file
1006 sub getkeytableselectoptions {
1011 # FIXME - Obsolete argument
1012 $tablename, # name of table containing list of choices
1013 $keyfieldname, # column name of code to use in option list
1014 $descfieldname, # column name of descriptive field
1015 $showkey, # flag to show key in description
1016 $default, # optional default key
1018 my $selectclause; # return value
1022 $key, $desc, $orderfieldname,
1026 $dbh = C4::Context->dbh;
1029 $orderfieldname=$keyfieldname;
1031 $orderfieldname=$descfieldname;
1033 $query= "select $keyfieldname,$descfieldname
1035 order by $orderfieldname ";
1036 print "<PRE>Query=$query </PRE>\n" if $debug;
1037 $sth=$dbh->prepare($query);
1039 while ( ($key, $desc) = $sth->fetchrow) {
1040 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1041 $selectclause.="<option";
1042 if (defined $default && $default eq $key) {
1043 $selectclause.=" selected";
1045 $selectclause.=" value='$key'>$desc\n";
1046 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1048 return $selectclause;
1049 } # sub getkeytableselectoptions
1051 #---------------------------------
1053 END { } # module clean-up code here (global destructor)
1062 Koha Developement team <info@koha.org>