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, $opac);
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, $section) = @_;
111 my $dbh = C4::Context->dbh;
114 if ( $section eq "intranet")
116 @languages = split " ", C4::Context->preference("opaclanguages");
117 @themes = split " ", C4::Context->preference("template");
121 @languages = split " ", C4::Context->preference("opaclanguages");
122 @themes = split " ", C4::Context->preference("opacthemes");
126 # searches through the themes and languages. First template it find it returns.
127 # Priority is for getting the theme right.
129 foreach my $th (@themes) {
130 foreach my $la (@languages) {
131 if (-e "$htdocs/$th/$la/$tmpl") {
138 if ($theme and $lang) {
139 return ($theme, $lang);
141 return ('default', 'en');
148 %values = &pathtotemplate(template => $template,
150 language => $language,
152 path => $includedir);
154 Finds a directory containing the desired template. The C<template>
155 argument specifies the template you're looking for (this should be the
156 name of the script you're using to generate an HTML page, without the
157 C<.pl> extension). Only the C<template> argument is required; the
160 C<theme> specifies the name of the theme to use. This will be used
161 only if it is allowed by the C<allowthemeoverride> system preference
162 option (in the C<systempreferences> table of the Koha database).
164 C<language> specifies the desired language. If not specified,
165 C<&pathtotemplate> will use the list of acceptable languages specified
166 by the browser, then C<all>, and finally C<en> as fallback options.
168 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
169 C<intranet> and C<opac> specify that you want a template for the
170 internal web site or the public OPAC, respectively. C<none> specifies
171 that the template you're looking for is at the top level of one of the
172 include directories. Any other value is taken as-is, as a subdirectory
173 of one of the include directories.
175 C<path> specifies an include directory.
177 C<&pathtotemplate> searches first in the directory given by the
178 C<path> argument, if any, then in the directories given by the
179 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
182 C<&pathtotemplate> returns a hash with the following keys:
188 The full pathname to the desired template.
190 =item C<foundlanguage>
192 The value is set to 1 if a template in the desired language was found,
197 The value is set to 1 if a template of the desired theme was found, or
202 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
204 Note that if a template of the desired language or theme cannot be
205 found, C<&pathtotemplate> will print a warning message. Unless you've
206 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
211 # FIXME - Fix POD: it doesn't look in the directory given by the
212 # 'includes' option in /etc/koha.conf.
215 my $template = $params{'template'};
216 my $themeor = $params{'theme'};
217 my $languageor = lc($params{'language'});
218 my $ptype = lc($params{'type'} or 'intranet');
220 # FIXME - Make sure $params{'template'} was given. Or else assume
223 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
224 elsif ($ptype eq 'none') {$type = ''; }
225 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
226 else {$type = $ptype . '/'; }
229 my $theme = C4::Context->preference("theme") || "default";
231 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
235 my @languageorder = getlanguageorder();
236 my $language = $languageor || shift(@languageorder);
238 #where to search for templates
239 my @tmpldirs = ("$path/templates", $path);
240 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
241 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
243 my ($etheme, $elanguage, $epath);
245 CHECK: foreach my $edir (@tmpldirs) {
246 foreach $etheme ($theme, 'all', 'default') {
247 foreach $elanguage ($language, @languageorder, 'all','en') {
248 # 'en' is the fallback-language
249 if (-e "$edir/$type$etheme/$elanguage/$template") {
250 $epath = "$edir/$type$etheme/$elanguage/$template";
258 warn "Could not find $template in @tmpldirs";
262 if ($language eq $elanguage) {
263 $returns{'foundlanguage'} = 1;
265 $returns{'foundlanguage'} = 0;
266 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
268 if ($theme eq $etheme) {
269 $returns{'foundtheme'} = 1;
271 $returns{'foundtheme'} = 0;
272 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
275 $returns{'path'} = $epath;
280 =item getlanguageorder
282 @languages = &getlanguageorder();
284 Returns the list of languages that the user will accept, and returns
285 them in order of decreasing preference. This is retrieved from the
286 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
287 the C<languageorder> setting from the C<systempreferences> table in
288 the Koha database. If neither is set, it defaults to C<en> (English).
292 sub getlanguageorder () {
295 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
296 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
297 } elsif (my $order = C4::Context->preference("languageorder")) {
298 @languageorder = split (/\s*,\s*/ ,lc($order));
299 } else { # here should be another elsif checking for apache's languageorder
300 @languageorder = ('en');
303 return (@languageorder);
311 Returns a string of HTML, the beginning of a new HTML document.
321 $str = &gotopage("//opac.koha.org/index.html");
324 Generates a snippet of HTML code that will redirect to the given URL
325 (which should not include the initial C<http:>), and returns it.
330 my ($target) = shift;
331 #print "<br>goto target = $target<br>";
332 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
338 @lines = &startmenu($type);
339 print join("", @lines);
341 Given a page type, or category, returns a set of lines of HTML which,
342 when concatenated, generate the menu at the top of the web page.
344 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
345 C<report>, C<circulation>, or something else, in which case the menu
346 will be for the catalog pages.
351 # edit the paths in here
353 if ($type eq 'issue') {
354 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
355 } elsif ($type eq 'opac') {
356 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
357 } elsif ($type eq 'member') {
358 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
359 } elsif ($type eq 'acquisitions'){
360 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
361 } elsif ($type eq 'report'){
362 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
363 } elsif ($type eq 'circulation') {
364 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
365 } elsif ($type eq 'admin') {
366 open (FILE,"$path/parameters-top.inc") || die "could not find : $path/parameters-top.inc";
368 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
373 # $string[$count]="<BLOCKQUOTE>";
379 @lines = &endmenu($type);
380 print join("", @lines);
382 Given a page type, or category, returns a set of lines of HTML which,
383 when concatenated, generate the menu at the bottom of the web page.
385 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
386 C<report>, C<circulation>, or something else, in which case the menu
387 will be for the catalog pages.
393 if ( ! defined $type ) { $type=''; }
394 # FIXME - It's bad form to die in a CGI script. It's even worse form
395 # to die without issuing an error message.
396 if ($type eq 'issue') {
397 open (FILE,"<$path/issues-bottom.inc") || die;
398 } elsif ($type eq 'opac') {
399 open (FILE,"<$path/opac-bottom.inc") || die;
400 } elsif ($type eq 'member') {
401 open (FILE,"<$path/members-bottom.inc") || die;
402 } elsif ($type eq 'acquisitions') {
403 open (FILE,"<$path/acquisitions-bottom.inc") || die;
404 } elsif ($type eq 'report') {
405 open (FILE,"<$path/reports-bottom.inc") || die;
406 } elsif ($type eq 'circulation') {
407 open (FILE,"<$path/circulation-bottom.inc") || die;
408 } elsif ($type eq 'admin') {
409 open (FILE,"<$path/parameters-bottom.inc") || die;
411 open (FILE,"<$path/cat-bottom.inc") || die;
420 $str = &mktablehdr();
423 Returns a string of HTML, which generates the beginning of a table
429 return("<table border=0 cellspacing=0 cellpadding=5>\n");
434 $str = &mktablerow($columns, $color, @column_data, $bgimage);
437 Returns a string of HTML, which generates a row of data inside a table
438 (see also C<&mktablehdr>, C<&mktableft>).
440 C<$columns> specifies the number of columns in this row of data.
442 C<$color> specifies the background color for the row, e.g., C<"white">
445 C<@column_data> is an array of C<$columns> elements, each one a string
446 of HTML. These are the contents of the row.
448 The optional C<$bgimage> argument specifies the pathname to an image
449 to use as the background for each cell in the row. This pathname will
450 used as is in the output, so it should be relative to the HTTP
456 #the last item in data may be a backgroundimage
459 # should this be a foreach (1..$cols) loop?
461 my ($cols,$colour,@data)=@_;
463 my $string="<tr valign=top bgcolor=$colour>";
465 if (defined $data[$cols]) { # if there is a background image
466 $string.="<td background=\"$data[$cols]\">";
467 } else { # if there's no background image
470 if (! defined $data[$i]) {$data[$i]="";}
471 if ($data[$i] eq "") {
472 $string.=" </td>";
474 $string.="$data[$i]</td>";
478 $string .= "</tr>\n";
487 Returns a string of HTML, which generates the end of a table
493 return("</table>\n");
496 # FIXME - This is never used.
498 my ($action,%inputs)=@_;
499 my $string="<form action=$action method=post>\n";
500 $string .= mktablehdr();
502 my @keys=sort keys %inputs;
506 while ( $i2<$count) {
507 my $value=$inputs{$keys[$i2]};
508 my @data=split('\t',$value);
509 #my $posn = shift(@data);
510 if ($data[0] eq 'hidden'){
511 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
514 if ($data[0] eq 'radio') {
515 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
516 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
518 if ($data[0] eq 'text') {
519 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
521 if ($data[0] eq 'textarea') {
522 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
524 if ($data[0] eq 'select') {
525 $text="<select name=$keys[$i2]>";
527 while ($data[$i] ne "") {
528 my $val = $data[$i+1];
529 $text .= "<option value=$data[$i]>$val";
532 $text .= "</select>";
534 $string .= mktablerow(2,'white',$keys[$i2],$text);
535 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
539 #$string=$string.join("\n",@order);
540 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
541 $string .= mktableft;
542 $string .= "</form>";
547 $str = &mkform3($action,
548 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
553 Takes a set of arguments that define an input form, generates an HTML
554 string for the form, and returns the string.
556 C<$action> is the action for the form, usually the URL of the script
557 that will process it.
559 The remaining arguments define the fields in the form. C<$fieldname>
560 is the field's name. This is for the script's benefit, and will not be
563 C<$fieldpos> is an integer; fields will be output in order of
564 increasing C<$fieldpos>. This number must be unique: if two fields
565 have the same C<$fieldpos>, one will be picked at random, and the
566 other will be ignored. See below for special considerations, however.
568 C<$fieldtype> specifies the type of the input field. It may be one of
575 Generates a hidden field, used to pass data to the script without
576 showing it to the user. C<$fieldvalue> is the value.
580 Generates a pair of radio buttons, with values C<$fieldvalue> and
581 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
586 Generates a one-line text input field. It initially contains
591 Generates a four-line text input area. The initial text (which, of
592 course, may not contain any tabs) is C<$fieldvalue>.
596 Generates a list of items, from which the user may choose one. This is
597 somewhat different from other input field types, and should be
599 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
600 where the C<text>N strings are the choices that will be presented to
601 the user, and C<label>N are the labels that will be passed to the
604 However, C<text0> should be an integer, since it will be used to
605 determine the order in which this field appears in the form. If any of
606 the C<label>Ns are empty, the rest of the list will be ignored.
613 my ($action, %inputs) = @_;
614 my $string = "<form action=\"$action\" method=\"post\">\n";
615 $string .= mktablehdr();
617 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
622 while ($i2 < $count) {
623 my $value=$inputs{$keys[$i2]};
624 # FIXME - Why use a tab-separated string? Why not just use an
626 my @data=split('\t',$value);
628 if ($data[0] eq 'hidden'){
629 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
632 if ($data[0] eq 'radio') {
633 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
634 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
636 # FIXME - Is 40 the right size in all cases?
637 if ($data[0] eq 'text') {
638 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
640 # FIXME - Is 40x4 the right size in all cases?
641 if ($data[0] eq 'textarea') {
642 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
644 if ($data[0] eq 'select') {
645 $text="<select name=$keys[$i2]>";
647 while ($data[$i] ne "") {
648 my $val = $data[$i+1];
649 $text .= "<option value=$data[$i]>$val";
652 $text .= "</select>";
654 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
655 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
659 my $temp=join("\n",@order);
661 $string .= mktablerow(1,'white','<input type=submit>');
662 $string .= mktableft;
663 $string .= "</form>";
664 # FIXME - A return statement, while not strictly necessary, would be nice.
669 $str = &mkformnotable($action, @inputs);
672 Takes a set of arguments that define an input form, generates an HTML
673 string for the form, and returns the string. Unlike C<&mkform2> and
674 C<&mkform3>, it does not put the form inside a table.
676 C<$action> is the action for the form, usually the URL of the script
677 that will process it.
679 The remaining arguments define the fields in the form. Each is an
680 anonymous array, e.g.:
682 &mkformnotable("/cgi-bin/foo",
683 [ "hidden", "hiddenvar", "value" ],
684 [ "text", "username", "" ]);
686 The first element of each argument defines its type. The remaining
687 ones are type-dependent. The supported types are:
691 =item C<[ "hidden", $name, $value]>
693 Generates a hidden field, for passing information to a script without
694 showing it to the user. C<$name> is the name of the field, and
695 C<$value> is the value to pass.
697 =item C<[ "radio", $groupname, $value ]>
699 Generates a radio button. Its name (or button group name) is C<$name>.
700 C<$value> is the value associated with the button; this is both the
701 value that will be shown to the user, and that which will be passed on
702 to the C<$action> script.
704 =item C<[ "text", $name, $inittext ]>
706 Generates a text input field. C<$name> specifies its name, and
707 C<$inittext> specifies the text that the field should initially
710 =item C<[ "textarea", $name ]>
712 Creates a 40x4 text area, named C<$name>.
714 =item C<[ "reset", $name, $label ]>
716 Generates a reset button, with name C<$name>. C<$label> specifies the
719 =item C<[ "submit", $name, $label ]>
721 Generates a submit button, with name C<$name>. C<$label> specifies the
729 my ($action,@inputs)=@_;
730 my $string="<form action=$action method=post>\n";
732 for (my $i=0; $i<$count; $i++){
733 if ($inputs[$i][0] eq 'hidden'){
734 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
736 if ($inputs[$i][0] eq 'radio') {
737 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
739 if ($inputs[$i][0] eq 'text') {
740 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
742 if ($inputs[$i][0] eq 'textarea') {
743 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
745 if ($inputs[$i][0] eq 'reset'){
746 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
748 if ($inputs[$i][0] eq 'submit'){
749 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
752 $string .= "</form>";
757 $str = &mkform2($action,
759 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
764 Takes a set of arguments that define an input form, generates an HTML
765 string for the form, and returns the string.
767 C<$action> is the action for the form, usually the URL of the script
768 that will process it.
770 The remaining arguments define the fields in the form. C<$fieldname>
771 is the field's name. This is for the script's benefit, and will not be
774 C<$fieldpos> is an integer; fields will be output in order of
775 increasing C<$fieldpos>. This number must be unique: if two fields
776 have the same C<$fieldpos>, one will be picked at random, and the
777 other will be ignored. See below for special considerations, however.
779 If C<$required> is the string C<R>, then the field is required, and
780 the label will have C< (Req.)> appended.
782 C<$label> is a string that will appear next to the input field.
784 C<$fieldtype> specifies the type of the input field. It may be one of
791 Generates a hidden field, used to pass data to the script without
792 showing it to the user. C<$value0> is its value.
796 Generates a pair of radio buttons, with values C<$value0> and
797 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
798 the user, next to the radio button.
802 Generates a one-line text input field. Its size may be specified by
803 C<$value0>. The default is 40. The initial text of the field may be
804 specified by C<$value1>.
808 Generates a text input area. C<$value0> may be a string of the form
809 "WWWxHHH", in which case the text input area will be WWW columns wide
810 and HHH rows tall. The size defaults to 40x4.
812 The initial text (which, of course, may not contain any tabs) may be
813 specified by C<$value1>.
817 Generates a list of items, from which the user may choose one. Here,
818 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
819 pair, the key specifies an internal label for a choice, and the value
820 specifies the description of the choice that will be shown the user.
822 If C<$value0> is the same as one of the keys that follows, then the
823 corresponding choice will initially be selected.
831 # No tests yet. Once tests are written,
832 # this function can be cleaned up with the following steps:
833 # turn the while loop into a foreach loop
834 # pull the nested if,elsif structure back up to the main level
835 # pull the code for the different kinds of inputs into separate
837 my ($action,%inputs)=@_;
838 my $string="<form action=$action method=post>\n";
839 $string .= mktablehdr();
842 while ( my ($key, $value) = each %inputs) {
843 my @data=split('\t',$value);
844 my $posn = shift(@data);
845 my $reqd = shift(@data);
846 my $ltext = shift(@data);
847 if ($data[0] eq 'hidden'){
848 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
851 if ($data[0] eq 'radio') {
852 $text="<input type=radio name=$key value=$data[1]>$data[1]
853 <input type=radio name=$key value=$data[2]>$data[2]";
854 } elsif ($data[0] eq 'text') {
859 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
860 } elsif ($data[0] eq 'textarea') {
861 my @size=split("x",$data[1]);
862 if ($data[1] eq "") {
866 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
867 } elsif ($data[0] eq 'select') {
868 $text="<select name=$key>";
871 while ($data[$i] ne "") {
872 my $val = $data[$i+1];
873 $text .= "<option value=\"$data[$i]\"";
874 if ($data[$i] eq $sel) {
875 $text .= " selected";
880 $text .= "</select>";
885 $order[$posn] =mktablerow(2,'white',$ltext,$text);
888 $string .= join("\n",@order);
889 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
890 $string .= mktableft;
891 $string .= "</form>";
899 Returns a string of HTML, the end of an HTML document.
904 return("</body></html>\n");
909 $str = &mklink($url, $text);
912 Returns an HTML string, where C<$text> is a link to C<$url>.
918 my $string="<a href=\"$url\">$text</a>";
924 $str = &mkheadr($type, $text);
927 Takes a header type and header text, and returns a string of HTML,
928 where C<$text> is rendered with emphasis in a large font size (not an
931 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
932 Type 2 has no special tag at the end; Type 3 ends with a paragraph
939 # would it be better to make this more generic by accepting an optional
940 # argument with a closing tag instead of a numeric type?
945 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
948 $string="<FONT SIZE=6><em>$text</em></FONT>";
951 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
956 =item center and endcenter
958 print ¢er(), "This is a line of centered text.", &endcenter();
960 C<¢er> and C<&endcenter> take no arguments and return HTML tags
961 <CENTER> and </CENTER> respectively.
966 return ("<CENTER>\n");
970 return ("</CENTER>\n");
978 Returns a string of HTML that renders C<$text> in bold.
984 return("<b>$text</b>");
987 =item getkeytableselectoptions
989 $str = &getkeytableselectoptions($dbh, $tablename,
990 $keyfieldname, $descfieldname,
994 Builds an HTML selection box from a database table. Returns a string
995 of HTML that implements this.
997 C<$dbh> is a DBI::db database handle.
999 C<$tablename> is the database table in which to look up the possible
1000 values for the selection box.
1002 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1003 internal label for the selection.
1005 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1006 option shown to the user.
1008 If C<$showkey> is true, then both the key and value will be shown to
1011 If the C<$default> argument is given, then if a value (from
1012 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1016 #---------------------------------------------
1017 # Create an HTML option list for a <SELECT> form tag by using
1018 # values from a DB file
1019 sub getkeytableselectoptions {
1024 # FIXME - Obsolete argument
1025 $tablename, # name of table containing list of choices
1026 $keyfieldname, # column name of code to use in option list
1027 $descfieldname, # column name of descriptive field
1028 $showkey, # flag to show key in description
1029 $default, # optional default key
1031 my $selectclause; # return value
1035 $key, $desc, $orderfieldname,
1039 $dbh = C4::Context->dbh;
1042 $orderfieldname=$keyfieldname;
1044 $orderfieldname=$descfieldname;
1046 $query= "select $keyfieldname,$descfieldname
1048 order by $orderfieldname ";
1049 print "<PRE>Query=$query </PRE>\n" if $debug;
1050 $sth=$dbh->prepare($query);
1052 while ( ($key, $desc) = $sth->fetchrow) {
1053 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1054 $selectclause.="<option";
1055 if (defined $default && $default eq $key) {
1056 $selectclause.=" selected";
1058 $selectclause.=" value='$key'>$desc\n";
1059 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1061 return $selectclause;
1062 } # sub getkeytableselectoptions
1064 #---------------------------------
1066 END { } # module clean-up code here (global destructor)
1075 Koha Developement team <info@koha.org>