C4/Output.pm

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