arensb
parent
7be6b413fe
commit
fddab26c2e
|
|
@ -27,7 +27,7 @@ use strict;
|
|||
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;
|
||||
|
|
@ -58,52 +58,13 @@ orders, converting money to different currencies, and so forth.
|
|||
&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
|
||||
|
||||
|
|
@ -142,7 +103,7 @@ Results are ordered from most to least recent.
|
|||
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')";
|
||||
|
|
@ -194,8 +155,8 @@ tables of the Koha database.
|
|||
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);
|
||||
|
|
@ -223,8 +184,8 @@ aqorderbreakdown tables of the Koha database.
|
|||
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";
|
||||
|
|
@ -291,9 +252,9 @@ sub getallorders {
|
|||
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;
|
||||
|
|
@ -316,11 +277,11 @@ sub getrecorders {
|
|||
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;
|
||||
|
|
@ -386,7 +347,7 @@ sub ordersearch {
|
|||
$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)";
|
||||
|
|
@ -499,15 +460,15 @@ number of elements in C<@orders>.
|
|||
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;
|
||||
|
|
@ -571,7 +532,7 @@ alphabetically by book fund name.
|
|||
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);
|
||||
|
|
@ -622,7 +583,7 @@ sub bookfundbreakdown {
|
|||
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'))
|
||||
|
|
@ -710,7 +671,7 @@ sub modbiblio {
|
|||
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'});
|
||||
|
|
@ -980,7 +941,7 @@ sub newbiblioitem {
|
|||
$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;
|
||||
|
|
@ -1166,7 +1127,7 @@ sub modorder {
|
|||
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
|
||||
|
|
@ -1242,7 +1203,7 @@ sub receiveorder {
|
|||
$sth=$dbh->prepare($query);
|
||||
# print $query;
|
||||
$sth->execute;
|
||||
$sth->finish;
|
||||
$sth->finish;
|
||||
}
|
||||
|
||||
=item updaterecorder
|
||||
|
|
@ -1276,7 +1237,7 @@ sub updaterecorder{
|
|||
$sth=$dbh->prepare($query);
|
||||
# print $query;
|
||||
$sth->execute;
|
||||
$sth->finish;
|
||||
$sth->finish;
|
||||
}
|
||||
|
||||
=item curconvert
|
||||
|
|
@ -1335,7 +1296,7 @@ sub getcurrencies {
|
|||
}
|
||||
$sth->finish;
|
||||
return($i,\@results);
|
||||
}
|
||||
}
|
||||
|
||||
# FIXME - This function appears in C4::Catalogue. Neither one is used.
|
||||
sub getcurrency {
|
||||
|
|
@ -1348,7 +1309,7 @@ sub getcurrency {
|
|||
my $data=$sth->fetchrow_hashref;
|
||||
$sth->finish;
|
||||
return($data);
|
||||
}
|
||||
}
|
||||
|
||||
=item updatecurrencies
|
||||
|
||||
|
|
@ -1366,7 +1327,7 @@ sub updatecurrencies {
|
|||
my $sth=$dbh->prepare($query);
|
||||
$sth->execute;
|
||||
$sth->finish;
|
||||
}
|
||||
}
|
||||
|
||||
=item updatesup
|
||||
|
||||
|
|
@ -1454,7 +1415,7 @@ sub newitems {
|
|||
$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'});
|
||||
|
|
@ -1571,8 +1532,8 @@ sub countitems{
|
|||
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";
|
||||
|
|
@ -1642,7 +1603,7 @@ where biblioitemnumber = $biblioitemnumber";
|
|||
my @results;
|
||||
|
||||
$sth->execute;
|
||||
|
||||
|
||||
if (@results = $sth->fetchrow_array) {
|
||||
|
||||
$query = "Insert into deletedbiblioitems values (";
|
||||
|
|
@ -1687,7 +1648,7 @@ EOT
|
|||
DELETE FROM items
|
||||
WHERE biblioitemnumber = $biblioitemnumber
|
||||
EOT
|
||||
|
||||
|
||||
} # sub deletebiblioitem
|
||||
|
||||
# FIXME - This is functionally identical to &C4::Biblio::delbiblio.
|
||||
|
|
@ -1730,14 +1691,14 @@ sub getitemtypes {
|
|||
# || 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
|
||||
|
|
@ -1753,14 +1714,14 @@ 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 getbiblio
|
||||
|
|
@ -1825,14 +1786,14 @@ biblio.biblionumber = items.biblionumber and biblioitemnumber
|
|||
# || 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
|
||||
|
|
@ -1847,13 +1808,13 @@ sub isbnsearch {
|
|||
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;
|
||||
|
|
@ -1933,12 +1894,12 @@ are mandatory.
|
|||
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'},
|
||||
|
|
@ -1963,11 +1924,11 @@ the entry to update.
|
|||
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'},
|
||||
|
|
|
|||
115
C4/Biblio.pm
115
C4/Biblio.pm
|
|
@ -1,6 +1,10 @@
|
|||
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.
|
||||
#
|
||||
|
|
@ -99,7 +103,7 @@ package C4::Biblio;
|
|||
#
|
||||
|
||||
|
||||
# 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
|
||||
|
|
@ -149,7 +153,7 @@ use C4::Context;
|
|||
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;
|
||||
|
|
@ -160,13 +164,13 @@ $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
|
||||
|
|
@ -180,21 +184,14 @@ $VERSION = 0.01;
|
|||
|
||||
&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
|
||||
|
|
@ -231,7 +228,7 @@ $VERSION = 0.01;
|
|||
|
||||
=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.
|
||||
|
||||
|
|
@ -485,8 +482,8 @@ sub MARCgetitem {
|
|||
$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.
|
||||
|
|
@ -565,7 +562,7 @@ sub MARCmoditem {
|
|||
}
|
||||
# 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();
|
||||
|
|
@ -667,7 +664,7 @@ sub MARCfindsubfield {
|
|||
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;
|
||||
|
|
@ -678,7 +675,7 @@ sub MARCdelsubfield {
|
|||
# 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
|
||||
");
|
||||
}
|
||||
|
|
@ -697,8 +694,8 @@ sub MARCkoha2marcBiblio {
|
|||
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;
|
||||
|
|
@ -712,10 +709,10 @@ sub MARCkoha2marcBiblio {
|
|||
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;
|
||||
|
|
@ -741,7 +738,7 @@ sub MARCkoha2marcItem {
|
|||
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);
|
||||
|
|
@ -813,7 +810,7 @@ sub MARCmarc2koha {
|
|||
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;
|
||||
}
|
||||
|
|
@ -875,7 +872,7 @@ sub MARCdelword {
|
|||
|
||||
#
|
||||
#
|
||||
# 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.
|
||||
|
|
@ -939,7 +936,7 @@ sub ALLnewbiblio {
|
|||
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...
|
||||
|
|
@ -955,7 +952,7 @@ sub ALLnewitem {
|
|||
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=?");
|
||||
|
|
@ -1003,7 +1000,7 @@ sub ALLnewitem {
|
|||
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
|
||||
|
|
@ -1052,7 +1049,7 @@ sub ALLnewitem {
|
|||
=head2 OLDdeletebiblioitem($dbh,$biblioitemnumber);
|
||||
deletes a biblioitem
|
||||
NOTE : not standard sub name. Should be OLDdelbiblioitem()
|
||||
|
||||
|
||||
=head2 OLDdelbiblio($dbh,$biblio);
|
||||
delete a biblio
|
||||
|
||||
|
|
@ -1104,7 +1101,7 @@ sub OLDmodbiblio {
|
|||
# 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'});
|
||||
|
|
@ -1113,7 +1110,7 @@ sub OLDmodbiblio {
|
|||
$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'},
|
||||
|
|
@ -1125,9 +1122,9 @@ unititle = $biblio->{'unititle'},
|
|||
notes = $biblio->{'notes'}
|
||||
where biblionumber = $biblio->{'biblionumber'}";
|
||||
$sth = $dbh->prepare($query);
|
||||
|
||||
|
||||
$sth->execute;
|
||||
|
||||
|
||||
$sth->finish;
|
||||
return($biblio->{'biblionumber'});
|
||||
} # sub modbiblio
|
||||
|
|
@ -1181,7 +1178,7 @@ sub OLDmodsubject {
|
|||
and catalogueentry = '$subject[$i]'";
|
||||
my $sth = $dbh->prepare($query);
|
||||
$sth->execute;
|
||||
|
||||
|
||||
if (my $data = $sth->fetchrow_hashref) {
|
||||
} else {
|
||||
if ($force eq $subject[$i]) {
|
||||
|
|
@ -1290,7 +1287,7 @@ sub OLDnewbiblioitem {
|
|||
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'});
|
||||
|
|
@ -1311,7 +1308,7 @@ sub OLDnewbiblioitem {
|
|||
$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;
|
||||
|
|
@ -1390,7 +1387,7 @@ sub OLDnewitems {
|
|||
$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'});
|
||||
|
|
@ -1444,7 +1441,7 @@ sub OLDmoditem {
|
|||
itemnotes='$item->{'notes'}',
|
||||
homebranch='$item->{'homebranch'}',
|
||||
itemlost='$item->{'lost'}',
|
||||
wthdrawn='$item->{'wthdrawn'}'
|
||||
wthdrawn='$item->{'wthdrawn'}'
|
||||
where itemnumber=$item->{'itemnum'}";
|
||||
}
|
||||
if ($item->{'replacement'} ne ''){
|
||||
|
|
@ -1492,7 +1489,7 @@ where biblioitemnumber = $biblioitemnumber";
|
|||
my @results;
|
||||
|
||||
$sth->execute;
|
||||
|
||||
|
||||
if (@results = $sth->fetchrow_array) {
|
||||
$query = "Insert into deletedbiblioitems values (";
|
||||
foreach my $value (@results) {
|
||||
|
|
@ -1578,8 +1575,8 @@ sub itemcount{
|
|||
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);
|
||||
|
|
@ -1595,8 +1592,8 @@ sub getorder{
|
|||
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";
|
||||
|
|
@ -1810,14 +1807,14 @@ sub getitemtypes {
|
|||
# || 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
|
||||
|
|
@ -1830,14 +1827,14 @@ 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 getbiblio
|
||||
|
|
@ -1900,14 +1897,14 @@ biblio.biblionumber = items.biblionumber and biblioitemnumber
|
|||
# || 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
|
||||
|
|
@ -1921,13 +1918,13 @@ sub isbnsearch {
|
|||
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;
|
||||
|
|
@ -1942,7 +1939,7 @@ and isbn = $isbn";
|
|||
# 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'}}) {
|
||||
|
|
@ -2030,7 +2027,7 @@ sub getoraddbiblio {
|
|||
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},
|
||||
|
|
@ -2449,7 +2446,7 @@ sub OLD_MAYBE_DELETED_updateBiblio {
|
|||
$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;
|
||||
|
|
@ -2533,7 +2530,7 @@ sub OLD_MAYBE_DELETED_updateBiblio {
|
|||
}
|
||||
|
||||
# Check for subject heading changes
|
||||
|
||||
|
||||
my $newsubject='';
|
||||
my $subjects;
|
||||
foreach $newsubject (@{$biblio->{'subject'}}) {
|
||||
|
|
@ -2740,7 +2737,7 @@ sub OLD_MAYBE_DELETED_updateItem {
|
|||
$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'});
|
||||
|
|
|
|||
|
|
@ -1,10 +1,6 @@
|
|||
package C4::BookShelves; #assumes C4/BookShelves
|
||||
|
||||
#
|
||||
# $Header$
|
||||
#
|
||||
#requires DBI.pm to be installed
|
||||
package C4::BookShelves;
|
||||
|
||||
# $Id$
|
||||
|
||||
# Copyright 2000-2002 Katipo Communications
|
||||
#
|
||||
|
|
@ -28,7 +24,7 @@ require Exporter;
|
|||
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;
|
||||
|
|
@ -55,43 +51,6 @@ items to and from bookshelves.
|
|||
|
||||
@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;
|
||||
|
||||
|
|
@ -280,6 +239,10 @@ END { } # module clean-up code here (global destructor)
|
|||
|
||||
#
|
||||
# $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.
|
||||
#
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
package C4::Catalogue; #assumes C4/Acquisitions.pm
|
||||
package C4::Catalogue;
|
||||
|
||||
# Continue working on updateItem!!!!!!
|
||||
#
|
||||
|
|
@ -6,8 +6,6 @@ package C4::Catalogue; #assumes C4/Acquisitions.pm
|
|||
# functions
|
||||
#
|
||||
# Trying to track down $dbh's that aren't disconnected....
|
||||
#
|
||||
|
||||
|
||||
|
||||
# Copyright 2000-2002 Katipo Communications
|
||||
|
|
@ -33,7 +31,7 @@ use C4::Context;
|
|||
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;
|
||||
|
|
@ -74,45 +72,6 @@ orders, converting money to different currencies, and so forth.
|
|||
&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;
|
||||
|
||||
|
||||
#
|
||||
#
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ package C4::Circulation;
|
|||
|
||||
# $Id$
|
||||
|
||||
#package to deal with circulation
|
||||
#package to deal with circulation
|
||||
|
||||
|
||||
# Copyright 2000-2002 Katipo Communications
|
||||
|
|
@ -36,10 +36,10 @@ use C4::Reserves;
|
|||
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);
|
||||
|
||||
|
|
@ -53,14 +53,14 @@ sub Start_circ{
|
|||
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') {
|
||||
|
|
@ -73,12 +73,12 @@ sub Start_circ{
|
|||
&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.
|
||||
|
|
@ -131,7 +131,7 @@ sub checkoverdues{
|
|||
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");
|
||||
|
|
@ -145,37 +145,37 @@ 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;
|
||||
|
|
@ -191,7 +191,7 @@ sub checkwaiting{
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,6 @@
|
|||
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
|
||||
|
|
@ -41,49 +43,14 @@ use C4::Scan;
|
|||
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) = @_;
|
||||
|
|
@ -99,38 +66,38 @@ sub findborrower {
|
|||
#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;
|
||||
|
|
@ -161,8 +128,8 @@ sub findoneborrower {
|
|||
$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;
|
||||
|
|
@ -177,17 +144,17 @@ sub findoneborrower {
|
|||
$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'};
|
||||
|
|
@ -195,22 +162,22 @@ sub findoneborrower {
|
|||
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");}
|
||||
|
|
@ -219,18 +186,18 @@ sub checktraps {
|
|||
#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);
|
||||
}
|
||||
|
|
@ -241,7 +208,7 @@ sub process_traps {
|
|||
my $x = 0;
|
||||
my %traps;
|
||||
while (@$traps_set[$x] ne "") {
|
||||
$traps{@$traps_set[$x]} = 1;
|
||||
$traps{@$traps_set[$x]} = 1;
|
||||
$x++;
|
||||
}
|
||||
my $traps_done;
|
||||
|
|
@ -251,7 +218,7 @@ sub process_traps {
|
|||
$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;
|
||||
|
|
@ -283,8 +250,8 @@ sub process_traps {
|
|||
}
|
||||
} 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();
|
||||
|
|
@ -300,8 +267,8 @@ sub process_traps {
|
|||
push @newtraps,$traps_set->[$x];
|
||||
}
|
||||
$x++;
|
||||
}
|
||||
$traps_set = \@newtraps;
|
||||
}
|
||||
$traps_set = \@newtraps;
|
||||
}
|
||||
}
|
||||
my $notr = @$traps_set;
|
||||
|
|
@ -346,7 +313,7 @@ sub Borenq {
|
|||
}
|
||||
}
|
||||
return $reason;
|
||||
}
|
||||
}
|
||||
|
||||
sub modifyuser {
|
||||
my ($env,$borrower) = @_;
|
||||
|
|
@ -383,7 +350,7 @@ Allocates a new, unused borrower number, and returns it.
|
|||
=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
|
||||
|
|
@ -408,7 +375,7 @@ sub NewBorrowerNumber {
|
|||
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;
|
||||
|
|
@ -421,4 +388,3 @@ sub findguarantees{
|
|||
$sth->finish;
|
||||
return($i,\@dat);
|
||||
}
|
||||
END { } # module clean-up code here (global destructor)
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@ sub Getoverdues{
|
|||
$sth->finish;
|
||||
# print @results;
|
||||
# FIXME - Bogus API.
|
||||
return($i,\@results);
|
||||
return($i,\@results);
|
||||
}
|
||||
|
||||
=item CalcFine
|
||||
|
|
@ -252,7 +252,7 @@ sub UpdateFine {
|
|||
# an existing fine.
|
||||
# print "in accounts ...";
|
||||
if ($data->{'amount'} != $amount){
|
||||
|
||||
|
||||
# print "updating";
|
||||
my $diff=$amount - $data->{'amount'};
|
||||
my $out=$data->{'amountoutstanding'}+$diff;
|
||||
|
|
@ -263,7 +263,7 @@ sub UpdateFine {
|
|||
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'}"
|
||||
}
|
||||
|
|
@ -316,7 +316,7 @@ category he or she belongs to.
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ use C4::Print;
|
|||
use C4::Format;
|
||||
use C4::Input;
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
|
||||
|
||||
# set the version for version checking
|
||||
$VERSION = 0.01;
|
||||
|
||||
|
|
@ -85,7 +85,7 @@ sub Issue {
|
|||
$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 "") {
|
||||
|
|
@ -96,7 +96,7 @@ sub Issue {
|
|||
$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";
|
||||
|
|
@ -108,10 +108,10 @@ sub Issue {
|
|||
}
|
||||
#&endint($env);
|
||||
}
|
||||
}
|
||||
}
|
||||
Cdk::refreshCdkScreen();
|
||||
return ($done);
|
||||
}
|
||||
}
|
||||
|
||||
# FIXME - Not exported, but called by "telnet/borrwraper.pl".
|
||||
# Presumably this function is obsolete.
|
||||
|
|
@ -120,7 +120,7 @@ sub processitems {
|
|||
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";
|
||||
|
|
@ -136,31 +136,31 @@ sub processitems {
|
|||
$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;
|
||||
}
|
||||
|
||||
|
|
@ -207,7 +207,7 @@ sub formatitem {
|
|||
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.
|
||||
|
|
@ -222,7 +222,7 @@ sub issueitem{
|
|||
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;
|
||||
|
|
@ -234,7 +234,7 @@ sub issueitem{
|
|||
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");
|
||||
|
|
@ -250,9 +250,9 @@ sub issueitem{
|
|||
}
|
||||
#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;
|
||||
|
|
@ -262,14 +262,14 @@ sub issueitem{
|
|||
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'}'
|
||||
|
|
@ -278,7 +278,7 @@ sub issueitem{
|
|||
$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;
|
||||
|
|
@ -294,7 +294,7 @@ sub issueitem{
|
|||
} 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'}'
|
||||
|
|
@ -308,7 +308,7 @@ sub issueitem{
|
|||
};
|
||||
}
|
||||
#if charge deal with it
|
||||
|
||||
|
||||
if ($canissue == 1) {
|
||||
$charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
|
||||
}
|
||||
|
|
@ -319,22 +319,22 @@ sub issueitem{
|
|||
&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");
|
||||
|
|
@ -362,14 +362,14 @@ sub updateissues{
|
|||
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;
|
||||
|
|
@ -378,7 +378,7 @@ sub updateissues{
|
|||
$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);
|
||||
|
|
@ -421,8 +421,8 @@ sub calc_charges {
|
|||
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);
|
||||
|
|
@ -432,7 +432,7 @@ sub calc_charges {
|
|||
$charge = ($charge *(100 - $discount)) / 100;
|
||||
}
|
||||
$sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
|
||||
}
|
||||
}
|
||||
$sth1->finish;
|
||||
return ($charge);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -41,47 +41,13 @@ use C4::Stats;
|
|||
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
|
||||
|
|
@ -89,7 +55,7 @@ my $priv_func = sub {
|
|||
# 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;
|
||||
|
|
@ -105,14 +71,14 @@ sub Returns {
|
|||
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);
|
||||
|
|
@ -120,7 +86,7 @@ sub Returns {
|
|||
$issues = "";
|
||||
$odues = "";
|
||||
$amt_owing = "";
|
||||
}
|
||||
}
|
||||
if ($resp ne "") {
|
||||
#if ($resp eq "Returned") {
|
||||
if ($itemno ne "" ) {
|
||||
|
|
@ -131,14 +97,14 @@ sub Returns {
|
|||
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 = "";
|
||||
#}
|
||||
}
|
||||
}
|
||||
|
|
@ -159,10 +125,10 @@ sub checkissue {
|
|||
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;
|
||||
|
|
@ -182,8 +148,8 @@ sub checkissue {
|
|||
$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'});
|
||||
|
|
@ -191,20 +157,20 @@ sub checkissue {
|
|||
}
|
||||
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
|
||||
}
|
||||
|
|
@ -219,9 +185,9 @@ sub returnrecord {
|
|||
#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;
|
||||
|
|
@ -248,14 +214,14 @@ sub returnrecord {
|
|||
}
|
||||
$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'};
|
||||
|
|
@ -289,7 +255,7 @@ sub returnrecord {
|
|||
$usth = $dbh->prepare($uquery);
|
||||
$usth->execute;
|
||||
$usth->finish;
|
||||
}
|
||||
}
|
||||
$sth->finish;
|
||||
UpdateStats($env,'branch','return','0','',$itemno);
|
||||
return($oduecharge);
|
||||
|
|
@ -303,7 +269,7 @@ sub calc_odues {
|
|||
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
|
||||
|
|
@ -312,13 +278,13 @@ sub calc_odues {
|
|||
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;
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -329,7 +295,7 @@ sub updatelastseen {
|
|||
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);
|
||||
|
|
@ -360,7 +326,7 @@ sub find_reserves {
|
|||
$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'}'
|
||||
|
|
@ -376,9 +342,9 @@ sub find_reserves {
|
|||
my $updsth = $dbh->prepare($updquery);
|
||||
$updsth->execute;
|
||||
$updsth->finish;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$sth->finish;
|
||||
return ($resfound,$resrec);
|
||||
return ($resfound,$resrec);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -28,48 +28,13 @@ use strict;
|
|||
|
||||
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");
|
||||
|
|
@ -79,7 +44,7 @@ sub accountsdialog {
|
|||
#$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();
|
||||
|
|
@ -106,7 +71,6 @@ sub accountsdialog {
|
|||
makepayment($borrowerno,$accountno,$amount2);
|
||||
$amount+=$amount2;
|
||||
}
|
||||
|
||||
}
|
||||
my $amountentry = new Cdk::Entry('Label'=>"Amount: ",
|
||||
'Max'=>"10",'Width'=>"10",
|
||||
|
|
@ -114,9 +78,9 @@ sub accountsdialog {
|
|||
'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();
|
||||
|
|
|
|||
|
|
@ -28,50 +28,18 @@ use Cdk;
|
|||
|
||||
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)=@_;
|
||||
|
|
@ -106,8 +74,8 @@ sub BorrAddpanel {
|
|||
while ($i < $numflds) {
|
||||
$responses[$i] =$info->[$i][0];
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return($reason,@responses);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -27,48 +27,14 @@ use strict;
|
|||
|
||||
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");
|
||||
|
|
@ -80,13 +46,13 @@ sub trapscreen {
|
|||
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;
|
||||
|
|
@ -109,8 +75,8 @@ sub trapsnotes {
|
|||
$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;
|
||||
|
|
|
|||
|
|
@ -30,47 +30,13 @@ use Date::Manip;
|
|||
|
||||
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)=@_;
|
||||
|
|
@ -88,8 +54,4 @@ sub renew_window {
|
|||
undef $issuelist;
|
||||
undef $borrbox;
|
||||
return \@renews;
|
||||
}
|
||||
|
||||
END { } # module clean-up code here (global destructor)
|
||||
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -29,57 +29,25 @@ use Cdk;
|
|||
|
||||
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);
|
||||
|
|
@ -104,21 +72,21 @@ sub FindBiblioScreen {
|
|||
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;
|
||||
|
|
@ -138,8 +106,8 @@ sub MakeReserveScreen {
|
|||
} 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");
|
||||
|
|
@ -147,7 +115,7 @@ sub MakeReserveScreen {
|
|||
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;
|
||||
|
|
@ -156,11 +124,11 @@ sub MakeReserveScreen {
|
|||
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",
|
||||
|
|
@ -193,17 +161,17 @@ sub MakeReserveScreen {
|
|||
'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) {
|
||||
|
|
@ -213,7 +181,7 @@ sub MakeReserveScreen {
|
|||
@answers[1] = "";
|
||||
} else {
|
||||
my @brline = split(" ",@$branches[$x]);
|
||||
@answers[1] = @brline[0];
|
||||
@answers[1] = @brline[0];
|
||||
$complete = 2;
|
||||
$answers[2] = "a";
|
||||
$answers[3] = "";
|
||||
|
|
@ -227,7 +195,7 @@ sub MakeReserveScreen {
|
|||
@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
|
||||
|
|
@ -244,22 +212,22 @@ sub MakeReserveScreen {
|
|||
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)
|
||||
|
|
|
|||
32
C4/Output.pm
32
C4/Output.pm
|
|
@ -1,5 +1,7 @@
|
|||
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
|
||||
|
|
@ -22,13 +24,16 @@ package C4::Output;
|
|||
# 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;
|
||||
|
|
@ -66,31 +71,6 @@ printable string.
|
|||
&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";
|
||||
|
|
|
|||
105
C4/Reserves.pm
105
C4/Reserves.pm
|
|
@ -1,5 +1,7 @@
|
|||
package C4::Reserves;
|
||||
|
||||
# $Id$
|
||||
|
||||
# Copyright 2000-2002 Katipo Communications
|
||||
#
|
||||
# This file is part of Koha.
|
||||
|
|
@ -31,52 +33,18 @@ use C4::Interface::ReserveentCDK;
|
|||
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");
|
||||
|
|
@ -85,7 +53,7 @@ sub EnterReserves{
|
|||
my $donext ="Circ";
|
||||
if ($reason ne "") {
|
||||
$donext = $reason;
|
||||
} else {
|
||||
} else {
|
||||
my %search;
|
||||
$search{'title'}= $title;
|
||||
$search{'keyword'}=$keyword;
|
||||
|
|
@ -108,7 +76,7 @@ sub EnterReserves{
|
|||
} else {
|
||||
if ($keyword ne ''){
|
||||
($count,@results)=&KeywordSearch($env,'intra',\%search,$num,$offset);
|
||||
} else {
|
||||
} else {
|
||||
($count,@results)=&CatSearch($env,'loose',\%search,$num,$offset);
|
||||
}
|
||||
}
|
||||
|
|
@ -118,8 +86,8 @@ sub EnterReserves{
|
|||
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;
|
||||
|
|
@ -129,7 +97,7 @@ sub EnterReserves{
|
|||
$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++;
|
||||
}
|
||||
|
|
@ -138,12 +106,12 @@ sub EnterReserves{
|
|||
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;
|
||||
|
|
@ -168,25 +136,25 @@ sub EnterReserves{
|
|||
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
|
||||
|
|
@ -196,8 +164,8 @@ sub CalcReserveFee {
|
|||
#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;
|
||||
|
|
@ -209,7 +177,7 @@ sub CalcReserveFee {
|
|||
# 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);
|
||||
|
|
@ -225,7 +193,7 @@ sub CalcReserveFee {
|
|||
$found = 1;
|
||||
}
|
||||
$x++;
|
||||
}
|
||||
}
|
||||
if ($const eq 'o') {if ($found == 1) {push @biblioitems,$data;}
|
||||
} else {if ($found == 0) {push @biblioitems,$data;} }
|
||||
}
|
||||
|
|
@ -236,13 +204,13 @@ sub CalcReserveFee {
|
|||
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();
|
||||
|
|
@ -257,7 +225,7 @@ sub CalcReserveFee {
|
|||
$rsth->execute();
|
||||
if (my $rdata = $rsth->fetchrow_hashref) { } else {
|
||||
$fee = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return $fee;
|
||||
|
|
@ -273,7 +241,7 @@ sub CreateReserve {
|
|||
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);
|
||||
|
|
@ -306,13 +274,8 @@ sub CreateReserve {
|
|||
#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
|
||||
|
|
|
|||
|
|
@ -1,9 +1,7 @@
|
|||
#!/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
|
||||
|
|
@ -29,15 +27,9 @@ package C4::SimpleMarc;
|
|||
# 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;
|
||||
|
|
@ -62,16 +54,12 @@ This module provides functions for parsing MARC records and files.
|
|||
|
||||
@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,
|
||||
|
|
@ -81,32 +69,6 @@ This module provides functions for parsing MARC records and files.
|
|||
%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;
|
||||
#------------------------------------------------
|
||||
|
||||
#------------------
|
||||
|
|
@ -246,7 +208,7 @@ sub extractmarcfields {
|
|||
# $record->[0]->{'subfields'}->{'a'} = subfieldvalue
|
||||
)=@_;
|
||||
|
||||
# return
|
||||
# return
|
||||
my $bib; # pointer to hash of named output fields
|
||||
# Example: $bib->{'author'} = "Twain, Mark";
|
||||
|
||||
|
|
@ -254,16 +216,16 @@ sub extractmarcfields {
|
|||
|
||||
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,
|
||||
);
|
||||
|
||||
|
|
@ -343,7 +305,7 @@ sub extractmarcfields {
|
|||
}
|
||||
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 {
|
||||
|
|
@ -412,7 +374,7 @@ sub extractmarcfields {
|
|||
$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} ) {
|
||||
|
|
@ -604,6 +566,10 @@ sub taglabel {
|
|||
|
||||
#---------------------------------------------
|
||||
# $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.
|
||||
#
|
||||
|
|
|
|||
34
C4/Z3950.pm
34
C4/Z3950.pm
|
|
@ -1,4 +1,4 @@
|
|||
package C4::Z3950;
|
||||
package C4::Z3950;
|
||||
|
||||
# $Id$
|
||||
|
||||
|
|
@ -66,8 +66,8 @@ entering Z39.50 lookup requests.
|
|||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(
|
||||
&z3950servername
|
||||
&addz3950queue
|
||||
&z3950servername
|
||||
&addz3950queue
|
||||
);
|
||||
|
||||
#------------------------------------------------
|
||||
|
|
@ -89,7 +89,7 @@ sub z3950servername {
|
|||
# inputs
|
||||
my (
|
||||
$dbh, # FIXME - Unused argument
|
||||
$srvid, # server id number
|
||||
$srvid, # server id number
|
||||
$default,
|
||||
)=@_;
|
||||
# return
|
||||
|
|
@ -99,8 +99,8 @@ sub z3950servername {
|
|||
$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 ) {
|
||||
|
|
@ -171,7 +171,7 @@ sub addz3950queue {
|
|||
|
||||
# FIXME - Should be configurable, probably in /etc/koha.conf.
|
||||
my $pidfile='/var/log/koha/processz3950queue.pid';
|
||||
|
||||
|
||||
$error="";
|
||||
|
||||
$dbh = C4::Context->dbh;
|
||||
|
|
@ -186,16 +186,16 @@ sub addz3950queue {
|
|||
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;
|
||||
|
|
@ -218,15 +218,15 @@ sub addz3950queue {
|
|||
# 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`;
|
||||
|
|
@ -256,7 +256,7 @@ sub addz3950queue {
|
|||
# server list is empty
|
||||
$error.="No Z39.50 search servers specified. ";
|
||||
} # if serverlist empty
|
||||
|
||||
|
||||
return $error;
|
||||
|
||||
} # sub addz3950queue
|
||||
|
|
@ -274,6 +274,10 @@ Koha Developement team <info@koha.org>
|
|||
|
||||
#--------------------------------------
|
||||
# $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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue