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