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