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