C4/Output.pm

   1 package C4::Output;
   2
   3 # $Id$
   4
   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
   8
   9
  10 # Copyright 2000-2002 Katipo Communications
  11 #
  12 # This file is part of Koha.
  13 #
  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
  17 # version.
  18 #
  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.
  22 #
  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
  26
  27 # NOTE: I'm pretty sure this module is deprecated in favor of
  28 # templates.
  29
  30 use strict;
  31 require Exporter;
  32
  33 use C4::Context;
  34 use C4::Database;
  35 use HTML::Template;
  36
  37 use vars qw($VERSION @ISA @EXPORT);
  38
  39 # set the version for version checking
  40 $VERSION = 0.01;
  41
  42 =head1 NAME
  43
  44 C4::Output - Functions for generating HTML for the Koha web interface
  45
  46 =head1 SYNOPSIS
  47
  48   use C4::Output;
  49
  50   $str = &mklink("http://www.koha.org/", "Koha web page");
  51   print $str;
  52
  53 =head1 DESCRIPTION
  54
  55 The functions in this module generate HTML, and return the result as a
  56 printable string.
  57
  58 =head1 FUNCTIONS
  59
  60 =over 2
  61
  62 =cut
  63
  64 @ISA = qw(Exporter);
  65 @EXPORT = qw(&startpage &endpage
  66              &mktablehdr &mktableft &mktablerow &mklink
  67              &startmenu &endmenu &mkheadr
  68              &center &endcenter
  69              &mkform &mkform2 &bold
  70              &gotopage &mkformnotable &mkform3
  71              &getkeytableselectoptions
  72              &pathtotemplate
  73                 &themelanguage &gettemplate
  74              );
  75
  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/";
  79
  80 #---------------------------------------------------------------------------------------------------------
  81 # FIXME - POD
  82 sub gettemplate {
  83         my ($tmplbase, $opac) = @_;
  84
  85         my $htdocs;
  86         if ($opac ne "intranet") {
  87                 $htdocs = C4::Context->config('opachtdocs');
  88         } else {
  89                 $htdocs = C4::Context->config('intrahtdocs');
  90         }
  91
  92         my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac);
  93
  94         my $template = HTML::Template->new(filename      => "$htdocs/$theme/$lang/$tmplbase",
  95                                    die_on_bad_params => 0,
  96                                    global_vars       => 1,
  97                                    path              => ["$htdocs/$theme/$lang/includes"]);
  98
  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'),
 102                                                         theme => $theme,
 103                                                         lang => $lang);
 104         return $template;
 105 }
 106
 107 #---------------------------------------------------------------------------------------------------------
 108 # FIXME - POD
 109 sub themelanguage {
 110   my ($htdocs, $tmpl, $section) = @_;
 111
 112   my $dbh = C4::Context->dbh;
 113   my @languages;
 114   my @themes;
 115   if ( $section eq "intranet")
 116   {
 117     @languages = split " ", C4::Context->preference("opaclanguages");
 118     @themes = split " ", C4::Context->preference("template");
 119   }
 120   else
 121   {
 122     @languages = split " ", C4::Context->preference("opaclanguages");
 123     @themes = split " ", C4::Context->preference("opacthemes");
 124   }
 125
 126   my ($theme, $lang);
 127 # searches through the themes and languages. First template it find it returns.
 128 # Priority is for getting the theme right.
 129   THEME:
 130   foreach my $th (@themes) {
 131     foreach my $la (@languages) {
 132         if (-e "$htdocs/$th/$la/$tmpl") {
 133             $theme = $th;
 134             $lang = $la;
 135             last THEME;
 136         }
 137     }
 138   }
 139   if ($theme and $lang) {
 140     return ($theme, $lang);
 141   } else {
 142     return ('default', 'en');
 143   }
 144 }
 145
 146
 147 =item pathtotemplate
 148
 149   %values = &pathtotemplate(template => $template,
 150         theme => $themename,
 151         language => $language,
 152         type => $ptype,
 153         path => $includedir);
 154
 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
 159 others are optional.
 160
 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).
 164
 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.
 168
 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.
 175
 176 C<path> specifies an include directory.
 177
 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>,
 181 in that order.
 182
 183 C<&pathtotemplate> returns a hash with the following keys:
 184
 185 =over 4
 186
 187 =item C<path>
 188
 189 The full pathname to the desired template.
 190
 191 =item C<foundlanguage>
 192
 193 The value is set to 1 if a template in the desired language was found,
 194 or 0 otherwise.
 195
 196 =item C<foundtheme>
 197
 198 The value is set to 1 if a template of the desired theme was found, or
 199 0 otherwise.
 200
 201 =back
 202
 203 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
 204
 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
 208 document.
 209
 210 =cut
 211 #'
 212 # FIXME - Fix POD: it doesn't look in the directory given by the
 213 # 'includes' option in /etc/koha.conf.
 214 sub pathtotemplate {
 215   my %params = @_;
 216   my $template = $params{'template'};
 217   my $themeor = $params{'theme'};
 218   my $languageor = lc($params{'language'});
 219   my $ptype = lc($params{'type'} or 'intranet');
 220
 221   # FIXME - Make sure $params{'template'} was given. Or else assume
 222   # "default".
 223   my $type;
 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 . '/'; }
 228
 229   my %returns;
 230   my $theme = C4::Context->preference("theme") || "default";
 231   if ($themeor and
 232       C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
 233   {
 234     $theme = $themeor;
 235   }
 236   my @languageorder = getlanguageorder();
 237   my $language = $languageor || shift(@languageorder);
 238
 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'};
 243
 244   my ($etheme, $elanguage, $epath);
 245
 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";
 252           last CHECK;
 253         }
 254       }
 255     }
 256   }
 257
 258   unless ($epath) {
 259     warn "Could not find $template in @tmpldirs";
 260     return 0;
 261   }
 262
 263   if ($language eq $elanguage) {
 264     $returns{'foundlanguage'} = 1;
 265   } else {
 266     $returns{'foundlanguage'} = 0;
 267     warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
 268   }
 269   if ($theme eq $etheme) {
 270     $returns{'foundtheme'} = 1;
 271   } else {
 272     $returns{'foundtheme'} = 0;
 273     warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
 274   }
 275
 276   $returns{'path'} = $epath;
 277
 278   return (%returns);
 279 }
 280
 281 =item getlanguageorder
 282
 283   @languages = &getlanguageorder();
 284
 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).
 290
 291 =cut
 292 #'
 293 sub getlanguageorder () {
 294   my @languageorder;
 295
 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');
 302   }
 303
 304   return (@languageorder);
 305 }
 306
 307 =item startpage
 308
 309   $str = &startpage();
 310   print $str;
 311
 312 Returns a string of HTML, the beginning of a new HTML document.
 313
 314 =cut
 315 #'
 316 sub startpage() {
 317   return("<html>\n");
 318 }
 319
 320 =item gotopage
 321
 322   $str = &gotopage("//opac.koha.org/index.html");
 323   print $str;
 324
 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.
 327
 328 =cut
 329 #'
 330 sub gotopage($) {
 331   my ($target) = shift;
 332   #print "<br>goto target = $target<br>";
 333   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
 334   return $string;
 335 }
 336
 337 =item startmenu
 338
 339   @lines = &startmenu($type);
 340   print join("", @lines);
 341
 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.
 344
 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.
 348
 349 =cut
 350 #'
 351 sub startmenu($) {
 352   # edit the paths in here
 353   my ($type)=shift;
 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";
 368   } else {
 369     open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
 370   }
 371   my @string=<FILE>;
 372   close FILE;
 373   # my $count=@string;
 374   # $string[$count]="<BLOCKQUOTE>";
 375   return @string;
 376 }
 377
 378 =item endmenu
 379
 380   @lines = &endmenu($type);
 381   print join("", @lines);
 382
 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.
 385
 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.
 389
 390 =cut
 391 #'
 392 sub endmenu {
 393   my ($type) = @_;
 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;
 411   } else {
 412     open (FILE,"<$path/cat-bottom.inc") || die;
 413   }
 414   my @string=<FILE>;
 415   close FILE;
 416   return @string;
 417 }
 418
 419 =item mktablehdr
 420
 421   $str = &mktablehdr();
 422   print $str;
 423
 424 Returns a string of HTML, which generates the beginning of a table
 425 declaration.
 426
 427 =cut
 428 #'
 429 sub mktablehdr() {
 430     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 431 }
 432
 433 =item mktablerow
 434
 435   $str = &mktablerow($columns, $color, @column_data, $bgimage);
 436   print $str;
 437
 438 Returns a string of HTML, which generates a row of data inside a table
 439 (see also C<&mktablehdr>, C<&mktableft>).
 440
 441 C<$columns> specifies the number of columns in this row of data.
 442
 443 C<$color> specifies the background color for the row, e.g., C<"white">
 444 or C<"#ffacac">.
 445
 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.
 448
 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
 452 document root.
 453
 454 =cut
 455 #'
 456 sub mktablerow {
 457     #the last item in data may be a backgroundimage
 458
 459     # FIXME
 460     # should this be a foreach (1..$cols) loop?
 461
 462   my ($cols,$colour,@data)=@_;
 463   my $i=0;
 464   my $string="<tr valign=top bgcolor=$colour>";
 465   while ($i <$cols){
 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
 469           $string.="<td>";
 470       }
 471       if (! defined $data[$i]) {$data[$i]="";}
 472       if ($data[$i] eq "") {
 473           $string.=" &nbsp; </td>";
 474       } else {
 475           $string.="$data[$i]</td>";
 476       }
 477       $i++;
 478   }
 479   $string .= "</tr>\n";
 480   return($string);
 481 }
 482
 483 =item mktableft
 484
 485   $str = &mktableft();
 486   print $str;
 487
 488 Returns a string of HTML, which generates the end of a table
 489 declaration.
 490
 491 =cut
 492 #'
 493 sub mktableft() {
 494   return("</table>\n");
 495 }
 496
 497 # FIXME - This is never used.
 498 sub mkform{
 499   my ($action,%inputs)=@_;
 500   my $string="<form action=$action method=post>\n";
 501   $string .= mktablehdr();
 502   my $key;
 503   my @keys=sort keys %inputs;
 504
 505   my $count=@keys;
 506   my $i2=0;
 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";
 513     } else {
 514       my $text;
 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]";
 518       }
 519       if ($data[0] eq 'text') {
 520         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 521       }
 522       if ($data[0] eq 'textarea') {
 523         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 524       }
 525       if ($data[0] eq 'select') {
 526         $text="<select name=$keys[$i2]>";
 527         my $i=1;
 528         while ($data[$i] ne "") {
 529           my $val = $data[$i+1];
 530           $text .= "<option value=$data[$i]>$val";
 531           $i += 2;
 532         }
 533         $text .= "</select>";
 534       }
 535       $string .= mktablerow(2,'white',$keys[$i2],$text);
 536       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 537     }
 538     $i2++;
 539   }
 540   #$string=$string.join("\n",@order);
 541   $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
 542   $string .= mktableft;
 543   $string .= "</form>";
 544 }
 545
 546 =item mkform3
 547
 548   $str = &mkform3($action,
 549         $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
 550         ...
 551         );
 552   print $str;
 553
 554 Takes a set of arguments that define an input form, generates an HTML
 555 string for the form, and returns the string.
 556
 557 C<$action> is the action for the form, usually the URL of the script
 558 that will process it.
 559
 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
 562 shown to the user.
 563
 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.
 568
 569 C<$fieldtype> specifies the type of the input field. It may be one of
 570 the following:
 571
 572 =over 4
 573
 574 =item C<hidden>
 575
 576 Generates a hidden field, used to pass data to the script without
 577 showing it to the user. C<$fieldvalue> is the value.
 578
 579 =item C<radio>
 580
 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
 583 shown to the user.
 584
 585 =item C<text>
 586
 587 Generates a one-line text input field. It initially contains
 588 C<$fieldvalue>.
 589
 590 =item C<textarea>
 591
 592 Generates a four-line text input area. The initial text (which, of
 593 course, may not contain any tabs) is C<$fieldvalue>.
 594
 595 =item C<select>
 596
 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
 599 specified as:
 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
 603 script.
 604
 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.
 608
 609 =back
 610
 611 =cut
 612 #'
 613 sub mkform3 {
 614   my ($action, %inputs) = @_;
 615   my $string = "<form action=\"$action\" method=\"post\">\n";
 616   $string   .= mktablehdr();
 617   my $key;
 618   my @keys = sort(keys(%inputs));       # FIXME - Why do these need to be
 619                                         # sorted?
 620   my @order;
 621   my $count = @keys;
 622   my $i2 = 0;
 623   while ($i2 < $count) {
 624     my $value=$inputs{$keys[$i2]};
 625     # FIXME - Why use a tab-separated string? Why not just use an
 626     # anonymous array?
 627     my @data=split('\t',$value);
 628     my $posn = $data[2];
 629     if ($data[0] eq 'hidden'){
 630       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 631     } else {
 632       my $text;
 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]";
 636       }
 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>";
 640       }
 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>";
 644       }
 645       if ($data[0] eq 'select') {
 646         $text="<select name=$keys[$i2]>";
 647         my $i=1;
 648         while ($data[$i] ne "") {
 649           my $val = $data[$i+1];
 650           $text .= "<option value=$data[$i]>$val";
 651           $i += 2;
 652         }
 653         $text .= "</select>";
 654       }
 655 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 656       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 657     }
 658     $i2++;
 659   }
 660   my $temp=join("\n",@order);
 661   $string .= $temp;
 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.
 666 }
 667
 668 =item mkformnotable
 669
 670   $str = &mkformnotable($action, @inputs);
 671   print $str;
 672
 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.
 676
 677 C<$action> is the action for the form, usually the URL of the script
 678 that will process it.
 679
 680 The remaining arguments define the fields in the form. Each is an
 681 anonymous array, e.g.:
 682
 683   &mkformnotable("/cgi-bin/foo",
 684         [ "hidden", "hiddenvar", "value" ],
 685         [ "text", "username", "" ]);
 686
 687 The first element of each argument defines its type. The remaining
 688 ones are type-dependent. The supported types are:
 689
 690 =over 4
 691
 692 =item C<[ "hidden", $name, $value]>
 693
 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.
 697
 698 =item C<[ "radio", $groupname, $value ]>
 699
 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.
 704
 705 =item C<[ "text", $name, $inittext ]>
 706
 707 Generates a text input field. C<$name> specifies its name, and
 708 C<$inittext> specifies the text that the field should initially
 709 contain.
 710
 711 =item C<[ "textarea", $name ]>
 712
 713 Creates a 40x4 text area, named C<$name>.
 714
 715 =item C<[ "reset", $name, $label ]>
 716
 717 Generates a reset button, with name C<$name>. C<$label> specifies the
 718 text for the button.
 719
 720 =item C<[ "submit", $name, $label ]>
 721
 722 Generates a submit button, with name C<$name>. C<$label> specifies the
 723 text for the button.
 724
 725 =back
 726
 727 =cut
 728 #'
 729 sub mkformnotable{
 730   my ($action,@inputs)=@_;
 731   my $string="<form action=$action method=post>\n";
 732   my $count=@inputs;
 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";
 736     }
 737     if ($inputs[$i][0] eq 'radio') {
 738       $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 739     }
 740     if ($inputs[$i][0] eq 'text') {
 741       $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 742     }
 743     if ($inputs[$i][0] eq 'textarea') {
 744         $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 745     }
 746     if ($inputs[$i][0] eq 'reset'){
 747       $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 748     }
 749     if ($inputs[$i][0] eq 'submit'){
 750       $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 751     }
 752   }
 753   $string .= "</form>";
 754 }
 755
 756 =item mkform2
 757
 758   $str = &mkform2($action,
 759         $fieldname =>
 760           "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
 761         ...
 762         );
 763   print $str;
 764
 765 Takes a set of arguments that define an input form, generates an HTML
 766 string for the form, and returns the string.
 767
 768 C<$action> is the action for the form, usually the URL of the script
 769 that will process it.
 770
 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
 773 shown to the user.
 774
 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.
 779
 780 If C<$required> is the string C<R>, then the field is required, and
 781 the label will have C< (Req.)> appended.
 782
 783 C<$label> is a string that will appear next to the input field.
 784
 785 C<$fieldtype> specifies the type of the input field. It may be one of
 786 the following:
 787
 788 =over 4
 789
 790 =item C<hidden>
 791
 792 Generates a hidden field, used to pass data to the script without
 793 showing it to the user. C<$value0> is its value.
 794
 795 =item C<radio>
 796
 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.
 800
 801 =item C<text>
 802
 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>.
 806
 807 =item C<textarea>
 808
 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.
 812
 813 The initial text (which, of course, may not contain any tabs) may be
 814 specified by C<$value1>.
 815
 816 =item C<select>
 817
 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.
 822
 823 If C<$value0> is the same as one of the keys that follows, then the
 824 corresponding choice will initially be selected.
 825
 826 =back
 827
 828 =cut
 829 #'
 830 sub mkform2{
 831     # FIXME
 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
 837     #   functions
 838   my ($action,%inputs)=@_;
 839   my $string="<form action=$action method=post>\n";
 840   $string .= mktablehdr();
 841   my $key;
 842   my @order;
 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";
 850     } else {
 851       my $text;
 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') {
 856         my $size = $data[1];
 857         if ($size eq "") {
 858           $size=40;
 859         }
 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 "") {
 864           $size[0] = 40;
 865           $size[1] = 4;
 866         }
 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>";
 870         my $sel=$data[1];
 871         my $i=2;
 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";
 877           }
 878           $text .= ">$val";
 879           $i += 2;
 880         }
 881         $text .= "</select>";
 882       }
 883       if ($reqd eq "R") {
 884         $ltext .= " (Req)";
 885         }
 886       $order[$posn] =mktablerow(2,'white',$ltext,$text);
 887     }
 888   }
 889   $string .= join("\n",@order);
 890   $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
 891   $string .= mktableft;
 892   $string .= "</form>";
 893 }
 894
 895 =item endpage
 896
 897   $str = &endpage();
 898   print $str;
 899
 900 Returns a string of HTML, the end of an HTML document.
 901
 902 =cut
 903 #'
 904 sub endpage() {
 905   return("</body></html>\n");
 906 }
 907
 908 =item mklink
 909
 910   $str = &mklink($url, $text);
 911   print $str;
 912
 913 Returns an HTML string, where C<$text> is a link to C<$url>.
 914
 915 =cut
 916 #'
 917 sub mklink($$) {
 918   my ($url,$text)=@_;
 919   my $string="<a href=\"$url\">$text</a>";
 920   return ($string);
 921 }
 922
 923 =item mkheadr
 924
 925   $str = &mkheadr($type, $text);
 926   print $str;
 927
 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
 930 actual HTML header).
 931
 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
 934 break.
 935
 936 =cut
 937 #'
 938 sub mkheadr {
 939     # FIXME
 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?
 942
 943   my ($type,$text)=@_;
 944   my $string;
 945   if ($type eq '1'){
 946     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 947   }
 948   if ($type eq '2'){
 949     $string="<FONT SIZE=6><em>$text</em></FONT>";
 950   }
 951   if ($type eq '3'){
 952     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 953   }
 954   return ($string);
 955 }
 956
 957 =item center and endcenter
 958
 959   print &center(), "This is a line of centered text.", &endcenter();
 960
 961 C<&center> and C<&endcenter> take no arguments and return HTML tags
 962 <CENTER> and </CENTER> respectively.
 963
 964 =cut
 965 #'
 966 sub center() {
 967   return ("<CENTER>\n");
 968 }
 969
 970 sub endcenter() {
 971   return ("</CENTER>\n");
 972 }
 973
 974 =item bold
 975
 976   $str = &bold($text);
 977   print $str;
 978
 979 Returns a string of HTML that renders C<$text> in bold.
 980
 981 =cut
 982 #'
 983 sub bold($) {
 984   my ($text)=shift;
 985   return("<b>$text</b>");
 986 }
 987
 988 =item getkeytableselectoptions
 989
 990   $str = &getkeytableselectoptions($dbh, $tablename,
 991         $keyfieldname, $descfieldname,
 992         $showkey, $default);
 993   print $str;
 994
 995 Builds an HTML selection box from a database table. Returns a string
 996 of HTML that implements this.
 997
 998 C<$dbh> is a DBI::db database handle.
 999
