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