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