-package C4::Output; #asummes C4/Output
+package C4::Output;
#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
+
use strict;
require Exporter;
+use C4::Database;
+
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = 0.01;
@ISA = qw(Exporter);
-@EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink
-&startmenu &endmenu &mkheadr ¢er &endcenter &mkform &mkform2 &bold
-&gotopage &mkformnotable &mkform3);
+@EXPORT = qw(&startpage &endpage
+ &mktablehdr &mktableft &mktablerow &mklink
+ &startmenu &endmenu &mkheadr
+ ¢er &endcenter
+ &mkform &mkform2 &bold
+ &gotopage &mkformnotable &mkform3
+ &getkeytableselectoptions
+ &picktemplate);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
# your exported package globals go here,
my %configfile;
open (KC, "/etc/koha.conf");
while (<KC>) {
- chomp;
- (next) if (/^\s*#/);
- if (/(.*)\s*=\s*(.*)/) {
- my $variable=$1;
- my $value=$2;
- # Clean up white space at beginning and end
- $variable=~s/^\s*//g;
- $variable=~s/\s*$//g;
- $value=~s/^\s*//g;
- $value=~s/\s*$//g;
- $configfile{$variable}=$value;
- }
-}
+ 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");
-
-# here's a file-private function as a closure,
-# callable as &$priv_func; it cannot be prototyped.
-my $priv_func = sub {
-# stuff goes here.
- };
-
# make all your functions, whether exported or not;
-
-sub startpage{
- my $string="<html>\n";
- return($string);
+
+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;
+ } else {
+ return 'default';
+ }
+
+}
+
+sub startpage() {
+ return("<html>\n");
}
-sub gotopage{
- my ($target) = @_;
- print "<br>goto target = $target<br>";
+sub gotopage($) {
+ my ($target) = shift;
+ #print "<br>goto target = $target<br>";
my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
return $string;
}
-sub startmenu{
+sub startmenu($) {
# edit the paths in here
- my ($type)=@_;
+ my ($type)=shift;
if ($type eq 'issue') {
open (FILE,"$path/issues-top.inc") || die;
} elsif ($type eq 'opac') {
} elsif ($type eq 'member') {
open (FILE,"$path/members-top.inc") || die;
} elsif ($type eq 'acquisitions'){
- open (FILE,"$path/aquisitions-top.inc")|| die;
+ open (FILE,"$path/acquisitions-top.inc") || die;
} elsif ($type eq 'report'){
open (FILE,"$path/reports-top.inc") || die;
} elsif ($type eq 'circulation') {
}
my @string=<FILE>;
close FILE;
- my $count=@string;
- #
$string[$count]="<BLOCKQUOTE>";
+ # my $count=@string;
+ # $string[$count]="<BLOCKQUOTE>";
return @string;
}
-sub endmenu{
- my ($type)=@_;
- if ($type eq 'issue'){
+sub endmenu {
+ my ($type) = @_;
+ if ( ! defined $type ) { $type=''; }
+ if ($type eq 'issue') {
open (FILE,"$path/issues-bottom.inc") || die;
} elsif ($type eq 'opac') {
open (FILE,"$path/opac-bottom.inc") || die;
} elsif ($type eq 'member') {
open (FILE,"$path/members-bottom.inc") || die;
} elsif ($type eq 'acquisitions') {
- open (FILE,"$path/aquisitions-bottom.inc") || die;
+ open (FILE,"$path/acquisitions-bottom.inc") || die;
} elsif ($type eq 'report') {
open (FILE,"$path/reports-bottom.inc") || die;
} elsif ($type eq 'circulation') {
return @string;
}
-sub mktablehdr {
- my $string="<table border=0 cellspacing=0 cellpadding=5>\n";
- return($string);
+sub mktablehdr() {
+ return("<table border=0 cellspacing=0 cellpadding=5>\n");
}
sub mktablerow {
- #the last item in data may be a backgroundimage
+ #the last item in data may be a backgroundimage
+
+ # FIXME
+ # should this be a foreach (1..$cols) loop?
+
my ($cols,$colour,@data)=@_;
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.=" </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.=" </td>";
+ } else {
+ $string.="$data[$i]</td>";
+ }
+ $i++;
}
$string=$string."</tr>\n";
return($string);
}
-sub mktableft {
- my $string="</table>\n";
- return($string);
+sub mktableft() {
+ return("</table>\n");
}
sub mkform{
$string=$string."</form>";
}
-sub mkform3{
- my ($action,%inputs)=@_;
- my $string="<form action=$action method=post>\n";
- $string=$string.mktablehdr();
+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 $count=@keys;
- my $i2=0;
- while ( $i2<$count) {
+ my @keys = sort(keys(%inputs));
+ my @order;
+ my $count = @keys;
+ my $i2 = 0;
+ while ($i2 < $count) {
my $value=$inputs{$keys[$i2]};
my @data=split('\t',$value);
my $posn = $data[2];
}
sub mkform2{
+ # FIXME
+ # no POD and 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();
if ($reqd eq "R") {
$ltext = $ltext." (Req)";
}
- @order[$posn] =mktablerow(2,'white',$ltext,$text);
+ $order[$posn] =mktablerow(2,'white',$ltext,$text);
}
}
$string=$string.join("\n",@order);
$string=$string."</form>";
}
+=pod
-sub endpage{
- my $string="</body></html>\n";
- return($string);
+=head2 &endpage
+
+ &endpage does not expect any arguments, it returns the string:
+ </body></html>\n
+
+=cut
+
+sub endpage() {
+ return("</body></html>\n");
}
-sub mklink {
+=pod
+
+=head2 &mklink
+
+ &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.
+
+=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 2 no special ending tag
+
+=item 3 ends with <p>
+
+=back
+
+ 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.
+
+=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'){
$string="<FONT SIZE=6><em>$text</em></FONT><br>";
}
if ($type eq '2'){
- $string="<FONT SIZE=6><em>$text</em></FONT>";
+ $string="<FONT SIZE=6><em>$text</em></FONT><br>";
}
- if ($type eq '3'){
+ if ($type eq '3'){
$string="<FONT SIZE=6><em>$text</em></FONT><p>";
}
return ($string);
}
-sub center {
- my ($text)=@_;
- my $string="<CENTER>\n";
- return ($string);
+=pod
+
+=head2 ¢er and &endcenter
+
+ ¢er and &endcenter take no arguments and return html tags <CENTER> and
+ </CENTER> respectivley.
+
+=cut
+
+sub center() {
+ return ("<CENTER>\n");
}
-sub endcenter {
- my ($text)=@_;
- my $string="</CENTER>\n";
- return ($string);
+sub endcenter() {
+ return ("</CENTER>\n");
}
-sub bold {
- my ($text)=@_;
- my $string="<b>$text</b>";
- return($string);
+=pod
+
+=head2 &bold
+
+ &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.
+
+=cut
+
+sub bold($) {
+ my ($text)=shift;
+ return("<b>$text</b>");
}
+#---------------------------------------------
+# 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
+ $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;
+
+ requireDBI($dbh,"getkeytableselectoptions");
+
+ 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)
+
+
projects / koha.git / blobdiff