Removed trailing whitespace.
require Exporter;
use C4::Context;
#use C4::Biblio;
-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;
&ordersearch &newbiblio &newbiblioitem &newsubject &newsubtitle &neworder
&newordernum &modbiblio &modorder &getsingleorder &invoice &receiveorder
&bookfundbreakdown &curconvert &updatesup &insertsup &newitems &modbibitem
-&getcurrencies &modsubtitle &modsubject &modaddauthor &moditem &countitems
+&getcurrencies &modsubtitle &modsubject &modaddauthor &moditem &countitems
&findall &needsmod &delitem &deletebiblioitem &delbiblio &delorder &branches
&getallorders &getrecorders &updatecurrencies &getorder &getcurrency &updaterecorder
&updatecost &checkitems &modnote &getitemtypes &getbiblio
&getbiblioitembybiblionumber
&getbiblioitem &getitemsbybiblioitem &isbnsearch
&websitesearch &addwebsite &updatewebsite &deletewebsite);
-%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); # FIXME - Never used
-
-
-# non-exported package globals go here
-use vars qw(@more $stuff); # FIXME - Never used
-
-# initalize package globals, first exported ones
-# FIXME - Never used
-my $Var1 = '';
-my %Hashit = ();
-
-
-
-# then the others (which are still accessible as $Some::Module::stuff)
-# FIXME - Never used
-my $stuff = '';
-my @more = ();
-
-# all file-scoped lexicals must be created before
-# the functions below that use them.
-
-# file-private lexicals go here
-# FIXME - Never used
-my $priv_var = '';
-my %secret_hash = ();
-
-# FIXME - Never used
-# 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;
=item getorders
sub getorders {
my ($supplierid)=@_;
my $dbh = C4::Context->dbh;
- my $query = "Select count(*),authorisedby,entrydate,basketno from aqorders where
+ my $query = "Select count(*),authorisedby,entrydate,basketno from aqorders where
booksellerid='$supplierid' and (quantity > quantityreceived or
quantityreceived is NULL)
and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')";
sub getorder{
my ($bi,$bib)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select ordernumber
- from aqorders
+ my $query="Select ordernumber
+ from aqorders
where biblionumber=? and biblioitemnumber=?";
my $sth=$dbh->prepare($query);
$sth->execute($bib,$bi);
sub getsingleorder {
my ($ordnum)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
- where aqorders.ordernumber=?
+ my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
+ where aqorders.ordernumber=?
and biblio.biblionumber=aqorders.biblionumber and
biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
aqorders.ordernumber=aqorderbreakdown.ordernumber";
my $dbh = C4::Context->dbh;
my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
and (cancelledby is NULL or cancelledby = '')
- and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
- aqorders.biblioitemnumber
- group by aqorders.biblioitemnumber
+ and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
+ aqorders.biblioitemnumber
+ group by aqorders.biblioitemnumber
order by
biblio.title";
my $i=0;
my $dbh = C4::Context->dbh;
my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
and (cancelledby is NULL or cancelledby = '')
- and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
+ and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
aqorders.biblioitemnumber and
aqorders.quantityreceived>0
and aqorders.datereceived >=now()
- group by aqorders.biblioitemnumber
+ group by aqorders.biblioitemnumber
order by
biblio.title";
my $i=0;
$query.= "(biblio.title like '$data[$i]%' or biblio.title like '% $data[$i]%') and ";
}
$query=~ s/ and $//;
- $query.=" ) or biblioitems.isbn='$search'
+ $query.=" ) or biblioitems.isbn='$search'
or (aqorders.ordernumber='$search' and aqorders.biblionumber='$biblio')) ";
if ($catview ne 'yes'){
$query.=" and (quantityreceived < quantity or quantityreceived is NULL)";
sub basket {
my ($basketno,$supplier)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select *,biblio.title from aqorders,biblio,biblioitems
+ my $query="Select *,biblio.title from aqorders,biblio,biblioitems
where basketno='$basketno'
and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
- =aqorders.biblioitemnumber
+ =aqorders.biblioitemnumber
and (datecancellationprinted is NULL or datecancellationprinted =
'0000-00-00')";
if (defined $supplier && $supplier ne ''){
$query.=" and aqorders.booksellerid='$supplier'";
- }
+ }
$query.=" group by aqorders.ordernumber";
my $sth=$dbh->prepare($query);
$sth->execute;
sub bookfunds {
my $dbh = C4::Context->dbh;
my $query="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
- =aqbudget.bookfundid
+ =aqbudget.bookfundid
and aqbudget.startdate='2001-07-01'
group by aqbookfund.bookfundid order by bookfundname";
my $sth=$dbh->prepare($query);
my ($id)=@_;
my $dbh = C4::Context->dbh;
my $query="Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
- from aqorders,aqorderbreakdown where bookfundid='$id' and
+ from aqorders,aqorderbreakdown where bookfundid='$id' and
aqorders.ordernumber=aqorderbreakdown.ordernumber and ((budgetdate >=
'2001-07-01' and budgetdate <'2002-07-01') or
(datereceived >= '2001-07-01' and datereceived < '2002-07-01'))
my $dbh = C4::Context->dbh;
my $query;
my $sth;
-
+
$biblio->{'title'} = $dbh->quote($biblio->{'title'});
$biblio->{'author'} = $dbh->quote($biblio->{'author'});
$biblio->{'abstract'} = $dbh->quote($biblio->{'abstract'});
$biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
$biblioitem->{'lccn'} = $dbh->quote($biblioitem->{'lccn'});
$biblioitem->{'marc'} = $dbh->quote($biblioitem->{'marc'});
-
+
$sth->execute;
$data = $sth->fetchrow_arrayref;
$bibitemnum = $$data[0] + 1;
my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice)=@_;
my $dbh = C4::Context->dbh;
my $query="update aqorders set title='$title',
- quantity='$quantity',listprice='$listprice',basketno='$basketno',
+ quantity='$quantity',listprice='$listprice',basketno='$basketno',
rrp='$rrp',ecost='$ecost',unitprice='$cost',
booksellerinvoicenumber='$invoice'
where
$sth=$dbh->prepare($query);
# print $query;
$sth->execute;
- $sth->finish;
+ $sth->finish;
}
=item updaterecorder
$sth=$dbh->prepare($query);
# print $query;
$sth->execute;
- $sth->finish;
+ $sth->finish;
}
=item curconvert
}
$sth->finish;
return($i,\@results);
-}
+}
# FIXME - This function appears in C4::Catalogue. Neither one is used.
sub getcurrency {
my $data=$sth->fetchrow_hashref;
$sth->finish;
return($data);
-}
+}
=item updatecurrencies
my $sth=$dbh->prepare($query);
$sth->execute;
$sth->finish;
-}
+}
=item updatesup
$data = $sth->fetchrow_hashref;
$itemnumber = $data->{'max(itemnumber)'} + 1;
$sth->finish;
-
+
$item->{'booksellerid'} = $dbh->quote($item->{'booksellerid'});
$item->{'homebranch'} = $dbh->quote($item->{'homebranch'});
$item->{'price'} = $dbh->quote($item->{'price'});
sub findall {
my ($biblionumber)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select * from biblioitems,items,itemtypes where
- biblioitems.biblionumber=$biblionumber
+ my $query="Select * from biblioitems,items,itemtypes where
+ biblioitems.biblionumber=$biblionumber
and biblioitems.biblioitemnumber=items.biblioitemnumber and
itemtypes.itemtype=biblioitems.itemtype
order by items.biblioitemnumber";
my @results;
$sth->execute;
-
+
if (@results = $sth->fetchrow_array) {
$query = "Insert into deletedbiblioitems values (";
DELETE FROM items
WHERE biblioitemnumber = $biblioitemnumber
EOT
-
+
} # sub deletebiblioitem
# FIXME - This is functionally identical to &C4::Biblio::delbiblio.
# || die "Cannot prepare $query" . $dbh->errstr;
my $count = 0;
my @results;
-
+
$sth->execute;
# || die "Cannot execute $query\n" . $sth->errstr;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
$count++;
} # while
-
+
$sth->finish;
return($count, @results);
} # sub getitemtypes
# || die "Cannot prepare $query\n" . $dbh->errstr;
my $count = 0;
my @results;
-
+
$sth->execute;
# || die "Cannot execute $query\n" . $sth->errstr;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
$count++;
} # while
-
+
$sth->finish;
return($count, @results);
} # sub getbiblio
# || die "Cannot prepare $query\n" . $dbh->errstr;
my $count = 0;
my @results;
-
+
$sth->execute;
# || die "Cannot execute $query\n" . $sth->errstr;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
$count++;
} # while
-
+
$sth->finish;
return($count, @results);
} # sub getitemsbybiblioitem
my $query;
my $sth;
my @results;
-
+
$isbn = $dbh->quote($isbn);
$query = "Select biblio.* from biblio, biblioitems where
biblio.biblionumber = biblioitems.biblionumber
and isbn = $isbn";
$sth = $dbh->prepare($query);
-
+
$sth->execute;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
sub addwebsite {
my ($website) = @_;
my $dbh = C4::Context->dbh;
-
+
$website->{'biblionumber'} = $dbh->quote($website->{'biblionumber'});
$website->{'title'} = $dbh->quote($website->{'title'});
$website->{'description'} = $dbh->quote($website->{'description'});
$website->{'url'} = $dbh->quote($website->{'url'});
-
+
$dbh->do(<<EOT);
INSERT INTO websites
SET biblionumber = $website->{'biblionumber'},
sub updatewebsite {
my ($website) = @_;
my $dbh = C4::Context->dbh;
-
+
$website->{'title'} = $dbh->quote($website->{'title'});
$website->{'description'} = $dbh->quote($website->{'description'});
$website->{'url'} = $dbh->quote($website->{'url'});
-
+
$dbh->do(<<EOT);
UPDATE websites
SET title = $website->{'title'},
package C4::Biblio;
# $Id$
# $Log$
+# Revision 1.20 2002/10/13 08:28:32 arensb
+# Deleted unused variables.
+# Removed trailing whitespace.
+#
# Revision 1.19 2002/10/13 05:56:10 arensb
# Added some FIXME comments.
#
#
-# move from 1.2 to 1.4 version :
+# move from 1.2 to 1.4 version :
# 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
# In the 1.4 version, we want to do 2 differents things :
# - keep populating the old-DB, that has a LOT less datas than MARC
use C4::Database;
use MARC::Record;
-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;
# as the old-style API and the ALL one are the only public functions.
#
@EXPORT = qw(
- &updateBiblio &updateBiblioItem &updateItem
- &itemcount &newbiblio &newbiblioitem
+ &updateBiblio &updateBiblioItem &updateItem
+ &itemcount &newbiblio &newbiblioitem
&modnote &newsubject &newsubtitle
&modbiblio &checkitems
&newitems &modbibitem
- &modsubtitle &modsubject &modaddauthor &moditem &countitems
- &delitem &deletebiblioitem &delbiblio
+ &modsubtitle &modsubject &modaddauthor &moditem &countitems
+ &delitem &deletebiblioitem &delbiblio
&getitemtypes &getbiblio
&getbiblioitembybiblionumber
&getbiblioitem &getitemsbybiblioitem &isbnsearch
&MARCgettagslib
&MARCaddbiblio &MARCadditem
- &MARCmodsubfield &MARCaddsubfield
+ &MARCmodsubfield &MARCaddsubfield
&MARCmodbiblio &MARCmoditem
- &MARCfindsubfield
+ &MARCfindsubfield
&MARCkoha2marcBiblio &MARCmarc2koha &MARCkoha2marcItem
&MARCgetbiblio &MARCgetitem
&MARCaddword &MARCdelword
);
-%EXPORT_TAGS = ( );
-
-# your exported package globals go here,
-# as well as any optionally exported functions
-
-@EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
-
#
#
# MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
=head2 &MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
adds a subfield in a biblio (in the MARC tables only).
-
+
=head2 $MARCRecord = &MARCgetbiblio($dbh,$bibid);
Returns a MARC::Record for the biblio $bibid.
$sth2->execute($bibid,$itemnumber);
my ($tagorder) = $sth2->fetchrow_array();
#---- TODO : the leader is missing
- my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
- from marc_subfield_table
+ my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
+ from marc_subfield_table
where bibid=? and tagorder=? order by subfieldorder
");
# FIXME - There's already a $sth2 in this scope.
}
# otherwise, skip through each subfield...
my @fields = $record->fields();
-# search old MARC item
+# search old MARC item
my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
$sth2->execute($bibid,$itemnumber);
my ($tagorder) = $sth2->fetchrow_array();
sub MARCfindsubfieldid {
my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
- where bibid=? and tag=? and tagorder=?
+ where bibid=? and tag=? and tagorder=?
and subfieldcode=? and subfieldorder=?");
$sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
my ($res) = $sth->fetchrow;
# delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
$dbh->do("delete from marc_subfield_table where bibid='$bibid' and
- tag='$tag' and tagorder='$tagorder'
+ tag='$tag' and tagorder='$tagorder'
and subfieldcode='$subfield' and subfieldorder='$subfieldorder
");
}
my $record = MARC::Record->new();
#--- if bibid, then retrieve old-style koha data
if ($biblionumber>0) {
- my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
- from biblio where biblionumber=?");
+ my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
+ from biblio where biblionumber=?");
$sth2->execute($biblionumber);
my $row=$sth2->fetchrow_hashref;
my $code;
if ($biblioitemnumber>0) {
my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
- volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
+ volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
FROM biblioitems
WHERE biblionumber=? and biblioitemnumber=?
- ");
+ ");
$sth2->execute($biblionumber,$biblioitemnumber);
my $row=$sth2->fetchrow_hashref;
my $code;
my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
- reserves,restricted,binding,itemnotes,holdingbranch,timestamp
+ reserves,restricted,binding,itemnotes,holdingbranch,timestamp
FROM items
WHERE itemnumber=?");
$sth2->execute($itemnumber);
while (($field)=$sth2->fetchrow) {
$result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
}
-# additional authors : specific
+# additional authors : specific
$result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
return $result;
}
#
#
-# ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL
+# ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL
#
#
# all the following subs are useful to manage MARC-DB with complete MARC records.
print "Error in ALLnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
die;
}
- my $newfield = MARC::Field->new( $tagfield1,'','',
+ my $newfield = MARC::Field->new( $tagfield1,'','',
"$tagsubfield1" => $oldbibnum,
"$tagsubfield2" => $oldbibitemnum);
# drop old field and create new one...
my $itemnumber;
my $error;
($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{'barcode'});
-# search MARC biblionumber
+# search MARC biblionumber
my $bibid=&MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{'biblionumber'});
# calculate tagorder
my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
They all are the exact copy of 1.0/1.2 version of the sub
without the OLD. The OLDxxx is called by the original xxx sub.
the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
-
+
WARNING : there is 1 difference between initialxxx and OLDxxx :
the db header $dbh is always passed as parameter
to avoid over-DB connexion
=head2 OLDdeletebiblioitem($dbh,$biblioitemnumber);
deletes a biblioitem
NOTE : not standard sub name. Should be OLDdelbiblioitem()
-
+
=head2 OLDdelbiblio($dbh,$biblio);
delete a biblio
# my $dbh = C4Connect;
my $query;
my $sth;
-
+
$biblio->{'title'} = $dbh->quote($biblio->{'title'});
$biblio->{'author'} = $dbh->quote($biblio->{'author'});
$biblio->{'abstract'} = $dbh->quote($biblio->{'abstract'});
$biblio->{'serial'} = $dbh->quote($biblio->{'serial'});
$biblio->{'unititle'} = $dbh->quote($biblio->{'unititle'});
$biblio->{'notes'} = $dbh->quote($biblio->{'notes'});
-
+
$query = "Update biblio set
title = $biblio->{'title'},
author = $biblio->{'author'},
notes = $biblio->{'notes'}
where biblionumber = $biblio->{'biblionumber'}";
$sth = $dbh->prepare($query);
-
+
$sth->execute;
-
+
$sth->finish;
return($biblio->{'biblionumber'});
} # sub modbiblio
and catalogueentry = '$subject[$i]'";
my $sth = $dbh->prepare($query);
$sth->execute;
-
+
if (my $data = $sth->fetchrow_hashref) {
} else {
if ($force eq $subject[$i]) {
my $sth = $dbh->prepare($query);
my $data;
my $bibitemnum;
-
+
$biblioitem->{'volume'} = $dbh->quote($biblioitem->{'volume'});
$biblioitem->{'number'} = $dbh->quote($biblioitem->{'number'});
$biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'});
$biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'});
$biblioitem->{'lccn'} = $dbh->quote($biblioitem->{'lccn'});
$biblioitem->{'marc'} = $dbh->quote($biblioitem->{'marc'});
-
+
$sth->execute;
$data = $sth->fetchrow_arrayref;
$bibitemnum = $$data[0] + 1;
$data = $sth->fetchrow_hashref;
$itemnumber = $data->{'max(itemnumber)'} + 1;
$sth->finish;
-
+
$item->{'booksellerid'} = $dbh->quote($item->{'booksellerid'});
$item->{'homebranch'} = $dbh->quote($item->{'homebranch'});
$item->{'price'} = $dbh->quote($item->{'price'});
itemnotes='$item->{'notes'}',
homebranch='$item->{'homebranch'}',
itemlost='$item->{'lost'}',
- wthdrawn='$item->{'wthdrawn'}'
+ wthdrawn='$item->{'wthdrawn'}'
where itemnumber=$item->{'itemnum'}";
}
if ($item->{'replacement'} ne ''){
my @results;
$sth->execute;
-
+
if (@results = $sth->fetchrow_array) {
$query = "Insert into deletedbiblioitems values (";
foreach my $value (@results) {
sub getorder{
my ($bi,$bib)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select ordernumber
- from aqorders
+ my $query="Select ordernumber
+ from aqorders
where biblionumber=? and biblioitemnumber=?";
my $sth=$dbh->prepare($query);
$sth->execute($bib,$bi);
sub getsingleorder {
my ($ordnum)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
- where aqorders.ordernumber=?
+ my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
+ where aqorders.ordernumber=?
and biblio.biblionumber=aqorders.biblionumber and
biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
aqorders.ordernumber=aqorderbreakdown.ordernumber";
# || die "Cannot prepare $query" . $dbh->errstr;
my $count = 0;
my @results;
-
+
$sth->execute;
# || die "Cannot execute $query\n" . $sth->errstr;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
$count++;
} # while
-
+
$sth->finish;
return($count, @results);
} # sub getitemtypes
# || die "Cannot prepare $query\n" . $dbh->errstr;
my $count = 0;
my @results;
-
+
$sth->execute;
# || die "Cannot execute $query\n" . $sth->errstr;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
$count++;
} # while
-
+
$sth->finish;
return($count, @results);
} # sub getbiblio
# || die "Cannot prepare $query\n" . $dbh->errstr;
my $count = 0;
my @results;
-
+
$sth->execute;
# || die "Cannot execute $query\n" . $sth->errstr;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
$count++;
} # while
-
+
$sth->finish;
return($count, @results);
} # sub getitemsbybiblioitem
my $query;
my $sth;
my @results;
-
+
$isbn = $dbh->quote($isbn);
$query = "Select biblio.* from biblio, biblioitems where
biblio.biblionumber = biblioitems.biblionumber
and isbn = $isbn";
$sth = $dbh->prepare($query);
-
+
$sth->execute;
while (my $data = $sth->fetchrow_hashref) {
$results[$count] = $data;
# At the moment this is just a straight copy of the subject code. Needs heavy
# modification to work for additional authors, obviously.
# Check for additional author changes
-
+
# my $newadditionalauthor='';
# my $additionalauthors;
# foreach $newadditionalauthor (@{$biblio->{'additionalauthor'}}) {
print "<PRE>Looking for biblio </PRE>\n" if $debug;
$sth=$dbh->prepare("select biblionumber
from biblio
- where title=? and author=?
+ where title=? and author=?
and copyrightdate=? and seriestitle=?");
$sth->execute(
$biblio->{title}, $biblio->{author},
$origsubjects->{$subject}=1;
}
-
+
# Obtain a list of MARC Record_ID's that are tied to this biblio
$sth=$dbh->prepare("select bibid from marc_subfield_table where tag='090' and subfieldvalue=$biblionumber and subfieldcode='c'");
$sth->execute;
}
# Check for subject heading changes
-
+
my $newsubject='';
my $subjects;
foreach $newsubject (@{$biblio->{'subject'}}) {
$sth=$dbh->prepare("select Subfield_ID from 8XX_Subfield_Table where Subfield_Mark=8 and Subfield_Value=$link and !(Subfield_ID=$Subfield876_ID)");
$sth->execute;
my ($Subfield852_ID) = $sth->fetchrow;
-
+
if ($item->{'barcode'} ne $olditem->{'barcode'}) {
logchange('kohadb', 'change', 'items', 'barcode', $olditem->{'barcode'}, $item->{'barcode'});
my $q_barcode=$dbh->quote($item->{'barcode'});
-package C4::BookShelves; #assumes C4/BookShelves
-
-#
-# $Header$
-#
-#requires DBI.pm to be installed
+package C4::BookShelves;
+# $Id$
# Copyright 2000-2002 Katipo Communications
#
use DBI;
use C4::Context;
use C4::Circulation::Circ2;
-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;
@ISA = qw(Exporter);
@EXPORT = qw(&GetShelfList &GetShelfContents &AddToShelf &RemoveFromShelf &AddShelf &RemoveShelf);
-%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); # FIXME - Never used
-
-
-# non-exported package globals go here
-use vars qw(@more $stuff); # FIXME - Never used
-
-# initalize package globals, first exported ones
-# FIXME - Never used
-my $Var1 = '';
-my %Hashit = ();
-
-# then the others (which are still accessible as $Some::Module::stuff)
-# FIXME - Never used
-my $stuff = '';
-my @more = ();
-
-# all file-scoped lexicals must be created before
-# the functions below that use them.
-
-# file-private lexicals go here
-# FIXME - Never used
-my $priv_var = '';
-my %secret_hash = ();
-
-# here's a file-private function as a closure,
-# callable as &$priv_func; it cannot be prototyped.
-# FIXME - Never used
-my $priv_func = sub {
- # stuff goes here.
-};
-
-# make all your functions, whether exported or not;
my $dbh = C4::Context->dbh;
#
# $Log$
+# Revision 1.9 2002/10/13 08:29:18 arensb
+# Deleted unused variables.
+# Removed trailing whitespace.
+#
# Revision 1.8 2002/10/10 04:32:44 arensb
# Simplified references.
#
-package C4::Catalogue; #assumes C4/Acquisitions.pm
+package C4::Catalogue;
# Continue working on updateItem!!!!!!
#
# functions
#
# Trying to track down $dbh's that aren't disconnected....
-#
-
# Copyright 2000-2002 Katipo Communications
use MARC::Record;
use C4::Biblio;
-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;
&bookseller &breakdown &checkitems
&websitesearch &addwebsite &updatewebsite &deletewebsite
);
-%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); # FIXME - Unused
-
-
-# non-exported package globals go here
-use vars qw(@more $stuff); # FIXME - Unused
-
-# initalize package globals, first exported ones
-# FIXME - Unused
-my $Var1 = '';
-my %Hashit = ();
-
-
-# then the others (which are still accessible as $Some::Module::stuff)
-# FIXME - Unused
-my $stuff = '';
-my @more = ();
-
-# all file-scoped lexicals must be created before
-# the functions below that use them.
-
-# file-private lexicals go here
-# FIXME - Unused
-my $priv_var = '';
-my %secret_hash = ();
-
-# here's a file-private function as a closure,
-# callable as &$priv_func; it cannot be prototyped.
-# FIXME - Unused
-my $priv_func = sub {
- # stuff goes here.
- };
-
-# make all your functions, whether exported or not;
-
#
#
# $Id$
-#package to deal with circulation
+#package to deal with circulation
# Copyright 2000-2002 Katipo Communications
use C4::Security;
use vars qw($VERSION @ISA @EXPORT);
-
+
# set the version for version checking
$VERSION = 0.01;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&Start_circ &scanborrower);
my $data;
while ($donext ne 'Quit') {
if ($donext eq "Circ") {
- clearscreen();
- ($reason,$data) = menu($env,'console','Circulation',
+ clearscreen();
+ ($reason,$data) = menu($env,'console','Circulation',
('Issues','Returns','Borrower Enquiries','Reserves','Log In'));
#debug_msg($env,"data = $data");
} else {
$data = $donext;
}
- if ($data eq 'Issues') {
+ if ($data eq 'Issues') {
$donext=Issue($env); #C4::Circulation::Issues
#debug_msg("","do next $donext");
} elsif ($data eq 'Returns') {
&endint($env);
&Login($env); #C4::Security
&startint($env,'Circulation');
- } elsif ($data eq 'Quit') {
+ } elsif ($data eq 'Quit') {
$donext = $data;
}
#debug_msg($env,"donext - $donext");
}
- &endint($env)
+ &endint($env)
}
# Not exported.
sub previousissue {
my ($env,$itemnum,$dbh,$bornum)=@_;
my $sth=$dbh->prepare("Select firstname,surname,issues.borrowernumber,cardnumber,returndate
- from issues,borrowers where
+ from issues,borrowers where
issues.itemnumber='$itemnum' and
issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
NULL");
my $resp = &msg_yn("Book is issued to this borrower", "Renew?");
if ($resp == "y") {
&renewbook($env,$dbh,$bornum,$itemnum);
- }
-
+ }
+
} else {
- my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
+ my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
my $resp = &msg_yn($text,"Mark as returned?");
if ($resp == "y") {
&returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
# can issue
} else {
# can't issue
- }
+ }
}
- }
+ }
return($borrower->{'borrowernumber'});
$sth->finish;
}
sub checkreserve{
- # Check for reserves for biblio
+ # Check for reserves for biblio
# does not look at constraints yet
my ($env,$dbh,$itemnum)=@_;
my $resbor = "";
- my $query = "select * from reserves,items
+ my $query = "select * from reserves,items
where (items.itemnumber = '$itemnum')
and (items.biblionumber = reserves.biblionumber)
and (reserves.found is null) order by priority";
my $sth = $dbh->prepare($query);
$sth->execute();
if (my $data=$sth->fetchrow_hashref) {
- $resbor = $data->{'borrowernumber'};
+ $resbor = $data->{'borrowernumber'};
}
return ($resbor);
$sth->finish;
my $sth = $dbh->prepare($query);
$sth->execute();
if (my $data=$sth->fetchrow_hashref) {
- push @itemswaiting,$data->{'itemnumber'};
+ push @itemswaiting,$data->{'itemnumber'};
}
return (\@itemswaiting);
$sth->finish;
-package C4::Circulation::Borrower; #assumes C4/Circulation/Borrower
+package C4::Circulation::Borrower;
+
+# $Id$
#package to deal with Issues
#written 3/11/99 by chris@katipo.co.nz
use C4::Search;
use C4::Stats;
use C4::Format;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&findborrower &Borenq &findoneborrower &NewBorrowerNumber
&findguarantees);
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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 findborrower {
my ($env,$dbh) = @_;
#get borrowerbarcode from scanner
my $title = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Borrower Entry");
if ($env->{'newborrower'} eq "") {
- ($borcode,$reason,$book)=&C4::Circulation::Main::scanborrower($env);
- } else {
+ ($borcode,$reason,$book)=&C4::Circulation::Main::scanborrower($env);
+ } else {
$borcode = $env->{'newborrower'};
$reason = "";
$book = "";
$env->{'newborrower'}= "";
- }
+ }
#C4::Circulation::Main
if ($reason eq "") {
if ($borcode ne '') {
($bornum,$borrower) = findoneborrower($env,$dbh,$borcode);
$env->{'IssuesAllowed'} = 1;
} elsif ($book ne "") {
- my $query = "select * from issues,items where (barcode = '$book')
- and (items.itemnumber = issues.itemnumber)
+ my $query = "select * from issues,items where (barcode = '$book')
+ and (items.itemnumber = issues.itemnumber)
and (issues.returndate is null)";
my $iss_sth=$dbh->prepare($query);
$iss_sth->execute;
if (my $issdata = $iss_sth->fetchrow_hashref) {
$bornum=$issdata->{'borrowernumber'};
- $sth = $dbh->prepare("Select * from borrowers
+ $sth = $dbh->prepare("Select * from borrowers
where borrowernumber = '$bornum'");
$sth->execute;
$borrower=$sth->fetchrow_hashref;
- $sth->finish;
+ $sth->finish;
} else {
error_msg($env,"Item $book not found");
- }
+ }
$iss_sth->finish;
}
- }
- }
+ }
+ }
my ($issuesallowed,$owing);
if ($reason eq "") {
$env->{'bornum'} = $bornum;
$sth->finish;
# my $borquery = "Select * from borrowers
# where surname ~* '$borcode' order by surname";
-
- my $borquery = "Select * from borrowers
+
+ my $borquery = "Select * from borrowers
where lower(surname) like \"$lcborcode%\" order by surname,firstname";
my $sthb =$dbh->prepare($borquery);
$sthb->execute;
$cntbor++;
}
if ($cntbor == 1) {
- $bornum = $bornums[0];
- my $query = "select * from borrowers where borrowernumber = '$bornum'";
+ $bornum = $bornums[0];
+ my $query = "select * from borrowers where borrowernumber = '$bornum'";
$sth = $dbh->prepare($query);
$sth->execute;
$borrower =$sth->fetchrow_hashref;
- $sth->finish;
+ $sth->finish;
} elsif ($cntbor > 0) {
my ($cardnum) = C4::InterfaceCDK::selborrower($env,$dbh,\@borrows,\@bornums);
- my $query = "select * from borrowers where cardnumber = '$cardnum'";
- $sth = $dbh->prepare($query);
- $sth->execute;
+ my $query = "select * from borrowers where cardnumber = '$cardnum'";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
$borrower =$sth->fetchrow_hashref;
$sth->finish;
$bornum=$borrower->{'borrowernumber'};
if ($bornum eq '') {
error_msg($env,"Borrower not found");
}
- }
+ }
}
- return ($bornum,$borrower);
+ return ($bornum,$borrower);
}
sub checktraps {
my ($env,$dbh,$bornum,$borrower) = @_;
my $issuesallowed = "1";
#my @traps_set;
#check amountowing
- my $traps_done;
+ my $traps_done;
my $odues;
my $amount;
while ($traps_done ne "DONE") {
my @traps_set;
$amount=C4::Accounts::checkaccount($env,$bornum,$dbh); #from C4::Accounts
- if ($amount > 0) { push (@traps_set,"CHARGES");}
+ if ($amount > 0) { push (@traps_set,"CHARGES");}
if ($borrower->{'gonenoaddress'} == 1){ push (@traps_set,"GNA");}
#check if member has a card reported as lost
if ($borrower->{'lost'} ==1){push (@traps_set,"LOST");}
#check if borrower has overdue items
#call overdue checker
my $odues = &C4::Circulation::Main::checkoverdues($env,$bornum,$dbh);
- if ($odues > 0) {push (@traps_set,"ODUES");}
+ if ($odues > 0) {push (@traps_set,"ODUES");}
#check if borrower has any items waiting
my ($nowaiting,$itemswaiting) = &C4::Circulation::Main::checkwaiting($env,$dbh,$bornum);
- if ($nowaiting > 0) { push (@traps_set,"WAITING"); }
+ if ($nowaiting > 0) { push (@traps_set,"WAITING"); }
# FIXME - This should be $traps_set[0], right?
if (@traps_set[0] ne "" ) {
- ($issuesallowed,$traps_done,$amount,$odues) =
+ ($issuesallowed,$traps_done,$amount,$odues) =
process_traps($env,$dbh,$bornum,$borrower,
$amount,$odues,\@traps_set,$itemswaiting);
} else {
$traps_done = "DONE";
- }
+ }
}
return ($issuesallowed, $odues,$amount);
}
my $x = 0;
my %traps;
while (@$traps_set[$x] ne "") {
- $traps{@$traps_set[$x]} = 1;
+ $traps{@$traps_set[$x]} = 1;
$x++;
}
my $traps_done;
$trapact = &trapscreen($env,$bornum,$borrower,$amount,$traps_set);
if ($trapact eq "CHARGES") {
C4::Accounts::reconcileaccount($env,$dbh,$bornum,$amount,$borrower,$odues);
- ($odues,$issues,$amount)=borrdata2($env,$bornum);
+ ($odues,$issues,$amount)=borrdata2($env,$bornum);
if ($amount <= 0) {
$traps{'CHARGES'} = 0;
my @newtraps;
}
} elsif ($trapact eq "NOTES") {
my $notes = trapsnotes($env,$bornum,$borrower,$amount);
- if ($notes ne $borrower->{'borrowernotes'}) {
- my $query = "update borrowers set borrowernotes = '$notes'
+ if ($notes ne $borrower->{'borrowernotes'}) {
+ my $query = "update borrowers set borrowernotes = '$notes'
where borrowernumber = $bornum";
my $sth = $dbh->prepare($query);
$sth->execute();
push @newtraps,$traps_set->[$x];
}
$x++;
- }
- $traps_set = \@newtraps;
+ }
+ $traps_set = \@newtraps;
}
}
my $notr = @$traps_set;
}
}
return $reason;
-}
+}
sub modifyuser {
my ($env,$borrower) = @_;
=cut
#'
# FIXME - This is identical to C4::Search::NewBorrowerNumber.
-# Pick one (preferably this one) and stick with it.
+# Pick one (preferably this one) and stick with it.
# FIXME - Race condition: this function just says what the next unused
# number is, but doesn't allocate it. Hence, two clients adding
sub findguarantees{
my ($bornum)=@_;
my $dbh = C4::Context->dbh;
- my $query="select cardnumber,borrowernumber from borrowers where
+ my $query="select cardnumber,borrowernumber from borrowers where
guarantor='$bornum'";
my $sth=$dbh->prepare($query);
$sth->execute;
$sth->finish;
return($i,\@dat);
}
-END { } # module clean-up code here (global destructor)
$sth->finish;
# print @results;
# FIXME - Bogus API.
- return($i,\@results);
+ return($i,\@results);
}
=item CalcFine
# an existing fine.
# print "in accounts ...";
if ($data->{'amount'} != $amount){
-
+
# print "updating";
my $diff=$amount - $data->{'amount'};
my $out=$data->{'amountoutstanding'}+$diff;
and (accounttype='FU' or accounttype='O') and description like '%$due%'";
my $sth2=$dbh->prepare($query2);
$sth2->execute;
- $sth2->finish;
+ $sth2->finish;
} else {
# print "no update needed $data->{'amount'}"
}
sub BorType {
my ($borrowernumber)=@_;
my $dbh = C4::Context->dbh;
- my $query="Select * from borrowers,categories where
+ my $query="Select * from borrowers,categories where
borrowernumber=$borrowernumber and
borrowers.categorycode=categories.categorycode";
my $sth=$dbh->prepare($query);
use C4::Format;
use C4::Input;
use vars qw($VERSION @ISA @EXPORT);
-
+
# set the version for version checking
$VERSION = 0.01;
$env->{'sysarea'} = "Issues";
$done = "Issues";
while ($done eq "Issues") {
- my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
+ my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
#C4::Circulation::Borrowers
$env->{'loanlength'}="";
if ($reason ne "") {
$env->{'bornum'} = $bornum;
$env->{'bcard'} = $borrower->{'cardnumber'};
#deal with alternative loans
- #now check items
+ #now check items
($items,$items2)=
C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
$done = "No";
}
#&endint($env);
}
- }
+ }
Cdk::refreshCdkScreen();
return ($done);
-}
+}
# FIXME - Not exported, but called by "telnet/borrwraper.pl".
# Presumably this function is obsolete.
my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
my $dbh = C4::Context->dbh;
$env->{'newborrower'} = "";
- my ($itemnum,$reason) =
+ my ($itemnum,$reason) =
issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
if ($itemnum eq ""){
$reason = "Finished user";
$it2p++;
$amountdue += $charge;
}
- }
+ }
#check to see if more books to process for this user
my @done;
- if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
+ if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
if ($reason eq 'Finished user'){
if (@$items2[0] ne "") {
remoteprint($env,$itemsdet,$borrower);
if ($amountdue > 0) {
&reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
}
- }
+ }
@done = ("Issues");
} elsif ($reason eq "Print"){
remoteprint($env,$itemsdet,$borrower);
@done = ("No",$items2,$it2p);
} else {
if ($reason ne 'Finished issues'){
- #return No to let them know that we wish to
+ #return No to let them know that we wish to
# process more Items for borrower
@done = ("No",$items2,$it2p,$amountdue,$itemsdet);
} else {
@done = ("Circ");
}
}
- #debug_msg($env, "return from issues $done[0]");
+ #debug_msg($env, "return from issues $done[0]");
return @done;
}
my $line = $line." $iclass "; # FIXME - .=
my $line = $line.fmtdec($env,$charge,"22"); # FIXME - .=
return $line;
-}
+}
# Only used internally
# FIXME - Only used by &processitems, which appears to be obsolete.
my $item;
my $charge;
my $datedue = $env->{'loanlength'};
- my $sth=$dbh->prepare($query);
+ my $sth=$dbh->prepare($query);
$sth->execute;
if ($item=$sth->fetchrow_hashref) {
$sth->finish;
error_msg($env,"Item Withdrawn");
$canissue = 0;
# } elsif ($item->{'itemlost'} == 1) {
-# error_msg($env,"Item Lost");
+# error_msg($env,"Item Lost");
# $canissue = 0;
} elsif ($item->{'restricted'} == 1 ){
error_msg($env,"Restricted Item");
}
#check if item is on issue already
if ($canissue == 1) {
- my ($currbor,$issuestat,$newdate) =
+ my ($currbor,$issuestat,$newdate) =
&C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
- if ($issuestat eq "N") {
+ if ($issuestat eq "N") {
$canissue = 0;
} elsif ($issuestat eq "R") {
$canissue = -1;
createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
}
&UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
- }
- }
+ }
+ }
if ($canissue == 1) {
#check reserve
- my ($resbor,$resrec) = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
+ my ($resbor,$resrec) = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
#debug_msg($env,$resbor);
- if ($resbor eq $bornum) {
- my $rquery = "update reserves
+ if ($resbor eq $bornum) {
+ my $rquery = "update reserves
set found = 'F'
where reservedate = '$resrec->{'reservedate'}'
and borrowernumber = '$resrec->{'borrowernumber'}'
$rsth->execute;
$rsth->finish;
} elsif ($resbor ne "") {
- my $bquery = "select * from borrowers
+ my $bquery = "select * from borrowers
where borrowernumber = '$resbor'";
my $btsh = $dbh->prepare($bquery);
$btsh->execute;
} else {
my $ans = msg_ny($env,"Cancel reserve?");
if ($ans eq "Y") {
- my $rquery = "update reserves
+ my $rquery = "update reserves
set found = 'F'
where reservedate = '$resrec->{'reservedate'}'
and borrowernumber = '$resrec->{'borrowernumber'}'
};
}
#if charge deal with it
-
+
if ($canissue == 1) {
$charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
}
&UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
if ($charge > 0) {
createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
- }
+ }
} elsif ($canissue == 0) {
info_msg($env,"Can't issue $item->{'cardnumber'}");
- }
+ }
} else {
my $valid = checkdigit($env,$itemnum);
if ($valid ==1) {
if (substr($itemnum,0,1) = "V") {
#this is a borrower
$env->{'newborrower'} = $itemnum;
- } else {
+ } else {
error_msg($env,"$itemnum not found - rescan");
}
} else {
error_msg($env,"Invalid Number");
- }
+ }
}
$sth->finish;
#debug_msg($env,"date $datedue");
my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
my $loanlength=21;
my $query="Select * from biblioitems,itemtypes
- where (biblioitems.biblioitemnumber='$bitno')
+ where (biblioitems.biblioitemnumber='$bitno')
and (biblioitems.itemtype = itemtypes.itemtype)";
my $sth=$dbh->prepare($query);
$sth->execute;
if (my $data=$sth->fetchrow_hashref) {
$loanlength = $data->{'loanlength'}
}
- $sth->finish;
+ $sth->finish;
my $dateduef;
if ($env->{'loanlength'} eq "") {
my $ti = time;
$dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
} else {
$dateduef = $env->{'loanlength'};
- }
+ }
$query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
my $sth=$dbh->prepare($query);
if (my $data1=$sth1->fetchrow_hashref) {
$item_type = $data1->{'itemtype'};
$charge = $data1->{'rentalcharge'};
- my $q2 = "select rentaldiscount from borrowers,categoryitem
- where (borrowers.borrowernumber = '$bornum')
+ my $q2 = "select rentaldiscount from borrowers,categoryitem
+ where (borrowers.borrowernumber = '$bornum')
and (borrowers.categorycode = categoryitem.categorycode)
and (categoryitem.itemtype = '$item_type')";
my $sth2=$dbh->prepare($q2);
$charge = ($charge *(100 - $discount)) / 100;
}
$sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
- }
+ }
$sth1->finish;
return ($charge);
}
use C4::Search;
use C4::Print;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&returnrecord &calc_odues &Returns);
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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;
# FIXME - This is only used in C4::Circmain and C4::Circulation, both
# of which appear to be obsolete. Presumably this function is obsolete
# Otherwise, it needs a POD.
sub Returns {
my ($env)=@_;
- my $dbh = C4::Context->dbh;
+ my $dbh = C4::Context->dbh;
my @items;
@items[0]=" "x50;
my $reason;
my $resp;
# until (($reason eq "Circ") || ($reason eq "Quit")) {
until ($reason ne "") {
- ($reason,$item) =
+ ($reason,$item) =
returnwindow($env,"Enter Returns",
$item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
#debug_msg($env,"item = $item");
#if (($reason ne "Circ") && ($reason ne "Quit")) {
if ($reason eq "") {
$resp = "";
- ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
+ ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
checkissue($env,$dbh,$item);
if ($bornum ne "") {
($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
$issues = "";
$odues = "";
$amt_owing = "";
- }
+ }
if ($resp ne "") {
#if ($resp eq "Returned") {
if ($itemno ne "" ) {
unshift @items,$fmtitem;
if ($items[20] > "") {
pop @items;
- }
+ }
}
#} elsif ($resp ne "") {
# error_msg($env,"$resp");
#}
#if ($resp ne "Returned") {
# error_msg($env,"$resp");
- # $bornum = "";
+ # $bornum = "";
#}
}
}
my $itemrec;
my $amt_owing;
$item = uc $item;
- my $query = "select * from items,biblio
+ my $query = "select * from items,biblio
where barcode = '$item'
and (biblio.biblionumber=items.biblionumber)";
- my $sth=$dbh->prepare($query);
+ my $sth=$dbh->prepare($query);
$sth->execute;
if ($itemrec=$sth->fetchrow_hashref) {
$sth->finish;
$borrower = $sth->fetchrow_hashref;
$bornum = $issuerec->{'borrowernumber'};
$itemno = $issuerec->{'itemnumber'};
- $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
- $reason = "Returned";
+ $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
+ $reason = "Returned";
} else {
$sth->finish;
updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
}
my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
if ($resfound eq "y") {
- my $bquery = "select * from borrowers
+ my $bquery = "select * from borrowers
where borrowernumber = '$resrec->{'borrowernumber'}'";
my $btsh = $dbh->prepare($bquery);
- $btsh->execute;
+ $btsh->execute;
my $resborrower = $btsh->fetchrow_hashref;
#printreserve($env,$resrec,$resborrower,$itemrec);
- my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
+ my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
C4::InterfaceCDK::error_msg($env,$mess);
$btsh->finish;
- }
+ }
} else {
$sth->finish;
$reason = "Item not found";
- }
+ }
return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
# end checkissue
}
#my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
my @datearr = localtime(time);
my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
- my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where
- (borrowernumber = '$bornum') and (itemnumber = '$itemno')
- and (returndate is null)";
+ my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where
+ (borrowernumber = '$bornum') and (itemnumber = '$itemno')
+ and (returndate is null)";
my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
}
$sth->finish;
# check for charge made for lost book
- my $query = "select * from accountlines
- where (borrowernumber = '$bornum')
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornum')
and (itemnumber = '$itemno')
and (accounttype = 'L')";
my $sth = $dbh->prepare($query);
$sth->execute;
if (my $data = $sth->fetchrow_hashref) {
- # writeoff this amount
+ # writeoff this amount
my $offset;
my $amount = $data->{'amount'};
my $acctno = $data->{'accountno'};
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
- }
+ }
$sth->finish;
UpdateStats($env,'branch','return','0','',$itemno);
return($oduecharge);
my ($env,$dbh,$bornum,$itemno)=@_;
my $amt_owing;
return($amt_owing);
-}
+}
# This function is only used in &checkissue and &returnrecord, both of
# which appear to be obsolete. So presumably this function is obsolete
sub updatelastseen {
my ($env,$dbh,$itemnumber)= @_;
my $br = $env->{'branchcode'};
- my $query = "update items
+ my $query = "update items
set datelastseen = now(), holdingbranch = '$br'
where (itemnumber = '$itemnumber')";
my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
-
+
}
sub find_reserves {
my ($env,$dbh,$itemno) = @_;
my $itemdata = itemnodata($env,$dbh,$itemno);
- my $query = "select * from reserves where found is null
+ my $query = "select * from reserves where found is null
and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
order by priority,reservedate ";
my $sth = $dbh->prepare($query);
$consth->finish;
}
if ($resfound eq "y") {
- my $updquery = "update reserves
+ my $updquery = "update reserves
set found = 'W',itemnumber='$itemno'
where borrowernumber = $resrec->{'borrowernumber'}
and reservedate = '$resrec->{'reservedate'}'
my $updsth = $dbh->prepare($updquery);
$updsth->execute;
$updsth->finish;
- }
+ }
}
}
$sth->finish;
- return ($resfound,$resrec);
+ return ($resfound,$resrec);
}
require Exporter;
use DBI;
-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;
-
@ISA = qw(Exporter);
@EXPORT = qw(&accountsdialog);
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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 accountsdialog {
my ($env,$title,$borrower,$accountlines,$amountowing)=@_;
my $titlepanel = titlepanel($env,$env->{'sysarea'},"Money Owing");
#$borinfo[1] = "$borrower->{'surname'}, $borrower->{'title'} $borrower->{'firstname'} ";
#$borinfo[2] = "$borrower->{'streetaddress'}, $borrower->{'city'}";
#$borinfo[3] = "<R>Total Due: </B>".fmtdec($env,$amountowing,"52");
- #my $borpanel =
+ #my $borpanel =
# new Cdk::Label ('Message' =>\@borinfo, 'Ypos'=>4, 'Xpos'=>"RIGHT");
my $borpanel = borrowerbox($env,$borrower,$amountowing);
$borpanel->draw();
makepayment($borrowerno,$accountno,$amount2);
$amount+=$amount2;
}
-
}
my $amountentry = new Cdk::Entry('Label'=>"Amount: ",
'Max'=>"10",'Width'=>"10",
'Type'=>"INT");
$amountentry->preProcess ('Function' => sub{preamt(@_,$env,$acctlist);});
#
-
+
if ($amount eq ''){
- $amount =$amountentry->activate();
+ $amount =$amountentry->activate();
} else {
$amountentry->set('Value'=>$amount);
$amount=$amountentry->activate();
require Exporter;
use DBI;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&BorrowerAddress);
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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 BorrowerAddress {
my ($env,$bornum,$borrower)=@_;
my $titlepanel = titlepanel($env,$env{'sysarea'},"Update Borrower");
$titlepanel->draw();
- my BorrAdd = BorrAddpame
+ my BorrAdd = BorrAddpame
sub BorrAddpanel {
my ($env,$bornum,$borrower)=@_;
while ($i < $numflds) {
$responses[$i] =$info->[$i][0];
$i++;
- }
- }
+ }
+ }
return($reason,@responses);
}
require Exporter;
use DBI;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&trapscreen &trapsnotes &reservesdisplay);
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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 trapscreen {
my ($env,$bornum,$borrower,$amount,$traps_set)=@_;
my $titlepanel = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Borrower Flags");
my $flagsset = new Cdk::Scroll ('Title'=>"Act On Flag",
'List'=>\@$traps_set,'Height'=>$hght,'Width'=>15,
'Xpos'=>4,'Ypos'=>3);
- my $act =$flagsset->activate();
+ my $act =$flagsset->activate();
my $action;
if (!defined $act) {
$action = "NONE";
} else {
$action = @$traps_set[$act];
- }
+ }
undef $titlepanel;
undef $flagsset;
undef $borpanel;
$x++;
}
my $notes = $notesbox->activate();
- if (!defined $notes) {
- $notes = $borrower->{'borrowernotes'};
+ if (!defined $notes) {
+ $notes = $borrower->{'borrowernotes'};
} else {
while (substr($notes,0,1) eq " ") {
my $temp;
require Exporter;
use DBI;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(renew_window);
-%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 se them.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-#defining keystrokes used for screens
-
-# 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 renew_window {
my ($env,$issueditems,$borrower,$amountowing,$odues)=@_;
undef $issuelist;
undef $borrbox;
return \@renews;
-}
-
-END { } # module clean-up code here (global destructor)
-
-
+}
require Exporter;
use DBI;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&FindBiblioScreen &SelectBiblio &MakeReserveScreen);
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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 FindBiblioScreen {
my ($env,$title,$numflds,$flds,$fldlns)=@_;
my $titlepanel = titlepanel($env,"Reserves","Find a title");
#my @coltitles=("a","b");
my @rowtitles;
- my $nflds =@$flds;
+ my $nflds =@$flds;
my $ow = 0;
while ($ow < $nflds) {
@rowtitles[$ow]=@$flds[$ow];
$ow++;
- }
+ }
my @coltitles = ("");
my @coltypes = ("UMIXED");
my @colwidths = (40);
while ($i < $numflds) {
$responses[$i] =$info->[$i][0];
$i++;
- }
- }
+ }
+ }
return($reason,@responses);
}
sub SelectBiblio {
my ($env,$count,$entries) = @_;
- my $titlepanel = titlepanel($env,"Reserves","Select title");
+ my $titlepanel = titlepanel($env,"Reserves","Select title");
my $biblist = new Cdk::Alphalist('Title'=>"Select a Title",
'List'=>\@$entries,'Height' => 22,'Width' => 76,
'Ypos'=>1);
my $selection = $biblist->activate();
my $reason;
my $result;
- if (!defined $selection) {
+ if (!defined $selection) {
$reason="Circ";
} else {
$result=$selection;
} else {
my $split = int(($testlen-72)*0.7);
$line = substr($line,0,72+$split-$authlen)." ".$bibliorec->{'author'};
- $line = fmtstr($env,$line,"L72");
- }
+ $line = fmtstr($env,$line,"L72");
+ }
my @book = ($line);
my $bookpanel = new Cdk::Label ('Message' =>\@book,
'Ypos'=>"2");
my $branchlist = new Cdk::Radio('Title'=>"Collection Branch",
'List'=>\@$branches,
'Xpos'=>"20",'Ypos'=>"5",'Width'=>"18",'Height'=>"6");
- $branchlist->draw();
+ $branchlist->draw();
my $i = 0;
my $brcnt = @$branches;
my $brdef = 0;
my $brtest = fmtstr($env,$env->{'branchcode'},"L2");
if ($brcode eq $brtest) {
$brdef = 1
- } else {
+ } else {
$branchlist->inject('Input'=>"KEY_DOWN");
$i++;
- }
- }
+ }
+ }
$branchlist->inject('Input'=>" ");
my @constraintlist = ("Any item","Only Selected","Except Selected");
my $constrainttype = new Cdk::Radio('Title'=>"Reserve Constraints",
'Xpos'=>"2",'Ypos'=>"5",
'Type'=>"UMIXED");
borrbind($env,$borrowerentry);
- # $borrowentry->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);});
+ # $borrowentry->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);});
my $complete = 0;
my $reason = "";
my @answers;
while ($complete == 0) {
- my $borrowercode = $borrowerentry->activate();
+ my $borrowercode = $borrowerentry->activate();
if (!defined $borrowercode) {
$reason="Circ";
$complete = 1;
@answers[0] = ""
- } else {
+ } else {
@answers[0] = $borrowercode;
if ($borrowercode ne "") { $complete = 1; };
while ($complete == 1) {
@answers[1] = "";
} else {
my @brline = split(" ",@$branches[$x]);
- @answers[1] = @brline[0];
+ @answers[1] = @brline[0];
$complete = 2;
$answers[2] = "a";
$answers[3] = "";
@answers[2] = $constarr[$constans];
$complete = 3;
if ($answers[2] ne "a") {
- while ($complete == 3) {
+ while ($complete == 3) {
my @itemans = $itemlist->activate();
if (!defined @itemans) {
$complete = 2; # go back a step
my @blarr = split("\t",$bitline);
@items[$j] = @blarr[0];
$j++;
- }
+ }
$i++;
}
@answers[3] = \@items;
}
}
}
- }
+ }
} else {
$complete = 3;
- }
+ }
}
}
- }
+ }
}
- }
+ }
return ($reason,@answers);
}
END { } # module clean-up code here (global destructor)
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 vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
$VERSION = 0.01;
&pathtotemplate
&themelanguage &gettemplate
);
-%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); # FIXME - These are never used
-
-
-# non-exported package globals go here
-use vars qw(@more $stuff); # FIXME - These are never used
-
-# initalize package globals, first exported ones
-
-# FIXME - These are never used
-my $Var1 = '';
-my %Hashit = ();
-
-
-# then the others (which are still accessible as $Some::Module::stuff)
-# FIXME - These are never used
-my $stuff = '';
-my @more = ();
-
-# all file-scoped lexicals must be created before
-# the functions below that use them.
my $path = C4::Context->config('includes') ||
"/usr/local/www/hdl/htdocs/includes";
package C4::Reserves;
+# $Id$
+
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
use C4::Circulation::Main;
use C4::Circulation::Borrower;
use C4::Search;
-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;
-
+
@ISA = qw(Exporter);
@EXPORT = qw(&EnterReserves CalcReserveFee CreateReserve );
-%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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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;
# FIXME - This doesn't appear to ever be used, except in modules that
# appear to be obsolete.
sub EnterReserves{
- my ($env)=@_;
+ my ($env)=@_;
my $titlepanel = titlepanel($env,"Reserves","Enter Selection");
my @flds = ("No of entries","Barcode","ISBN","Title","Keywords","Author","Subject");
my @fldlens = ("5","15","15","50","50","50","50");
my $donext ="Circ";
if ($reason ne "") {
$donext = $reason;
- } else {
+ } else {
my %search;
$search{'title'}= $title;
$search{'keyword'}=$keyword;
} else {
if ($keyword ne ''){
($count,@results)=&KeywordSearch($env,'intra',\%search,$num,$offset);
- } else {
+ } else {
($count,@results)=&CatSearch($env,'loose',\%search,$num,$offset);
}
}
if ($no_ents > 0) {
if ($no_ents == 1) {
my @ents = split("\t",@results[0]);
- $biblionumber = @ents[2];
- } else {
+ $biblionumber = @ents[2];
+ } else {
my %biblio_xref;
my @bibtitles;
my $i = 0;
$line = fmtstr($env,@ents[1],"L70");
my $auth = substr(@ents[0],0,30);
substr($line,(70-length($auth)-2),length($auth)+2) = " ".$auth;
- @bibtitles[$i]=$line;
+ @bibtitles[$i]=$line;
$biblio_xref{$line}=@ents[2];
$i++;
}
if ($results eq "") {
$biblionumber = $biblio_xref{$bibres};
} else {
- $donext = $results;
+ $donext = $results;
}
}
-
+
if ($biblionumber eq "") {
- error_msg($env,"No items found");
+ error_msg($env,"No items found");
} else {
my @items = GetItems($env,$biblionumber);
my $cnt_it = @items;
my $title = titlepanel($env,"Reserves","Create Reserve");
my ($reason,$borcode,$branch,$constraint,$bibitems) =
MakeReserveScreen($env, $data, \@items, \@branches);
- if ($borcode ne "") {
+ if ($borcode ne "") {
my ($borrnum,$borrower) = findoneborrower($env,$dbh,$borcode);
- if ($reason eq "") {
+ if ($reason eq "") {
if ($borrnum ne "") {
my $fee =
CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems);
CreateReserve($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$fee);
$donext = "Circ"
}
-
+
} else {
$donext = $reason;
}
- } else { $donext = "Circ" }
- }
+ } else { $donext = "Circ" }
+ }
}
}
}
- return ($donext);
+ return ($donext);
}
# FIXME - A functionally identical version of this function appears in
#check for issues;
my $dbh = C4::Context->dbh;
my $const = lc substr($constraint,0,1);
- my $query = "select * from borrowers,categories
- where (borrowernumber = '$borrnum')
+ my $query = "select * from borrowers,categories
+ where (borrowernumber = '$borrnum')
and (borrowers.categorycode = categories.categorycode)";
my $sth = $dbh->prepare($query);
$sth->execute;
# check for items on issue
# first find biblioitem records
my @biblioitems;
- my $query1 = "select * from biblio,biblioitems
+ my $query1 = "select * from biblio,biblioitems
where (biblio.biblionumber = '$biblionumber')
and (biblio.biblionumber = biblioitems.biblionumber)";
my $sth1 = $dbh->prepare($query1);
$found = 1;
}
$x++;
- }
+ }
if ($const eq 'o') {if ($found == 1) {push @biblioitems,$data;}
} else {if ($found == 0) {push @biblioitems,$data;} }
}
my $x = 0;
my $allissued = 1;
while ($x < $cntitemsfound) {
- my $bitdata = @biblioitems[$x];
- my $query2 = "select * from items
- where biblioitemnumber = '$bitdata->{'biblioitemnumber'}'";
+ my $bitdata = @biblioitems[$x];
+ my $query2 = "select * from items
+ where biblioitemnumber = '$bitdata->{'biblioitemnumber'}'";
my $sth2 = $dbh->prepare($query2);
$sth2->execute;
- while (my $itdata=$sth2->fetchrow_hashref) {
- my $query3 = "select * from issues
+ while (my $itdata=$sth2->fetchrow_hashref) {
+ my $query3 = "select * from issues
where itemnumber = '$itdata->{'itemnumber'}' and returndate is null";
my $sth3 = $dbh->prepare($query3);
$sth3->execute();
$rsth->execute();
if (my $rdata = $rsth->fetchrow_hashref) { } else {
$fee = 0;
- }
+ }
}
}
return $fee;
my $const = lc substr($constraint,0,1);
my @datearr = localtime(time);
my $resdate = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
- #eval {
+ #eval {
# updates take place here
if ($fee > 0) {
my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
#if (@_) {
# # update failed
# my $temp = @_;
- # # error_msg($env,"Update failed");
- # $dbh->rollback();
+ # # error_msg($env,"Update failed");
+ # $dbh->rollback();
#}
return();
-} # end CreateReserve
-
-
-
-
-END { } # module clean-up code here (global destructor)
+} # end CreateReserve
-#!/usr/bin/perl
+package C4::SimpleMarc;
# $Id$
-package C4::SimpleMarc;
-
# Routines for handling import of MARC data into Koha db
# Koha library project www.koha.org
# Suite 330, Boston, MA 02111-1307 USA
use strict;
-
-# standard or CPAN modules used
use DBI;
-
-# Koha modules used
-
require Exporter;
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
# set the version for version checking
$VERSION = 0.01;
@ISA = qw(Exporter);
@EXPORT = qw(
- &extractmarcfields
- &parsemarcfileformat
+ &extractmarcfields
+ &parsemarcfileformat
&taglabel
%tagtext
%tagmap
);
-%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
-
-# your exported package globals go here,
-# as well as any optionally exported functions
# FIXME - %tagtext and %tagmap are in both @EXPORT and @EXPORT_OK.
# They should be in one or the other, but not both (though preferably,
%tagmap
);
-# 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.
-
-# file-private lexicals go here
-my $priv_var = '';
-my %secret_hash = ();
-
-# 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;
#------------------------------------------------
#------------------
# $record->[0]->{'subfields'}->{'a'} = subfieldvalue
)=@_;
- # return
+ # return
my $bib; # pointer to hash of named output fields
# Example: $bib->{'author'} = "Twain, Mark";
my (
$field, # hash ref
- $value,
+ $value,
$subfield, # Marc subfield [a-z]
$fieldname, # name of field "author", "title", etc.
$strip, # chars to remove from end of field
$stripregex, # reg exp pattern
);
- my ($lccn, $isbn, $issn,
+ my ($lccn, $isbn, $issn,
$publicationyear, @subjects, $subject,
- $controlnumber,
- $notes, $additionalauthors, $illustrator, $copyrightdate,
+ $controlnumber,
+ $notes, $additionalauthors, $illustrator, $copyrightdate,
$s, $subdivision, $subjectsubfield,
);
}
if ($field->{'tag'} eq '700') {
my $name=$field->{'subfields'}->{'a'};
- if ( defined($field->{'subfields'}->{'e'})
+ if ( defined($field->{'subfields'}->{'e'})
and $field->{'subfields'}->{'e'}=~/ill/) {
$illustrator=$name;
} else {
$bib->{isbn}=~s/[^\d]*//g; # drop non-digits
# FIXME - "[^\d]" can be rewritten as "\D"
# FIXME - Does this include the check digit? If so,
- # it might be "X".
+ # it might be "X".
};
if ( $bib->{issn} ) {
#---------------------------------------------
# $Log$
+# Revision 1.7 2002/10/13 08:30:38 arensb
+# Deleted unused variables.
+# Removed trailing whitespace.
+#
# Revision 1.6 2002/10/10 04:44:28 arensb
# Added whitespace to make the POD work.
#
-package C4::Z3950;
+package C4::Z3950;
# $Id$
@ISA = qw(Exporter);
@EXPORT = qw(
- &z3950servername
- &addz3950queue
+ &z3950servername
+ &addz3950queue
);
#------------------------------------------------
# inputs
my (
$dbh, # FIXME - Unused argument
- $srvid, # server id number
+ $srvid, # server id number
$default,
)=@_;
# return
$dbh = C4::Context->dbh;
# FIXME - Fix indentation
- my $sti=$dbh->prepare("select name
- from z3950servers
+ my $sti=$dbh->prepare("select name
+ from z3950servers
where id=?");
$sti->execute($srvid);
if ( ! $sti->err ) {
# FIXME - Should be configurable, probably in /etc/koha.conf.
my $pidfile='/var/log/koha/processz3950queue.pid';
-
+
$error="";
$dbh = C4::Context->dbh;
push @serverlist, $server;
} elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) {
$sth=$dbh->prepare("select host,port,db,userid,password ,name
- from z3950servers
+ from z3950servers
where checked <> 0 ");
$sth->execute;
- while ( my ($host, $port, $db, $userid, $password,$servername)
+ while ( my ($host, $port, $db, $userid, $password,$servername)
= $sth->fetchrow ) {
push @serverlist, "$servername/$host\:$port/$db/$userid/$password";
} # while
} else {
$sth=$dbh->prepare("select host,port,db,userid,password
- from z3950servers
+ from z3950servers
where id=? ");
$sth->execute($server);
my ($host, $port, $db, $userid, $password) = $sth->fetchrow;
# when there are 0 or 1 elements in @serverlist.
if ( $serverlist !~ /^ +$/ ) {
# Don't allow reinsertion of the same request identifier.
- $sth=$dbh->prepare("select identifier from z3950queue
+ $sth=$dbh->prepare("select identifier from z3950queue
where identifier=?");
$sth->execute($requestid);
if ( ! $sth->rows) {
- $sth=$dbh->prepare("insert into z3950queue
- (term,type,servers, identifier)
+ $sth=$dbh->prepare("insert into z3950queue
+ (term,type,servers, identifier)
values (?, ?, ?, ?)");
$sth->execute($query, $type, $serverlist, $requestid);
- if ( -r $pidfile ) {
+ if ( -r $pidfile ) {
# FIXME - Perl is good at opening files. No need to
# spawn a separate 'cat' process.
my $pid=`cat $pidfile`;
# server list is empty
$error.="No Z39.50 search servers specified. ";
} # if serverlist empty
-
+
return $error;
} # sub addz3950queue
#--------------------------------------
# $Log$
+# Revision 1.6 2002/10/13 08:30:53 arensb
+# Deleted unused variables.
+# Removed trailing whitespace.
+#
# Revision 1.5 2002/10/13 06:13:23 arensb
# Removed bogus #! line (this isn't a script!)
# Removed unused global variables.
projects / srvgit / commitdiff