C4/Output.pm

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