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",
100 interface => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl'),
106 #---------------------------------------------------------------------------------------------------------
109 my ($htdocs, $tmpl) = @_;
111 my $dbh = C4::Context->dbh;
112 my @languages = split " ", C4::Context->preference("opaclanguages");
113 # language preference
114 my @themes = split " ", C4::Context->preference("opacthemes");
118 # searches through the themes and languages. First template it find it returns.
119 # Priority is for getting the theme right.
121 foreach my $th (@themes) {
122 foreach my $la (@languages) {
123 # warn "File = $htdocs/$th/$la/$tmpl\n";
124 if (-e "$htdocs/$th/$la/$tmpl") {
131 if ($theme and $lang) {
132 return ($theme, $lang);
134 return ('default', 'en');
141 %values = &pathtotemplate(template => $template,
143 language => $language,
145 path => $includedir);
147 Finds a directory containing the desired template. The C<template>
148 argument specifies the template you're looking for (this should be the
149 name of the script you're using to generate an HTML page, without the
150 C<.pl> extension). Only the C<template> argument is required; the
153 C<theme> specifies the name of the theme to use. This will be used
154 only if it is allowed by the C<allowthemeoverride> system preference
155 option (in the C<systempreferences> table of the Koha database).
157 C<language> specifies the desired language. If not specified,
158 C<&pathtotemplate> will use the list of acceptable languages specified
159 by the browser, then C<all>, and finally C<en> as fallback options.
161 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
162 C<intranet> and C<opac> specify that you want a template for the
163 internal web site or the public OPAC, respectively. C<none> specifies
164 that the template you're looking for is at the top level of one of the
165 include directories. Any other value is taken as-is, as a subdirectory
166 of one of the include directories.
168 C<path> specifies an include directory.
170 C<&pathtotemplate> searches first in the directory given by the
171 C<path> argument, if any, then in the directories given by the
172 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
175 C<&pathtotemplate> returns a hash with the following keys:
181 The full pathname to the desired template.
183 =item C<foundlanguage>
185 The value is set to 1 if a template in the desired language was found,
190 The value is set to 1 if a template of the desired theme was found, or
195 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
197 Note that if a template of the desired language or theme cannot be
198 found, C<&pathtotemplate> will print a warning message. Unless you've
199 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
204 # FIXME - Fix POD: it doesn't look in the directory given by the
205 # 'includes' option in /etc/koha.conf.
208 my $template = $params{'template'};
209 my $themeor = $params{'theme'};
210 my $languageor = lc($params{'language'});
211 my $ptype = lc($params{'type'} or 'intranet');
213 # FIXME - Make sure $params{'template'} was given. Or else assume
216 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
217 elsif ($ptype eq 'none') {$type = ''; }
218 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
219 else {$type = $ptype . '/'; }
222 my $theme = C4::Context->preference("theme") || "default";
224 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
228 my @languageorder = getlanguageorder();
229 my $language = $languageor || shift(@languageorder);
231 #where to search for templates
232 my @tmpldirs = ("$path/templates", $path);
233 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
234 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
236 my ($etheme, $elanguage, $epath);
238 CHECK: foreach my $edir (@tmpldirs) {
239 foreach $etheme ($theme, 'all', 'default') {
240 foreach $elanguage ($language, @languageorder, 'all','en') {
241 # 'en' is the fallback-language
242 if (-e "$edir/$type$etheme/$elanguage/$template") {
243 $epath = "$edir/$type$etheme/$elanguage/$template";
251 warn "Could not find $template in @tmpldirs";
255 if ($language eq $elanguage) {
256 $returns{'foundlanguage'} = 1;
258 $returns{'foundlanguage'} = 0;
259 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
261 if ($theme eq $etheme) {
262 $returns{'foundtheme'} = 1;
264 $returns{'foundtheme'} = 0;
265 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
268 $returns{'path'} = $epath;
273 =item getlanguageorder
275 @languages = &getlanguageorder();
277 Returns the list of languages that the user will accept, and returns
278 them in order of decreasing preference. This is retrieved from the
279 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
280 the C<languageorder> setting from the C<systempreferences> table in
281 the Koha database. If neither is set, it defaults to C<en> (English).
285 sub getlanguageorder () {
288 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
289 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
290 } elsif (my $order = C4::Context->preference("languageorder")) {
291 @languageorder = split (/\s*,\s*/ ,lc($order));
292 } else { # here should be another elsif checking for apache's languageorder
293 @languageorder = ('en');
296 return (@languageorder);
304 Returns a string of HTML, the beginning of a new HTML document.
314 $str = &gotopage("//opac.koha.org/index.html");
317 Generates a snippet of HTML code that will redirect to the given URL
318 (which should not include the initial C<http:>), and returns it.
323 my ($target) = shift;
324 #print "<br>goto target = $target<br>";
325 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
331 @lines = &startmenu($type);
332 print join("", @lines);
334 Given a page type, or category, returns a set of lines of HTML which,
335 when concatenated, generate the menu at the top of the web page.
337 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
338 C<report>, C<circulation>, or something else, in which case the menu
339 will be for the catalog pages.
344 # edit the paths in here
346 if ($type eq 'issue') {
347 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
348 } elsif ($type eq 'opac') {
349 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
350 } elsif ($type eq 'member') {
351 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
352 } elsif ($type eq 'acquisitions'){
353 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
354 } elsif ($type eq 'report'){
355 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
356 } elsif ($type eq 'circulation') {
357 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
359 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
364 # $string[$count]="<BLOCKQUOTE>";
370 @lines = &endmenu($type);
371 print join("", @lines);
373 Given a page type, or category, returns a set of lines of HTML which,
374 when concatenated, generate the menu at the bottom of the web page.
376 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
377 C<report>, C<circulation>, or something else, in which case the menu
378 will be for the catalog pages.
384 if ( ! defined $type ) { $type=''; }
385 # FIXME - It's bad form to die in a CGI script. It's even worse form
386 # to die without issuing an error message.
387 if ($type eq 'issue') {
388 open (FILE,"<$path/issues-bottom.inc") || die;
389 } elsif ($type eq 'opac') {
390 open (FILE,"<$path/opac-bottom.inc") || die;
391 } elsif ($type eq 'member') {
392 open (FILE,"<$path/members-bottom.inc") || die;
393 } elsif ($type eq 'acquisitions') {
394 open (FILE,"<$path/acquisitions-bottom.inc") || die;
395 } elsif ($type eq 'report') {
396 open (FILE,"<$path/reports-bottom.inc") || die;
397 } elsif ($type eq 'circulation') {
398 open (FILE,"<$path/circulation-bottom.inc") || die;
400 open (FILE,"<$path/cat-bottom.inc") || die;
409 $str = &mktablehdr();
412 Returns a string of HTML, which generates the beginning of a table
418 return("<table border=0 cellspacing=0 cellpadding=5>\n");
423 $str = &mktablerow($columns, $color, @column_data, $bgimage);
426 Returns a string of HTML, which generates a row of data inside a table
427 (see also C<&mktablehdr>, C<&mktableft>).
429 C<$columns> specifies the number of columns in this row of data.
431 C<$color> specifies the background color for the row, e.g., C<"white">
434 C<@column_data> is an array of C<$columns> elements, each one a string
435 of HTML. These are the contents of the row.
437 The optional C<$bgimage> argument specifies the pathname to an image
438 to use as the background for each cell in the row. This pathname will
439 used as is in the output, so it should be relative to the HTTP
445 #the last item in data may be a backgroundimage
448 # should this be a foreach (1..$cols) loop?
450 my ($cols,$colour,@data)=@_;
452 my $string="<tr valign=top bgcolor=$colour>";
454 if (defined $data[$cols]) { # if there is a background image
455 $string.="<td background=\"$data[$cols]\">";
456 } else { # if there's no background image
459 if (! defined $data[$i]) {$data[$i]="";}
460 if ($data[$i] eq "") {
461 $string.=" </td>";
463 $string.="$data[$i]</td>";
467 $string .= "</tr>\n";
476 Returns a string of HTML, which generates the end of a table
482 return("</table>\n");
485 # FIXME - This is never used.
487 my ($action,%inputs)=@_;
488 my $string="<form action=$action method=post>\n";
489 $string .= mktablehdr();
491 my @keys=sort keys %inputs;
495 while ( $i2<$count) {
496 my $value=$inputs{$keys[$i2]};
497 my @data=split('\t',$value);
498 #my $posn = shift(@data);
499 if ($data[0] eq 'hidden'){
500 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
503 if ($data[0] eq 'radio') {
504 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
505 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
507 if ($data[0] eq 'text') {
508 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
510 if ($data[0] eq 'textarea') {
511 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
513 if ($data[0] eq 'select') {
514 $text="<select name=$keys[$i2]>";
516 while ($data[$i] ne "") {
517 my $val = $data[$i+1];
518 $text .= "<option value=$data[$i]>$val";
521 $text .= "</select>";
523 $string .= mktablerow(2,'white',$keys[$i2],$text);
524 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
528 #$string=$string.join("\n",@order);
529 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
530 $string .= mktableft;
531 $string .= "</form>";
536 $str = &mkform3($action,
537 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
542 Takes a set of arguments that define an input form, generates an HTML
543 string for the form, and returns the string.
545 C<$action> is the action for the form, usually the URL of the script
546 that will process it.
548 The remaining arguments define the fields in the form. C<$fieldname>
549 is the field's name. This is for the script's benefit, and will not be
552 C<$fieldpos> is an integer; fields will be output in order of
553 increasing C<$fieldpos>. This number must be unique: if two fields
554 have the same C<$fieldpos>, one will be picked at random, and the
555 other will be ignored. See below for special considerations, however.
557 C<$fieldtype> specifies the type of the input field. It may be one of
564 Generates a hidden field, used to pass data to the script without
565 showing it to the user. C<$fieldvalue> is the value.
569 Generates a pair of radio buttons, with values C<$fieldvalue> and
570 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
575 Generates a one-line text input field. It initially contains
580 Generates a four-line text input area. The initial text (which, of
581 course, may not contain any tabs) is C<$fieldvalue>.
585 Generates a list of items, from which the user may choose one. This is
586 somewhat different from other input field types, and should be
588 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
589 where the C<text>N strings are the choices that will be presented to
590 the user, and C<label>N are the labels that will be passed to the
593 However, C<text0> should be an integer, since it will be used to
594 determine the order in which this field appears in the form. If any of
595 the C<label>Ns are empty, the rest of the list will be ignored.
602 my ($action, %inputs) = @_;
603 my $string = "<form action=\"$action\" method=\"post\">\n";
604 $string .= mktablehdr();
606 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
611 while ($i2 < $count) {
612 my $value=$inputs{$keys[$i2]};
613 # FIXME - Why use a tab-separated string? Why not just use an
615 my @data=split('\t',$value);
617 if ($data[0] eq 'hidden'){
618 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
621 if ($data[0] eq 'radio') {
622 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
623 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
625 # FIXME - Is 40 the right size in all cases?
626 if ($data[0] eq 'text') {
627 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
629 # FIXME - Is 40x4 the right size in all cases?
630 if ($data[0] eq 'textarea') {
631 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
633 if ($data[0] eq 'select') {
634 $text="<select name=$keys[$i2]>";
636 while ($data[$i] ne "") {
637 my $val = $data[$i+1];
638 $text .= "<option value=$data[$i]>$val";
641 $text .= "</select>";
643 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
644 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
648 my $temp=join("\n",@order);
650 $string .= mktablerow(1,'white','<input type=submit>');
651 $string .= mktableft;
652 $string .= "</form>";
653 # FIXME - A return statement, while not strictly necessary, would be nice.
658 $str = &mkformnotable($action, @inputs);
661 Takes a set of arguments that define an input form, generates an HTML
662 string for the form, and returns the string. Unlike C<&mkform2> and
663 C<&mkform3>, it does not put the form inside a table.
665 C<$action> is the action for the form, usually the URL of the script
666 that will process it.
668 The remaining arguments define the fields in the form. Each is an
669 anonymous array, e.g.:
671 &mkformnotable("/cgi-bin/foo",
672 [ "hidden", "hiddenvar", "value" ],
673 [ "text", "username", "" ]);
675 The first element of each argument defines its type. The remaining
676 ones are type-dependent. The supported types are:
680 =item C<[ "hidden", $name, $value]>
682 Generates a hidden field, for passing information to a script without
683 showing it to the user. C<$name> is the name of the field, and
684 C<$value> is the value to pass.
686 =item C<[ "radio", $groupname, $value ]>
688 Generates a radio button. Its name (or button group name) is C<$name>.
689 C<$value> is the value associated with the button; this is both the
690 value that will be shown to the user, and that which will be passed on
691 to the C<$action> script.
693 =item C<[ "text", $name, $inittext ]>
695 Generates a text input field. C<$name> specifies its name, and
696 C<$inittext> specifies the text that the field should initially
699 =item C<[ "textarea", $name ]>
701 Creates a 40x4 text area, named C<$name>.
703 =item C<[ "reset", $name, $label ]>
705 Generates a reset button, with name C<$name>. C<$label> specifies the
708 =item C<[ "submit", $name, $label ]>
710 Generates a submit button, with name C<$name>. C<$label> specifies the
718 my ($action,@inputs)=@_;
719 my $string="<form action=$action method=post>\n";
721 for (my $i=0; $i<$count; $i++){
722 if ($inputs[$i][0] eq 'hidden'){
723 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
725 if ($inputs[$i][0] eq 'radio') {
726 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
728 if ($inputs[$i][0] eq 'text') {
729 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
731 if ($inputs[$i][0] eq 'textarea') {
732 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
734 if ($inputs[$i][0] eq 'reset'){
735 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
737 if ($inputs[$i][0] eq 'submit'){
738 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
741 $string .= "</form>";
746 $str = &mkform2($action,
748 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
753 Takes a set of arguments that define an input form, generates an HTML
754 string for the form, and returns the string.
756 C<$action> is the action for the form, usually the URL of the script
757 that will process it.
759 The remaining arguments define the fields in the form. C<$fieldname>
760 is the field's name. This is for the script's benefit, and will not be
763 C<$fieldpos> is an integer; fields will be output in order of
764 increasing C<$fieldpos>. This number must be unique: if two fields
765 have the same C<$fieldpos>, one will be picked at random, and the
766 other will be ignored. See below for special considerations, however.
768 If C<$required> is the string C<R>, then the field is required, and
769 the label will have C< (Req.)> appended.
771 C<$label> is a string that will appear next to the input field.
773 C<$fieldtype> specifies the type of the input field. It may be one of
780 Generates a hidden field, used to pass data to the script without
781 showing it to the user. C<$value0> is its value.
785 Generates a pair of radio buttons, with values C<$value0> and
786 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
787 the user, next to the radio button.
791 Generates a one-line text input field. Its size may be specified by
792 C<$value0>. The default is 40. The initial text of the field may be
793 specified by C<$value1>.
797 Generates a text input area. C<$value0> may be a string of the form
798 "WWWxHHH", in which case the text input area will be WWW columns wide
799 and HHH rows tall. The size defaults to 40x4.
801 The initial text (which, of course, may not contain any tabs) may be
802 specified by C<$value1>.
806 Generates a list of items, from which the user may choose one. Here,
807 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
808 pair, the key specifies an internal label for a choice, and the value
809 specifies the description of the choice that will be shown the user.
811 If C<$value0> is the same as one of the keys that follows, then the
812 corresponding choice will initially be selected.
820 # No tests yet. Once tests are written,
821 # this function can be cleaned up with the following steps:
822 # turn the while loop into a foreach loop
823 # pull the nested if,elsif structure back up to the main level
824 # pull the code for the different kinds of inputs into separate
826 my ($action,%inputs)=@_;
827 my $string="<form action=$action method=post>\n";
828 $string .= mktablehdr();
831 while ( my ($key, $value) = each %inputs) {
832 my @data=split('\t',$value);
833 my $posn = shift(@data);
834 my $reqd = shift(@data);
835 my $ltext = shift(@data);
836 if ($data[0] eq 'hidden'){
837 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
840 if ($data[0] eq 'radio') {
841 $text="<input type=radio name=$key value=$data[1]>$data[1]
842 <input type=radio name=$key value=$data[2]>$data[2]";
843 } elsif ($data[0] eq 'text') {
848 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
849 } elsif ($data[0] eq 'textarea') {
850 my @size=split("x",$data[1]);
851 if ($data[1] eq "") {
855 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
856 } elsif ($data[0] eq 'select') {
857 $text="<select name=$key>";
860 while ($data[$i] ne "") {
861 my $val = $data[$i+1];
862 $text .= "<option value=\"$data[$i]\"";
863 if ($data[$i] eq $sel) {
864 $text .= " selected";
869 $text .= "</select>";
874 $order[$posn] =mktablerow(2,'white',$ltext,$text);
877 $string .= join("\n",@order);
878 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
879 $string .= mktableft;
880 $string .= "</form>";
888 Returns a string of HTML, the end of an HTML document.
893 return("</body></html>\n");
898 $str = &mklink($url, $text);
901 Returns an HTML string, where C<$text> is a link to C<$url>.
907 my $string="<a href=\"$url\">$text</a>";
913 $str = &mkheadr($type, $text);
916 Takes a header type and header text, and returns a string of HTML,
917 where C<$text> is rendered with emphasis in a large font size (not an
920 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
921 Type 2 has no special tag at the end; Type 3 ends with a paragraph
928 # would it be better to make this more generic by accepting an optional
929 # argument with a closing tag instead of a numeric type?
934 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
937 $string="<FONT SIZE=6><em>$text</em></FONT>";
940 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
945 =item center and endcenter
947 print ¢er(), "This is a line of centered text.", &endcenter();
949 C<¢er> and C<&endcenter> take no arguments and return HTML tags
950 <CENTER> and </CENTER> respectively.
955 return ("<CENTER>\n");
959 return ("</CENTER>\n");
967 Returns a string of HTML that renders C<$text> in bold.
973 return("<b>$text</b>");
976 =item getkeytableselectoptions
978 $str = &getkeytableselectoptions($dbh, $tablename,
979 $keyfieldname, $descfieldname,
983 Builds an HTML selection box from a database table. Returns a string
984 of HTML that implements this.
986 C<$dbh> is a DBI::db database handle.
988 C<$tablename> is the database table in which to look up the possible
989 values for the selection box.
991 C<$keyfieldname> is field in C<$tablename>. It will be used as the
992 internal label for the selection.
994 C<$descfieldname> is a field in C<$tablename>. It will be used as the
995 option shown to the user.
997 If C<$showkey> is true, then both the key and value will be shown to
1000 If the C<$default> argument is given, then if a value (from
1001 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1005 #---------------------------------------------
1006 # Create an HTML option list for a <SELECT> form tag by using
1007 # values from a DB file
1008 sub getkeytableselectoptions {
1013 # FIXME - Obsolete argument
1014 $tablename, # name of table containing list of choices
1015 $keyfieldname, # column name of code to use in option list
1016 $descfieldname, # column name of descriptive field
1017 $showkey, # flag to show key in description
1018 $default, # optional default key
1020 my $selectclause; # return value
1024 $key, $desc, $orderfieldname,
1028 $dbh = C4::Context->dbh;
1031 $orderfieldname=$keyfieldname;
1033 $orderfieldname=$descfieldname;
1035 $query= "select $keyfieldname,$descfieldname
1037 order by $orderfieldname ";
1038 print "<PRE>Query=$query </PRE>\n" if $debug;
1039 $sth=$dbh->prepare($query);
1041 while ( ($key, $desc) = $sth->fetchrow) {
1042 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1043 $selectclause.="<option";
1044 if (defined $default && $default eq $key) {
1045 $selectclause.=" selected";
1047 $selectclause.=" value='$key'>$desc\n";
1048 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1050 return $selectclause;
1051 } # sub getkeytableselectoptions
1053 #---------------------------------
1055 END { } # module clean-up code here (global destructor)
1064 Koha Developement team <info@koha.org>