C4/Output.pm

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