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