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 .= "</tr>\n";
 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 .= mktablehdr();
 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 .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 496     } else {
 497       my $text;
 498       if ($data[0] eq 'radio') {
 499         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 500         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 501       }
 502       if ($data[0] eq 'text') {
 503         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 504       }
 505       if ($data[0] eq 'textarea') {
 506         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 507       }
 508       if ($data[0] eq 'select') {
 509         $text="<select name=$keys[$i2]>";
 510         my $i=1;
 511         while ($data[$i] ne "") {
 512           my $val = $data[$i+1];
 513           $text .= "<option value=$data[$i]>$val";
 514           $i += 2;
 515         }
 516         $text .= "</select>";
 517       }
 518       $string .= mktablerow(2,'white',$keys[$i2],$text);
 519       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 520     }
 521     $i2++;
 522   }
 523   #$string=$string.join("\n",@order);
 524   $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
 525   $string .= mktableft;
 526   $string .= "</form>";
 527 }
 528
 529 =item mkform3
 530
 531   $str = &mkform3($action,
 532         $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
 533         ...
 534         );
 535   print $str;
 536
 537 Takes a set of arguments that define an input form, generates an HTML
 538 string for the form, and returns the string.
 539
 540 C<$action> is the action for the form, usually the URL of the script
 541 that will process it.
 542
 543 The remaining arguments define the fields in the form. C<$fieldname>
 544 is the field's name. This is for the script's benefit, and will not be
 545 shown to the user.
 546
 547 C<$fieldpos> is an integer; fields will be output in order of
 548 increasing C<$fieldpos>. This number must be unique: if two fields
 549 have the same C<$fieldpos>, one will be picked at random, and the
 550 other will be ignored. See below for special considerations, however.
 551
 552 C<$fieldtype> specifies the type of the input field. It may be one of
 553 the following:
 554
 555 =over 4
 556
 557 =item C<hidden>
 558
 559 Generates a hidden field, used to pass data to the script without
 560 showing it to the user. C<$fieldvalue> is the value.
 561
 562 =item C<radio>
 563
 564 Generates a pair of radio buttons, with values C<$fieldvalue> and
 565 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
 566 shown to the user.
 567
 568 =item C<text>
 569
 570 Generates a one-line text input field. It initially contains
 571 C<$fieldvalue>.
 572
 573 =item C<textarea>
 574
 575 Generates a four-line text input area. The initial text (which, of
 576 course, may not contain any tabs) is C<$fieldvalue>.
 577
 578 =item C<select>
 579
 580 Generates a list of items, from which the user may choose one. This is
 581 somewhat different from other input field types, and should be
 582 specified as:
 583   "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
 584 where the C<text>N strings are the choices that will be presented to
 585 the user, and C<label>N are the labels that will be passed to the
 586 script.
 587
 588 However, C<text0> should be an integer, since it will be used to
 589 determine the order in which this field appears in the form. If any of
 590 the C<label>Ns are empty, the rest of the list will be ignored.
 591
 592 =back
 593
 594 =cut
 595 #'
 596 sub mkform3 {
 597   my ($action, %inputs) = @_;
 598   my $string = "<form action=\"$action\" method=\"post\">\n";
 599   $string   .= mktablehdr();
 600   my $key;
 601   my @keys = sort(keys(%inputs));       # FIXME - Why do these need to be
 602                                         # sorted?
 603   my @order;
 604   my $count = @keys;
 605   my $i2 = 0;
 606   while ($i2 < $count) {
 607     my $value=$inputs{$keys[$i2]};
 608     # FIXME - Why use a tab-separated string? Why not just use an
 609     # anonymous array?
 610     my @data=split('\t',$value);
 611     my $posn = $data[2];
 612     if ($data[0] eq 'hidden'){
 613       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 614     } else {
 615       my $text;
 616       if ($data[0] eq 'radio') {
 617         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 618         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 619       }
 620       # FIXME - Is 40 the right size in all cases?
 621       if ($data[0] eq 'text') {
 622         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 623       }
 624       # FIXME - Is 40x4 the right size in all cases?
 625       if ($data[0] eq 'textarea') {
 626         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 627       }
 628       if ($data[0] eq 'select') {
 629         $text="<select name=$keys[$i2]>";
 630         my $i=1;
 631         while ($data[$i] ne "") {
 632           my $val = $data[$i+1];
 633           $text .= "<option value=$data[$i]>$val";
 634           $i += 2;
 635         }
 636         $text .= "</select>";
 637       }
 638 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 639       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 640     }
 641     $i2++;
 642   }
 643   my $temp=join("\n",@order);
 644   $string .= $temp;
 645   $string .= mktablerow(1,'white','<input type=submit>');
 646   $string .= mktableft;
 647   $string .= "</form>";
 648   # FIXME - A return statement, while not strictly necessary, would be nice.
 649 }
 650
 651 =item mkformnotable
 652
 653   $str = &mkformnotable($action, @inputs);
 654   print $str;
 655
 656 Takes a set of arguments that define an input form, generates an HTML
 657 string for the form, and returns the string. Unlike C<&mkform2> and
 658 C<&mkform3>, it does not put the form inside a table.
 659
 660 C<$action> is the action for the form, usually the URL of the script
 661 that will process it.
 662
 663 The remaining arguments define the fields in the form. Each is an
 664 anonymous array, e.g.:
 665
 666   &mkformnotable("/cgi-bin/foo",
 667         [ "hidden", "hiddenvar", "value" ],
 668         [ "text", "username", "" ]);
 669
 670 The first element of each argument defines its type. The remaining
 671 ones are type-dependent. The supported types are:
 672
 673 =over 4
 674
 675 =item C<[ "hidden", $name, $value]>
 676
 677 Generates a hidden field, for passing information to a script without
 678 showing it to the user. C<$name> is the name of the field, and
 679 C<$value> is the value to pass.
 680
 681 =item C<[ "radio", $groupname, $value ]>
 682
 683 Generates a radio button. Its name (or button group name) is C<$name>.
 684 C<$value> is the value associated with the button; this is both the
 685 value that will be shown to the user, and that which will be passed on
 686 to the C<$action> script.
 687
 688 =item C<[ "text", $name, $inittext ]>
 689
 690 Generates a text input field. C<$name> specifies its name, and
 691 C<$inittext> specifies the text that the field should initially
 692 contain.
 693
 694 =item C<[ "textarea", $name ]>
 695
 696 Creates a 40x4 text area, named C<$name>.
 697
 698 =item C<[ "reset", $name, $label ]>
 699
 700 Generates a reset button, with name C<$name>. C<$label> specifies the
 701 text for the button.
 702
 703 =item C<[ "submit", $name, $label ]>
 704
 705 Generates a submit button, with name C<$name>. C<$label> specifies the
 706 text for the button.
 707
 708 =back
 709
 710 =cut
 711 #'
 712 sub mkformnotable{
 713   my ($action,@inputs)=@_;
 714   my $string="<form action=$action method=post>\n";
 715   my $count=@inputs;
 716   for (my $i=0; $i<$count; $i++){
 717     if ($inputs[$i][0] eq 'hidden'){
 718       $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 719     }
 720     if ($inputs[$i][0] eq 'radio') {
 721       $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 722     }
 723     if ($inputs[$i][0] eq 'text') {
 724       $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 725     }
 726     if ($inputs[$i][0] eq 'textarea') {
 727         $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 728     }
 729     if ($inputs[$i][0] eq 'reset'){
 730       $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 731     }
 732     if ($inputs[$i][0] eq 'submit'){
 733       $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 734     }
 735   }
 736   $string .= "</form>";
 737 }
 738
 739 =item mkform2
 740
 741   $str = &mkform2($action,
 742         $fieldname =>
 743           "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
 744         ...
 745         );
 746   print $str;
 747
 748 Takes a set of arguments that define an input form, generates an HTML
 749 string for the form, and returns the string.
 750
 751 C<$action> is the action for the form, usually the URL of the script
 752 that will process it.
 753
 754 The remaining arguments define the fields in the form. C<$fieldname>
 755 is the field's name. This is for the script's benefit, and will not be
 756 shown to the user.
 757
 758 C<$fieldpos> is an integer; fields will be output in order of
 759 increasing C<$fieldpos>. This number must be unique: if two fields
 760 have the same C<$fieldpos>, one will be picked at random, and the
 761 other will be ignored. See below for special considerations, however.
 762
 763 If C<$required> is the string C<R>, then the field is required, and
 764 the label will have C< (Req.)> appended.
 765
 766 C<$label> is a string that will appear next to the input field.
 767
 768 C<$fieldtype> specifies the type of the input field. It may be one of
 769 the following:
 770
 771 =over 4
 772
 773 =item C<hidden>
 774
 775 Generates a hidden field, used to pass data to the script without
 776 showing it to the user. C<$value0> is its value.
 777
 778 =item C<radio>
 779
 780 Generates a pair of radio buttons, with values C<$value0> and
 781 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
 782 the user, next to the radio button.
 783
 784 =item C<text>
 785
 786 Generates a one-line text input field. Its size may be specified by
 787 C<$value0>. The default is 40. The initial text of the field may be
 788 specified by C<$value1>.
 789
 790 =item C<textarea>
 791
 792 Generates a text input area. C<$value0> may be a string of the form
 793 "WWWxHHH", in which case the text input area will be WWW columns wide
 794 and HHH rows tall. The size defaults to 40x4.
 795
 796 The initial text (which, of course, may not contain any tabs) may be
 797 specified by C<$value1>.
 798
 799 =item C<select>
 800
 801 Generates a list of items, from which the user may choose one. Here,
 802 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
 803 pair, the key specifies an internal label for a choice, and the value
 804 specifies the description of the choice that will be shown the user.
 805
 806 If C<$value0> is the same as one of the keys that follows, then the
 807 corresponding choice will initially be selected.
 808
 809 =back
 810
 811 =cut
 812 #'
 813 sub mkform2{
 814     # FIXME
 815     # No tests yet.  Once tests are written,
 816     # this function can be cleaned up with the following steps:
 817     #  turn the while loop into a foreach loop
 818     #  pull the nested if,elsif structure back up to the main level
 819     #  pull the code for the different kinds of inputs into separate
 820     #   functions
 821   my ($action,%inputs)=@_;
 822   my $string="<form action=$action method=post>\n";
 823   $string .= mktablehdr();
 824   my $key;
 825   my @order;
 826   while ( my ($key, $value) = each %inputs) {
 827     my @data=split('\t',$value);
 828     my $posn = shift(@data);
 829     my $reqd = shift(@data);
 830     my $ltext = shift(@data);
 831     if ($data[0] eq 'hidden'){
 832       $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
 833     } else {
 834       my $text;
 835       if ($data[0] eq 'radio') {
 836         $text="<input type=radio name=$key value=$data[1]>$data[1]
 837         <input type=radio name=$key value=$data[2]>$data[2]";
 838       } elsif ($data[0] eq 'text') {
 839         my $size = $data[1];
 840         if ($size eq "") {
 841           $size=40;
 842         }
 843         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 844       } elsif ($data[0] eq 'textarea') {
 845         my @size=split("x",$data[1]);
 846         if ($data[1] eq "") {
 847           $size[0] = 40;
 848           $size[1] = 4;
 849         }
 850         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 851       } elsif ($data[0] eq 'select') {
 852         $text="<select name=$key>";
 853         my $sel=$data[1];
 854         my $i=2;
 855         while ($data[$i] ne "") {
 856           my $val = $data[$i+1];
 857           $text .= "<option value=\"$data[$i]\"";
 858           if ($data[$i] eq $sel) {
 859              $text .= " selected";
 860           }
 861           $text .= ">$val";
 862           $i += 2;
 863         }
 864         $text .= "</select>";
 865       }
 866       if ($reqd eq "R") {
 867         $ltext .= " (Req)";
 868         }
 869       $order[$posn] =mktablerow(2,'white',$ltext,$text);
 870     }
 871   }
 872   $string .= join("\n",@order);
 873   $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
 874   $string .= mktableft;
 875   $string .= "</form>";
 876 }
 877
 878 =item endpage
 879
 880   $str = &endpage();
 881   print $str;
 882
 883 Returns a string of HTML, the end of an HTML document.
 884
 885 =cut
 886 #'
 887 sub endpage() {
 888   return("</body></html>\n");
 889 }
 890
 891 =item mklink
 892
 893   $str = &mklink($url, $text);
 894   print $str;
 895
 896 Returns an HTML string, where C<$text> is a link to C<$url>.
 897
 898 =cut
 899 #'
 900 sub mklink($$) {
 901   my ($url,$text)=@_;
 902   my $string="<a href=\"$url\">$text</a>";
 903   return ($string);
 904 }
 905
 906 =item mkheadr
 907
 908   $str = &mkheadr($type, $text);
 909   print $str;
 910
 911 Takes a header type and header text, and returns a string of HTML,
 912 where C<$text> is rendered with emphasis in a large font size (not an
 913 actual HTML header).
 914
 915 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
 916 Type 2 has no special tag at the end; Type 3 ends with a paragraph
 917 break.
 918
 919 =cut
 920 #'
 921 sub mkheadr {
 922     # FIXME
 923     # would it be better to make this more generic by accepting an optional
 924     # argument with a closing tag instead of a numeric type?
 925
 926   my ($type,$text)=@_;
 927   my $string;
 928   if ($type eq '1'){
 929     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 930   }
 931   if ($type eq '2'){
 932     $string="<FONT SIZE=6><em>$text</em></FONT>";
 933   }
 934   if ($type eq '3'){
 935     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 936   }
 937   return ($string);
 938 }
 939
 940 =item center and endcenter
 941
 942   print &center(), "This is a line of centered text.", &endcenter();
 943
 944 C<&center> and C<&endcenter> take no arguments and return HTML tags
 945 <CENTER> and </CENTER> respectively.
 946
 947 =cut
 948 #'
 949 sub center() {
 950   return ("<CENTER>\n");
 951 }
 952
 953 sub endcenter() {
 954   return ("</CENTER>\n");
 955 }
 956
 957 =item bold
 958
 959   $str = &bold($text);
 960   print $str;
 961
 962 Returns a string of HTML that renders C<$text> in bold.
 963
 964 =cut
 965 #'
 966 sub bold($) {
 967   my ($text)=shift;
 968   return("<b>$text</b>");
 969 }
 970
 971 =item getkeytableselectoptions
 972
 973   $str = &getkeytableselectoptions($dbh, $tablename,
 974         $keyfieldname, $descfieldname,
 975         $showkey, $default);
 976   print $str;
 977
 978 Builds an HTML selection box from a database table. Returns a string
 979 of HTML that implements this.
 980
 981 C<$dbh> is a DBI::db database handle.
 982
 983 C<$tablename> is the database table in which to look up the possible
 984 values for the selection box.
 985
 986 C<$keyfieldname> is field in C<$tablename>. It will be used as the
 987 internal label for the selection.
 988
 989 C<$descfieldname> is a field in C<$tablename>. It will be used as the
 990 option shown to the user.
 991
 992 If C<$showkey> is true, then both the key and value will be shown to
 993 the user.
 994
 995 If the C<$default> argument is given, then if a value (from
 996 C<$keyfieldname>) matches C<$default>, it will be selected by default.
 997
 998 =cut
 999 #'
