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") {
132 if ($theme and $lang) {
133 return ($theme, $lang);
135 return ('default', 'en');
142 %values = &pathtotemplate(template => $template,
144 language => $language,
146 path => $includedir);
148 Finds a directory containing the desired template. The C<template>
149 argument specifies the template you're looking for (this should be the
150 name of the script you're using to generate an HTML page, without the
151 C<.pl> extension). Only the C<template> argument is required; the
154 C<theme> specifies the name of the theme to use. This will be used
155 only if it is allowed by the C<allowthemeoverride> system preference
156 option (in the C<systempreferences> table of the Koha database).
158 C<language> specifies the desired language. If not specified,
159 C<&pathtotemplate> will use the list of acceptable languages specified
160 by the browser, then C<all>, and finally C<en> as fallback options.
162 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
163 C<intranet> and C<opac> specify that you want a template for the
164 internal web site or the public OPAC, respectively. C<none> specifies
165 that the template you're looking for is at the top level of one of the
166 include directories. Any other value is taken as-is, as a subdirectory
167 of one of the include directories.
169 C<path> specifies an include directory.
171 C<&pathtotemplate> searches first in the directory given by the
172 C<path> argument, if any, then in the directories given by the
173 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
176 C<&pathtotemplate> returns a hash with the following keys:
182 The full pathname to the desired template.
184 =item C<foundlanguage>
186 The value is set to 1 if a template in the desired language was found,
191 The value is set to 1 if a template of the desired theme was found, or
196 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
198 Note that if a template of the desired language or theme cannot be
199 found, C<&pathtotemplate> will print a warning message. Unless you've
200 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
205 # FIXME - Fix POD: it doesn't look in the directory given by the
206 # 'includes' option in /etc/koha.conf.
209 my $template = $params{'template'};
210 my $themeor = $params{'theme'};
211 my $languageor = lc($params{'language'});
212 my $ptype = lc($params{'type'} or 'intranet');
214 # FIXME - Make sure $params{'template'} was given. Or else assume
217 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
218 elsif ($ptype eq 'none') {$type = ''; }
219 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
220 else {$type = $ptype . '/'; }
223 my $theme = C4::Context->preference("theme") || "default";
225 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
229 my @languageorder = getlanguageorder();
230 my $language = $languageor || shift(@languageorder);
232 #where to search for templates
233 my @tmpldirs = ("$path/templates", $path);
234 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
235 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
237 my ($etheme, $elanguage, $epath);
239 CHECK: foreach my $edir (@tmpldirs) {
240 foreach $etheme ($theme, 'all', 'default') {
241 foreach $elanguage ($language, @languageorder, 'all','en') {
242 # 'en' is the fallback-language
243 if (-e "$edir/$type$etheme/$elanguage/$template") {
244 $epath = "$edir/$type$etheme/$elanguage/$template";
252 warn "Could not find $template in @tmpldirs";
256 if ($language eq $elanguage) {
257 $returns{'foundlanguage'} = 1;
259 $returns{'foundlanguage'} = 0;
260 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
262 if ($theme eq $etheme) {
263 $returns{'foundtheme'} = 1;
265 $returns{'foundtheme'} = 0;
266 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
269 $returns{'path'} = $epath;
274 =item getlanguageorder
276 @languages = &getlanguageorder();
278 Returns the list of languages that the user will accept, and returns
279 them in order of decreasing preference. This is retrieved from the
280 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
281 the C<languageorder> setting from the C<systempreferences> table in
282 the Koha database. If neither is set, it defaults to C<en> (English).
286 sub getlanguageorder () {
289 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
290 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
291 } elsif (my $order = C4::Context->preference("languageorder")) {
292 @languageorder = split (/\s*,\s*/ ,lc($order));
293 } else { # here should be another elsif checking for apache's languageorder
294 @languageorder = ('en');
297 return (@languageorder);
305 Returns a string of HTML, the beginning of a new HTML document.
315 $str = &gotopage("//opac.koha.org/index.html");
318 Generates a snippet of HTML code that will redirect to the given URL
319 (which should not include the initial C<http:>), and returns it.
324 my ($target) = shift;
325 #print "<br>goto target = $target<br>";
326 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
332 @lines = &startmenu($type);
333 print join("", @lines);
335 Given a page type, or category, returns a set of lines of HTML which,
336 when concatenated, generate the menu at the top of the web page.
338 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
339 C<report>, C<circulation>, or something else, in which case the menu
340 will be for the catalog pages.
345 # edit the paths in here
347 if ($type eq 'issue') {
348 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
349 } elsif ($type eq 'opac') {
350 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
351 } elsif ($type eq 'member') {
352 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
353 } elsif ($type eq 'acquisitions'){
354 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
355 } elsif ($type eq 'report'){
356 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
357 } elsif ($type eq 'circulation') {
358 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
360 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
365 # $string[$count]="<BLOCKQUOTE>";
371 @lines = &endmenu($type);
372 print join("", @lines);
374 Given a page type, or category, returns a set of lines of HTML which,
375 when concatenated, generate the menu at the bottom of the web page.
377 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
378 C<report>, C<circulation>, or something else, in which case the menu
379 will be for the catalog pages.
385 if ( ! defined $type ) { $type=''; }
386 # FIXME - It's bad form to die in a CGI script. It's even worse form
387 # to die without issuing an error message.
388 if ($type eq 'issue') {
389 open (FILE,"<$path/issues-bottom.inc") || die;
390 } elsif ($type eq 'opac') {
391 open (FILE,"<$path/opac-bottom.inc") || die;
392 } elsif ($type eq 'member') {
393 open (FILE,"<$path/members-bottom.inc") || die;
394 } elsif ($type eq 'acquisitions') {
395 open (FILE,"<$path/acquisitions-bottom.inc") || die;
396 } elsif ($type eq 'report') {
397 open (FILE,"<$path/reports-bottom.inc") || die;
398 } elsif ($type eq 'circulation') {
399 open (FILE,"<$path/circulation-bottom.inc") || die;
401 open (FILE,"<$path/cat-bottom.inc") || die;
410 $str = &mktablehdr();
413 Returns a string of HTML, which generates the beginning of a table
419 return("<table border=0 cellspacing=0 cellpadding=5>\n");
424 $str = &mktablerow($columns, $color, @column_data, $bgimage);
427 Returns a string of HTML, which generates a row of data inside a table
428 (see also C<&mktablehdr>, C<&mktableft>).
430 C<$columns> specifies the number of columns in this row of data.
432 C<$color> specifies the background color for the row, e.g., C<"white">
435 C<@column_data> is an array of C<$columns> elements, each one a string
436 of HTML. These are the contents of the row.
438 The optional C<$bgimage> argument specifies the pathname to an image
439 to use as the background for each cell in the row. This pathname will
440 used as is in the output, so it should be relative to the HTTP
446 #the last item in data may be a backgroundimage
449 # should this be a foreach (1..$cols) loop?
451 my ($cols,$colour,@data)=@_;
453 my $string="<tr valign=top bgcolor=$colour>";
455 if (defined $data[$cols]) { # if there is a background image
456 $string.="<td background=\"$data[$cols]\">";
457 } else { # if there's no background image
460 if (! defined $data[$i]) {$data[$i]="";}
461 if ($data[$i] eq "") {
462 $string.=" </td>";
464 $string.="$data[$i]</td>";
468 $string .= "</tr>\n";
477 Returns a string of HTML, which generates the end of a table
483 return("</table>\n");
486 # FIXME - This is never used.
488 my ($action,%inputs)=@_;
489 my $string="<form action=$action method=post>\n";
490 $string .= mktablehdr();
492 my @keys=sort keys %inputs;
496 while ( $i2<$count) {
497 my $value=$inputs{$keys[$i2]};
498 my @data=split('\t',$value);
499 #my $posn = shift(@data);
500 if ($data[0] eq 'hidden'){
501 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
504 if ($data[0] eq 'radio') {
505 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
506 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
508 if ($data[0] eq 'text') {
509 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
511 if ($data[0] eq 'textarea') {
512 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
514 if ($data[0] eq 'select') {
515 $text="<select name=$keys[$i2]>";
517 while ($data[$i] ne "") {
518 my $val = $data[$i+1];
519 $text .= "<option value=$data[$i]>$val";
522 $text .= "</select>";
524 $string .= mktablerow(2,'white',$keys[$i2],$text);
525 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
529 #$string=$string.join("\n",@order);
530 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
531 $string .= mktableft;
532 $string .= "</form>";
537 $str = &mkform3($action,
538 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
543 Takes a set of arguments that define an input form, generates an HTML
544 string for the form, and returns the string.
546 C<$action> is the action for the form, usually the URL of the script
547 that will process it.
549 The remaining arguments define the fields in the form. C<$fieldname>
550 is the field's name. This is for the script's benefit, and will not be
553 C<$fieldpos> is an integer; fields will be output in order of
554 increasing C<$fieldpos>. This number must be unique: if two fields
555 have the same C<$fieldpos>, one will be picked at random, and the
556 other will be ignored. See below for special considerations, however.
558 C<$fieldtype> specifies the type of the input field. It may be one of
565 Generates a hidden field, used to pass data to the script without
566 showing it to the user. C<$fieldvalue> is the value.
570 Generates a pair of radio buttons, with values C<$fieldvalue> and
571 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
576 Generates a one-line text input field. It initially contains
581 Generates a four-line text input area. The initial text (which, of
582 course, may not contain any tabs) is C<$fieldvalue>.
586 Generates a list of items, from which the user may choose one. This is
587 somewhat different from other input field types, and should be
589 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
590 where the C<text>N strings are the choices that will be presented to
591 the user, and C<label>N are the labels that will be passed to the
594 However, C<text0> should be an integer, since it will be used to
595 determine the order in which this field appears in the form. If any of
596 the C<label>Ns are empty, the rest of the list will be ignored.
603 my ($action, %inputs) = @_;
604 my $string = "<form action=\"$action\" method=\"post\">\n";
605 $string .= mktablehdr();
607 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
612 while ($i2 < $count) {
613 my $value=$inputs{$keys[$i2]};
614 # FIXME - Why use a tab-separated string? Why not just use an
616 my @data=split('\t',$value);
618 if ($data[0] eq 'hidden'){
619 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
622 if ($data[0] eq 'radio') {
623 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
624 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
626 # FIXME - Is 40 the right size in all cases?
627 if ($data[0] eq 'text') {
628 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
630 # FIXME - Is 40x4 the right size in all cases?
631 if ($data[0] eq 'textarea') {
632 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
634 if ($data[0] eq 'select') {
635 $text="<select name=$keys[$i2]>";
637 while ($data[$i] ne "") {
638 my $val = $data[$i+1];
639 $text .= "<option value=$data[$i]>$val";
642 $text .= "</select>";
644 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
645 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
649 my $temp=join("\n",@order);
651 $string .= mktablerow(1,'white','<input type=submit>');
652 $string .= mktableft;
653 $string .= "</form>";
654 # FIXME - A return statement, while not strictly necessary, would be nice.
659 $str = &mkformnotable($action, @inputs);
662 Takes a set of arguments that define an input form, generates an HTML
663 string for the form, and returns the string. Unlike C<&mkform2> and
664 C<&mkform3>, it does not put the form inside a table.
666 C<$action> is the action for the form, usually the URL of the script
667 that will process it.
669 The remaining arguments define the fields in the form. Each is an
670 anonymous array, e.g.:
672 &mkformnotable("/cgi-bin/foo",
673 [ "hidden", "hiddenvar", "value" ],
674 [ "text", "username", "" ]);
676 The first element of each argument defines its type. The remaining
677 ones are type-dependent. The supported types are:
681 =item C<[ "hidden", $name, $value]>
683 Generates a hidden field, for passing information to a script without
684 showing it to the user. C<$name> is the name of the field, and
685 C<$value> is the value to pass.
687 =item C<[ "radio", $groupname, $value ]>
689 Generates a radio button. Its name (or button group name) is C<$name>.
690 C<$value> is the value associated with the button; this is both the
691 value that will be shown to the user, and that which will be passed on
692 to the C<$action> script.
694 =item C<[ "text", $name, $inittext ]>
696 Generates a text input field. C<$name> specifies its name, and
697 C<$inittext> specifies the text that the field should initially
700 =item C<[ "textarea", $name ]>
702 Creates a 40x4 text area, named C<$name>.
704 =item C<[ "reset", $name, $label ]>
706 Generates a reset button, with name C<$name>. C<$label> specifies the
709 =item C<[ "submit", $name, $label ]>
711 Generates a submit button, with name C<$name>. C<$label> specifies the
719 my ($action,@inputs)=@_;
720 my $string="<form action=$action method=post>\n";
722 for (my $i=0; $i<$count; $i++){
723 if ($inputs[$i][0] eq 'hidden'){
724 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
726 if ($inputs[$i][0] eq 'radio') {
727 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
729 if ($inputs[$i][0] eq 'text') {
730 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
732 if ($inputs[$i][0] eq 'textarea') {
733 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
735 if ($inputs[$i][0] eq 'reset'){
736 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
738 if ($inputs[$i][0] eq 'submit'){
739 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
742 $string .= "</form>";
747 $str = &mkform2($action,
749 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
754 Takes a set of arguments that define an input form, generates an HTML
755 string for the form, and returns the string.
757 C<$action> is the action for the form, usually the URL of the script
758 that will process it.
760 The remaining arguments define the fields in the form. C<$fieldname>
761 is the field's name. This is for the script's benefit, and will not be
764 C<$fieldpos> is an integer; fields will be output in order of
765 increasing C<$fieldpos>. This number must be unique: if two fields
766 have the same C<$fieldpos>, one will be picked at random, and the
767 other will be ignored. See below for special considerations, however.
769 If C<$required> is the string C<R>, then the field is required, and
770 the label will have C< (Req.)> appended.
772 C<$label> is a string that will appear next to the input field.
774 C<$fieldtype> specifies the type of the input field. It may be one of
781 Generates a hidden field, used to pass data to the script without
782 showing it to the user. C<$value0> is its value.
786 Generates a pair of radio buttons, with values C<$value0> and
787 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
788 the user, next to the radio button.
792 Generates a one-line text input field. Its size may be specified by
793 C<$value0>. The default is 40. The initial text of the field may be
794 specified by C<$value1>.
798 Generates a text input area. C<$value0> may be a string of the form
799 "WWWxHHH", in which case the text input area will be WWW columns wide
800 and HHH rows tall. The size defaults to 40x4.
802 The initial text (which, of course, may not contain any tabs) may be
803 specified by C<$value1>.
807 Generates a list of items, from which the user may choose one. Here,
808 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
809 pair, the key specifies an internal label for a choice, and the value
810 specifies the description of the choice that will be shown the user.
812 If C<$value0> is the same as one of the keys that follows, then the
813 corresponding choice will initially be selected.
821 # No tests yet. Once tests are written,
822 # this function can be cleaned up with the following steps:
823 # turn the while loop into a foreach loop
824 # pull the nested if,elsif structure back up to the main level
825 # pull the code for the different kinds of inputs into separate
827 my ($action,%inputs)=@_;
828 my $string="<form action=$action method=post>\n";
829 $string .= mktablehdr();
832 while ( my ($key, $value) = each %inputs) {
833 my @data=split('\t',$value);
834 my $posn = shift(@data);
835 my $reqd = shift(@data);
836 my $ltext = shift(@data);
837 if ($data[0] eq 'hidden'){
838 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
841 if ($data[0] eq 'radio') {
842 $text="<input type=radio name=$key value=$data[1]>$data[1]
843 <input type=radio name=$key value=$data[2]>$data[2]";
844 } elsif ($data[0] eq 'text') {
849 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
850 } elsif ($data[0] eq 'textarea') {
851 my @size=split("x",$data[1]);
852 if ($data[1] eq "") {
856 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
857 } elsif ($data[0] eq 'select') {
858 $text="<select name=$key>";
861 while ($data[$i] ne "") {
862 my $val = $data[$i+1];
863 $text .= "<option value=\"$data[$i]\"";
864 if ($data[$i] eq $sel) {
865 $text .= " selected";
870 $text .= "</select>";
875 $order[$posn] =mktablerow(2,'white',$ltext,$text);
878 $string .= join("\n",@order);
879 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
880 $string .= mktableft;
881 $string .= "</form>";
889 Returns a string of HTML, the end of an HTML document.
894 return("</body></html>\n");
899 $str = &mklink($url, $text);
902 Returns an HTML string, where C<$text> is a link to C<$url>.
908 my $string="<a href=\"$url\">$text</a>";
914 $str = &mkheadr($type, $text);
917 Takes a header type and header text, and returns a string of HTML,
918 where C<$text> is rendered with emphasis in a large font size (not an
921 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
922 Type 2 has no special tag at the end; Type 3 ends with a paragraph
929 # would it be better to make this more generic by accepting an optional
930 # argument with a closing tag instead of a numeric type?
935 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
938 $string="<FONT SIZE=6><em>$text</em></FONT>";
941 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
946 =item center and endcenter
948 print ¢er(), "This is a line of centered text.", &endcenter();
950 C<¢er> and C<&endcenter> take no arguments and return HTML tags
951 <CENTER> and </CENTER> respectively.
956 return ("<CENTER>\n");
960 return ("</CENTER>\n");
968 Returns a string of HTML that renders C<$text> in bold.
974 return("<b>$text</b>");
977 =item getkeytableselectoptions
979 $str = &getkeytableselectoptions($dbh, $tablename,
980 $keyfieldname, $descfieldname,
984 Builds an HTML selection box from a database table. Returns a string
985 of HTML that implements this.
987 C<$dbh> is a DBI::db database handle.
989 C<$tablename> is the database table in which to look up the possible
990 values for the selection box.
992 C<$keyfieldname> is field in C<$tablename>. It will be used as the
993 internal label for the selection.
995 C<$descfieldname> is a field in C<$tablename>. It will be used as the
996 option shown to the user.
998 If C<$showkey> is true, then both the key and value will be shown to
1001 If the C<$default> argument is given, then if a value (from
1002 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1006 #---------------------------------------------
1007 # Create an HTML option list for a <SELECT> form tag by using
1008 # values from a DB file
1009 sub getkeytableselectoptions {
1014 # FIXME - Obsolete argument
1015 $tablename, # name of table containing list of choices
1016 $keyfieldname, # column name of code to use in option list
1017 $descfieldname, # column name of descriptive field
1018 $showkey, # flag to show key in description
1019 $default, # optional default key
1021 my $selectclause; # return value
1025 $key, $desc, $orderfieldname,
1029 $dbh = C4::Context->dbh;
1032 $orderfieldname=$keyfieldname;
1034 $orderfieldname=$descfieldname;
1036 $query= "select $keyfieldname,$descfieldname
1038 order by $orderfieldname ";
1039 print "<PRE>Query=$query </PRE>\n" if $debug;
1040 $sth=$dbh->prepare($query);
1042 while ( ($key, $desc) = $sth->fetchrow) {
1043 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1044 $selectclause.="<option";
1045 if (defined $default && $default eq $key) {
1046 $selectclause.=" selected";
1048 $selectclause.=" value='$key'>$desc\n";
1049 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1051 return $selectclause;
1052 } # sub getkeytableselectoptions
1054 #---------------------------------
1056 END { } # module clean-up code here (global destructor)
1065 Koha Developement team <info@koha.org>