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