1000 C<$tablename> is the database table in which to look up the possible
1001 values for the selection box.
1002
1003 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1004 internal label for the selection.
1005
1006 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1007 option shown to the user.
1008
1009 If C<$showkey> is true, then both the key and value will be shown to
1010 the user.
1011
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.
1014
1015 =cut
1016 #'
1017 #---------------------------------------------
1018 # Create an HTML option list for a <SELECT> form tag by using
1019 #    values from a DB file
1020 sub getkeytableselectoptions {
1021         use strict;
1022         # inputs
1023         my (
1024                 $dbh,           # DBI handle
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
1031         )=@_;
1032         my $selectclause;       # return value
1033
1034         my (
1035                 $sth, $query,
1036                 $key, $desc, $orderfieldname,
1037         );
1038         my $debug=0;
1039
1040         $dbh = C4::Context->dbh;
1041
1042         if ( $showkey ) {
1043                 $orderfieldname=$keyfieldname;
1044         } else {
1045                 $orderfieldname=$descfieldname;
1046         }
1047         $query= "select $keyfieldname,$descfieldname
1048                 from $tablename
1049                 order by $orderfieldname ";
1050         print "<PRE>Query=$query </PRE>\n" if $debug;
1051         $sth=$dbh->prepare($query);
1052         $sth->execute;
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";
1058             }
1059             $selectclause.=" value='$key'>$desc\n";
1060             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1061         }
1062         return $selectclause;
1063 } # sub getkeytableselectoptions
1064
1065 #---------------------------------
1066
1067 END { }       # module clean-up code here (global destructor)
1068
1069 1;
1070 __END__
1071
1072 =back
1073
1074 =head1 AUTHOR
1075
1076 Koha Developement team <info@koha.org>
1077
1078 =cut