X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FOutput.pm;h=4f308c7604e46739a2131d26c049316963cc3eef;hb=a2f1bf834f4d758a991266b577b85ed232218e0d;hp=3af786b3274e2e92e45347b8532d04c1750b1d30;hpb=cefb0bb2c1a48145f2829a052154075110cce770;p=koha.git

diff --git a/C4/Output.pm b/C4/Output.pm
index 3af786b327..4f308c7604 100644
--- a/C4/Output.pm
+++ b/C4/Output.pm
@@ -1,170 +1,465 @@
-package C4::Output; #asummes C4/Output
+package C4::Output;
+
+# $Id$
 
 #package to deal with marking up output
 #You will need to edit parts of this pm
 #set the value of path to be where your html lives
 
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA  02111-1307 USA
+
+# NOTE: I'm pretty sure this module is deprecated in favor of
+# templates.
+
 use strict;
-use warnings;
-use C4::Database;
 require Exporter;
 
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use C4::Context;
+use C4::Database;
+use HTML::Template;
+
+use vars qw($VERSION @ISA @EXPORT);
 
 # set the version for version checking
 $VERSION = 0.01;
 
+=head1 NAME
+
+C4::Output - Functions for generating HTML for the Koha web interface
+
+=head1 SYNOPSIS
+
+  use C4::Output;
+
+  $str = &mklink("http://www.koha.org/", "Koha web page");
+  print $str;
+
+=head1 DESCRIPTION
+
+The functions in this module generate HTML, and return the result as a
+printable string.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
 @ISA = qw(Exporter);
-@EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink
-&startmenu &endmenu &mkheadr &center &endcenter &mkform &mkform2 &bold
-&gotopage &mkformnotable &mkform3 picktemplate);
-%EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
+@EXPORT = qw(&startpage &endpage
+	     &mktablehdr &mktableft &mktablerow &mklink
+	     &startmenu &endmenu &mkheadr
+	     &center &endcenter
+	     &mkform &mkform2 &bold
+	     &gotopage &mkformnotable &mkform3
+	     &getkeytableselectoptions
+	     &pathtotemplate
+		&themelanguage &gettemplate
+	     );
+
+#FIXME: this is a quick fix to stop rc1 installing broken
+#Still trying to figure out the correct fix.
+my $path = C4::Context->config('intrahtdocs')."/default/en/includes/";
+
+#---------------------------------------------------------------------------------------------------------
+# FIXME - POD
+sub gettemplate {
+	my ($tmplbase, $opac) = @_;
+
+	my $htdocs;
+	if ($opac ne "intranet") {
+		$htdocs = C4::Context->config('opachtdocs');
+	} else {
+		$htdocs = C4::Context->config('intrahtdocs');
+	}
+
+	my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac);
+
+	my $template = HTML::Template->new(filename      => "$htdocs/$theme/$lang/$tmplbase",
+				   die_on_bad_params => 0,
+				   global_vars       => 1,
+				   path              => ["$htdocs/$theme/$lang/includes"]);
 
-# your exported package globals go here,
-# as well as any optionally exported functions
+	# XXX temporary patch for Bug 182 for themelang
+	$template->param(themelang => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl') . "/$theme/$lang",
+							interface => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl'),
+							theme => $theme,
+							lang => $lang);
+	return $template;
+}
+
+#---------------------------------------------------------------------------------------------------------
+# FIXME - POD
+sub themelanguage {
+  my ($htdocs, $tmpl, $section) = @_;
+
+  my $dbh = C4::Context->dbh;
+  my @languages;
+  my @themes;
+  if ( $section eq "intranet")
+  {
+    @languages = split " ", C4::Context->preference("opaclanguages");
+    @themes = split " ", C4::Context->preference("template");
+  }
+  else
+  {
+    @languages = split " ", C4::Context->preference("opaclanguages");
+    @themes = split " ", C4::Context->preference("opacthemes");
+  }
+
+  my ($theme, $lang);
+# searches through the themes and languages. First template it find it returns.
+# Priority is for getting the theme right.
+  THEME:
+  foreach my $th (@themes) {
+    foreach my $la (@languages) {
+	for (my $pass = 1; $pass <= 2; $pass += 1) {
+	  $la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
+	  if (-e "$htdocs/$th/$la/$tmpl") {
+	      $theme = $th;
+	      $lang = $la;
+	      last THEME;
+	  }
+	last unless $la =~ /[-_]/;
+	}
+    }
+  }
+  if ($theme and $lang) {
+    return ($theme, $lang);
+  } else {
+    return ('default', 'en');
+  }
+}
 
