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 #FIXME: this is a quick fix to stop rc1 installing broken
77 #Still trying to figure out the correct fix.
78 my $path = C4::Context->config('intrahtdocs')."/intranet-tmpl/default/en/includes/";
80 #---------------------------------------------------------------------------------------------------------
83 my ($tmplbase, $opac) = @_;
86 if ($opac ne "intranet") {
87 $htdocs = C4::Context->config('opachtdocs');
89 $htdocs = C4::Context->config('intrahtdocs');
92 my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac);
94 my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
95 die_on_bad_params => 0,
97 path => ["$htdocs/$theme/$lang/includes"]);
99 # XXX temporary patch for Bug 182 for themelang
100 $template->param(themelang => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl') . "/$theme/$lang",
101 interface => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl'),
107 #---------------------------------------------------------------------------------------------------------
110 my ($htdocs, $tmpl, $section) = @_;
112 my $dbh = C4::Context->dbh;
115 if ( $section eq "intranet")
117 @languages = split " ", C4::Context->preference("opaclanguages");
118 @themes = split " ", C4::Context->preference("template");
122 @languages = split " ", C4::Context->preference("opaclanguages");
123 @themes = split " ", C4::Context->preference("opacthemes");
127 # searches through the themes and languages. First template it find it returns.
128 # Priority is for getting the theme right.
130 foreach my $th (@themes) {
131 foreach my $la (@languages) {
132 if (-e "$htdocs/$th/$la/$tmpl") {
139 if ($theme and $lang) {
140 return ($theme, $lang);
142 return ('default', 'en');
149 %values = &pathtotemplate(template => $template,
151 language => $language,
153 path => $includedir);
155 Finds a directory containing the desired template. The C<template>
156 argument specifies the template you're looking for (this should be the
157 name of the script you're using to generate an HTML page, without the
158 C<.pl> extension). Only the C<template> argument is required; the
161 C<theme> specifies the name of the theme to use. This will be used
162 only if it is allowed by the C<allowthemeoverride> system preference
163 option (in the C<systempreferences> table of the Koha database).
165 C<language> specifies the desired language. If not specified,
166 C<&pathtotemplate> will use the list of acceptable languages specified
167 by the browser, then C<all>, and finally C<en> as fallback options.
169 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
170 C<intranet> and C<opac> specify that you want a template for the
171 internal web site or the public OPAC, respectively. C<none> specifies
172 that the template you're looking for is at the top level of one of the
173 include directories. Any other value is taken as-is, as a subdirectory
174 of one of the include directories.
176 C<path> specifies an include directory.
178 C<&pathtotemplate> searches first in the directory given by the
179 C<path> argument, if any, then in the directories given by the
180 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
183 C<&pathtotemplate> returns a hash with the following keys:
189 The full pathname to the desired template.
191 =item C<foundlanguage>
193 The value is set to 1 if a template in the desired language was found,
198 The value is set to 1 if a template of the desired theme was found, or
203 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
205 Note that if a template of the desired language or theme cannot be
206 found, C<&pathtotemplate> will print a warning message. Unless you've
207 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
212 # FIXME - Fix POD: it doesn't look in the directory given by the
213 # 'includes' option in /etc/koha.conf.
216 my $template = $params{'template'};
217 my $themeor = $params{'theme'};
218 my $languageor = lc($params{'language'});
219 my $ptype = lc($params{'type'} or 'intranet');
221 # FIXME - Make sure $params{'template'} was given. Or else assume
224 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
225 elsif ($ptype eq 'none') {$type = ''; }
226 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
227 else {$type = $ptype . '/'; }
230 my $theme = C4::Context->preference("theme") || "default";
232 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
236 my @languageorder = getlanguageorder();
237 my $language = $languageor || shift(@languageorder);
239 #where to search for templates
240 my @tmpldirs = ("$path/templates", $path);
241 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
242 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
244 my ($etheme, $elanguage, $epath);
246 CHECK: foreach my $edir (@tmpldirs) {
247 foreach $etheme ($theme, 'all', 'default') {
248 foreach $elanguage ($language, @languageorder, 'all','en') {
249 # 'en' is the fallback-language
250 if (-e "$edir/$type$etheme/$elanguage/$template") {
251 $epath = "$edir/$type$etheme/$elanguage/$template";
259 warn "Could not find $template in @tmpldirs";
263 if ($language eq $elanguage) {
264 $returns{'foundlanguage'} = 1;
266 $returns{'foundlanguage'} = 0;
267 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
269 if ($theme eq $etheme) {
270 $returns{'foundtheme'} = 1;
272 $returns{'foundtheme'} = 0;
273 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
276 $returns{'path'} = $epath;
281 =item getlanguageorder
283 @languages = &getlanguageorder();
285 Returns the list of languages that the user will accept, and returns
286 them in order of decreasing preference. This is retrieved from the
287 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
288 the C<languageorder> setting from the C<systempreferences> table in
289 the Koha database. If neither is set, it defaults to C<en> (English).
293 sub getlanguageorder () {
296 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
297 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
298 } elsif (my $order = C4::Context->preference("languageorder")) {
299 @languageorder = split (/\s*,\s*/ ,lc($order));
300 } else { # here should be another elsif checking for apache's languageorder
301 @languageorder = ('en');
304 return (@languageorder);
312 Returns a string of HTML, the beginning of a new HTML document.
322 $str = &gotopage("//opac.koha.org/index.html");
325 Generates a snippet of HTML code that will redirect to the given URL
326 (which should not include the initial C<http:>), and returns it.
331 my ($target) = shift;
332 #print "<br>goto target = $target<br>";
333 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
339 @lines = &startmenu($type);
340 print join("", @lines);
342 Given a page type, or category, returns a set of lines of HTML which,
343 when concatenated, generate the menu at the top of the web page.
345 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
346 C<report>, C<circulation>, or something else, in which case the menu
347 will be for the catalog pages.
352 # edit the paths in here
354 if ($type eq 'issue') {
355 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
356 } elsif ($type eq 'opac') {
357 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
358 } elsif ($type eq 'member') {
359 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
360 } elsif ($type eq 'acquisitions'){
361 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
362 } elsif ($type eq 'report'){
363 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
364 } elsif ($type eq 'circulation') {
365 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
366 } elsif ($type eq 'admin') {
367 open (FILE,"$path/parameters-top.inc") || die "could not find : $path/parameters-top.inc";
369 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
374 # $string[$count]="<BLOCKQUOTE>";
380 @lines = &endmenu($type);
381 print join("", @lines);
383 Given a page type, or category, returns a set of lines of HTML which,
384 when concatenated, generate the menu at the bottom of the web page.
386 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
387 C<report>, C<circulation>, or something else, in which case the menu
388 will be for the catalog pages.
394 if ( ! defined $type ) { $type=''; }
395 # FIXME - It's bad form to die in a CGI script. It's even worse form
396 # to die without issuing an error message.
397 if ($type eq 'issue') {
398 open (FILE,"<$path/issues-bottom.inc") || die;
399 } elsif ($type eq 'opac') {
400 open (FILE,"<$path/opac-bottom.inc") || die;
401 } elsif ($type eq 'member') {
402 open (FILE,"<$path/members-bottom.inc") || die;
403 } elsif ($type eq 'acquisitions') {
404 open (FILE,"<$path/acquisitions-bottom.inc") || die;
405 } elsif ($type eq 'report') {
406 open (FILE,"<$path/reports-bottom.inc") || die;
407 } elsif ($type eq 'circulation') {
408 open (FILE,"<$path/circulation-bottom.inc") || die;
409 } elsif ($type eq 'admin') {
410 open (FILE,"<$path/parameters-bottom.inc") || die;
412 open (FILE,"<$path/cat-bottom.inc") || die;
421 $str = &mktablehdr();
424 Returns a string of HTML, which generates the beginning of a table
430 return("<table border=0 cellspacing=0 cellpadding=5>\n");
435 $str = &mktablerow($columns, $color, @column_data, $bgimage);
438 Returns a string of HTML, which generates a row of data inside a table
439 (see also C<&mktablehdr>, C<&mktableft>).
441 C<$columns> specifies the number of columns in this row of data.
443 C<$color> specifies the background color for the row, e.g., C<"white">
446 C<@column_data> is an array of C<$columns> elements, each one a string
447 of HTML. These are the contents of the row.
449 The optional C<$bgimage> argument specifies the pathname to an image
450 to use as the background for each cell in the row. This pathname will
451 used as is in the output, so it should be relative to the HTTP
457 #the last item in data may be a backgroundimage
460 # should this be a foreach (1..$cols) loop?
462 my ($cols,$colour,@data)=@_;
464 my $string="<tr valign=top bgcolor=$colour>";
466 if (defined $data[$cols]) { # if there is a background image
467 $string.="<td background=\"$data[$cols]\">";
468 } else { # if there's no background image
471 if (! defined $data[$i]) {$data[$i]="";}
472 if ($data[$i] eq "") {
473 $string.=" </td>";
475 $string.="$data[$i]</td>";
479 $string .= "</tr>\n";
488 Returns a string of HTML, which generates the end of a table
494 return("</table>\n");
497 # FIXME - This is never used.
499 my ($action,%inputs)=@_;
500 my $string="<form action=$action method=post>\n";
501 $string .= mktablehdr();
503 my @keys=sort keys %inputs;
507 while ( $i2<$count) {
508 my $value=$inputs{$keys[$i2]};
509 my @data=split('\t',$value);
510 #my $posn = shift(@data);
511 if ($data[0] eq 'hidden'){
512 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
515 if ($data[0] eq 'radio') {
516 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
517 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
519 if ($data[0] eq 'text') {
520 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
522 if ($data[0] eq 'textarea') {
523 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
525 if ($data[0] eq 'select') {
526 $text="<select name=$keys[$i2]>";
528 while ($data[$i] ne "") {
529 my $val = $data[$i+1];
530 $text .= "<option value=$data[$i]>$val";
533 $text .= "</select>";
535 $string .= mktablerow(2,'white',$keys[$i2],$text);
536 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
540 #$string=$string.join("\n",@order);
541 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
542 $string .= mktableft;
543 $string .= "</form>";
548 $str = &mkform3($action,
549 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
554 Takes a set of arguments that define an input form, generates an HTML
555 string for the form, and returns the string.
557 C<$action> is the action for the form, usually the URL of the script
558 that will process it.
560 The remaining arguments define the fields in the form. C<$fieldname>
561 is the field's name. This is for the script's benefit, and will not be
564 C<$fieldpos> is an integer; fields will be output in order of
565 increasing C<$fieldpos>. This number must be unique: if two fields
566 have the same C<$fieldpos>, one will be picked at random, and the
567 other will be ignored. See below for special considerations, however.
569 C<$fieldtype> specifies the type of the input field. It may be one of
576 Generates a hidden field, used to pass data to the script without
577 showing it to the user. C<$fieldvalue> is the value.
581 Generates a pair of radio buttons, with values C<$fieldvalue> and
582 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
587 Generates a one-line text input field. It initially contains
592 Generates a four-line text input area. The initial text (which, of
593 course, may not contain any tabs) is C<$fieldvalue>.
597 Generates a list of items, from which the user may choose one. This is
598 somewhat different from other input field types, and should be
600 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
601 where the C<text>N strings are the choices that will be presented to
602 the user, and C<label>N are the labels that will be passed to the
605 However, C<text0> should be an integer, since it will be used to
606 determine the order in which this field appears in the form. If any of
607 the C<label>Ns are empty, the rest of the list will be ignored.
614 my ($action, %inputs) = @_;
615 my $string = "<form action=\"$action\" method=\"post\">\n";
616 $string .= mktablehdr();
618 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
623 while ($i2 < $count) {
624 my $value=$inputs{$keys[$i2]};
625 # FIXME - Why use a tab-separated string? Why not just use an
627 my @data=split('\t',$value);
629 if ($data[0] eq 'hidden'){
630 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
633 if ($data[0] eq 'radio') {
634 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
635 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
637 # FIXME - Is 40 the right size in all cases?
638 if ($data[0] eq 'text') {
639 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
641 # FIXME - Is 40x4 the right size in all cases?
642 if ($data[0] eq 'textarea') {
643 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
645 if ($data[0] eq 'select') {
646 $text="<select name=$keys[$i2]>";
648 while ($data[$i] ne "") {
649 my $val = $data[$i+1];
650 $text .= "<option value=$data[$i]>$val";
653 $text .= "</select>";
655 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
656 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
660 my $temp=join("\n",@order);
662 $string .= mktablerow(1,'white','<input type=submit>');
663 $string .= mktableft;
664 $string .= "</form>";
665 # FIXME - A return statement, while not strictly necessary, would be nice.
670 $str = &mkformnotable($action, @inputs);
673 Takes a set of arguments that define an input form, generates an HTML
674 string for the form, and returns the string. Unlike C<&mkform2> and
675 C<&mkform3>, it does not put the form inside a table.
677 C<$action> is the action for the form, usually the URL of the script
678 that will process it.
680 The remaining arguments define the fields in the form. Each is an
681 anonymous array, e.g.:
683 &mkformnotable("/cgi-bin/foo",
684 [ "hidden", "hiddenvar", "value" ],
685 [ "text", "username", "" ]);
687 The first element of each argument defines its type. The remaining
688 ones are type-dependent. The supported types are:
692 =item C<[ "hidden", $name, $value]>
694 Generates a hidden field, for passing information to a script without
695 showing it to the user. C<$name> is the name of the field, and
696 C<$value> is the value to pass.
698 =item C<[ "radio", $groupname, $value ]>
700 Generates a radio button. Its name (or button group name) is C<$name>.
701 C<$value> is the value associated with the button; this is both the
702 value that will be shown to the user, and that which will be passed on
703 to the C<$action> script.
705 =item C<[ "text", $name, $inittext ]>
707 Generates a text input field. C<$name> specifies its name, and
708 C<$inittext> specifies the text that the field should initially
711 =item C<[ "textarea", $name ]>
713 Creates a 40x4 text area, named C<$name>.
715 =item C<[ "reset", $name, $label ]>
717 Generates a reset button, with name C<$name>. C<$label> specifies the
720 =item C<[ "submit", $name, $label ]>
722 Generates a submit button, with name C<$name>. C<$label> specifies the
730 my ($action,@inputs)=@_;
731 my $string="<form action=$action method=post>\n";
733 for (my $i=0; $i<$count; $i++){
734 if ($inputs[$i][0] eq 'hidden'){
735 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
737 if ($inputs[$i][0] eq 'radio') {
738 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
740 if ($inputs[$i][0] eq 'text') {
741 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
743 if ($inputs[$i][0] eq 'textarea') {
744 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
746 if ($inputs[$i][0] eq 'reset'){
747 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
749 if ($inputs[$i][0] eq 'submit'){
750 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
753 $string .= "</form>";
758 $str = &mkform2($action,
760 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
765 Takes a set of arguments that define an input form, generates an HTML
766 string for the form, and returns the string.
768 C<$action> is the action for the form, usually the URL of the script
769 that will process it.
771 The remaining arguments define the fields in the form. C<$fieldname>
772 is the field's name. This is for the script's benefit, and will not be
775 C<$fieldpos> is an integer; fields will be output in order of
776 increasing C<$fieldpos>. This number must be unique: if two fields
777 have the same C<$fieldpos>, one will be picked at random, and the
778 other will be ignored. See below for special considerations, however.
780 If C<$required> is the string C<R>, then the field is required, and
781 the label will have C< (Req.)> appended.
783 C<$label> is a string that will appear next to the input field.
785 C<$fieldtype> specifies the type of the input field. It may be one of
792 Generates a hidden field, used to pass data to the script without
793 showing it to the user. C<$value0> is its value.
797 Generates a pair of radio buttons, with values C<$value0> and
798 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
799 the user, next to the radio button.
803 Generates a one-line text input field. Its size may be specified by
804 C<$value0>. The default is 40. The initial text of the field may be
805 specified by C<$value1>.
809 Generates a text input area. C<$value0> may be a string of the form
810 "WWWxHHH", in which case the text input area will be WWW columns wide
811 and HHH rows tall. The size defaults to 40x4.
813 The initial text (which, of course, may not contain any tabs) may be
814 specified by C<$value1>.
818 Generates a list of items, from which the user may choose one. Here,
819 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
820 pair, the key specifies an internal label for a choice, and the value
821 specifies the description of the choice that will be shown the user.
823 If C<$value0> is the same as one of the keys that follows, then the
824 corresponding choice will initially be selected.
832 # No tests yet. Once tests are written,
833 # this function can be cleaned up with the following steps:
834 # turn the while loop into a foreach loop
835 # pull the nested if,elsif structure back up to the main level
836 # pull the code for the different kinds of inputs into separate
838 my ($action,%inputs)=@_;
839 my $string="<form action=$action method=post>\n";
840 $string .= mktablehdr();
843 while ( my ($key, $value) = each %inputs) {
844 my @data=split('\t',$value);
845 my $posn = shift(@data);
846 my $reqd = shift(@data);
847 my $ltext = shift(@data);
848 if ($data[0] eq 'hidden'){
849 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
852 if ($data[0] eq 'radio') {
853 $text="<input type=radio name=$key value=$data[1]>$data[1]
854 <input type=radio name=$key value=$data[2]>$data[2]";
855 } elsif ($data[0] eq 'text') {
860 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
861 } elsif ($data[0] eq 'textarea') {
862 my @size=split("x",$data[1]);
863 if ($data[1] eq "") {
867 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
868 } elsif ($data[0] eq 'select') {
869 $text="<select name=$key>";
872 while ($data[$i] ne "") {
873 my $val = $data[$i+1];
874 $text .= "<option value=\"$data[$i]\"";
875 if ($data[$i] eq $sel) {
876 $text .= " selected";
881 $text .= "</select>";
886 $order[$posn] =mktablerow(2,'white',$ltext,$text);
889 $string .= join("\n",@order);
890 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
891 $string .= mktableft;
892 $string .= "</form>";
900 Returns a string of HTML, the end of an HTML document.
905 return("</body></html>\n");
910 $str = &mklink($url, $text);
913 Returns an HTML string, where C<$text> is a link to C<$url>.
919 my $string="<a href=\"$url\">$text</a>";
925 $str = &mkheadr($type, $text);
928 Takes a header type and header text, and returns a string of HTML,
929 where C<$text> is rendered with emphasis in a large font size (not an
932 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
933 Type 2 has no special tag at the end; Type 3 ends with a paragraph
940 # would it be better to make this more generic by accepting an optional
941 # argument with a closing tag instead of a numeric type?
946 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
949 $string="<FONT SIZE=6><em>$text</em></FONT>";
952 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
957 =item center and endcenter
959 print ¢er(), "This is a line of centered text.", &endcenter();
961 C<¢er> and C<&endcenter> take no arguments and return HTML tags
962 <CENTER> and </CENTER> respectively.
967 return ("<CENTER>\n");
971 return ("</CENTER>\n");
979 Returns a string of HTML that renders C<$text> in bold.
985 return("<b>$text</b>");
988 =item getkeytableselectoptions
990 $str = &getkeytableselectoptions($dbh, $tablename,
991 $keyfieldname, $descfieldname,
995 Builds an HTML selection box from a database table. Returns a string
996 of HTML that implements this.
998 C<$dbh> is a DBI::db database handle.
1000 C<$tablename> is the database table in which to look up the possible
1001 values for the selection box.
1003 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1004 internal label for the selection.
1006 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1007 option shown to the user.
1009 If C<$showkey> is true, then both the key and value will be shown to
1012 If the C<$default> argument is given, then if a value (from
1013 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1017 #---------------------------------------------
1018 # Create an HTML option list for a <SELECT> form tag by using
1019 # values from a DB file
1020 sub getkeytableselectoptions {
1025 # FIXME - Obsolete argument
1026 $tablename, # name of table containing list of choices
1027 $keyfieldname, # column name of code to use in option list
1028 $descfieldname, # column name of descriptive field
1029 $showkey, # flag to show key in description
1030 $default, # optional default key
1032 my $selectclause; # return value
1036 $key, $desc, $orderfieldname,
1040 $dbh = C4::Context->dbh;
1043 $orderfieldname=$keyfieldname;
1045 $orderfieldname=$descfieldname;
1047 $query= "select $keyfieldname,$descfieldname
1049 order by $orderfieldname ";
1050 print "<PRE>Query=$query </PRE>\n" if $debug;
1051 $sth=$dbh->prepare($query);
1053 while ( ($key, $desc) = $sth->fetchrow) {
1054 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1055 $selectclause.="<option";
1056 if (defined $default && $default eq $key) {
1057 $selectclause.=" selected";
1059 $selectclause.=" value='$key'>$desc\n";
1060 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1062 return $selectclause;
1063 } # sub getkeytableselectoptions
1065 #---------------------------------
1067 END { } # module clean-up code here (global destructor)
1076 Koha Developement team <info@koha.org>