1000 #---------------------------------------------
1001 # Create an HTML option list for a <SELECT> form tag by using
1002 #    values from a DB file
1003 sub getkeytableselectoptions {
1004         use strict;
1005         # inputs
1006         my (
1007                 $dbh,           # DBI handle
1008                                 # FIXME - Obsolete argument
1009                 $tablename,     # name of table containing list of choices
1010                 $keyfieldname,  # column name of code to use in option list
1011                 $descfieldname, # column name of descriptive field
1012                 $showkey,       # flag to show key in description
1013                 $default,       # optional default key
1014         )=@_;
1015         my $selectclause;       # return value
1016
1017         my (
1018                 $sth, $query,
1019                 $key, $desc, $orderfieldname,
1020         );
1021         my $debug=0;
1022
1023         $dbh = C4::Context->dbh;
1024
1025         if ( $showkey ) {
1026                 $orderfieldname=$keyfieldname;
1027         } else {
1028                 $orderfieldname=$descfieldname;
1029         }
1030         $query= "select $keyfieldname,$descfieldname
1031                 from $tablename
1032                 order by $orderfieldname ";
1033         print "<PRE>Query=$query </PRE>\n" if $debug;
1034         $sth=$dbh->prepare($query);
1035         $sth->execute;
1036         while ( ($key, $desc) = $sth->fetchrow) {
1037             if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1038             $selectclause.="<option";
1039             if (defined $default && $default eq $key) {
1040                 $selectclause.=" selected";
1041             }
1042             $selectclause.=" value='$key'>$desc\n";
1043             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1044         }
1045         return $selectclause;
1046 } # sub getkeytableselectoptions
1047
1048 #---------------------------------
1049
1050 END { }       # module clean-up code here (global destructor)
1051
1052 1;
1053 __END__
1054
1055 =back
1056
1057 =head1 AUTHOR
1058
1059 Koha Developement team <info@koha.org>
1060
1061 =cut