-@EXPORT_OK   = qw($Var1 %Hashit);
 
+=item pathtotemplate
 
-# non-exported package globals go here
-use vars qw(@more $stuff);
+  %values = &pathtotemplate(template => $template,
+	theme => $themename,
+	language => $language,
+	type => $ptype,
+	path => $includedir);
 
-# initalize package globals, first exported ones
+Finds a directory containing the desired template. The C<template>
+argument specifies the template you're looking for (this should be the
+name of the script you're using to generate an HTML page, without the
+C<.pl> extension). Only the C<template> argument is required; the
+others are optional.
 
-my $Var1   = '';
-my %Hashit = ();
+C<theme> specifies the name of the theme to use. This will be used
+only if it is allowed by the C<allowthemeoverride> system preference
+option (in the C<systempreferences> table of the Koha database).
 
+C<language> specifies the desired language. If not specified,
+C<&pathtotemplate> will use the list of acceptable languages specified
+by the browser, then C<all>, and finally C<en> as fallback options.
 
-# then the others (which are still accessible as $Some::Module::stuff)
-my $stuff  = '';
-my @more   = ();
+C<type> may be C<intranet>, C<opac>, C<none>, or some other value.
+C<intranet> and C<opac> specify that you want a template for the
+internal web site or the public OPAC, respectively. C<none> specifies
+that the template you're looking for is at the top level of one of the
+include directories. Any other value is taken as-is, as a subdirectory
+of one of the include directories.
 
-# all file-scoped lexicals must be created before
-# the functions below that use them.
+C<path> specifies an include directory.
 
