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