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
# 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;
require Exporter;
+use C4::Context;
use C4::Database;
-use C4::Search; #for getting the systempreferences
+use HTML::Template;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
$VERSION = 0.01;
=cut
@ISA = qw(Exporter);
-@EXPORT = qw(&startpage &endpage
+@EXPORT = qw(&startpage &endpage
&mktablehdr &mktableft &mktablerow &mklink
- &startmenu &endmenu &mkheadr
- ¢er &endcenter
+ &startmenu &endmenu &mkheadr
+ ¢er &endcenter
&mkform &mkform2 &bold
&gotopage &mkformnotable &mkform3
&getkeytableselectoptions
&pathtotemplate
- &picktemplate);
-%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
+ &themelanguage &gettemplate
+ );
-# your exported package globals go here,
-# as well as any optionally exported functions
+my $path = C4::Context->config('includes') ||
+ "/usr/local/www/hdl/htdocs/includes";
-@EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
+#---------------------------------------------------------------------------------------------------------
+# FIXME - POD
+sub gettemplate {
+ my ($tmplbase, $opac) = @_;
+ my $htdocs;
+ if ($opac ne "intranet") {
+ $htdocs = C4::Context->config('opachtdocs');
+ } else {
+ $htdocs = C4::Context->config('intrahtdocs');
+ }
-# non-exported package globals go here
-use vars qw(@more $stuff); # FIXME - These are never used
+ my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac);
-# initalize package globals, first exported ones
+ my $template = HTML::Template->new(filename => "$htdocs/$theme/$lang/$tmplbase",
+ die_on_bad_params => 0,
+ global_vars => 1,
+ path => ["$htdocs/$theme/$lang/includes"]);
-# FIXME - These are never used
-my $Var1 = '';
-my %Hashit = ();
+ # 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");
+ }
-# then the others (which are still accessible as $Some::Module::stuff)
-# FIXME - These are never used
-my $stuff = '';
-my @more = ();
+ 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) {
+ if (-e "$htdocs/$th/$la/$tmpl") {
+ $theme = $th;
+ $lang = $la;
+ last THEME;
+ }
+ }
+ }
+ if ($theme and $lang) {
+ return ($theme, $lang);
+ } else {
+ return ('default', 'en');
+ }
+}
-# all file-scoped lexicals must be created before
-# the functions below that use them.
-#
-# Change this value to reflect where you will store your includes
-#
-# FIXME - Since this is used in several places, it ought to be put
-# into a separate file. Better yet, put "use C4::Config;" inside the
-# &import method of any package that requires the config file.
-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;
-
-=item picktemplate
-
- $template = &picktemplate($includes, $base);
-
-Returns the preferred template for a given page. C<$base> is the
-basename of the script that will generate the page (with the C<.pl>
-extension stripped off), and C<$includes> is the directory in which
-HTML include files are located.
-
-The preferred template is given by the C<template> entry in the
-C<systempreferences> table in the Koha database. If
-C<$includes>F</templates/preferred-template/>C<$base.tmpl> exists,
-C<&picktemplate> returns the preferred template; otherwise, it returns
-the string C<default>.
+=item pathtotemplate
+
+ %values = &pathtotemplate(template => $template,
+ theme => $themename,
+ language => $language,
+ type => $ptype,
+ path => $includedir);
+
+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.
+
+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.
+
+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.
+
+C<path> specifies an include directory.
+
+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
#'
-sub picktemplate {
- my ($includes, $base) = @_;
- my $dbh=C4Connect;
- my $templates;
- # FIXME - Instead of generating the list of possible templates, and
- # then querying the database to see if, by chance, one of them has
- # been selected, wouldn't it be better to query the database first,
- # and then see whether the selected template file exists?
- 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;
- } else {
- return 'default';
- }
-
-}
-
+# 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 $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 %prefs= systemprefs();
- my $theme= $prefs{'theme'} || 'default';
- if ($themeor and ($prefs{'allowthemeoverride'} =~ qr/$themeor/i )) {$theme = $themeor;}
+ 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, $configfile{'templatedirectory'}) if $configfile{'templatedirectory'};
+ unshift (@tmpldirs, C4::Context->config('templatedirectory')) if C4::Context->config('templatedirectory');
unshift (@tmpldirs, $params{'path'}) if $params{'path'};
- my ($edir, $etheme, $elanguage, $epath);
+ my ($etheme, $elanguage, $epath);
- CHECK: foreach (@tmpldirs) {
- $edir= $_;
- foreach ($theme, 'all', 'default') {
- $etheme=$_;
- foreach ($language, @languageorder, 'all','en') { # 'en' is the fallback-language
- $elanguage = $_;
+ 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 {
$returns{'path'} = $epath;
- return (%returns);
+ 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;
- my %prefs = systemprefs();
-
+
if ($ENV{'HTTP_ACCEPT_LANGUAGE'}) {
- @languageorder = split (/,/ ,lc($ENV{'HTTP_ACCEPT_LANGUAGE'}));
- } elsif ($prefs{'languageorder'}) {
- @languageorder = split (/,/ ,lc($prefs{'languageorder'}));
+ @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");
}
+=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>";
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.
+=cut
+#'
sub startmenu($) {
# edit the paths in here
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;
+ 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;
# 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;
}
+=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?
$string.=" </td>";
} else {
$string.="$data[$i]</td>";
- }
+ }
$i++;
}
- $string=$string."</tr>\n";
+ $string .= "</tr>\n";
return($string);
}
+=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) {
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]\">";
}
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 @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'){
my $i=1;
while ($data[$i] ne "") {
my $val = $data[$i+1];
- $text = $text."<option value=$data[$i]>$val";
- $i = $i+2; # FIXME - Use $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);
- # FIXME - Use ".=". That's what it's for.
- $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.
}
-# XXX - POD
+=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...",
+ $fieldname =>
+ "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
...
);
print $str;
#'
sub mkform2{
# FIXME
- # no POD and no tests yet. Once tests are written,
+ # 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
# 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') {
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>";
}
-=pod
+=item endpage
-=head2 &endpage
+ $str = &endpage();
+ print $str;
- &endpage does not expect any arguments, it returns the string:
- </body></html>\n
+Returns a string of HTML, the end of an HTML document.
=cut
-
+#'
sub endpage() {
return("</body></html>\n");
}
-=pod
+=item mklink
-=head2 &mklink
+ $str = &mklink($url, $text);
+ print $str;
- &mklink expects two arguments, the url to link to and the text of the link.
- It returns this string:
- <a href="$url">$text</a>
- where $url is the first argument and $text is the second.
+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);
}
-=pod
-
-=head2 &mkheadr
-
- &mkeadr expects two strings, a type and the text to use in the header.
- types are:
-
-=over
-
-=item 1 ends with <br>
+=item mkheadr
-=item 2 no special ending tag
-
-=item 3 ends with <p>
+ $str = &mkheadr($type, $text);
+ print $str;
-=back
+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).
- Other than this, the return value is the same:
- <FONT SIZE=6><em>$text</em></FONT>$string
- Where $test is the text passed in and $string is the tag generated from
- the type value.
+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
$string="<FONT SIZE=6><em>$text</em></FONT><br>";
}
if ($type eq '2'){
- $string="<FONT SIZE=6><em>$text</em></FONT><br>";
+ $string="<FONT SIZE=6><em>$text</em></FONT>";
}
if ($type eq '3'){
$string="<FONT SIZE=6><em>$text</em></FONT><p>";
return ($string);
}
-=pod
+=item center and endcenter
-=head2 ¢er and &endcenter
+ print ¢er(), "This is a line of centered text.", &endcenter();
- ¢er and &endcenter take no arguments and return html tags <CENTER> and
- </CENTER> respectivley.
+C<¢er> and C<&endcenter> take no arguments and return HTML tags
+<CENTER> and </CENTER> respectively.
=cut
-
+#'
sub center() {
return ("<CENTER>\n");
-}
+}
sub endcenter() {
return ("</CENTER>\n");
-}
+}
-=pod
+=item bold
-=head2 &bold
+ $str = &bold($text);
+ print $str;
- &bold requires that a single string be passed in by the caller. &bold
- will return "<b>$text</b>" where $text is the string passed in.
+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
# 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
my $selectclause; # return value
my (
- $sth, $query,
+ $sth, $query,
$key, $desc, $orderfieldname,
);
my $debug=0;
- requireDBI($dbh,"getkeytableselectoptions");
+ $dbh = C4::Context->dbh;
if ( $showkey ) {
$orderfieldname=$keyfieldname;
$query= "select $keyfieldname,$descfieldname
from $tablename
order by $orderfieldname ";
- print "<PRE>Query=$query </PRE>\n" if $debug;
+ print "<PRE>Query=$query </PRE>\n" if $debug;
$sth=$dbh->prepare($query);
$sth->execute;
while ( ($key, $desc) = $sth->fetchrow) {
$selectclause.=" selected";
}
$selectclause.=" value='$key'>$desc\n";
- print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
+ print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
}
return $selectclause;
} # sub getkeytableselectoptions
1;
__END__
+
=back
-=head1 SEE ALSO
+=head1 AUTHOR
-L<DBI(3)|DBI>
+Koha Developement team <info@koha.org>
=cut
projects / koha.git / blobdiff