C4/Output.pm

   1 package C4::Output;
   2
   3 #package to deal with marking up output
   4 #You will need to edit parts of this pm
   5 #set the value of path to be where your html lives
   6
   7
   8 # Copyright 2000-2002 Katipo Communications
   9 #
  10 # This file is part of Koha.
  11 #
  12 # Koha is free software; you can redistribute it and/or modify it under the
  13 # terms of the GNU General Public License as published by the Free Software
  14 # Foundation; either version 2 of the License, or (at your option) any later
  15 # version.
  16 #
  17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  19 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License along with
  22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  23 # Suite 330, Boston, MA  02111-1307 USA
  24
  25 use strict;
  26 require Exporter;
  27
  28 use C4::Database;
  29 use C4::Search; #for getting the systempreferences
  30
  31 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  32
  33 # set the version for version checking
  34 $VERSION = 0.01;
  35
  36 =head1 NAME
  37
  38 C4::Output - Functions for generating HTML for the Koha web interface
  39
  40 =head1 SYNOPSIS
  41
  42   use C4::Output;
  43
  44   $str = &mklink("http://www.koha.org/", "Koha web page");
  45   print $str;
  46
  47 =head1 DESCRIPTION
  48
  49 The functions in this module generate HTML, and return the result as a
  50 printable string.
  51
  52 =head1 FUNCTIONS
  53
  54 =over 2
  55
  56 =cut
  57
  58 @ISA = qw(Exporter);
  59 @EXPORT = qw(&startpage &endpage
  60              &mktablehdr &mktableft &mktablerow &mklink
  61              &startmenu &endmenu &mkheadr
  62              &center &endcenter
  63              &mkform &mkform2 &bold
  64              &gotopage &mkformnotable &mkform3
  65              &getkeytableselectoptions
  66              &pathtotemplate
  67                 &themelanguage &gettemplate
  68              );
  69 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  70
  71 # your exported package globals go here,
  72 # as well as any optionally exported functions
  73
  74 @EXPORT_OK   = qw($Var1 %Hashit);       # FIXME - These are never used
  75
  76
  77 # non-exported package globals go here
  78 use vars qw(@more $stuff);              # FIXME - These are never used
  79
  80 # initalize package globals, first exported ones
  81
  82 # FIXME - These are never used
  83 my $Var1   = '';
  84 my %Hashit = ();
  85
  86
  87 # then the others (which are still accessible as $Some::Module::stuff)
  88 # FIXME - These are never used
  89 my $stuff  = '';
  90 my @more   = ();
  91
  92 # all file-scoped lexicals must be created before
  93 # the functions below that use them.
  94
  95 #
  96 # Change this value to reflect where you will store your includes
  97 #
  98 # FIXME - Since this is used in several places, it ought to be put
  99 # into a separate file. Better yet, put "use C4::Config;" inside the
 100 # &import method of any package that requires the config file.
 101
 102 my $configfile=configfile();
 103
 104 my $path=$configfile->{'includes'};
 105 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
 106
 107 #---------------------------------------------------------------------------------------------------------
 108 sub gettemplate {
 109     my ($tmplbase, $opac) = @_;
 110
 111     my $htdocs;
 112     if ($opac) {
 113         $htdocs = $configfile->{'opachtdocs'};
 114     } else {
 115         $htdocs = $configfile->{'intrahtdocs'};
 116     }
 117
 118     my ($theme, $lang) = themelanguage($htdocs, $tmplbase);
 119
 120     my $template = HTML::Template->new(filename      => "$htdocs/$theme/$lang/$tmplbase",
 121                                    die_on_bad_params => 0,
 122                                    global_vars       => 1,
 123                                    path              => ["$htdocs/$theme/$lang/includes"]);
 124
 125     $template->param(themelang => "/$theme/$lang");
 126     return $template;
 127 }
 128
 129 #---------------------------------------------------------------------------------------------------------
 130 sub themelanguage {
 131   my ($htdocs, $tmpl) = @_;
 132
 133 # language preferences....
 134   my $dbh=C4Connect;
 135   my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opaclanguages'");
 136   $sth->execute;
 137   my ($lang) = $sth->fetchrow;
 138   $sth->finish;
 139   my @languages = split " ", $lang;
 140
 141 # theme preferences....
 142   my $sth=$dbh->prepare("SELECT value FROM systempreferences WHERE variable='opacthemes'");
 143   $sth->execute;
 144   my ($theme) = $sth->fetchrow;
 145   $sth->finish;
 146   my @themes = split " ", $theme;
 147
 148   $dbh->disconnect;
 149
 150   my ($theme, $lang);
 151 # searches through the themes and languages. First template it find it returns.
 152 # Priority is for getting the theme right.
 153   THEME:
 154   foreach my $th (@themes) {
 155     foreach my $la (@languages) {
 156         warn "File = $htdocs/$th/$la/$tmpl\n";
 157         if (-e "$htdocs/$th/$la/$tmpl") {
 158             $theme = $th;
 159             $lang = $la;
 160             last THEME;
 161         }
 162     }
 163   }
 164   if ($theme and $lang) {
 165     return ($theme, $lang);
 166   } else {
 167     return ('default', 'en');
 168   }
 169 }
 170
 171
 172 =item pathtotemplate
 173
 174   %values = &pathtotemplate(template => $template,
 175         theme => $themename,
 176         language => $language,
 177         type => $ptype,
 178         path => $includedir);
 179
 180 Finds a directory containing the desired template. The C<template>
 181 argument specifies the template you're looking for (this should be the
 182 name of the script you're using to generate an HTML page, without the
 183 C<.pl> extension). Only the C<template> argument is required; the
 184 others are optional.
 185
 186 C<theme> specifies the name of the theme to use. This will be used
 187 only if it is allowed by the C<allowthemeoverride> system preference
 188 option (in the C<systempreferences> table of the Koha database).
 189
 190 C<language> specifies the desired language. If not specified,
 191 C<&pathtotemplate> will use the list of acceptable languages specified
 192 by the browser, then C<all>, and finally C<en> as fallback options.
 193
 194 C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
 195 C<intranet> and C<opac> specify that you want a template for the
 196 internal web site or the public OPAC, respectively. C<none> specifies
 197 that the template you're looking for is at the top level of one of the
 198 include directories. Any other value is taken as-is, as a subdirectory
 199 of one of the include directories.
 200
 201 C<path> specifies an include directory.
 202
 203 C<&pathtotemplate> searches first in the directory given by the
 204 C<path> argument, if any, then in the directories given by the
 205 C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
 206 in that order.
 207
 208 C<&pathtotemplate> returns a hash with the following keys:
 209
 210 =over 4
 211
 212 =item C<path>
 213
 214 The full pathname to the desired template.
 215
 216 =item C<foundlanguage>
 217
 218 The value is set to 1 if a template in the desired language was found,
 219 or 0 otherwise.
 220
 221 =item C<foundtheme>
 222
 223 The value is set to 1 if a template of the desired theme was found, or
 224 0 otherwise.
 225
 226 =back
 227
 228 If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
 229
 230 Note that if a template of the desired language or theme cannot be
 231 found, C<&pathtotemplate> will print a warning message. Unless you've
 232 set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
 233 document.
 234
 235 =cut
 236 #'
 237 sub pathtotemplate {
 238   my %params = @_;
 239   my $template = $params{'template'};
 240   my $themeor = $params{'theme'};
 241   my $languageor = lc($params{'language'});
 242   my $ptype = lc($params{'type'} or 'intranet');
 243
 244   # FIXME - Make sure $params{'template'} was given. Or else assume
 245   # "default".
 246   my $type;
 247   if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
 248   elsif ($ptype eq 'none') {$type = ''; }
 249   elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
 250   else {$type = $ptype . '/'; }
 251
 252   my %returns;
 253   my %prefs= systemprefs();
 254   my $theme= $prefs{'theme'} || 'default';
 255   if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
 256   my @languageorder = getlanguageorder();
 257   my $language = $languageor || shift(@languageorder);
 258
 259   #where to search for templates
 260   my @tmpldirs = ("$path/templates", $path);
 261   unshift (@tmpldirs, $configfile->{'templatedirectory'}) if $configfile->{'templatedirectory'};
 262   unshift (@tmpldirs, $params{'path'}) if $params{'path'};
 263
 264   my ($edir, $etheme, $elanguage, $epath);
 265
 266   # FIXME - Use 'foreach my $var (...)'
 267   CHECK: foreach (@tmpldirs) {
 268     $edir= $_;
 269     foreach ($theme, 'all', 'default') {
 270       $etheme=$_;
 271       foreach ($language, @languageorder, 'all','en') {  # 'en' is the fallback-language
 272         $elanguage = $_;
 273         if (-e "$edir/$type$etheme/$elanguage/$template") {
 274           $epath = "$edir/$type$etheme/$elanguage/$template";
 275           last CHECK;
 276         }
 277       }
 278     }
 279   }
 280
 281   unless ($epath) {
 282     warn "Could not find $template in @tmpldirs";
 283     return 0;
 284   }
 285
 286   if ($language eq $elanguage) {
 287     $returns{'foundlanguage'} = 1;
 288   } else {
 289     $returns{'foundlanguage'} = 0;
 290     warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
 291   }
 292   if ($theme eq $etheme) {
 293     $returns{'foundtheme'} = 1;
 294   } else {
 295     $returns{'foundtheme'} = 0;
 296     warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
 297   }
 298
 299   $returns{'path'} = $epath;
 300
 301   return (%returns);
 302 }
 303
 304 =item getlanguageorder
 305
 306   @languages = &getlanguageorder();
 307
 308 Returns the list of languages that the user will accept, and returns
 309 them in order of decreasing preference. This is retrieved from the
 310 browser's headers, if possible; otherwise, C<&getlanguageorder> uses
 311 the C<languageorder> setting from the C<systempreferences> table in
 312 the Koha database. If neither is set, it defaults to C<en> (English).
 313
 314 =cut
 315 #'
 316 sub getlanguageorder () {
 317   my @languageorder;
 318   my %prefs = systemprefs();
 319
 320   if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
 321     @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
 322   } elsif ($prefs{'languageorder'}) {
 323     @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
 324   } else { # here should be another elsif checking for apache's languageorder
 325     @languageorder = ('en');
 326   }
 327
 328   return (@languageorder);
 329 }
 330
 331 =item startpage
 332
 333   $str = &startpage();
 334   print $str;
 335
 336 Returns a string of HTML, the beginning of a new HTML document.
 337
 338 =cut
 339 #'
 340 sub startpage() {
 341   return("<html>\n");
 342 }
 343
 344 =item gotopage
 345
 346   $str = &gotopage("//opac.koha.org/index.html");
 347   print $str;
 348
 349 Generates a snippet of HTML code that will redirect to the given URL
 350 (which should not include the initial C<http:>), and returns it.
 351
 352 =cut
 353 #'
 354 sub gotopage($) {
 355   my ($target) = shift;
 356   #print "<br>goto target = $target<br>";
 357   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
 358   return $string;
 359 }
 360
 361 =item startmenu
 362
 363   @lines = &startmenu($type);
 364   print join("", @lines);
 365
 366 Given a page type, or category, returns a set of lines of HTML which,
 367 when concatenated, generate the menu at the top of the web page.
 368
 369 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
 370 C<report>, C<circulation>, or something else, in which case the menu
 371 will be for the catalog pages.
 372
 373 =cut
 374 #'
 375 sub startmenu($) {
 376   # edit the paths in here
 377   my ($type)=shift;
 378   if ($type eq 'issue') {
 379     open (FILE,"$path/issues-top.inc") || die;
 380   } elsif ($type eq 'opac') {
 381     open (FILE,"$path/opac-top.inc") || die;
 382   } elsif ($type eq 'member') {
 383     open (FILE,"$path/members-top.inc") || die;
 384   } elsif ($type eq 'acquisitions'){
 385     open (FILE,"$path/acquisitions-top.inc") || die;
 386   } elsif ($type eq 'report'){
 387     open (FILE,"$path/reports-top.inc") || die;
 388   } elsif ($type eq 'circulation') {
 389     open (FILE,"$path/circulation-top.inc") || die;
 390   } else {
 391     open (FILE,"$path/cat-top.inc") || die;
 392   }
 393   my @string=<FILE>;
 394   close FILE;
 395   # my $count=@string;
 396   # $string[$count]="<BLOCKQUOTE>";
 397   return @string;
 398 }
 399
 400 =item endmenu
 401
 402   @lines = &endmenu($type);
 403   print join("", @lines);
 404
 405 Given a page type, or category, returns a set of lines of HTML which,
 406 when concatenated, generate the menu at the bottom of the web page.
 407
 408 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
 409 C<report>, C<circulation>, or something else, in which case the menu
 410 will be for the catalog pages.
 411
 412 =cut
 413 #'
 414 sub endmenu {
 415   my ($type) = @_;
 416   if ( ! defined $type ) { $type=''; }
 417   # FIXME - It's bad form to die in a CGI script. It's even worse form
 418   # to die without issuing an error message.
 419   if ($type eq 'issue') {
 420     open (FILE,"$path/issues-bottom.inc") || die;
 421   } elsif ($type eq 'opac') {
 422     open (FILE,"$path/opac-bottom.inc") || die;
 423   } elsif ($type eq 'member') {
 424     open (FILE,"$path/members-bottom.inc") || die;
 425   } elsif ($type eq 'acquisitions') {
 426     open (FILE,"$path/acquisitions-bottom.inc") || die;
 427   } elsif ($type eq 'report') {
 428     open (FILE,"$path/reports-bottom.inc") || die;
 429   } elsif ($type eq 'circulation') {
 430     open (FILE,"$path/circulation-bottom.inc") || die;
 431   } else {
 432     open (FILE,"$path/cat-bottom.inc") || die;
 433   }
 434   my @string=<FILE>;
 435   close FILE;
 436   return @string;
 437 }
 438
 439 =item mktablehdr
 440
 441   $str = &mktablehdr();
 442   print $str;
 443
 444 Returns a string of HTML, which generates the beginning of a table
 445 declaration.
 446
 447 =cut
 448 #'
 449 sub mktablehdr() {
 450     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 451 }
 452
 453 =item mktablerow
 454
 455   $str = &mktablerow($columns, $color, @column_data, $bgimage);
 456   print $str;
 457
 458 Returns a string of HTML, which generates a row of data inside a table
 459 (see also C<&mktablehdr>, C<&mktableft>).
 460
 461 C<$columns> specifies the number of columns in this row of data.
 462
 463 C<$color> specifies the background color for the row, e.g., C<"white">
 464 or C<"#ffacac">.
 465
 466 C<@column_data> is an array of C<$columns> elements, each one a string
 467 of HTML. These are the contents of the row.
 468
 469 The optional C<$bgimage> argument specifies the pathname to an image
 470 to use as the background for each cell in the row. This pathname will
 471 used as is in the output, so it should be relative to the HTTP
 472 document root.
 473
 474 =cut
 475 #'
 476 sub mktablerow {
 477     #the last item in data may be a backgroundimage
 478
 479     # FIXME
 480     # should this be a foreach (1..$cols) loop?
 481
 482   my ($cols,$colour,@data)=@_;
 483   my $i=0;
 484   my $string="<tr valign=top bgcolor=$colour>";
 485   while ($i <$cols){
 486       if (defined $data[$cols]) { # if there is a background image
 487           $string.="<td background=\"$data[$cols]\">";
 488       } else { # if there's no background image
 489           $string.="<td>";
 490       }
 491       if (! defined $data[$i]) {$data[$i]="";}
 492       if ($data[$i] eq "") {
 493           $string.=" &nbsp; </td>";
 494       } else {
 495           $string.="$data[$i]</td>";
 496       }
 497       $i++;
 498   }
 499   $string=$string."</tr>\n";
 500   return($string);
 501 }
 502
 503 =item mktableft
 504
 505   $str = &mktableft();
 506   print $str;
 507
 508 Returns a string of HTML, which generates the end of a table
 509 declaration.
 510
 511 =cut
 512 #'
 513 sub mktableft() {
 514   return("</table>\n");
 515 }
 516
 517 # FIXME - This is never used.
 518 sub mkform{
 519   my ($action,%inputs)=@_;
 520   my $string="<form action=$action method=post>\n";
 521   $string=$string.mktablehdr();
 522   my $key;
 523   my @keys=sort keys %inputs;
 524
 525   my $count=@keys;
 526   my $i2=0;
 527   while ( $i2<$count) {
 528     my $value=$inputs{$keys[$i2]};
 529     my @data=split('\t',$value);
 530     #my $posn = shift(@data);
 531     if ($data[0] eq 'hidden'){
 532       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 533     } else {
 534       my $text;
 535       if ($data[0] eq 'radio') {
 536         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 537         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 538       }
 539       if ($data[0] eq 'text') {
 540         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 541       }
 542       if ($data[0] eq 'textarea') {
 543         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 544       }
 545       if ($data[0] eq 'select') {
 546         $text="<select name=$keys[$i2]>";
 547         my $i=1;
 548         while ($data[$i] ne "") {
 549           my $val = $data[$i+1];
 550           $text = $text."<option value=$data[$i]>$val";
 551           $i = $i+2;
 552         }
 553         $text=$text."</select>";
 554       }
 555       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 556       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 557     }
 558     $i2++;
 559   }
 560   #$string=$string.join("\n",@order);
 561   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 562   $string=$string.mktableft;
 563   $string=$string."</form>";
 564 }
 565
 566 =item mkform3
 567
 568   $str = &mkform3($action,
 569         $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
 570         ...
 571         );
 572   print $str;
 573
 574 Takes a set of arguments that define an input form, generates an HTML
 575 string for the form, and returns the string.
 576
 577 C<$action> is the action for the form, usually the URL of the script
 578 that will process it.
 579
 580 The remaining arguments define the fields in the form. C<$fieldname>
 581 is the field's name. This is for the script's benefit, and will not be
 582 shown to the user.
 583
 584 C<$fieldpos> is an integer; fields will be output in order of
 585 increasing C<$fieldpos>. This number must be unique: if two fields
 586 have the same C<$fieldpos>, one will be picked at random, and the
 587 other will be ignored. See below for special considerations, however.
 588
 589 C<$fieldtype> specifies the type of the input field. It may be one of
 590 the following:
 591
 592 =over 4
 593
 594 =item C<hidden>
 595
 596 Generates a hidden field, used to pass data to the script without
 597 showing it to the user. C<$fieldvalue> is the value.
 598
 599 =item C<radio>
 600
 601 Generates a pair of radio buttons, with values C<$fieldvalue> and
 602 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
 603 shown to the user.
 604
 605 =item C<text>
 606
 607 Generates a one-line text input field. It initially contains
 608 C<$fieldvalue>.
 609
 610 =item C<textarea>
 611
 612 Generates a four-line text input area. The initial text (which, of
 613 course, may not contain any tabs) is C<$fieldvalue>.
 614
 615 =item C<select>
 616
 617 Generates a list of items, from which the user may choose one. This is
 618 somewhat different from other input field types, and should be
 619 specified as:
 620   "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
 621 where the C<text>N strings are the choices that will be presented to
 622 the user, and C<label>N are the labels that will be passed to the
 623 script.
 624
 625 However, C<text0> should be an integer, since it will be used to
 626 determine the order in which this field appears in the form. If any of
 627 the C<label>Ns are empty, the rest of the list will be ignored.
 628
 629 =back
 630
 631 =cut
 632 #'
 633 sub mkform3 {
 634   my ($action, %inputs) = @_;
 635   my $string = "<form action=\"$action\" method=\"post\">\n";
 636   $string   .= mktablehdr();
 637   my $key;
 638   my @keys = sort(keys(%inputs));       # FIXME - Why do these need to be
 639                                         # sorted?
 640   my @order;
 641   my $count = @keys;
 642   my $i2 = 0;
 643   while ($i2 < $count) {
 644     my $value=$inputs{$keys[$i2]};
 645     # FIXME - Why use a tab-separated string? Why not just use an
 646     # anonymous array?
 647     my @data=split('\t',$value);
 648     my $posn = $data[2];
 649     if ($data[0] eq 'hidden'){
 650       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 651     } else {
 652       my $text;
 653       if ($data[0] eq 'radio') {
 654         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 655         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 656       }
 657       # FIXME - Is 40 the right size in all cases?
 658       if ($data[0] eq 'text') {
 659         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 660       }
 661       # FIXME - Is 40x4 the right size in all cases?
 662       if ($data[0] eq 'textarea') {
 663         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 664       }
 665       if ($data[0] eq 'select') {
 666         $text="<select name=$keys[$i2]>";
 667         my $i=1;
 668         while ($data[$i] ne "") {
 669           my $val = $data[$i+1];
 670           $text = $text."<option value=$data[$i]>$val";
 671           $i = $i+2;            # FIXME - Use $i += 2.
 672         }
 673         $text=$text."</select>";
 674       }
 675 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 676       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 677     }
 678     $i2++;
 679   }
 680   my $temp=join("\n",@order);
 681   # FIXME - Use ".=". That's what it's for.
 682   $string=$string.$temp;
 683   $string=$string.mktablerow(1,'white','<input type=submit>');
 684   $string=$string.mktableft;
 685   $string=$string."</form>";
 686   # FIXME - A return statement, while not strictly necessary, would be nice.
 687 }
 688
 689 =item mkformnotable
 690
 691   $str = &mkformnotable($action, @inputs);
 692   print $str;
 693
 694 Takes a set of arguments that define an input form, generates an HTML
 695 string for the form, and returns the string. Unlike C<&mkform2> and
 696 C<&mkform3>, it does not put the form inside a table.
 697
 698 C<$action> is the action for the form, usually the URL of the script
 699 that will process it.
 700
 701 The remaining arguments define the fields in the form. Each is an
 702 anonymous array, e.g.:
 703
 704   &mkformnotable("/cgi-bin/foo",
 705         [ "hidden", "hiddenvar", "value" ],
 706         [ "text", "username", "" ]);
 707
 708 The first element of each argument defines its type. The remaining
 709 ones are type-dependent. The supported types are:
 710
 711 =over 4
 712
 713 =item C<[ "hidden", $name, $value]>
 714
 715 Generates a hidden field, for passing information to a script without
 716 showing it to the user. C<$name> is the name of the field, and
 717 C<$value> is the value to pass.
 718
 719 =item C<[ "radio", $groupname, $value ]>
 720
 721 Generates a radio button. Its name (or button group name) is C<$name>.
 722 C<$value> is the value associated with the button; this is both the
 723 value that will be shown to the user, and that which will be passed on
 724 to the C<$action> script.
 725
 726 =item C<[ "text", $name, $inittext ]>
 727
 728 Generates a text input field. C<$name> specifies its name, and
 729 C<$inittext> specifies the text that the field should initially
 730 contain.
 731
 732 =item C<[ "textarea", $name ]>
 733
 734 Creates a 40x4 text area, named C<$name>.
 735
 736 =item C<[ "reset", $name, $label ]>
 737
 738 Generates a reset button, with name C<$name>. C<$label> specifies the
 739 text for the button.
 740
 741 =item C<[ "submit", $name, $label ]>
 742
 743 Generates a submit button, with name C<$name>. C<$label> specifies the
 744 text for the button.
 745
 746 =back
 747
 748 =cut
 749 #'
 750 sub mkformnotable{
 751   my ($action,@inputs)=@_;
 752   my $string="<form action=$action method=post>\n";
 753   my $count=@inputs;
 754   for (my $i=0; $i<$count; $i++){
 755     if ($inputs[$i][0] eq 'hidden'){
 756       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 757     }
 758     if ($inputs[$i][0] eq 'radio') {
 759       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 760     }
 761     if ($inputs[$i][0] eq 'text') {
 762       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 763     }
 764     if ($inputs[$i][0] eq 'textarea') {
 765         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 766     }
 767     if ($inputs[$i][0] eq 'reset'){
 768       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 769     }
 770     if ($inputs[$i][0] eq 'submit'){
 771       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 772     }
 773   }
 774   $string=$string."</form>";
 775 }
 776
 777 =item mkform2
 778
 779   $str = &mkform2($action,
 780         $fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
 781         ...
 782         );
 783   print $str;
 784
 785 Takes a set of arguments that define an input form, generates an HTML
 786 string for the form, and returns the string.
 787
 788 C<$action> is the action for the form, usually the URL of the script
 789 that will process it.
 790
 791 The remaining arguments define the fields in the form. C<$fieldname>
 792 is the field's name. This is for the script's benefit, and will not be
 793 shown to the user.
 794
 795 C<$fieldpos> is an integer; fields will be output in order of
 796 increasing C<$fieldpos>. This number must be unique: if two fields
 797 have the same C<$fieldpos>, one will be picked at random, and the
 798 other will be ignored. See below for special considerations, however.
 799
 800 If C<$required> is the string C<R>, then the field is required, and
 801 the label will have C< (Req.)> appended.
 802
 803 C<$label> is a string that will appear next to the input field.
 804
 805 C<$fieldtype> specifies the type of the input field. It may be one of
 806 the following:
 807
 808 =over 4
 809
 810 =item C<hidden>
 811
 812 Generates a hidden field, used to pass data to the script without
 813 showing it to the user. C<$value0> is its value.
 814
 815 =item C<radio>
 816
 817 Generates a pair of radio buttons, with values C<$value0> and
 818 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
 819 the user, next to the radio button.
 820
 821 =item C<text>
 822
 823 Generates a one-line text input field. Its size may be specified by
 824 C<$value0>. The default is 40. The initial text of the field may be
 825 specified by C<$value1>.
 826
 827 =item C<textarea>
 828
 829 Generates a text input area. C<$value0> may be a string of the form
 830 "WWWxHHH", in which case the text input area will be WWW columns wide
 831 and HHH rows tall. The size defaults to 40x4.
 832
 833 The initial text (which, of course, may not contain any tabs) may be
 834 specified by C<$value1>.
 835
 836 =item C<select>
 837
 838 Generates a list of items, from which the user may choose one. Here,
 839 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
 840 pair, the key specifies an internal label for a choice, and the value
 841 specifies the description of the choice that will be shown the user.
 842
 843 If C<$value0> is the same as one of the keys that follows, then the
 844 corresponding choice will initially be selected.
 845
 846 =back
 847
 848 =cut
 849 #'
 850 sub mkform2{
 851     # FIXME
 852     # no POD and no tests yet.  Once tests are written,
 853     # this function can be cleaned up with the following steps:
 854     #  turn the while loop into a foreach loop
 855     #  pull the nested if,elsif structure back up to the main level
 856     #  pull the code for the different kinds of inputs into separate
 857     #   functions
 858   my ($action,%inputs)=@_;
 859   my $string="<form action=$action method=post>\n";
 860   $string=$string.mktablehdr();
 861   my $key;
 862   my @order;
 863   while ( my ($key, $value) = each %inputs) {
 864     my @data=split('\t',$value);
 865     my $posn = shift(@data);
 866     my $reqd = shift(@data);
 867     my $ltext = shift(@data);
 868     if ($data[0] eq 'hidden'){
 869       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 870     } else {
 871       my $text;
 872       if ($data[0] eq 'radio') {
 873         $text="<input type=radio name=$key value=$data[1]>$data[1]
 874         <input type=radio name=$key value=$data[2]>$data[2]";
 875       } elsif ($data[0] eq 'text') {
 876         my $size = $data[1];
 877         if ($size eq "") {
 878           $size=40;
 879         }
 880         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 881       } elsif ($data[0] eq 'textarea') {
 882         my @size=split("x",$data[1]);
 883         if ($data[1] eq "") {
 884           $size[0] = 40;
 885           $size[1] = 4;
 886         }
 887         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 888       } elsif ($data[0] eq 'select') {
 889         $text="<select name=$key>";
 890         my $sel=$data[1];
 891         my $i=2;
 892         while ($data[$i] ne "") {
 893           my $val = $data[$i+1];
 894           $text = $text."<option value=\"$data[$i]\"";
 895           if ($data[$i] eq $sel) {
 896              $text = $text." selected";
 897           }
 898           $text = $text.">$val";
 899           $i = $i+2;
 900         }
 901         $text=$text."</select>";
 902       }
 903       if ($reqd eq "R") {
 904         $ltext = $ltext." (Req)";
 905         }
 906       $order[$posn] =mktablerow(2,'white',$ltext,$text);
 907     }
 908   }
 909   $string=$string.join("\n",@order);
 910   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 911   $string=$string.mktableft;
 912   $string=$string."</form>";
 913 }
 914
 915 =item endpage
 916
 917   $str = &endpage();
 918   print $str;
 919
 920 Returns a string of HTML, the end of an HTML document.
 921
 922 =cut
 923 #'
 924 sub endpage() {
 925   return("</body></html>\n");
 926 }
 927
 928 =item mklink
 929
 930   $str = &mklink($url, $text);
 931   print $str;
 932
 933 Returns an HTML string, where C<$text> is a link to C<$url>.
 934
 935 =cut
 936 #'
 937 sub mklink($$) {
 938   my ($url,$text)=@_;
 939   my $string="<a href=\"$url\">$text</a>";
 940   return ($string);
 941 }
 942
 943 =item mkheadr
 944
 945   $str = &mkheadr($type, $text);
 946   print $str;
 947
 948 Takes a header type and header text, and returns a string of HTML,
 949 where C<$text> is rendered with emphasis in a large font size (not an
 950 actual HTML header).
 951
 952 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
 953 Type 2 has no special tag at the end; Type 3 ends with a paragraph
 954 break.
 955
 956 =cut
 957 #'
 958 sub mkheadr {
 959     # FIXME
 960     # would it be better to make this more generic by accepting an optional
 961     # argument with a closing tag instead of a numeric type?
 962
 963   my ($type,$text)=@_;
 964   my $string;
 965   if ($type eq '1'){
 966     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 967   }
 968   if ($type eq '2'){
 969     $string="<FONT SIZE=6><em>$text</em></FONT>";
 970   }
 971   if ($type eq '3'){
 972     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 973   }
 974   return ($string);
 975 }
 976
 977 =item center and endcenter
 978
 979   print &center(), "This is a line of centered text.", &endcenter();
 980
 981 C<&center> and C<&endcenter> take no arguments and return HTML tags
 982 <CENTER> and </CENTER> respectively.
 983
 984 =cut
 985 #'
 986 sub center() {
 987   return ("<CENTER>\n");
 988 }
 989
 990 sub endcenter() {
 991   return ("</CENTER>\n");
 992 }
 993
 994 =item bold
 995
 996   $str = &bold($text);
 997   print $str;
 998
 999 Returns a string of HTML that renders C<$text> in bold.
