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 for (my $pass = 1; $pass <= 2; $pass += 1) {
133 $la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
134 if (-e "$htdocs/$th/$la/$tmpl") {
139 last unless $la =~ /[-_]/;
143 if ($theme and $lang) {
144 return ($theme, $lang);
146 return ('default', 'en');
153 %values = &pathtotemplate(template => $template,
155 language => $language,
157 path => $includedir);
159 Finds a directory containing the desired template. The C<template>
160 argument specifies the template you're looking for (this should be the
161 name of the script you're using to generate an HTML page, without the
162 C<.pl> extension). Only the C<template> argument is required; the
165 C<theme> specifies the name of the theme to use. This will be used
166 only if it is allowed by the C<allowthemeoverride> system preference
167 option (in the C<systempreferences> table of the Koha database).
169 C<language> specifies the desired language. If not specified,
170 C<&pathtotemplate> will use the list of acceptable languages specified
171 by the browser, then C<all>, and finally C<en> as fallback options.
173 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
174 C<intranet> and C<opac> specify that you want a template for the
175 internal web site or the public OPAC, respectively. C<none> specifies
176 that the template you're looking for is at the top level of one of the
177 include directories. Any other value is taken as-is, as a subdirectory
178 of one of the include directories.
180 C<path> specifies an include directory.
182 C<&pathtotemplate> searches first in the directory given by the
183 C<path> argument, if any, then in the directories given by the
184 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
187 C<&pathtotemplate> returns a hash with the following keys:
193 The full pathname to the desired template.
195 =item C<foundlanguage>
197 The value is set to 1 if a template in the desired language was found,
202 The value is set to 1 if a template of the desired theme was found, or
207 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
209 Note that if a template of the desired language or theme cannot be
210 found, C<&pathtotemplate> will print a warning message. Unless you've
211 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
216 # FIXME - Fix POD: it doesn't look in the directory given by the
217 # 'includes' option in /etc/koha.conf.
220 my $template = $params{'template'};
221 my $themeor = $params{'theme'};
222 my $languageor = lc($params{'language'});
223 my $ptype = lc($params{'type'} or 'intranet');
225 # FIXME - Make sure $params{'template'} was given. Or else assume
228 if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
229 elsif ($ptype eq 'none') {$type = ''; }
230 elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
231 else {$type = $ptype . '/'; }
234 my $theme = C4::Context->preference("theme") || "default";
236 C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
240 my @languageorder = getlanguageorder();
241 my $language = $languageor || shift(@languageorder);
243 #where to search for templates
244 my @tmpldirs = ("$path/templates", $path);
245 unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
246 unshift (@tmpldirs, $params{'path'}) if $params{'path'};
248 my ($etheme, $elanguage, $epath);
250 CHECK: foreach my $edir (@tmpldirs) {
251 foreach $etheme ($theme, 'all', 'default') {
252 foreach $elanguage ($language, @languageorder, 'all','en') {
253 # 'en' is the fallback-language
254 if (-e "$edir/$type$etheme/$elanguage/$template") {
255 $epath = "$edir/$type$etheme/$elanguage/$template";
263 warn "Could not find $template in @tmpldirs";
267 if ($language eq $elanguage) {
268 $returns{'foundlanguage'} = 1;
270 $returns{'foundlanguage'} = 0;
271 warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
273 if ($theme eq $etheme) {
274 $returns{'foundtheme'} = 1;
276 $returns{'foundtheme'} = 0;
277 warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
280 $returns{'path'} = $epath;
285 =item getlanguageorder
287 @languages = &getlanguageorder();
289 Returns the list of languages that the user will accept, and returns
290 them in order of decreasing preference. This is retrieved from the
291 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
292 the C<languageorder> setting from the C<systempreferences> table in
293 the Koha database. If neither is set, it defaults to C<en> (English).
297 sub getlanguageorder () {
300 if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
301 @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
302 } elsif (my $order = C4::Context->preference("languageorder")) {
303 @languageorder = split (/\s*,\s*/ ,lc($order));
304 } else { # here should be another elsif checking for apache's languageorder
305 @languageorder = ('en');
308 return (@languageorder);
316 Returns a string of HTML, the beginning of a new HTML document.
326 $str = &gotopage("//opac.koha.org/index.html");
329 Generates a snippet of HTML code that will redirect to the given URL
330 (which should not include the initial C<http:>), and returns it.
335 my ($target) = shift;
336 #print "<br>goto target = $target<br>";
337 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
343 @lines = &startmenu($type);
344 print join("", @lines);
346 Given a page type, or category, returns a set of lines of HTML which,
347 when concatenated, generate the menu at the top of the web page.
349 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
350 C<report>, C<circulation>, or something else, in which case the menu
351 will be for the catalog pages.
356 # edit the paths in here
358 if ($type eq 'issue') {
359 open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
360 } elsif ($type eq 'opac') {
361 open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
362 } elsif ($type eq 'member') {
363 open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
364 } elsif ($type eq 'acquisitions'){
365 open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
366 } elsif ($type eq 'report'){
367 open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
368 } elsif ($type eq 'circulation') {
369 open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
370 } elsif ($type eq 'admin') {
371 open (FILE,"$path/parameters-top.inc") || die "could not find : $path/parameters-top.inc";
373 open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
378 # $string[$count]="<BLOCKQUOTE>";
384 @lines = &endmenu($type);
385 print join("", @lines);
387 Given a page type, or category, returns a set of lines of HTML which,
388 when concatenated, generate the menu at the bottom of the web page.
390 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
391 C<report>, C<circulation>, or something else, in which case the menu
392 will be for the catalog pages.
398 if ( ! defined $type ) { $type=''; }
399 # FIXME - It's bad form to die in a CGI script. It's even worse form
400 # to die without issuing an error message.
401 if ($type eq 'issue') {
402 open (FILE,"<$path/issues-bottom.inc") || die;
403 } elsif ($type eq 'opac') {
404 open (FILE,"<$path/opac-bottom.inc") || die;
405 } elsif ($type eq 'member') {
406 open (FILE,"<$path/members-bottom.inc") || die;
407 } elsif ($type eq 'acquisitions') {
408 open (FILE,"<$path/acquisitions-bottom.inc") || die;
409 } elsif ($type eq 'report') {
410 open (FILE,"<$path/reports-bottom.inc") || die;
411 } elsif ($type eq 'circulation') {
412 open (FILE,"<$path/circulation-bottom.inc") || die;
413 } elsif ($type eq 'admin') {
414 open (FILE,"<$path/parameters-bottom.inc") || die;
416 open (FILE,"<$path/cat-bottom.inc") || die;
425 $str = &mktablehdr();
428 Returns a string of HTML, which generates the beginning of a table
434 return("<table border=0 cellspacing=0 cellpadding=5>\n");
439 $str = &mktablerow($columns, $color, @column_data, $bgimage);
442 Returns a string of HTML, which generates a row of data inside a table
443 (see also C<&mktablehdr>, C<&mktableft>).
445 C<$columns> specifies the number of columns in this row of data.
447 C<$color> specifies the background color for the row, e.g., C<"white">
450 C<@column_data> is an array of C<$columns> elements, each one a string
451 of HTML. These are the contents of the row.
453 The optional C<$bgimage> argument specifies the pathname to an image
454 to use as the background for each cell in the row. This pathname will
455 used as is in the output, so it should be relative to the HTTP
461 #the last item in data may be a backgroundimage
464 # should this be a foreach (1..$cols) loop?
466 my ($cols,$colour,@data)=@_;
468 my $string="<tr valign=top bgcolor=$colour>";
470 if (defined $data[$cols]) { # if there is a background image
471 $string.="<td background=\"$data[$cols]\">";
472 } else { # if there's no background image
475 if (! defined $data[$i]) {$data[$i]="";}
476 if ($data[$i] eq "") {
477 $string.=" </td>";
479 $string.="$data[$i]</td>";
483 $string .= "</tr>\n";
492 Returns a string of HTML, which generates the end of a table
498 return("</table>\n");
501 # FIXME - This is never used.
503 my ($action,%inputs)=@_;
504 my $string="<form action=$action method=post>\n";
505 $string .= mktablehdr();
507 my @keys=sort keys %inputs;
511 while ( $i2<$count) {
512 my $value=$inputs{$keys[$i2]};
513 my @data=split('\t',$value);
514 #my $posn = shift(@data);
515 if ($data[0] eq 'hidden'){
516 $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
519 if ($data[0] eq 'radio') {
520 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
521 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
523 if ($data[0] eq 'text') {
524 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
526 if ($data[0] eq 'textarea') {
527 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
529 if ($data[0] eq 'select') {
530 $text="<select name=$keys[$i2]>";
532 while ($data[$i] ne "") {
533 my $val = $data[$i+1];
534 $text .= "<option value=$data[$i]>$val";
537 $text .= "</select>";
539 $string .= mktablerow(2,'white',$keys[$i2],$text);
540 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
544 #$string=$string.join("\n",@order);
545 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
546 $string .= mktableft;
547 $string .= "</form>";
552 $str = &mkform3($action,
553 $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
558 Takes a set of arguments that define an input form, generates an HTML
559 string for the form, and returns the string.
561 C<$action> is the action for the form, usually the URL of the script
562 that will process it.
564 The remaining arguments define the fields in the form. C<$fieldname>
565 is the field's name. This is for the script's benefit, and will not be
568 C<$fieldpos> is an integer; fields will be output in order of
569 increasing C<$fieldpos>. This number must be unique: if two fields
570 have the same C<$fieldpos>, one will be picked at random, and the
571 other will be ignored. See below for special considerations, however.
573 C<$fieldtype> specifies the type of the input field. It may be one of
580 Generates a hidden field, used to pass data to the script without
581 showing it to the user. C<$fieldvalue> is the value.
585 Generates a pair of radio buttons, with values C<$fieldvalue> and
586 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
591 Generates a one-line text input field. It initially contains
596 Generates a four-line text input area. The initial text (which, of
597 course, may not contain any tabs) is C<$fieldvalue>.
601 Generates a list of items, from which the user may choose one. This is
602 somewhat different from other input field types, and should be
604 "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
605 where the C<text>N strings are the choices that will be presented to
606 the user, and C<label>N are the labels that will be passed to the
609 However, C<text0> should be an integer, since it will be used to
610 determine the order in which this field appears in the form. If any of
611 the C<label>Ns are empty, the rest of the list will be ignored.
618 my ($action, %inputs) = @_;
619 my $string = "<form action=\"$action\" method=\"post\">\n";
620 $string .= mktablehdr();
622 my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
627 while ($i2 < $count) {
628 my $value=$inputs{$keys[$i2]};
629 # FIXME - Why use a tab-separated string? Why not just use an
631 my @data=split('\t',$value);
633 if ($data[0] eq 'hidden'){
634 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
637 if ($data[0] eq 'radio') {
638 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
639 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
641 # FIXME - Is 40 the right size in all cases?
642 if ($data[0] eq 'text') {
643 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
645 # FIXME - Is 40x4 the right size in all cases?
646 if ($data[0] eq 'textarea') {
647 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
649 if ($data[0] eq 'select') {
650 $text="<select name=$keys[$i2]>";
652 while ($data[$i] ne "") {
653 my $val = $data[$i+1];
654 $text .= "<option value=$data[$i]>$val";
657 $text .= "</select>";
659 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
660 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
664 my $temp=join("\n",@order);
666 $string .= mktablerow(1,'white','<input type=submit>');
667 $string .= mktableft;
668 $string .= "</form>";
669 # FIXME - A return statement, while not strictly necessary, would be nice.
674 $str = &mkformnotable($action, @inputs);
677 Takes a set of arguments that define an input form, generates an HTML
678 string for the form, and returns the string. Unlike C<&mkform2> and
679 C<&mkform3>, it does not put the form inside a table.
681 C<$action> is the action for the form, usually the URL of the script
682 that will process it.
684 The remaining arguments define the fields in the form. Each is an
685 anonymous array, e.g.:
687 &mkformnotable("/cgi-bin/foo",
688 [ "hidden", "hiddenvar", "value" ],
689 [ "text", "username", "" ]);
691 The first element of each argument defines its type. The remaining
692 ones are type-dependent. The supported types are:
696 =item C<[ "hidden", $name, $value]>
698 Generates a hidden field, for passing information to a script without
699 showing it to the user. C<$name> is the name of the field, and
700 C<$value> is the value to pass.
702 =item C<[ "radio", $groupname, $value ]>
704 Generates a radio button. Its name (or button group name) is C<$name>.
705 C<$value> is the value associated with the button; this is both the
706 value that will be shown to the user, and that which will be passed on
707 to the C<$action> script.
709 =item C<[ "text", $name, $inittext ]>
711 Generates a text input field. C<$name> specifies its name, and
712 C<$inittext> specifies the text that the field should initially
715 =item C<[ "textarea", $name ]>
717 Creates a 40x4 text area, named C<$name>.
719 =item C<[ "reset", $name, $label ]>
721 Generates a reset button, with name C<$name>. C<$label> specifies the
724 =item C<[ "submit", $name, $label ]>
726 Generates a submit button, with name C<$name>. C<$label> specifies the
734 my ($action,@inputs)=@_;
735 my $string="<form action=$action method=post>\n";
737 for (my $i=0; $i<$count; $i++){
738 if ($inputs[$i][0] eq 'hidden'){
739 $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
741 if ($inputs[$i][0] eq 'radio') {
742 $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
744 if ($inputs[$i][0] eq 'text') {
745 $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
747 if ($inputs[$i][0] eq 'textarea') {
748 $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
750 if ($inputs[$i][0] eq 'reset'){
751 $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
753 if ($inputs[$i][0] eq 'submit'){
754 $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
757 $string .= "</form>";
762 $str = &mkform2($action,
764 "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
769 Takes a set of arguments that define an input form, generates an HTML
770 string for the form, and returns the string.
772 C<$action> is the action for the form, usually the URL of the script
773 that will process it.
775 The remaining arguments define the fields in the form. C<$fieldname>
776 is the field's name. This is for the script's benefit, and will not be
779 C<$fieldpos> is an integer; fields will be output in order of
780 increasing C<$fieldpos>. This number must be unique: if two fields
781 have the same C<$fieldpos>, one will be picked at random, and the
782 other will be ignored. See below for special considerations, however.
784 If C<$required> is the string C<R>, then the field is required, and
785 the label will have C< (Req.)> appended.
787 C<$label> is a string that will appear next to the input field.
789 C<$fieldtype> specifies the type of the input field. It may be one of
796 Generates a hidden field, used to pass data to the script without
797 showing it to the user. C<$value0> is its value.
801 Generates a pair of radio buttons, with values C<$value0> and
802 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
803 the user, next to the radio button.
807 Generates a one-line text input field. Its size may be specified by
808 C<$value0>. The default is 40. The initial text of the field may be
809 specified by C<$value1>.
813 Generates a text input area. C<$value0> may be a string of the form
814 "WWWxHHH", in which case the text input area will be WWW columns wide
815 and HHH rows tall. The size defaults to 40x4.
817 The initial text (which, of course, may not contain any tabs) may be
818 specified by C<$value1>.
822 Generates a list of items, from which the user may choose one. Here,
823 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
824 pair, the key specifies an internal label for a choice, and the value
825 specifies the description of the choice that will be shown the user.
827 If C<$value0> is the same as one of the keys that follows, then the
828 corresponding choice will initially be selected.
836 # No tests yet. Once tests are written,
837 # this function can be cleaned up with the following steps:
838 # turn the while loop into a foreach loop
839 # pull the nested if,elsif structure back up to the main level
840 # pull the code for the different kinds of inputs into separate
842 my ($action,%inputs)=@_;
843 my $string="<form action=$action method=post>\n";
844 $string .= mktablehdr();
847 while ( my ($key, $value) = each %inputs) {
848 my @data=split('\t',$value);
849 my $posn = shift(@data);
850 my $reqd = shift(@data);
851 my $ltext = shift(@data);
852 if ($data[0] eq 'hidden'){
853 $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
856 if ($data[0] eq 'radio') {
857 $text="<input type=radio name=$key value=$data[1]>$data[1]
858 <input type=radio name=$key value=$data[2]>$data[2]";
859 } elsif ($data[0] eq 'text') {
864 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
865 } elsif ($data[0] eq 'textarea') {
866 my @size=split("x",$data[1]);
867 if ($data[1] eq "") {
871 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
872 } elsif ($data[0] eq 'select') {
873 $text="<select name=$key>";
876 while ($data[$i] ne "") {
877 my $val = $data[$i+1];
878 $text .= "<option value=\"$data[$i]\"";
879 if ($data[$i] eq $sel) {
880 $text .= " selected";
885 $text .= "</select>";
890 $order[$posn] =mktablerow(2,'white',$ltext,$text);
893 $string .= join("\n",@order);
894 $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
895 $string .= mktableft;
896 $string .= "</form>";
904 Returns a string of HTML, the end of an HTML document.
909 return("</body></html>\n");
914 $str = &mklink($url, $text);
917 Returns an HTML string, where C<$text> is a link to C<$url>.
923 my $string="<a href=\"$url\">$text</a>";
929 $str = &mkheadr($type, $text);
932 Takes a header type and header text, and returns a string of HTML,
933 where C<$text> is rendered with emphasis in a large font size (not an
936 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
937 Type 2 has no special tag at the end; Type 3 ends with a paragraph
944 # would it be better to make this more generic by accepting an optional
945 # argument with a closing tag instead of a numeric type?
950 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
953 $string="<FONT SIZE=6><em>$text</em></FONT>";
956 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
961 =item center and endcenter
963 print ¢er(), "This is a line of centered text.", &endcenter();
965 C<¢er> and C<&endcenter> take no arguments and return HTML tags
966 <CENTER> and </CENTER> respectively.
971 return ("<CENTER>\n");
975 return ("</CENTER>\n");
983 Returns a string of HTML that renders C<$text> in bold.
989 return("<b>$text</b>");
992 =item getkeytableselectoptions
994 $str = &getkeytableselectoptions($dbh, $tablename,
995 $keyfieldname, $descfieldname,
999 Builds an HTML selection box from a database table. Returns a string
1000 of HTML that implements this.
1002 C<$dbh> is a DBI::db database handle.
1004 C<$tablename> is the database table in which to look up the possible
1005 values for the selection box.
1007 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1008 internal label for the selection.
1010 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1011 option shown to the user.
1013 If C<$showkey> is true, then both the key and value will be shown to
1016 If the C<$default> argument is given, then if a value (from
1017 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1021 #---------------------------------------------
1022 # Create an HTML option list for a <SELECT> form tag by using
1023 # values from a DB file
1024 sub getkeytableselectoptions {
1029 # FIXME - Obsolete argument
1030 $tablename, # name of table containing list of choices
1031 $keyfieldname, # column name of code to use in option list
1032 $descfieldname, # column name of descriptive field
1033 $showkey, # flag to show key in description
1034 $default, # optional default key
1036 my $selectclause; # return value
1040 $key, $desc, $orderfieldname,
1044 $dbh = C4::Context->dbh;
1047 $orderfieldname=$keyfieldname;
1049 $orderfieldname=$descfieldname;
1051 $query= "select $keyfieldname,$descfieldname
1053 order by $orderfieldname ";
1054 print "<PRE>Query=$query </PRE>\n" if $debug;
1055 $sth=$dbh->prepare($query);
1057 while ( ($key, $desc) = $sth->fetchrow) {
1058 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1059 $selectclause.="<option";
1060 if (defined $default && $default eq $key) {
1061 $selectclause.=" selected";
1063 $selectclause.=" value='$key'>$desc\n";
1064 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1066 return $selectclause;
1067 } # sub getkeytableselectoptions
1069 #---------------------------------
1071 END { } # module clean-up code here (global destructor)
1080 Koha Developement team <info@koha.org>