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                                                         interface => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl'),
 101                                                         theme => $theme,
 102                                                         lang => $lang);
 103         return $template;
 104 }
 105
 106 #---------------------------------------------------------------------------------------------------------
 107 # FIXME - POD
 108 sub themelanguage {
 109   my ($htdocs, $tmpl) = @_;
 110
 111   my $dbh = C4::Context->dbh;
 112   my @languages = split " ", C4::Context->preference("opaclanguages");
 113                         # language preference
 114   my @themes = split " ", C4::Context->preference("opacthemes");
 115                         # theme preferences
 116
 117   my ($theme, $lang);
 118 # searches through the themes and languages. First template it find it returns.
 119 # Priority is for getting the theme right.
 120   THEME:
 121   foreach my $th (@themes) {
 122     foreach my $la (@languages) {
 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   } elsif ($type eq 'admin') {
 358     open (FILE,"$path/parameters-top.inc") || die "could not find : $path/parameters-top.inc";
 359   } else {
 360     open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
 361   }
 362   my @string=<FILE>;
 363   close FILE;
 364   # my $count=@string;
 365   # $string[$count]="<BLOCKQUOTE>";
 366   return @string;
 367 }
 368
 369 =item endmenu
 370
 371   @lines = &endmenu($type);
 372   print join("", @lines);
 373
 374 Given a page type, or category, returns a set of lines of HTML which,
 375 when concatenated, generate the menu at the bottom of the web page.
 376
 377 C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
 378 C<report>, C<circulation>, or something else, in which case the menu
 379 will be for the catalog pages.
 380
 381 =cut
 382 #'
 383 sub endmenu {
 384   my ($type) = @_;
 385   if ( ! defined $type ) { $type=''; }
 386   # FIXME - It's bad form to die in a CGI script. It's even worse form
 387   # to die without issuing an error message.
 388   if ($type eq 'issue') {
 389     open (FILE,"<$path/issues-bottom.inc") || die;
 390   } elsif ($type eq 'opac') {
 391     open (FILE,"<$path/opac-bottom.inc") || die;
 392   } elsif ($type eq 'member') {
 393     open (FILE,"<$path/members-bottom.inc") || die;
 394   } elsif ($type eq 'acquisitions') {
 395     open (FILE,"<$path/acquisitions-bottom.inc") || die;
 396   } elsif ($type eq 'report') {
 397     open (FILE,"<$path/reports-bottom.inc") || die;
 398   } elsif ($type eq 'circulation') {
 399     open (FILE,"<$path/circulation-bottom.inc") || die;
 400   } elsif ($type eq 'admin') {
 401     open (FILE,"<$path/parameters-bottom.inc") || die;
 402   } else {
 403     open (FILE,"<$path/cat-bottom.inc") || die;
 404   }
 405   my @string=<FILE>;
 406   close FILE;
 407   return @string;
 408 }
 409
 410 =item mktablehdr
 411
 412   $str = &mktablehdr();
 413   print $str;
 414
 415 Returns a string of HTML, which generates the beginning of a table
 416 declaration.
 417
 418 =cut
 419 #'
 420 sub mktablehdr() {
 421     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 422 }
 423
 424 =item mktablerow
 425
 426   $str = &mktablerow($columns, $color, @column_data, $bgimage);
 427   print $str;
 428
 429 Returns a string of HTML, which generates a row of data inside a table
 430 (see also C<&mktablehdr>, C<&mktableft>).
 431
 432 C<$columns> specifies the number of columns in this row of data.
 433
 434 C<$color> specifies the background color for the row, e.g., C<"white">
 435 or C<"#ffacac">.
 436
 437 C<@column_data> is an array of C<$columns> elements, each one a string
 438 of HTML. These are the contents of the row.
 439
 440 The optional C<$bgimage> argument specifies the pathname to an image
 441 to use as the background for each cell in the row. This pathname will
 442 used as is in the output, so it should be relative to the HTTP
 443 document root.
 444
 445 =cut
 446 #'
 447 sub mktablerow {
 448     #the last item in data may be a backgroundimage
 449
 450     # FIXME
 451     # should this be a foreach (1..$cols) loop?
 452
 453   my ($cols,$colour,@data)=@_;
 454   my $i=0;
 455   my $string="<tr valign=top bgcolor=$colour>";
 456   while ($i <$cols){
 457       if (defined $data[$cols]) { # if there is a background image
 458           $string.="<td background=\"$data[$cols]\">";
 459       } else { # if there's no background image
 460           $string.="<td>";
 461       }
 462       if (! defined $data[$i]) {$data[$i]="";}
 463       if ($data[$i] eq "") {
 464           $string.=" &nbsp; </td>";
 465       } else {
 466           $string.="$data[$i]</td>";
 467       }
 468       $i++;
 469   }
 470   $string .= "</tr>\n";
 471   return($string);
 472 }
 473
 474 =item mktableft
 475
 476   $str = &mktableft();
 477   print $str;
 478
 479 Returns a string of HTML, which generates the end of a table
 480 declaration.
 481
 482 =cut
 483 #'
 484 sub mktableft() {
 485   return("</table>\n");
 486 }
 487
 488 # FIXME - This is never used.
 489 sub mkform{
 490   my ($action,%inputs)=@_;
 491   my $string="<form action=$action method=post>\n";
 492   $string .= mktablehdr();
 493   my $key;
 494   my @keys=sort keys %inputs;
 495
 496   my $count=@keys;
 497   my $i2=0;
 498   while ( $i2<$count) {
 499     my $value=$inputs{$keys[$i2]};
 500     my @data=split('\t',$value);
 501     #my $posn = shift(@data);
 502     if ($data[0] eq 'hidden'){
 503       $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 504     } else {
 505       my $text;
 506       if ($data[0] eq 'radio') {
 507         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 508         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 509       }
 510       if ($data[0] eq 'text') {
 511         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 512       }
 513       if ($data[0] eq 'textarea') {
 514         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 515       }
 516       if ($data[0] eq 'select') {
 517         $text="<select name=$keys[$i2]>";
 518         my $i=1;
 519         while ($data[$i] ne "") {
 520           my $val = $data[$i+1];
 521           $text .= "<option value=$data[$i]>$val";
 522           $i += 2;
 523         }
 524         $text .= "</select>";
 525       }
 526       $string .= mktablerow(2,'white',$keys[$i2],$text);
 527       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 528     }
 529     $i2++;
 530   }
 531   #$string=$string.join("\n",@order);
 532   $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
 533   $string .= mktableft;
 534   $string .= "</form>";
 535 }
 536
 537 =item mkform3
 538
 539   $str = &mkform3($action,
 540         $fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
 541         ...
 542         );
 543   print $str;
 544
 545 Takes a set of arguments that define an input form, generates an HTML
 546 string for the form, and returns the string.
 547
 548 C<$action> is the action for the form, usually the URL of the script
 549 that will process it.
 550
 551 The remaining arguments define the fields in the form. C<$fieldname>
 552 is the field's name. This is for the script's benefit, and will not be
 553 shown to the user.
 554
 555 C<$fieldpos> is an integer; fields will be output in order of
 556 increasing C<$fieldpos>. This number must be unique: if two fields
 557 have the same C<$fieldpos>, one will be picked at random, and the
 558 other will be ignored. See below for special considerations, however.
 559
 560 C<$fieldtype> specifies the type of the input field. It may be one of
 561 the following:
 562
 563 =over 4
 564
 565 =item C<hidden>
 566
 567 Generates a hidden field, used to pass data to the script without
 568 showing it to the user. C<$fieldvalue> is the value.
 569
 570 =item C<radio>
 571
 572 Generates a pair of radio buttons, with values C<$fieldvalue> and
 573 C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
 574 shown to the user.
 575
 576 =item C<text>
 577
 578 Generates a one-line text input field. It initially contains
 579 C<$fieldvalue>.
 580
 581 =item C<textarea>
 582
 583 Generates a four-line text input area. The initial text (which, of
 584 course, may not contain any tabs) is C<$fieldvalue>.
 585
 586 =item C<select>
 587
 588 Generates a list of items, from which the user may choose one. This is
 589 somewhat different from other input field types, and should be
 590 specified as:
 591   "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
 592 where the C<text>N strings are the choices that will be presented to
 593 the user, and C<label>N are the labels that will be passed to the
 594 script.
 595
 596 However, C<text0> should be an integer, since it will be used to
 597 determine the order in which this field appears in the form. If any of
 598 the C<label>Ns are empty, the rest of the list will be ignored.
 599
 600 =back
 601
 602 =cut
 603 #'
 604 sub mkform3 {
 605   my ($action, %inputs) = @_;
 606   my $string = "<form action=\"$action\" method=\"post\">\n";
 607   $string   .= mktablehdr();
 608   my $key;
 609   my @keys = sort(keys(%inputs));       # FIXME - Why do these need to be
 610                                         # sorted?
 611   my @order;
 612   my $count = @keys;
 613   my $i2 = 0;
 614   while ($i2 < $count) {
 615     my $value=$inputs{$keys[$i2]};
 616     # FIXME - Why use a tab-separated string? Why not just use an
 617     # anonymous array?
 618     my @data=split('\t',$value);
 619     my $posn = $data[2];
 620     if ($data[0] eq 'hidden'){
 621       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 622     } else {
 623       my $text;
 624       if ($data[0] eq 'radio') {
 625         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 626         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 627       }
 628       # FIXME - Is 40 the right size in all cases?
 629       if ($data[0] eq 'text') {
 630         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 631       }
 632       # FIXME - Is 40x4 the right size in all cases?
 633       if ($data[0] eq 'textarea') {
 634         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 635       }
 636       if ($data[0] eq 'select') {
 637         $text="<select name=$keys[$i2]>";
 638         my $i=1;
 639         while ($data[$i] ne "") {
 640           my $val = $data[$i+1];
 641           $text .= "<option value=$data[$i]>$val";
 642           $i += 2;
 643         }
 644         $text .= "</select>";
 645       }
 646 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 647       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 648     }
 649     $i2++;
 650   }
 651   my $temp=join("\n",@order);
 652   $string .= $temp;
 653   $string .= mktablerow(1,'white','<input type=submit>');
 654   $string .= mktableft;
 655   $string .= "</form>";
 656   # FIXME - A return statement, while not strictly necessary, would be nice.
 657 }
 658
 659 =item mkformnotable
 660
 661   $str = &mkformnotable($action, @inputs);
 662   print $str;
 663
 664 Takes a set of arguments that define an input form, generates an HTML
 665 string for the form, and returns the string. Unlike C<&mkform2> and
 666 C<&mkform3>, it does not put the form inside a table.
 667
 668 C<$action> is the action for the form, usually the URL of the script
 669 that will process it.
 670
 671 The remaining arguments define the fields in the form. Each is an
 672 anonymous array, e.g.:
 673
 674   &mkformnotable("/cgi-bin/foo",
 675         [ "hidden", "hiddenvar", "value" ],
 676         [ "text", "username", "" ]);
 677
 678 The first element of each argument defines its type. The remaining
 679 ones are type-dependent. The supported types are:
 680
 681 =over 4
 682
 683 =item C<[ "hidden", $name, $value]>
 684
 685 Generates a hidden field, for passing information to a script without
 686 showing it to the user. C<$name> is the name of the field, and
 687 C<$value> is the value to pass.
 688
 689 =item C<[ "radio", $groupname, $value ]>
 690
 691 Generates a radio button. Its name (or button group name) is C<$name>.
 692 C<$value> is the value associated with the button; this is both the
 693 value that will be shown to the user, and that which will be passed on
 694 to the C<$action> script.
 695
 696 =item C<[ "text", $name, $inittext ]>
 697
 698 Generates a text input field. C<$name> specifies its name, and
 699 C<$inittext> specifies the text that the field should initially
 700 contain.
 701
 702 =item C<[ "textarea", $name ]>
 703
 704 Creates a 40x4 text area, named C<$name>.
 705
 706 =item C<[ "reset", $name, $label ]>
 707
 708 Generates a reset button, with name C<$name>. C<$label> specifies the
 709 text for the button.
 710
 711 =item C<[ "submit", $name, $label ]>
 712
 713 Generates a submit button, with name C<$name>. C<$label> specifies the
 714 text for the button.
 715
 716 =back
 717
 718 =cut
 719 #'
 720 sub mkformnotable{
 721   my ($action,@inputs)=@_;
 722   my $string="<form action=$action method=post>\n";
 723   my $count=@inputs;
 724   for (my $i=0; $i<$count; $i++){
 725     if ($inputs[$i][0] eq 'hidden'){
 726       $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 727     }
 728     if ($inputs[$i][0] eq 'radio') {
 729       $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 730     }
 731     if ($inputs[$i][0] eq 'text') {
 732       $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 733     }
 734     if ($inputs[$i][0] eq 'textarea') {
 735         $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 736     }
 737     if ($inputs[$i][0] eq 'reset'){
 738       $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 739     }
 740     if ($inputs[$i][0] eq 'submit'){
 741       $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 742     }
 743   }
 744   $string .= "</form>";
 745 }
 746
 747 =item mkform2
 748
 749   $str = &mkform2($action,
 750         $fieldname =>
 751           "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
 752         ...
 753         );
 754   print $str;
 755
 756 Takes a set of arguments that define an input form, generates an HTML
 757 string for the form, and returns the string.
 758
 759 C<$action> is the action for the form, usually the URL of the script
 760 that will process it.
 761
 762 The remaining arguments define the fields in the form. C<$fieldname>
 763 is the field's name. This is for the script's benefit, and will not be
 764 shown to the user.
 765
 766 C<$fieldpos> is an integer; fields will be output in order of
 767 increasing C<$fieldpos>. This number must be unique: if two fields
 768 have the same C<$fieldpos>, one will be picked at random, and the
 769 other will be ignored. See below for special considerations, however.
 770
 771 If C<$required> is the string C<R>, then the field is required, and
 772 the label will have C< (Req.)> appended.
 773
 774 C<$label> is a string that will appear next to the input field.
 775
 776 C<$fieldtype> specifies the type of the input field. It may be one of
 777 the following:
 778
 779 =over 4
 780
 781 =item C<hidden>
 782
 783 Generates a hidden field, used to pass data to the script without
 784 showing it to the user. C<$value0> is its value.
 785
 786 =item C<radio>
 787
 788 Generates a pair of radio buttons, with values C<$value0> and
 789 C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
 790 the user, next to the radio button.
 791
 792 =item C<text>
 793
 794 Generates a one-line text input field. Its size may be specified by
 795 C<$value0>. The default is 40. The initial text of the field may be
 796 specified by C<$value1>.
 797
 798 =item C<textarea>
 799
 800 Generates a text input area. C<$value0> may be a string of the form
 801 "WWWxHHH", in which case the text input area will be WWW columns wide
 802 and HHH rows tall. The size defaults to 40x4.
 803
 804 The initial text (which, of course, may not contain any tabs) may be
 805 specified by C<$value1>.
 806
 807 =item C<select>
 808
 809 Generates a list of items, from which the user may choose one. Here,
 810 C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
 811 pair, the key specifies an internal label for a choice, and the value
 812 specifies the description of the choice that will be shown the user.
 813
 814 If C<$value0> is the same as one of the keys that follows, then the
 815 corresponding choice will initially be selected.
 816
 817 =back
 818
 819 =cut
 820 #'
 821 sub mkform2{
 822     # FIXME
 823     # No tests yet.  Once tests are written,
 824     # this function can be cleaned up with the following steps:
 825     #  turn the while loop into a foreach loop
 826     #  pull the nested if,elsif structure back up to the main level
 827     #  pull the code for the different kinds of inputs into separate
 828     #   functions
 829   my ($action,%inputs)=@_;
 830   my $string="<form action=$action method=post>\n";
 831   $string .= mktablehdr();
 832   my $key;
 833   my @order;
 834   while ( my ($key, $value) = each %inputs) {
 835     my @data=split('\t',$value);
 836     my $posn = shift(@data);
 837     my $reqd = shift(@data);
 838     my $ltext = shift(@data);
 839     if ($data[0] eq 'hidden'){
 840       $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
 841     } else {
 842       my $text;
 843       if ($data[0] eq 'radio') {
 844         $text="<input type=radio name=$key value=$data[1]>$data[1]
 845         <input type=radio name=$key value=$data[2]>$data[2]";
 846       } elsif ($data[0] eq 'text') {
 847         my $size = $data[1];
 848         if ($size eq "") {
 849           $size=40;
 850         }
 851         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 852       } elsif ($data[0] eq 'textarea') {
 853         my @size=split("x",$data[1]);
 854         if ($data[1] eq "") {
 855           $size[0] = 40;
 856           $size[1] = 4;
 857         }
 858         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 859       } elsif ($data[0] eq 'select') {
 860         $text="<select name=$key>";
 861         my $sel=$data[1];
 862         my $i=2;
 863         while ($data[$i] ne "") {
 864           my $val = $data[$i+1];
 865           $text .= "<option value=\"$data[$i]\"";
 866           if ($data[$i] eq $sel) {
 867              $text .= " selected";
 868           }
 869           $text .= ">$val";
 870           $i += 2;
 871         }
 872         $text .= "</select>";
 873       }
 874       if ($reqd eq "R") {
 875         $ltext .= " (Req)";
 876         }
 877       $order[$posn] =mktablerow(2,'white',$ltext,$text);
 878     }
 879   }
 880   $string .= join("\n",@order);
 881   $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
 882   $string .= mktableft;
 883   $string .= "</form>";
 884 }
 885
 886 =item endpage
 887
 888   $str = &endpage();
 889   print $str;
 890
 891 Returns a string of HTML, the end of an HTML document.
 892
 893 =cut
 894 #'
 895 sub endpage() {
 896   return("</body></html>\n");
 897 }
 898
 899 =item mklink
 900
 901   $str = &mklink($url, $text);
 902   print $str;
 903
 904 Returns an HTML string, where C<$text> is a link to C<$url>.
 905
 906 =cut
 907 #'
 908 sub mklink($$) {
 909   my ($url,$text)=@_;
 910   my $string="<a href=\"$url\">$text</a>";
 911   return ($string);
 912 }
 913
 914 =item mkheadr
 915
 916   $str = &mkheadr($type, $text);
 917   print $str;
 918
 919 Takes a header type and header text, and returns a string of HTML,
 920 where C<$text> is rendered with emphasis in a large font size (not an
 921 actual HTML header).
 922
 923 C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
 924 Type 2 has no special tag at the end; Type 3 ends with a paragraph
 925 break.
 926
 927 =cut
 928 #'
 929 sub mkheadr {
 930     # FIXME
 931     # would it be better to make this more generic by accepting an optional
 932     # argument with a closing tag instead of a numeric type?
 933
 934   my ($type,$text)=@_;
 935   my $string;
 936   if ($type eq '1'){
 937     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 938   }
 939   if ($type eq '2'){
 940     $string="<FONT SIZE=6><em>$text</em></FONT>";
 941   }
 942   if ($type eq '3'){
 943     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 944   }
 945   return ($string);
 946 }
 947
 948 =item center and endcenter
 949
 950   print &center(), "This is a line of centered text.", &endcenter();
 951
 952 C<&center> and C<&endcenter> take no arguments and return HTML tags
 953 <CENTER> and </CENTER> respectively.
 954
 955 =cut
 956 #'
 957 sub center() {
 958   return ("<CENTER>\n");
 959 }
 960
 961 sub endcenter() {
 962   return ("</CENTER>\n");
 963 }
 964
 965 =item bold
 966
 967   $str = &bold($text);
 968   print $str;
 969
 970 Returns a string of HTML that renders C<$text> in bold.
 971
 972 =cut
 973 #'
 974 sub bold($) {
 975   my ($text)=shift;
 976   return("<b>$text</b>");
 977 }
 978
 979 =item getkeytableselectoptions
 980
 981   $str = &getkeytableselectoptions($dbh, $tablename,
 982         $keyfieldname, $descfieldname,
 983         $showkey, $default);
 984   print $str;
 985
 986 Builds an HTML selection box from a database table. Returns a string
 987 of HTML that implements this.
 988
 989 C<$dbh> is a DBI::db database handle.
 990
 991 C<$tablename> is the database table in which to look up the possible
 992 values for the selection box.
 993
 994 C<$keyfieldname> is field in C<$tablename>. It will be used as the
 995 internal label for the selection.
 996
 997 C<$descfieldname> is a field in C<$tablename>. It will be used as the
 998 option shown to the user.
 999
1000 If C<$showkey> is true, then both the key and value will be shown to
1001 the user.
1002
1003 If the C<$default> argument is given, then if a value (from
1004 C<$keyfieldname>) matches C<$default>, it will be selected by default.
1005
1006 =cut
1007 #'
1008 #---------------------------------------------
1009 # Create an HTML option list for a <SELECT> form tag by using
1010 #    values from a DB file
1011 sub getkeytableselectoptions {
1012         use strict;
1013         # inputs
1014         my (
1015                 $dbh,           # DBI handle
1016                                 # FIXME - Obsolete argument
1017                 $tablename,     # name of table containing list of choices
1018                 $keyfieldname,  # column name of code to use in option list
1019                 $descfieldname, # column name of descriptive field
1020                 $showkey,       # flag to show key in description
1021                 $default,       # optional default key
1022         )=@_;
1023         my $selectclause;       # return value
1024
1025         my (
1026                 $sth, $query,
1027                 $key, $desc, $orderfieldname,
1028         );
1029         my $debug=0;
1030
1031         $dbh = C4::Context->dbh;
1032
1033         if ( $showkey ) {
1034                 $orderfieldname=$keyfieldname;
1035         } else {
1036                 $orderfieldname=$descfieldname;
1037         }
1038         $query= "select $keyfieldname,$descfieldname
1039                 from $tablename
1040                 order by $orderfieldname ";
1041         print "<PRE>Query=$query </PRE>\n" if $debug;
1042         $sth=$dbh->prepare($query);
1043         $sth->execute;
1044         while ( ($key, $desc) = $sth->fetchrow) {
1045             if ($showkey || ! $desc ) { $desc="$key - $desc"; }
1046             $selectclause.="<option";
1047             if (defined $default && $default eq $key) {
1048                 $selectclause.=" selected";
1049             }
1050             $selectclause.=" value='$key'>$desc\n";
1051             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
1052         }
1053         return $selectclause;
1054 } # sub getkeytableselectoptions
1055
1056 #---------------------------------
1057
1058 END { }       # module clean-up code here (global destructor)
1059
1060 1;
1061 __END__
1062
1063 =back
1064
1065 =head1 AUTHOR
1066
1067 Koha Developement team <info@koha.org>
1068
1069 =cut