-#
-# Change this value to reflect where you will store your includes
-#
-my %configfile;
-open (KC, "/etc/koha.conf");
-while (<KC>) {
-    chomp;
-    (next) if (/^\s*#/);
-    if (/(.*)\s*=\s*(.*)/) {
-        my $variable=$1;
-        my $value=$2;
-
-        $variable =~ s/^\s*//g;
-        $variable =~ s/\s*$//g;
-        $value    =~ s/^\s*//g;
-        $value    =~ s/\s*$//g;
-        $configfile{$variable}=$value;
-    } # if
-} # while
-close(KC);
-
-my $path=$configfile{'includes'};
-($path) || ($path="/usr/local/www/hdl/htdocs/includes");
-
-# make all your functions, whether exported or not;
-
-sub picktemplate {
-  my ($includes, $base) = @_;
-  my $dbh=C4Connect;
-  my $templates;
-  opendir (D, "$includes/templates");
-  my @dirlist=readdir D;
-  foreach (@dirlist) {
-    (next) if (/^\./);
-    #(next) unless (/\.tmpl$/);
-    (next) unless (-e "$includes/templates/$_/$base");
-    $templates->{$_}=1;
-  }							    
-  my $sth=$dbh->prepare("select value from systempreferences where
-  variable='template'");
-  $sth->execute;
-  my ($preftemplate) = $sth->fetchrow;
-  $sth->finish;
-  $dbh->disconnect;
-  if ($templates->{$preftemplate}) {
-    return $preftemplate;
+C<&pathtotemplate> searches first in the directory given by the
+C<path> argument, if any, then in the directories given by the
+C<templatedirectory> and C<includes> directives in F</etc/koha.conf>,
+in that order.
+
+C<&pathtotemplate> returns a hash with the following keys:
+
+=over 4
+
+=item C<path>
+
+The full pathname to the desired template.
+
+=item C<foundlanguage>
+
+The value is set to 1 if a template in the desired language was found,
+or 0 otherwise.
+
+=item C<foundtheme>
+
+The value is set to 1 if a template of the desired theme was found, or
+0 otherwise.
+
+=back
+
+If C<&pathtotemplate> cannot find an acceptable template, it returns 0.
+
+Note that if a template of the desired language or theme cannot be
+found, C<&pathtotemplate> will print a warning message. Unless you've
+set C<$SIG{__WARN__}>, though, this won't show up in the output HTML
+document.
+
+=cut
+#'
+# FIXME - Fix POD: it doesn't look in the directory given by the
+# 'includes' option in /etc/koha.conf.
+sub pathtotemplate {
+  my %params = @_;
+  my $template = $params{'template'};
+  my $themeor = $params{'theme'};
+  my $languageor = lc($params{'language'});
+  my $ptype = lc($params{'type'} or 'intranet');
+
+  # FIXME - Make sure $params{'template'} was given. Or else assume
+  # "default".
+  my $type;
+  if ($ptype eq 'opac') {$type = 'opac-tmpl/'; }
+  elsif ($ptype eq 'none') {$type = ''; }
+  elsif ($ptype eq 'intranet') {$type = 'intranet-tmpl/'; }
+  else {$type = $ptype . '/'; }
+
+  my %returns;
+  my $theme = C4::Context->preference("theme") || "default";
+  if ($themeor and
+      C4::Context->preference("allowthemeoverride") =~ qr/$themeor/i)
+  {
+    $theme = $themeor;
+  }
+  my @languageorder = getlanguageorder();
+  my $language = $languageor || shift(@languageorder);
+
+  #where to search for templates
+  my @tmpldirs = ("$path/templates", $path);
+  unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
+  unshift (@tmpldirs, $params{'path'}) if $params{'path'};
+
+  my ($etheme, $elanguage, $epath);
+
+  CHECK: foreach my $edir (@tmpldirs) {
+    foreach $etheme ($theme, 'all', 'default') {
+      foreach $elanguage ($language, @languageorder, 'all','en') {
+				# 'en' is the fallback-language
+      	if (-e "$edir/$type$etheme/$elanguage/$template") {
+      	  $epath = "$edir/$type$etheme/$elanguage/$template";
+      	  last CHECK;
+      	}
+      }
+    }
+  }
+
+  unless ($epath) {
+    warn "Could not find $template in @tmpldirs";
+    return 0;
+  }
+
+  if ($language eq $elanguage) {
+    $returns{'foundlanguage'} = 1;
   } else {
-    return 'default';
+    $returns{'foundlanguage'} = 0;
+    warn "The language $language could not be found for $template of $theme.\nServing $elanguage instead.\n";
   }
-  
+  if ($theme eq $etheme) {
+    $returns{'foundtheme'} = 1;
+  } else {
+    $returns{'foundtheme'} = 0;
+    warn "The template $template could not be found for theme $theme.\nServing $template of $etheme instead.\n";
+  }
+
+  $returns{'path'} = $epath;
+
+  return (%returns);
 }
-				    
 
+=item getlanguageorder
+
+  @languages = &getlanguageorder();
+
+Returns the list of languages that the user will accept, and returns
+them in order of decreasing preference. This is retrieved from the
+browser's headers, if possible; otherwise, C<&getlanguageorder> uses
+the C<languageorder> setting from the C<systempreferences> table in
+the Koha database. If neither is set, it defaults to C<en> (English).
+
+=cut
+#'
+sub getlanguageorder () {
+  my @languageorder;
 
-sub startpage{
+  if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
+    @languageorder = split (/\s*,\s*/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
+  } elsif (my $order = C4::Context->preference("languageorder")) {
+    @languageorder = split (/\s*,\s*/ ,lc($order));
+  } else { # here should be another elsif checking for apache's languageorder
+    @languageorder = ('en');
+  }
+
+  return (@languageorder);
+}
+
+=item startpage
+
+  $str = &startpage();
+  print $str;
+
+Returns a string of HTML, the beginning of a new HTML document.
+
+=cut
+#'
+sub startpage() {
   return("<html>\n");
 }
 
-sub gotopage{
-  my ($target) = @_;
-  print "<br>goto target = $target<br>";
+=item gotopage
+
+  $str = &gotopage("//opac.koha.org/index.html");
+  print $str;
+
+Generates a snippet of HTML code that will redirect to the given URL
+(which should not include the initial C<http:>), and returns it.
+
+=cut
+#'
+sub gotopage($) {
+  my ($target) = shift;
+  #print "<br>goto target = $target<br>";
   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
   return $string;
 }
 
+=item startmenu
+
+  @lines = &startmenu($type);
+  print join("", @lines);
+
+Given a page type, or category, returns a set of lines of HTML which,
+when concatenated, generate the menu at the top of the web page.
+
+C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
+C<report>, C<circulation>, or something else, in which case the menu
+will be for the catalog pages.
 
-sub startmenu{
+=cut
+#'
+sub startmenu($) {
   # edit the paths in here
-  my ($type)=@_;
+  my ($type)=shift;
   if ($type eq 'issue') {
-    open (FILE,"$path/issues-top.inc") || die;
+    open (FILE,"$path/issues-top.inc") || die "could not find : $path/issues-top.inc";
   } elsif ($type eq 'opac') {
-    open (FILE,"$path/opac-top.inc") || die;
+    open (FILE,"$path/opac-top.inc") || die "could not find : $path/opac-top.inc";
   } elsif ($type eq 'member') {
-    open (FILE,"$path/members-top.inc") || die;
+    open (FILE,"$path/members-top.inc") || die "could not find : $path/members-top.inc";
   } elsif ($type eq 'acquisitions'){
-    open (FILE,"$path/acquisitions-top.inc")
-      || die "Cannot open $path/acquisitions-top.inc";
+    open (FILE,"$path/acquisitions-top.inc") || die "could not find : $path/acquisition-top.inc";
   } elsif ($type eq 'report'){
-    open (FILE,"$path/reports-top.inc") || die;
+    open (FILE,"$path/reports-top.inc") || die "could not find : $path/reports-top.inc";
   } elsif ($type eq 'circulation') {
-    open (FILE,"$path/circulation-top.inc") || die;
+    open (FILE,"$path/circulation-top.inc") || die "could not find : $path/circulation-top.inc";
+  } elsif ($type eq 'admin') {
+    open (FILE,"$path/parameters-top.inc") || die "could not find : $path/parameters-top.inc";
   } else {
-    open (FILE,"$path/cat-top.inc") || die;
+    open (FILE,"$path/cat-top.inc") || die "could not find : $path/cat-top.inc";
   }
   my @string=<FILE>;
   close FILE;
-  my $count=@string;
-  #  $string[$count]="<BLOCKQUOTE>";
+  # my $count=@string;
+  # $string[$count]="<BLOCKQUOTE>";
   return @string;
 }
 
+=item endmenu
+
+  @lines = &endmenu($type);
+  print join("", @lines);
+
+Given a page type, or category, returns a set of lines of HTML which,
+when concatenated, generate the menu at the bottom of the web page.
+
+C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
+C<report>, C<circulation>, or something else, in which case the menu
+will be for the catalog pages.
 
+=cut
+#'
 sub endmenu {
   my ($type) = @_;
+  if ( ! defined $type ) { $type=''; }
+  # FIXME - It's bad form to die in a CGI script. It's even worse form
+  # to die without issuing an error message.
   if ($type eq 'issue') {
-    open (FILE,"$path/issues-bottom.inc") || die;
+    open (FILE,"<$path/issues-bottom.inc") || die;
   } elsif ($type eq 'opac') {
-    open (FILE,"$path/opac-bottom.inc") || die;
+    open (FILE,"<$path/opac-bottom.inc") || die;
   } elsif ($type eq 'member') {
-    open (FILE,"$path/members-bottom.inc") || die;
+    open (FILE,"<$path/members-bottom.inc") || die;
   } elsif ($type eq 'acquisitions') {
-    open (FILE,"$path/acquisitions-bottom.inc") || die;
+    open (FILE,"<$path/acquisitions-bottom.inc") || die;
   } elsif ($type eq 'report') {
-    open (FILE,"$path/reports-bottom.inc") || die;
+    open (FILE,"<$path/reports-bottom.inc") || die;
   } elsif ($type eq 'circulation') {
-    open (FILE,"$path/circulation-bottom.inc") || die;
+    open (FILE,"<$path/circulation-bottom.inc") || die;
+  } elsif ($type eq 'admin') {
+    open (FILE,"<$path/parameters-bottom.inc") || die;
   } else {
-    open (FILE,"$path/cat-bottom.inc") || die;
+    open (FILE,"<$path/cat-bottom.inc") || die;
   }
   my @string=<FILE>;
   close FILE;
   return @string;
 }
 
-sub mktablehdr {
+=item mktablehdr
+
+  $str = &mktablehdr();
+  print $str;
+
+Returns a string of HTML, which generates the beginning of a table
+declaration.
+
+=cut
+#'
+sub mktablehdr() {
     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 }
 
+=item mktablerow
+
+  $str = &mktablerow($columns, $color, @column_data, $bgimage);
+  print $str;
+
+Returns a string of HTML, which generates a row of data inside a table
+(see also C<&mktablehdr>, C<&mktableft>).
+
+C<$columns> specifies the number of columns in this row of data.
+
+C<$color> specifies the background color for the row, e.g., C<"white">
+or C<"#ffacac">.
 
+C<@column_data> is an array of C<$columns> elements, each one a string
+of HTML. These are the contents of the row.
+
+The optional C<$bgimage> argument specifies the pathname to an image
+to use as the background for each cell in the row. This pathname will
+used as is in the output, so it should be relative to the HTTP
+document root.
+
+=cut
+#'
 sub mktablerow {
     #the last item in data may be a backgroundimage
-    
+
     # FIXME
     # should this be a foreach (1..$cols) loop?
 
@@ -172,34 +467,45 @@ sub mktablerow {
   my $i=0;
   my $string="<tr valign=top bgcolor=$colour>";
   while ($i <$cols){
-    if ($data[$cols] ne ''){
-    #check for backgroundimage
-      $string.="<td background=\"$data[$cols]\">";
-    } else {
-      $string.="<td>";
-    }
-    if ($data[$i] eq "") {
-      $string.=" &nbsp; </td>";
-    } else {
-      $string.="$data[$i]</td>";
-    } 
-    $i++;
+      if (defined $data[$cols]) { # if there is a background image
+	  $string.="<td background=\"$data[$cols]\">";
+      } else { # if there's no background image
+	  $string.="<td>";
+      }
+      if (! defined $data[$i]) {$data[$i]="";}
+      if ($data[$i] eq "") {
+	  $string.=" &nbsp; </td>";
+      } else {
+	  $string.="$data[$i]</td>";
+      }
+      $i++;
   }
-  $string=$string."</tr>\n";
+  $string .= "</tr>\n";
   return($string);
 }
 
-sub mktableft {
+=item mktableft
+
+  $str = &mktableft();
+  print $str;
+
+Returns a string of HTML, which generates the end of a table
+declaration.
+
+=cut
+#'
+sub mktableft() {
   return("</table>\n");
 }
 
+# FIXME - This is never used.
 sub mkform{
   my ($action,%inputs)=@_;
   my $string="<form action=$action method=post>\n";
-  $string=$string.mktablehdr();
+  $string .= mktablehdr();
   my $key;
   my @keys=sort keys %inputs;
-  
+
   my $count=@keys;
   my $i2=0;
   while ( $i2<$count) {
@@ -207,13 +513,13 @@ sub mkform{
     my @data=split('\t',$value);
     #my $posn = shift(@data);
     if ($data[0] eq 'hidden'){
-      $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
+      $string .= "<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
     } else {
       my $text;
       if ($data[0] eq 'radio') {
         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 	<input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
-      } 
+      }
       if ($data[0] eq 'text') {
         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
       }
@@ -225,33 +531,103 @@ sub mkform{
 	my $i=1;
        	while ($data[$i] ne "") {
 	  my $val = $data[$i+1];
-      	  $text = $text."<option value=$data[$i]>$val";
-	  $i = $i+2;
+      	  $text .= "<option value=$data[$i]>$val";
+      	  $i += 2;
 	}
-	$text=$text."</select>";
-      }	
-      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
+	$text .= "</select>";
+      }
+      $string .= mktablerow(2,'white',$keys[$i2],$text);
       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
     }
     $i2++;
   }
   #$string=$string.join("\n",@order);
-  $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
-  $string=$string.mktableft;
-  $string=$string."</form>";
+  $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
+  $string .= mktableft;
+  $string .= "</form>";
 }
 
+=item mkform3
+
+  $str = &mkform3($action,
+	$fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
+	...
+	);
+  print $str;
+
+Takes a set of arguments that define an input form, generates an HTML
+string for the form, and returns the string.
+
+C<$action> is the action for the form, usually the URL of the script
+that will process it.
+
+The remaining arguments define the fields in the form. C<$fieldname>
+is the field's name. This is for the script's benefit, and will not be
+shown to the user.
+
+C<$fieldpos> is an integer; fields will be output in order of
+increasing C<$fieldpos>. This number must be unique: if two fields
+have the same C<$fieldpos>, one will be picked at random, and the
+other will be ignored. See below for special considerations, however.
+
+C<$fieldtype> specifies the type of the input field. It may be one of
+the following:
+
+=over 4
+
+=item C<hidden>
+
+Generates a hidden field, used to pass data to the script without
+showing it to the user. C<$fieldvalue> is the value.
+
+=item C<radio>
+
+Generates a pair of radio buttons, with values C<$fieldvalue> and
+C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
+shown to the user.
+
+=item C<text>
+
+Generates a one-line text input field. It initially contains
+C<$fieldvalue>.
+
+=item C<textarea>
+
+Generates a four-line text input area. The initial text (which, of
+course, may not contain any tabs) is C<$fieldvalue>.
+
+=item C<select>
+
+Generates a list of items, from which the user may choose one. This is
+somewhat different from other input field types, and should be
+specified as:
+  "myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
+where the C<text>N strings are the choices that will be presented to
+the user, and C<label>N are the labels that will be passed to the
+script.
+
+However, C<text0> should be an integer, since it will be used to
+determine the order in which this field appears in the form. If any of
+the C<label>Ns are empty, the rest of the list will be ignored.
+
+=back
+
+=cut
+#'
 sub mkform3 {
   my ($action, %inputs) = @_;
   my $string = "<form action=\"$action\" method=\"post\">\n";
   $string   .= mktablehdr();
   my $key;
-  my @keys = sort(keys(%inputs));
-  my @order;  
+  my @keys = sort(keys(%inputs));	# FIXME - Why do these need to be
+					# sorted?
+  my @order;
   my $count = @keys;
   my $i2 = 0;
   while ($i2 < $count) {
     my $value=$inputs{$keys[$i2]};
+    # FIXME - Why use a tab-separated string? Why not just use an
+    # anonymous array?
     my @data=split('\t',$value);
     my $posn = $data[2];
     if ($data[0] eq 'hidden'){
@@ -261,10 +637,12 @@ sub mkform3 {
       if ($data[0] eq 'radio') {
         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 	<input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
-      } 
+      }
+      # FIXME - Is 40 the right size in all cases?
       if ($data[0] eq 'text') {
         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
       }
+      # FIXME - Is 40x4 the right size in all cases?
       if ($data[0] eq 'textarea') {
         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
       }
@@ -273,63 +651,206 @@ sub mkform3 {
 	my $i=1;
        	while ($data[$i] ne "") {
 	  my $val = $data[$i+1];
-      	  $text = $text."<option value=$data[$i]>$val";
-	  $i = $i+2;
+      	  $text .= "<option value=$data[$i]>$val";
+      	  $i += 2;
 	}
-	$text=$text."</select>";
-      }	
+	$text .= "</select>";
+      }
 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
     }
     $i2++;
   }
   my $temp=join("\n",@order);
-  $string=$string.$temp;
-  $string=$string.mktablerow(1,'white','<input type=submit>');
-  $string=$string.mktableft;
-  $string=$string."</form>";
+  $string .= $temp;
+  $string .= mktablerow(1,'white','<input type=submit>');
+  $string .= mktableft;
+  $string .= "</form>";
+  # FIXME - A return statement, while not strictly necessary, would be nice.
 }
 
+=item mkformnotable
+
+  $str = &mkformnotable($action, @inputs);
+  print $str;
+
+Takes a set of arguments that define an input form, generates an HTML
+string for the form, and returns the string. Unlike C<&mkform2> and
+C<&mkform3>, it does not put the form inside a table.
+
+C<$action> is the action for the form, usually the URL of the script
+that will process it.
+
+The remaining arguments define the fields in the form. Each is an
+anonymous array, e.g.:
+
+  &mkformnotable("/cgi-bin/foo",
+	[ "hidden", "hiddenvar", "value" ],
+	[ "text", "username", "" ]);
+
+The first element of each argument defines its type. The remaining
+ones are type-dependent. The supported types are:
+
+=over 4
+
+=item C<[ "hidden", $name, $value]>
+
+Generates a hidden field, for passing information to a script without
+showing it to the user. C<$name> is the name of the field, and
+C<$value> is the value to pass.
+
+=item C<[ "radio", $groupname, $value ]>
+
+Generates a radio button. Its name (or button group name) is C<$name>.
+C<$value> is the value associated with the button; this is both the
+value that will be shown to the user, and that which will be passed on
+to the C<$action> script.
+
+=item C<[ "text", $name, $inittext ]>
+
+Generates a text input field. C<$name> specifies its name, and
+C<$inittext> specifies the text that the field should initially
+contain.
+
+=item C<[ "textarea", $name ]>
+
+Creates a 40x4 text area, named C<$name>.
+
+=item C<[ "reset", $name, $label ]>
+
+Generates a reset button, with name C<$name>. C<$label> specifies the
+text for the button.
+
+=item C<[ "submit", $name, $label ]>
+
+Generates a submit button, with name C<$name>. C<$label> specifies the
+text for the button.
+
+=back
+
+=cut
+#'
 sub mkformnotable{
   my ($action,@inputs)=@_;
   my $string="<form action=$action method=post>\n";
   my $count=@inputs;
   for (my $i=0; $i<$count; $i++){
     if ($inputs[$i][0] eq 'hidden'){
-      $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
+      $string .= "<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
     }
     if ($inputs[$i][0] eq 'radio') {
-      $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
-    } 
+      $string .= "<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
+    }
     if ($inputs[$i][0] eq 'text') {
-      $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
+      $string .= "<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
     }
     if ($inputs[$i][0] eq 'textarea') {
-        $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
+        $string .= "<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
     }
     if ($inputs[$i][0] eq 'reset'){
-      $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
-    }    
+      $string .= "<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
+    }
     if ($inputs[$i][0] eq 'submit'){
-      $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
-    }    
+      $string .= "<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
+    }
   }
-  $string=$string."</form>";
+  $string .= "</form>";
 }
 
+=item mkform2
+
+  $str = &mkform2($action,
+	$fieldname =>
+	  "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
+	...
+	);
+  print $str;
+
+Takes a set of arguments that define an input form, generates an HTML
+string for the form, and returns the string.
+
+C<$action> is the action for the form, usually the URL of the script
+that will process it.
+
+The remaining arguments define the fields in the form. C<$fieldname>
+is the field's name. This is for the script's benefit, and will not be
+shown to the user.
+
+C<$fieldpos> is an integer; fields will be output in order of
+increasing C<$fieldpos>. This number must be unique: if two fields
+have the same C<$fieldpos>, one will be picked at random, and the
+other will be ignored. See below for special considerations, however.
+
+If C<$required> is the string C<R>, then the field is required, and
+the label will have C< (Req.)> appended.
+
+C<$label> is a string that will appear next to the input field.
+
+C<$fieldtype> specifies the type of the input field. It may be one of
+the following:
+
+=over 4
+
+=item C<hidden>
+
+Generates a hidden field, used to pass data to the script without
+showing it to the user. C<$value0> is its value.
+
+=item C<radio>
+
+Generates a pair of radio buttons, with values C<$value0> and
+C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
+the user, next to the radio button.
+
+=item C<text>
+
+Generates a one-line text input field. Its size may be specified by
+C<$value0>. The default is 40. The initial text of the field may be
+specified by C<$value1>.
+
+=item C<textarea>
+
+Generates a text input area. C<$value0> may be a string of the form
+"WWWxHHH", in which case the text input area will be WWW columns wide
+and HHH rows tall. The size defaults to 40x4.
+
+The initial text (which, of course, may not contain any tabs) may be
+specified by C<$value1>.
+
+=item C<select>
+
+Generates a list of items, from which the user may choose one. Here,
+C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
+pair, the key specifies an internal label for a choice, and the value
+specifies the description of the choice that will be shown the user.
+
+If C<$value0> is the same as one of the keys that follows, then the
+corresponding choice will initially be selected.
+
+=back
+
+=cut
+#'
 sub mkform2{
+    # FIXME
+    # No tests yet.  Once tests are written,
+    # this function can be cleaned up with the following steps:
+    #  turn the while loop into a foreach loop
+    #  pull the nested if,elsif structure back up to the main level
+    #  pull the code for the different kinds of inputs into separate
+    #   functions
   my ($action,%inputs)=@_;
   my $string="<form action=$action method=post>\n";
-  $string=$string.mktablehdr();
+  $string .= mktablehdr();
   my $key;
   my @order;
   while ( my ($key, $value) = each %inputs) {
     my @data=split('\t',$value);
     my $posn = shift(@data);
     my $reqd = shift(@data);
-    my $ltext = shift(@data);    
+    my $ltext = shift(@data);
     if ($data[0] eq 'hidden'){
-      $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
+      $string .= "<input type=hidden name=$key value=\"$data[1]\">\n";
     } else {
       my $text;
       if ($data[0] eq 'radio') {
@@ -354,39 +875,75 @@ sub mkform2{
 	my $i=2;
        	while ($data[$i] ne "") {
 	  my $val = $data[$i+1];
-       	  $text = $text."<option value=\"$data[$i]\"";
+       	  $text .= "<option value=\"$data[$i]\"";
 	  if ($data[$i] eq $sel) {
-	     $text = $text." selected";
-	  }   
-          $text = $text.">$val";
-	  $i = $i+2;
+	     $text .= " selected";
+	  }
+          $text .= ">$val";
+          $i += 2;
 	}
-	$text=$text."</select>";
+	$text .= "</select>";
       }
       if ($reqd eq "R") {
-        $ltext = $ltext." (Req)";
+        $ltext .= " (Req)";
 	}
       $order[$posn] =mktablerow(2,'white',$ltext,$text);
     }
   }
-  $string=$string.join("\n",@order);
-  $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
-  $string=$string.mktableft;
-  $string=$string."</form>";
+  $string .= join("\n",@order);
+  $string .= mktablerow(2,'white','<input type=submit>','<input type=reset>');
+  $string .= mktableft;
+  $string .= "</form>";
 }
 
+=item endpage
 
-sub endpage{
+  $str = &endpage();
+  print $str;
+
+Returns a string of HTML, the end of an HTML document.
+
+=cut
+#'
+sub endpage() {
   return("</body></html>\n");
 }
 
-sub mklink {
+=item mklink
+
+  $str = &mklink($url, $text);
+  print $str;
+
+Returns an HTML string, where C<$text> is a link to C<$url>.
+
+=cut
+#'
+sub mklink($$) {
   my ($url,$text)=@_;
   my $string="<a href=\"$url\">$text</a>";
   return ($string);
 }
 
+=item mkheadr
+
+  $str = &mkheadr($type, $text);
+  print $str;
+
+Takes a header type and header text, and returns a string of HTML,
+where C<$text> is rendered with emphasis in a large font size (not an
+actual HTML header).
+
+C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
+Type 2 has no special tag at the end; Type 3 ends with a paragraph
+break.
+
+=cut
+#'
 sub mkheadr {
+    # FIXME
+    # would it be better to make this more generic by accepting an optional
+    # argument with a closing tag instead of a numeric type?
+
   my ($type,$text)=@_;
   my $string;
   if ($type eq '1'){
@@ -395,30 +952,131 @@ sub mkheadr {
   if ($type eq '2'){
     $string="<FONT SIZE=6><em>$text</em></FONT>";
   }
-    if ($type eq '3'){
+  if ($type eq '3'){
     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
   }
   return ($string);
 }
 
-sub center {
+=item center and endcenter
+
+  print &center(), "This is a line of centered text.", &endcenter();
+
+C<&center> and C<&endcenter> take no arguments and return HTML tags
+<CENTER> and </CENTER> respectively.
+
+=cut
+#'
+sub center() {
   return ("<CENTER>\n");
-}  
+}
 
-sub endcenter {
+sub endcenter() {
   return ("</CENTER>\n");
-}  
+}
 
-sub bold {
-  my ($text)=@_;
-  my $string="<b>$text</b>";
-  return($string);
+=item bold
+
+  $str = &bold($text);
+  print $str;
+
+Returns a string of HTML that renders C<$text> in bold.
+
+=cut
+#'
+sub bold($) {
+  my ($text)=shift;
+  return("<b>$text</b>");
 }
 
+=item getkeytableselectoptions
+
+  $str = &getkeytableselectoptions($dbh, $tablename,
+	$keyfieldname, $descfieldname,
+	$showkey, $default);
+  print $str;
+
+Builds an HTML selection box from a database table. Returns a string
+of HTML that implements this.
+
+C<$dbh> is a DBI::db database handle.
 
+C<$tablename> is the database table in which to look up the possible
+values for the selection box.
 
+C<$keyfieldname> is field in C<$tablename>. It will be used as the
+internal label for the selection.
+
+C<$descfieldname> is a field in C<$tablename>. It will be used as the
+option shown to the user.
+
+If C<$showkey> is true, then both the key and value will be shown to
+the user.
+
+If the C<$default> argument is given, then if a value (from
+C<$keyfieldname>) matches C<$default>, it will be selected by default.
+
+=cut
+#'
+#---------------------------------------------
+# Create an HTML option list for a <SELECT> form tag by using
+#    values from a DB file
+sub getkeytableselectoptions {
+	use strict;
+	# inputs
+	my (
+		$dbh,		# DBI handle
+				# FIXME - Obsolete argument
+		$tablename,	# name of table containing list of choices
+		$keyfieldname,	# column name of code to use in option list
+		$descfieldname,	# column name of descriptive field
+		$showkey,	# flag to show key in description
+		$default,	# optional default key
+	)=@_;
+	my $selectclause;	# return value
+
+	my (
+		$sth, $query,
+		$key, $desc, $orderfieldname,
+	);
+	my $debug=0;
+
+    	$dbh = C4::Context->dbh;
+
+	if ( $showkey ) {
+		$orderfieldname=$keyfieldname;
+	} else {
+		$orderfieldname=$descfieldname;
+	}
+	$query= "select $keyfieldname,$descfieldname
+		from $tablename
+		order by $orderfieldname ";
+	print "<PRE>Query=$query </PRE>\n" if $debug;
+	$sth=$dbh->prepare($query);
+	$sth->execute;
+	while ( ($key, $desc) = $sth->fetchrow) {
+	    if ($showkey || ! $desc ) { $desc="$key - $desc"; }
+	    $selectclause.="<option";
+	    if (defined $default && $default eq $key) {
+		$selectclause.=" selected";
+	    }
+	    $selectclause.=" value='$key'>$desc\n";
+	    print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
+	}
+	return $selectclause;
+} # sub getkeytableselectoptions
+
+#---------------------------------
 
 END { }       # module clean-up code here (global destructor)
-    
 
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <info@koha.org>
 
+=cut