1000
1001 =cut
1002 #'
1003 sub bold($) {
1004   my ($text)=shift;
1005   return("<b>$text</b>");
1006 }
1007
1008 =item getkeytableselectoptions
1009
1010   $str = &getkeytableselectoptions($dbh, $tablename,
1011         $keyfieldname, $descfieldname,
1012         $showkey, $default);
1013   print $str;
1014
1015 Builds an HTML selection box from a database table. Returns a string
1016 of HTML that implements this.
1017
1018 C<$dbh> is a DBI::db database handle.
1019
1020 C<$tablename> is the database table in which to look up the possible
1021 values for the selection box.
1022
1023 C<$keyfieldname> is field in C<$tablename>. It will be used as the
1024 internal label for the selection.
1025
1026 C<$descfieldname> is a field in C<$tablename>. It will be used as the
1027 option shown to the user.
1028
1029 If C<$showkey> is true, then both the key and value will be shown to
1030 the user.
1031
1032 If the C<$default> argument is given, then if a value (from
1033 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1034
1035 =cut
1036 #'
1037 #---------------------------------------------
1038 # Create an HTML option list for a <SELECT> form tag by using
1039 #    values from a DB file
1040 sub getkeytableselectoptions {
1041         use strict;
1042         # inputs
1043         my (
1044                 $dbh,           # DBI handle
1045                 $tablename,     # name of table containing list of choices
1046                 $keyfieldname,  # column name of code to use in option list
1047                 $descfieldname, # column name of descriptive field
1048                 $showkey,       # flag to show key in description
1049                 $default,       # optional default key
1050         )=@_;
1051         my $selectclause;       # return value
1052
1053         my (
1054                 $sth, $query,
1055                 $key, $desc, $orderfieldname,
1056         );
1057         my $debug=0;
1058
1059         requireDBI($dbh,"getkeytableselectoptions");
1060
1061         if ( $showkey ) {
1062                 $orderfieldname=$keyfieldname;
1063         } else {
1064                 $orderfieldname=$descfieldname;
1065         }
1066         $query= "select $keyfieldname,$descfieldname
1067                 from $tablename
1068                 order by $orderfieldname ";
1069         print "<PRE>Query=$query </PRE>\n" if $debug;
1070         $sth=$dbh->prepare($query);
1071         $sth->execute;
1072         while ( ($key, $desc) = $sth->fetchrow) {
1073             if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1074             $selectclause.="<option";
1075             if (defined $default && $default eq $key) {
1076                 $selectclause.=" selected";
1077             }
1078             $selectclause.=" value='$key'>$desc\n";
1079             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1080         }
1081         return $selectclause;
1082 } # sub getkeytableselectoptions
1083
1084 #---------------------------------
1085
1086 END { }       # module clean-up code here (global destructor)
1087
1088 1;
1089 __END__
1090 =back
1091
1092 =head1 SEE ALSO
1093
1094 L<DBI(3)|DBI>
1095
1096 =cut