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
37 use vars qw($VERSION @ISA @EXPORT);
39 # set the version for version checking
44 C4::Output - Functions for generating HTML for the Koha web interface
50 $str = &mklink("http://www.koha.org/", "Koha web page");
55 The functions in this module generate HTML, and return the result as a
65 @EXPORT = qw(&startpage &endpage
66 &mktablehdr &mktableft &mktablerow &mklink
67 &startmenu &endmenu &mkheadr
69 &mkform &mkform2 &bold
70 &gotopage &mkformnotable &mkform3
71 &getkeytableselectoptions
73 &themelanguage &gettemplate
76 my $path = C4::Context->config('includes') ||
77 "/usr/local/www/hdl/htdocs/includes";
79 #---------------------------------------------------------------------------------------------------------
82 my ($tmplbase, $opac) = @_;
85 if ($opac ne "intranet") {
86 $htdocs = C4::Context->config('opachtdocs');
88 $htdocs = C4::Context->config('intrahtdocs');
91 my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
93 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
94 die_on_bad_params => 0,
96 path => ["$htdocs/$theme/$lang/includes"]);
98 # XXX temporary patch for Bug 182 for themelang
99 $template->param(themelang => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl') . "/$theme/$lang",
105 #---------------------------------------------------------------------------------------------------------
108 my ($htdocs, $tmpl) = @_;
110 my $dbh = C4::Context->dbh;
111 my @languages = split " ", C4::Context->preference("opaclanguages");
112 # language preference
113 my @themes = split " ", C4::Context->preference("opacthemes");
117 # searches through the themes and languages. First template it find it returns.
118 # Priority is for getting the theme right.
120 foreach my $th (@themes) {
121 foreach my $la (@languages) {
122 # warn "File = $htdocs/$th/$la/$tmpl\n";
123 if (-e "$htdocs/$th/$la/$tmpl") {
130 if ($theme and $lang) {
131 return ($theme, $lang);
133 return ('default', 'en');
140 %values = &pathtotemplate(template => $template,
142 language => $language,
144 path => $includedir);
146 Finds a directory containing the desired template. The C<template>
147 argument specifies the template you're looking for (this should be the
148 name of the script you're using to generate an HTML page, without the
149 C<.pl> extension). Only the C<template> argument is required; the
152 C<theme> specifies the name of the theme to use. This will be used
153 only if it is allowed by the C<allowthemeoverride> system preference
154 option (in the C<systempreferences> table of the Koha database).
156 C<language> specifies the desired language. If not specified,
157 C<&pathtotemplate> will use the list of acceptable languages specified
158 by the browser, then C<all>, and finally C<en> as fallback options.
160 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
161 C<intranet> and C<opac> specify that you want a template for the
162 internal web site or the public OPAC, respectively. C<none> specifies
163 that the template you're looking for is at the top level of one of the
164 include directories. Any other value is taken as-is, as a subdirectory
165 of one of the include directories.
167 C<path> specifies an include directory.
169 C<&pathtotemplate> searches first in the directory given by the
170 C<path> argument, if any, then in the directories given by the
171 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
174 C<&pathtotemplate> returns a hash with the following keys:
180 The full pathname to the desired template.
182 =item C<foundlanguage>
184 The value is set to 1 if a template in the desired language was found,
189 The value is set to 1 if a template of the desired theme was found, or
194 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
196 Note that if a template of the desired language or theme cannot be
197 found, C<&pathtotemplate> will print a warning message. Unless you've
198 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
203 # FIXME - Fix POD: it doesn't look in the directory given by the
204 # 'includes' option in /etc/koha.conf.
207 my $template = $params{'template'};
208 my $themeor = $params{'theme'};
209 my $languageor = lc($params{'language'});
210 my $ptype = lc($params{'type'} or 'intranet');
212 # FIXME - Make sure $params{'template'} was given. Or else assume
215 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
216 elsif ($ptype eq 'none') {$type = ''; }
217 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
218 else {$type = $ptype . '/'; }
221 my $theme = C4::Context->preference("theme") || "default";
223 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
227 my @languageorder = getlanguageorder();
228 my $language = $languageor || shift(@languageorder);
230 #where to search for templates
231 my @tmpldirs = ("$path/templates", $path);
232 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
233 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
235 my ($etheme, $elanguage, $epath);
237 CHECK: foreach my $edir (@tmpldirs) {
238 foreach $etheme ($theme, 'all', 'default') {
239 foreach $elanguage ($language, @languageorder, 'all','en') {
240 # 'en' is the fallback-language
241 if (-e "$edir/$type$etheme/$elanguage/$template") {
242 $epath = "$edir/$type$etheme/$elanguage/$template";
250 warn "Could not find $template in @tmpldirs";
254 if ($language eq $elanguage) {
255 $returns{'foundlanguage'} = 1;
257 $returns{'foundlanguage'} = 0;
258 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
260 if ($theme eq $etheme) {
261 $returns{'foundtheme'} = 1;
263 $returns{'foundtheme'} = 0;
264 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
267 $returns{'path'} = $epath;
272 =item getlanguageorder
274 @languages = &getlanguageorder();
276 Returns the list of languages that the user will accept, and returns
277 them in order of decreasing preference. This is retrieved from the
278 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
279 the C<languageorder> setting from the C<systempreferences> table in
280 the Koha database. If neither is set, it defaults to C<en> (English).
284 sub getlanguageorder () {
287 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
288 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
289 } elsif (my $order = C4::Context->preference("languageorder")) {
290 @languageorder = split (/\s*,\s*/ ,lc($order));
291 } else { # here should be another elsif checking for apache's languageorder
292 @languageorder = ('en');
295 return (@languageorder);
303 Returns a string of HTML, the beginning of a new HTML document.
313 $str = &gotopage("//opac.koha.org/index.html");
316 Generates a snippet of HTML code that will redirect to the given URL
317 (which should not include the initial C<http:>), and returns it.
322 my ($target) = shift;
323 #print "<br>goto target = $target<br>";
324 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
330 @lines = &startmenu($type);
331 print join("", @lines);
333 Given a page type, or category, returns a set of lines of HTML which,
334 when concatenated, generate the menu at the top of the web page.
336 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
337 C<report>, C<circulation>, or something else, in which case the menu
338 will be for the catalog pages.
343 # edit the paths in here
345 if ($type eq 'issue') {
346 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
347 } elsif ($type eq 'opac') {
348 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
349 } elsif ($type eq 'member') {
350 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
351 } elsif ($type eq 'acquisitions'){
352 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
353 } elsif ($type eq 'report'){
354 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
355 } elsif ($type eq 'circulation') {
356 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
358 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
363 # $string[$count]="<BLOCKQUOTE>";
369 @lines = &endmenu($type);
370 print join("", @lines);
372 Given a page type, or category, returns a set of lines of HTML which,
373 when concatenated, generate the menu at the bottom of the web page.
375 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
376 C<report>, C<circulation>, or something else, in which case the menu
377 will be for the catalog pages.
383 if ( ! defined $type ) { $type=''; }
384 # FIXME - It's bad form to die in a CGI script. It's even worse form
385 # to die without issuing an error message.
386 if ($type eq 'issue') {
387 open (FILE,"<$path/issues-bottom.inc") || die;
388 } elsif ($type eq 'opac') {
389 open (FILE,"<$path/opac-bottom.inc") || die;
390 } elsif ($type eq 'member') {
391 open (FILE,"<$path/members-bottom.inc") || die;
392 } elsif ($type eq 'acquisitions') {
393 open (FILE,"<$path/acquisitions-bottom.inc") || die;
394 } elsif ($type eq 'report') {
395 open (FILE,"<$path/reports-bottom.inc") || die;
396 } elsif ($type eq 'circulation') {
397 open (FILE,"<$path/circulation-bottom.inc") || die;
399 open (FILE,"<$path/cat-bottom.inc") || die;
408 $str = &mktablehdr();
411 Returns a string of HTML, which generates the beginning of a table
417 return("<table border=0 cellspacing=0 cellpadding=5>\n");
422 $str = &mktablerow($columns, $color, @column_data, $bgimage);
425 Returns a string of HTML, which generates a row of data inside a table
426 (see also C<&mktablehdr>, C<&mktableft>).
428 C<$columns> specifies the number of columns in this row of data.
430 C<$color> specifies the background color for the row, e.g., C<"white">
433 C<@column_data> is an array of C<$columns> elements, each one a string
434 of HTML. These are the contents of the row.
436 The optional C<$bgimage> argument specifies the pathname to an image
437 to use as the background for each cell in the row. This pathname will
438 used as is in the output, so it should be relative to the HTTP
444 #the last item in data may be a backgroundimage
447 # should this be a foreach (1..$cols) loop?
449 my ($cols,$colour,@data)=@_;
451 my $string="<tr valign=top bgcolor=$colour>";
453 if (defined $data[$cols]) { # if there is a background image
454 $string.="<td background=\"$data[$cols]\">";
455 } else { # if there's no background image
458 if (! defined $data[$i]) {$data[$i]="";}
459 if ($data[$i] eq "") {
460 $string.=" </td>";
462 $string.="$data[$i]</td>";
466 $string .= "</tr>\n";
475 Returns a string of HTML, which generates the end of a table
481 return("</table>\n");
484 # FIXME - This is never used.
486 my ($action,%inputs)=@_;
487 my $string="<form action=$action method=post>\n";
488 $string .= mktablehdr();
490 my @keys=sort keys %inputs;
494 while ( $i2<$count) {
495 my $value=$inputs{$keys[$i2]};
496 my @data=split('\t',$value);
497 #my $posn = shift(@data);
498 if ($data[0] eq 'hidden'){
499 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
502 if ($data[0] eq 'radio') {
503 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
504 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
506 if ($data[0] eq 'text') {
507 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
509 if ($data[0] eq 'textarea') {
510 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
512 if ($data[0] eq 'select') {
513 $text="<select name=$keys[$i2]>";
515 while ($data[$i] ne "") {
516 my $val = $data[$i+1];
517 $text .= "<option value=$data[$i]>$val";
520 $text .= "</select>";
522 $string .= mktablerow(2,'white',$keys[$i2],$text);
523 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
527 #$string=$string.join("\n",@order);
528 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
529 $string .= mktableft;
530 $string .= "</form>";
535 $str = &mkform3($action,
536 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
541 Takes a set of arguments that define an input form, generates an HTML
542 string for the form, and returns the string.
544 C<$action> is the action for the form, usually the URL of the script
545 that will process it.
547 The remaining arguments define the fields in the form. C<$fieldname>
548 is the field's name. This is for the script's benefit, and will not be
551 C<$fieldpos> is an integer; fields will be output in order of
552 increasing C<$fieldpos>. This number must be unique: if two fields
553 have the same C<$fieldpos>, one will be picked at random, and the
554 other will be ignored. See below for special considerations, however.
556 C<$fieldtype> specifies the type of the input field. It may be one of
563 Generates a hidden field, used to pass data to the script without
564 showing it to the user. C<$fieldvalue> is the value.
568 Generates a pair of radio buttons, with values C<$fieldvalue> and
569 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
574 Generates a one-line text input field. It initially contains
579 Generates a four-line text input area. The initial text (which, of
580 course, may not contain any tabs) is C<$fieldvalue>.
584 Generates a list of items, from which the user may choose one. This is
585 somewhat different from other input field types, and should be
587 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
588 where the C<text>N strings are the choices that will be presented to
589 the user, and C<label>N are the labels that will be passed to the
592 However, C<text0> should be an integer, since it will be used to
593 determine the order in which this field appears in the form. If any of
594 the C<label>Ns are empty, the rest of the list will be ignored.
601 my ($action, %inputs) = @_;
602 my $string = "<form action=\"$action\" method=\"post\">\n";
603 $string .= mktablehdr();
605 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
610 while ($i2 < $count) {
611 my $value=$inputs{$keys[$i2]};
612 # FIXME - Why use a tab-separated string? Why not just use an
614 my @data=split('\t',$value);
616 if ($data[0] eq 'hidden'){
617 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
620 if ($data[0] eq 'radio') {
621 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
622 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
624 # FIXME - Is 40 the right size in all cases?
625 if ($data[0] eq 'text') {
626 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
628 # FIXME - Is 40x4 the right size in all cases?
629 if ($data[0] eq 'textarea') {
630 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
632 if ($data[0] eq 'select') {
633 $text="<select name=$keys[$i2]>";
635 while ($data[$i] ne "") {
636 my $val = $data[$i+1];
637 $text .= "<option value=$data[$i]>$val";
640 $text .= "</select>";
642 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
643 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
647 my $temp=join("\n",@order);
649 $string .= mktablerow(1,'white','<input type=submit>');
650 $string .= mktableft;
651 $string .= "</form>";
652 # FIXME - A return statement, while not strictly necessary, would be nice.
657 $str = &mkformnotable($action, @inputs);
660 Takes a set of arguments that define an input form, generates an HTML
661 string for the form, and returns the string. Unlike C<&mkform2> and
662 C<&mkform3>, it does not put the form inside a table.
664 C<$action> is the action for the form, usually the URL of the script
665 that will process it.
667 The remaining arguments define the fields in the form. Each is an
668 anonymous array, e.g.:
670 &mkformnotable("/cgi-bin/foo",
671 [ "hidden", "hiddenvar", "value" ],
672 [ "text", "username", "" ]);
674 The first element of each argument defines its type. The remaining
675 ones are type-dependent. The supported types are:
679 =item C<[ "hidden", $name, $value]>
681 Generates a hidden field, for passing information to a script without
682 showing it to the user. C<$name> is the name of the field, and
683 C<$value> is the value to pass.
685 =item C<[ "radio", $groupname, $value ]>
687 Generates a radio button. Its name (or button group name) is C<$name>.
688 C<$value> is the value associated with the button; this is both the
689 value that will be shown to the user, and that which will be passed on
690 to the C<$action> script.
692 =item C<[ "text", $name, $inittext ]>
694 Generates a text input field. C<$name> specifies its name, and
695 C<$inittext> specifies the text that the field should initially
698 =item C<[ "textarea", $name ]>
700 Creates a 40x4 text area, named C<$name>.
702 =item C<[ "reset", $name, $label ]>
704 Generates a reset button, with name C<$name>. C<$label> specifies the
707 =item C<[ "submit", $name, $label ]>
709 Generates a submit button, with name C<$name>. C<$label> specifies the
717 my ($action,@inputs)=@_;
718 my $string="<form action=$action method=post>\n";
720 for (my $i=0; $i<$count; $i++){
721 if ($inputs[$i][0] eq 'hidden'){
722 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
724 if ($inputs[$i][0] eq 'radio') {
725 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
727 if ($inputs[$i][0] eq 'text') {
728 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
730 if ($inputs[$i][0] eq 'textarea') {
731 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
733 if ($inputs[$i][0] eq 'reset'){
734 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
736 if ($inputs[$i][0] eq 'submit'){
737 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
740 $string .= "</form>";
745 $str = &mkform2($action,
747 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
752 Takes a set of arguments that define an input form, generates an HTML
753 string for the form, and returns the string.
755 C<$action> is the action for the form, usually the URL of the script
756 that will process it.
758 The remaining arguments define the fields in the form. C<$fieldname>
759 is the field's name. This is for the script's benefit, and will not be
762 C<$fieldpos> is an integer; fields will be output in order of
763 increasing C<$fieldpos>. This number must be unique: if two fields
764 have the same C<$fieldpos>, one will be picked at random, and the
765 other will be ignored. See below for special considerations, however.
767 If C<$required> is the string C<R>, then the field is required, and
768 the label will have C< (Req.)> appended.
770 C<$label> is a string that will appear next to the input field.
772 C<$fieldtype> specifies the type of the input field. It may be one of
779 Generates a hidden field, used to pass data to the script without
780 showing it to the user. C<$value0> is its value.
784 Generates a pair of radio buttons, with values C<$value0> and
785 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
786 the user, next to the radio button.
790 Generates a one-line text input field. Its size may be specified by
791 C<$value0>. The default is 40. The initial text of the field may be
792 specified by C<$value1>.
796 Generates a text input area. C<$value0> may be a string of the form
797 "WWWxHHH", in which case the text input area will be WWW columns wide
798 and HHH rows tall. The size defaults to 40x4.
800 The initial text (which, of course, may not contain any tabs) may be
801 specified by C<$value1>.
805 Generates a list of items, from which the user may choose one. Here,
806 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
807 pair, the key specifies an internal label for a choice, and the value
808 specifies the description of the choice that will be shown the user.
810 If C<$value0> is the same as one of the keys that follows, then the
811 corresponding choice will initially be selected.
819 # No tests yet. Once tests are written,
820 # this function can be cleaned up with the following steps:
821 # turn the while loop into a foreach loop
822 # pull the nested if,elsif structure back up to the main level
823 # pull the code for the different kinds of inputs into separate
825 my ($action,%inputs)=@_;
826 my $string="<form action=$action method=post>\n";
827 $string .= mktablehdr();
830 while ( my ($key, $value) = each %inputs) {
831 my @data=split('\t',$value);
832 my $posn = shift(@data);
833 my $reqd = shift(@data);
834 my $ltext = shift(@data);
835 if ($data[0] eq 'hidden'){
836 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
839 if ($data[0] eq 'radio') {
840 $text="<input type=radio name=$key value=$data[1]>$data[1]
841 <input type=radio name=$key value=$data[2]>$data[2]";
842 } elsif ($data[0] eq 'text') {
847 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
848 } elsif ($data[0] eq 'textarea') {
849 my @size=split("x",$data[1]);
850 if ($data[1] eq "") {
854 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
855 } elsif ($data[0] eq 'select') {
856 $text="<select name=$key>";
859 while ($data[$i] ne "") {
860 my $val = $data[$i+1];
861 $text .= "<option value=\"$data[$i]\"";
862 if ($data[$i] eq $sel) {
863 $text .= " selected";
868 $text .= "</select>";
873 $order[$posn] =mktablerow(2,'white',$ltext,$text);
876 $string .= join("\n",@order);
877 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
878 $string .= mktableft;
879 $string .= "</form>";
887 Returns a string of HTML, the end of an HTML document.
892 return("</body></html>\n");
897 $str = &mklink($url, $text);
900 Returns an HTML string, where C<$text> is a link to C<$url>.
906 my $string="<a href=\"$url\">$text</a>";
912 $str = &mkheadr($type, $text);
915 Takes a header type and header text, and returns a string of HTML,
916 where C<$text> is rendered with emphasis in a large font size (not an
919 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
920 Type 2 has no special tag at the end; Type 3 ends with a paragraph
927 # would it be better to make this more generic by accepting an optional
928 # argument with a closing tag instead of a numeric type?
933 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
936 $string="<FONT SIZE=6><em>$text</em></FONT>";
939 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
944 =item center and endcenter
946 print ¢er(), "This is a line of centered text.", &endcenter();
948 C<¢er> and C<&endcenter> take no arguments and return HTML tags
949 <CENTER> and </CENTER> respectively.
954 return ("<CENTER>\n");
958 return ("</CENTER>\n");
966 Returns a string of HTML that renders C<$text> in bold.
972 return("<b>$text</b>");
975 =item getkeytableselectoptions
977 $str = &getkeytableselectoptions($dbh, $tablename,
978 $keyfieldname, $descfieldname,
982 Builds an HTML selection box from a database table. Returns a string
983 of HTML that implements this.
985 C<$dbh> is a DBI::db database handle.
987 C<$tablename> is the database table in which to look up the possible
988 values for the selection box.
990 C<$keyfieldname> is field in C<$tablename>. It will be used as the
991 internal label for the selection.
993 C<$descfieldname> is a field in C<$tablename>. It will be used as the
994 option shown to the user.
996 If C<$showkey> is true, then both the key and value will be shown to
999 If the C<$default> argument is given, then if a value (from
1000 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1004 #---------------------------------------------
1005 # Create an HTML option list for a <SELECT> form tag by using
1006 # values from a DB file
1007 sub getkeytableselectoptions {
1012 # FIXME - Obsolete argument
1013 $tablename, # name of table containing list of choices
1014 $keyfieldname, # column name of code to use in option list
1015 $descfieldname, # column name of descriptive field
1016 $showkey, # flag to show key in description
1017 $default, # optional default key
1019 my $selectclause; # return value
1023 $key, $desc, $orderfieldname,
1027 $dbh = C4::Context->dbh;
1030 $orderfieldname=$keyfieldname;
1032 $orderfieldname=$descfieldname;
1034 $query= "select $keyfieldname,$descfieldname
1036 order by $orderfieldname ";
1037 print "<PRE>Query=$query </PRE>\n" if $debug;
1038 $sth=$dbh->prepare($query);
1040 while ( ($key, $desc) = $sth->fetchrow) {
1041 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1042 $selectclause.="<option";
1043 if (defined $default && $default eq $key) {
1044 $selectclause.=" selected";
1046 $selectclause.=" value='$key'>$desc\n";
1047 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1049 return $selectclause;
1050 } # sub getkeytableselectoptions
1052 #---------------------------------
1054 END { } # module clean-up code here (global destructor)
1063 Koha Developement team <info@koha.org>