9fb81afb85
Database.pm and Output.pm are almost not modified (var test...) Biblio.pm is almost completly rewritten. WHAT DOES IT ??? ==> END of Hitchcock suspens 1st, it does... nothing... Every old API should be there. So if MARC-stuff is not done, the behaviour is EXACTLY the same (if there is no added bug, of course). So, if you use normal acquisition, you won't find anything new neither on screen or old-DB tables ... All old-API functions have been cloned. for example, the "newbiblio" sub, now has become : * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio * a "OLDnewbiblio" sub, which is a copy/paste of the previous newbiblio sub. Then, when you want to add the MARC-DB stuff, you can modify the newbiblio sub without modifying the OLDnewbiblio one. If we correct a bug in 1.2 in newbiblio, we can do the same in main branch by correcting OLDnewbiblio. * The MARC stuff is usually done through a sub named MARCxxx where xxx is the same as OLDxxx. For example, newbiblio calls MARCnewbiblio. the MARCxxx subs use a MARC::Record as parameter. The last thing to solve was to manage biblios through real MARC import : they must populate the old-db, but must populate the MARC-DB too, without loosing information (if we go from MARC::Record to old-data then back to MARC::Record, we loose A LOT OF ROWS). To do this, there are subs beginning by "ALLxxx" : they manage datas with MARC::Record datas. they call OLDxxx sub too (to populate old-DB), but MARCxxx subs too, with a complete MARC::Record ;-) In Biblio.pm, there are some subs that permits to build a old-style record from a MARC::Record, and the opposite. There is also a sub finding a MARC-bibid from a old-biblionumber and the opposite too. Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
544 lines
14 KiB
Perl
544 lines
14 KiB
Perl
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
|
|
|
|
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
|
|
&getkeytableselectoptions
|
|
&picktemplate);
|
|
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
|
|
|
|
# your exported package globals go here,
|
|
# as well as any optionally exported functions
|
|
|
|
@EXPORT_OK = qw($Var1 %Hashit);
|
|
|
|
|
|
# non-exported package globals go here
|
|
use vars qw(@more $stuff);
|
|
|
|
# initalize package globals, first exported ones
|
|
|
|
my $Var1 = '';
|
|
my %Hashit = ();
|
|
|
|
|
|
# then the others (which are still accessible as $Some::Module::stuff)
|
|
my $stuff = '';
|
|
my @more = ();
|
|
|
|
# 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
|
|
#
|
|
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;
|
|
} else {
|
|
return 'default';
|
|
}
|
|
|
|
}
|
|
|
|
sub startpage() {
|
|
return("<html>\n");
|
|
}
|
|
|
|
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($) {
|
|
# edit the paths in here
|
|
my ($type)=shift;
|
|
if ($type eq 'issue') {
|
|
open (FILE,"$path/issues-top.inc") || die;
|
|
} elsif ($type eq 'opac') {
|
|
open (FILE,"$path/opac-top.inc") || die;
|
|
} elsif ($type eq 'member') {
|
|
open (FILE,"$path/members-top.inc") || die;
|
|
} elsif ($type eq 'acquisitions'){
|
|
open (FILE,"$path/acquisitions-top.inc") || die;
|
|
} elsif ($type eq 'report'){
|
|
open (FILE,"$path/reports-top.inc") || die;
|
|
} elsif ($type eq 'circulation') {
|
|
open (FILE,"$path/circulation-top.inc") || die;
|
|
} else {
|
|
open (FILE,"$path/cat-top.inc") || die;
|
|
}
|
|
my @string=<FILE>;
|
|
close FILE;
|
|
# my $count=@string;
|
|
# $string[$count]="<BLOCKQUOTE>";
|
|
return @string;
|
|
}
|
|
|
|
|
|
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/acquisitions-bottom.inc") || die;
|
|
} elsif ($type eq 'report') {
|
|
open (FILE,"$path/reports-bottom.inc") || die;
|
|
} elsif ($type eq 'circulation') {
|
|
open (FILE,"$path/circulation-bottom.inc") || die;
|
|
} else {
|
|
open (FILE,"$path/cat-bottom.inc") || die;
|
|
}
|
|
my @string=<FILE>;
|
|
close FILE;
|
|
return @string;
|
|
}
|
|
|
|
sub mktablehdr() {
|
|
return("<table border=0 cellspacing=0 cellpadding=5>\n");
|
|
}
|
|
|
|
|
|
sub mktablerow {
|
|
#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 (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() {
|
|
return("</table>\n");
|
|
}
|
|
|
|
sub mkform{
|
|
my ($action,%inputs)=@_;
|
|
my $string="<form action=$action method=post>\n";
|
|
$string=$string.mktablehdr();
|
|
my $key;
|
|
my @keys=sort keys %inputs;
|
|
|
|
my $count=@keys;
|
|
my $i2=0;
|
|
while ( $i2<$count) {
|
|
my $value=$inputs{$keys[$i2]};
|
|
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";
|
|
} 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]\">";
|
|
}
|
|
if ($data[0] eq 'textarea') {
|
|
$text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
|
|
}
|
|
if ($data[0] eq 'select') {
|
|
$text="<select name=$keys[$i2]>";
|
|
my $i=1;
|
|
while ($data[$i] ne "") {
|
|
my $val = $data[$i+1];
|
|
$text = $text."<option value=$data[$i]>$val";
|
|
$i = $i+2;
|
|
}
|
|
$text=$text."</select>";
|
|
}
|
|
$string=$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>";
|
|
}
|
|
|
|
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 $value=$inputs{$keys[$i2]};
|
|
my @data=split('\t',$value);
|
|
my $posn = $data[2];
|
|
if ($data[0] eq 'hidden'){
|
|
$order[$posn]="<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]\" size=40>";
|
|
}
|
|
if ($data[0] eq 'textarea') {
|
|
$text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
|
|
}
|
|
if ($data[0] eq 'select') {
|
|
$text="<select name=$keys[$i2]>";
|
|
my $i=1;
|
|
while ($data[$i] ne "") {
|
|
my $val = $data[$i+1];
|
|
$text = $text."<option value=$data[$i]>$val";
|
|
$i = $i+2;
|
|
}
|
|
$text=$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>";
|
|
}
|
|
|
|
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";
|
|
}
|
|
if ($inputs[$i][0] eq 'radio') {
|
|
$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]\">";
|
|
}
|
|
if ($inputs[$i][0] eq '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]\">";
|
|
}
|
|
if ($inputs[$i][0] eq 'submit'){
|
|
$string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
|
|
}
|
|
}
|
|
$string=$string."</form>";
|
|
}
|
|
|
|
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();
|
|
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);
|
|
if ($data[0] eq 'hidden'){
|
|
$string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
|
|
} else {
|
|
my $text;
|
|
if ($data[0] eq 'radio') {
|
|
$text="<input type=radio name=$key value=$data[1]>$data[1]
|
|
<input type=radio name=$key value=$data[2]>$data[2]";
|
|
} elsif ($data[0] eq 'text') {
|
|
my $size = $data[1];
|
|
if ($size eq "") {
|
|
$size=40;
|
|
}
|
|
$text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
|
|
} elsif ($data[0] eq 'textarea') {
|
|
my @size=split("x",$data[1]);
|
|
if ($data[1] eq "") {
|
|
$size[0] = 40;
|
|
$size[1] = 4;
|
|
}
|
|
$text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
|
|
} elsif ($data[0] eq 'select') {
|
|
$text="<select name=$key>";
|
|
my $sel=$data[1];
|
|
my $i=2;
|
|
while ($data[$i] ne "") {
|
|
my $val = $data[$i+1];
|
|
$text = $text."<option value=\"$data[$i]\"";
|
|
if ($data[$i] eq $sel) {
|
|
$text = $text." selected";
|
|
}
|
|
$text = $text.">$val";
|
|
$i = $i+2;
|
|
}
|
|
$text=$text."</select>";
|
|
}
|
|
if ($reqd eq "R") {
|
|
$ltext = $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>";
|
|
}
|
|
|
|
=pod
|
|
|
|
=head2 &endpage
|
|
|
|
&endpage does not expect any arguments, it returns the string:
|
|
</body></html>\n
|
|
|
|
=cut
|
|
|
|
sub endpage() {
|
|
return("</body></html>\n");
|
|
}
|
|
|
|
=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><br>";
|
|
}
|
|
if ($type eq '3'){
|
|
$string="<FONT SIZE=6><em>$text</em></FONT><p>";
|
|
}
|
|
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() {
|
|
return ("</CENTER>\n");
|
|
}
|
|
|
|
=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)
|
|
|
|
|
|
|