[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Koha-cvs] koha bookshelves/addbookbybiblionumber.pl books...
|
From: |
paul poulain |
|
Subject: |
[Koha-cvs] koha bookshelves/addbookbybiblionumber.pl books... |
|
Date: |
Wed, 04 Apr 2007 16:46:24 +0000 |
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/04/04 16:46:23
Modified files:
bookshelves : addbookbybiblionumber.pl shelves.pl
C4 : Accounts.pm Auth.pm Auth_with_ldap.pm Biblio.pm
BookShelves.pm Date.pm Members.pm Print.pm
Reserves2.pm
C4/Circulation : Fines.pm
catalogue : issuehistory.pl moredetail.pl
circ : bookcount.pl branchoverdues.pl
branchreserves.pl branchtransfers.pl
circulation.pl currenttransfers.pl returns.pl
selectbranchprinter.pl
waitingreservestransfers.pl
members : deletemem.pl member-flags.pl member-password.pl
moremember.pl pay.pl
misc : fines.pl fines2.pl
misc/cronjobs : notifyMailsOp.pl
misc/notifys : contact_history.pl fines.pl printnote.pl
opac : opac-account.pl opac-addbookbybiblionumber.pl
opac-passwd.pl opac-readingrecord.pl
opac-renew.pl opac-reserve.pl opac-review.pl
opac-shelves.pl opac-showreviews.pl
opac-user.pl opac-userdetails.pl
opac-userupdate.pl
reports : acquisitions_stats.pl bor_issues_top.pl
borrowers_out.pl borrowers_stats.pl
cat_issues_top.pl catalogue_out.pl
catalogue_stats.pl inventory.pl
issues_avg_stats.pl issues_stats.pl manager.pl
reserve : placerequest.pl renewscript.pl request.pl
serials : routing-preview.pl
tools : cleanborrowers.pl inventory.pl itemslost.pl
Removed files:
C4/Circulation : Circ2.pm
Log message:
HUGE COMMIT : code cleaning circulation.
some stuff to do, i'll write a mail on koha-devel NOW !
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/bookshelves/addbookbybiblionumber.pl?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/bookshelves/shelves.pl?cvsroot=koha&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Accounts.pm?cvsroot=koha&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Auth.pm?cvsroot=koha&r1=1.58&r2=1.59
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Auth_with_ldap.pm?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&r1=1.194&r2=1.195
http://cvs.savannah.gnu.org/viewcvs/koha/C4/BookShelves.pm?cvsroot=koha&r1=1.20&r2=1.21
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Date.pm?cvsroot=koha&r1=1.28&r2=1.29
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Members.pm?cvsroot=koha&r1=1.40&r2=1.41
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Print.pm?cvsroot=koha&r1=1.19&r2=1.20
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Reserves2.pm?cvsroot=koha&r1=1.51&r2=1.52
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Fines.pm?cvsroot=koha&r1=1.23&r2=1.24
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&r1=1.129&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/catalogue/issuehistory.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/catalogue/moredetail.pl?cvsroot=koha&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/circ/bookcount.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/circ/branchoverdues.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/circ/branchreserves.pl?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/circ/branchtransfers.pl?cvsroot=koha&r1=1.27&r2=1.28
http://cvs.savannah.gnu.org/viewcvs/koha/circ/circulation.pl?cvsroot=koha&r1=1.102&r2=1.103
http://cvs.savannah.gnu.org/viewcvs/koha/circ/currenttransfers.pl?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/circ/returns.pl?cvsroot=koha&r1=1.46&r2=1.47
http://cvs.savannah.gnu.org/viewcvs/koha/circ/selectbranchprinter.pl?cvsroot=koha&r1=1.17&r2=1.18
http://cvs.savannah.gnu.org/viewcvs/koha/circ/waitingreservestransfers.pl?cvsroot=koha&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/koha/members/deletemem.pl?cvsroot=koha&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/members/member-flags.pl?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/members/member-password.pl?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/members/moremember.pl?cvsroot=koha&r1=1.30&r2=1.31
http://cvs.savannah.gnu.org/viewcvs/koha/members/pay.pl?cvsroot=koha&r1=1.8&r2=1.9
http://cvs.savannah.gnu.org/viewcvs/koha/misc/fines.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/misc/fines2.pl?cvsroot=koha&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/koha/misc/cronjobs/notifyMailsOp.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/misc/notifys/contact_history.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/misc/notifys/fines.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/misc/notifys/printnote.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-account.pl?cvsroot=koha&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-addbookbybiblionumber.pl?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-passwd.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-readingrecord.pl?cvsroot=koha&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-renew.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-reserve.pl?cvsroot=koha&r1=1.30&r2=1.31
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-review.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-shelves.pl?cvsroot=koha&r1=1.9&r2=1.10
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-showreviews.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-user.pl?cvsroot=koha&r1=1.24&r2=1.25
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-userdetails.pl?cvsroot=koha&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-userupdate.pl?cvsroot=koha&r1=1.15&r2=1.16
http://cvs.savannah.gnu.org/viewcvs/koha/reports/acquisitions_stats.pl?cvsroot=koha&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/koha/reports/bor_issues_top.pl?cvsroot=koha&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/reports/borrowers_out.pl?cvsroot=koha&r1=1.8&r2=1.9
http://cvs.savannah.gnu.org/viewcvs/koha/reports/borrowers_stats.pl?cvsroot=koha&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/koha/reports/cat_issues_top.pl?cvsroot=koha&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/koha/reports/catalogue_out.pl?cvsroot=koha&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/koha/reports/catalogue_stats.pl?cvsroot=koha&r1=1.19&r2=1.20
http://cvs.savannah.gnu.org/viewcvs/koha/reports/inventory.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/reports/issues_avg_stats.pl?cvsroot=koha&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/koha/reports/issues_stats.pl?cvsroot=koha&r1=1.15&r2=1.16
http://cvs.savannah.gnu.org/viewcvs/koha/reports/manager.pl?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/reserve/placerequest.pl?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/reserve/renewscript.pl?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/reserve/request.pl?cvsroot=koha&r1=1.8&r2=1.9
http://cvs.savannah.gnu.org/viewcvs/koha/serials/routing-preview.pl?cvsroot=koha&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/tools/cleanborrowers.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/tools/inventory.pl?cvsroot=koha&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/tools/itemslost.pl?cvsroot=koha&r1=1.2&r2=1.3
Patches:
Index: bookshelves/addbookbybiblionumber.pl
===================================================================
RCS file: /sources/koha/koha/bookshelves/addbookbybiblionumber.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- bookshelves/addbookbybiblionumber.pl 9 Mar 2007 14:32:26 -0000
1.6
+++ bookshelves/addbookbybiblionumber.pl 4 Apr 2007 16:46:22 -0000
1.7
@@ -20,7 +20,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: addbookbybiblionumber.pl,v 1.6 2007/03/09 14:32:26 tipaul Exp $
+# $Id: addbookbybiblionumber.pl,v 1.7 2007/04/04 16:46:22 tipaul Exp $
=head1 NAME
@@ -60,7 +60,7 @@
use CGI;
use C4::Output;
use C4::BookShelves;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Auth;
use C4::Interface::CGI::Output;
@@ -122,6 +122,11 @@
}
# $Log: addbookbybiblionumber.pl,v $
+# Revision 1.7 2007/04/04 16:46:22 tipaul
+# HUGE COMMIT : code cleaning circulation.
+#
+# some stuff to do, i'll write a mail on koha-devel NOW !
+#
# Revision 1.6 2007/03/09 14:32:26 tipaul
# rel_3_0 moved to HEAD
#
Index: bookshelves/shelves.pl
===================================================================
RCS file: /sources/koha/koha/bookshelves/shelves.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- bookshelves/shelves.pl 9 Mar 2007 14:32:26 -0000 1.11
+++ bookshelves/shelves.pl 4 Apr 2007 16:46:22 -0000 1.12
@@ -67,7 +67,7 @@
use CGI;
use C4::Output;
use C4::BookShelves;
-use C4::Circulation::Circ2;
+use C4::Biblio;
use C4::Auth;
use C4::Interface::CGI::Output;
@@ -86,7 +86,7 @@
if ( $query->param('modifyshelfcontents') ) {
my $shelfnumber = $query->param('viewshelf');
my $barcode = $query->param('addbarcode');
- my ($item) = getiteminformation( 0, $barcode );
+ my ($item) = GetItem( 0, $barcode );
if ( ShelfPossibleAction( $loggedinuser, $shelfnumber, 'manage' ) ) {
AddToShelf( $item->{'itemnumber'}, $shelfnumber );
foreach ( $query->param ) {
@@ -281,6 +281,11 @@
#
# $Log: shelves.pl,v $
+# Revision 1.12 2007/04/04 16:46:22 tipaul
+# HUGE COMMIT : code cleaning circulation.
+#
+# some stuff to do, i'll write a mail on koha-devel NOW !
+#
# Revision 1.11 2007/03/09 14:32:26 tipaul
# rel_3_0 moved to HEAD
#
Index: C4/Accounts.pm
===================================================================
RCS file: /sources/koha/koha/C4/Accounts.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- C4/Accounts.pm 9 Mar 2007 23:33:26 -0000 1.18
+++ C4/Accounts.pm 4 Apr 2007 16:46:22 -0000 1.19
@@ -17,18 +17,18 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Accounts.pm,v 1.18 2007/03/09 23:33:26 kados Exp $
+# $Id: Accounts.pm,v 1.19 2007/04/04 16:46:22 tipaul Exp $
use strict;
require Exporter;
use C4::Context;
use C4::Stats;
use C4::Members;
-#use C4::Circulation::Circ2;
+#use C4::Circulation;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.18 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.19 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -55,7 +55,7 @@
=head2 checkaccount
- $owed = &checkaccount($env, $borrowernumber, $dbh, $date);
+ $owed = &checkaccount($borrowernumber, $dbh, $date);
Looks up the total amount of money owed by a borrower (fines, etc.).
@@ -71,7 +71,7 @@
sub checkaccount {
#take borrower number
#check accounts and list amounts owing
- my ($env,$borrowernumber,$dbh,$date)address@hidden;
+ my ($borrowernumber,$dbh,$date)address@hidden;
my $select="SELECT SUM(amountoutstanding) AS total
FROM accountlines
WHERE borrowernumber = ?
@@ -126,7 +126,7 @@
warn $branch;
my $amountleft = $data;
# begin transaction
- my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
+ my $nextaccntno = getnextacctno($borrowernumber);
# get lines with outstanding amounts to offset
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?) and (amountoutstanding<>0)
@@ -189,7 +189,7 @@
$env{'branchcode'}=$branch;
my $dbh = C4::Context->dbh;
# begin transaction
- my $nextaccntno = getnextacctno(\%env,$borrowernumber,$dbh);
+ my $nextaccntno = getnextacctno($borrowernumber);
my $newamtos=0;
my $sth=$dbh->prepare("Select * from accountlines where borrowernumber=?
and accountno=?");
$sth->execute($borrowernumber,$accountno);
@@ -234,7 +234,7 @@
=head2 getnextacctno
- $nextacct = &getnextacctno($env, $borrowernumber, $dbh);
+ $nextacct = &getnextacctno($borrowernumber);
Returns the next unused account number for the patron with the given
borrower number.
@@ -248,11 +248,12 @@
#'
# FIXME - Okay, so what does the above actually _mean_?
sub getnextacctno {
- my ($env,$borrowernumber,$dbh)address@hidden;
+ my ($borrowernumber)address@hidden;
my $nextaccntno = 1;
- my $sth = $dbh->prepare("select * from accountlines
- where (borrowernumber = ?)
- order by accountno desc");
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT * FROM accountlines
+ WHERE (borrowernumber = ?)
+ ORDER BY accountno DESC");
$sth->execute($borrowernumber);
if (my $accdata=$sth->fetchrow_hashref){
$nextaccntno = $accdata->{'accountno'} + 1;
@@ -330,7 +331,7 @@
my $insert;
$itemnum=~ s/ //g;
my %env;
- my $accountno=getnextacctno('',$borrowernumber,$dbh);
+ my $accountno=getnextacctno($borrowernumber);
my $amountleft=$amount;
if ($type eq 'CS' || $type eq 'CB' || $type eq 'CW'
@@ -395,8 +396,8 @@
my $accdata = "";
my $amountleft = $data;
if ($barcode ne ''){
- my $item=getiteminformation('',$barcode);
- my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
+ my $item=GetBiblioFromItemNumber('',$barcode);
+ my $nextaccntno = getnextacctno($borrowernumber);
my $query="Select * from accountlines where (borrowernumber=?
and itemnumber=? and amountoutstanding > 0)";
if ($type eq 'CL'){
@@ -431,7 +432,7 @@
$usth->finish;
}
# begin transaction
- my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
+ my $nextaccntno = getnextacctno($borrowernumber);
# get lines with outstanding amounts to offset
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?) and (amountoutstanding >0)
@@ -483,7 +484,7 @@
my $amountleft = $data *-1;
# begin transaction
- my $nextaccntno = getnextacctno($env,$borrowernumber,$dbh);
+ my $nextaccntno = getnextacctno($borrowernumber);
# get lines with outstanding amounts to offset
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?) and (amountoutstanding<0)
Index: C4/Auth.pm
===================================================================
RCS file: /sources/koha/koha/C4/Auth.pm,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -b -r1.58 -r1.59
--- C4/Auth.pm 9 Mar 2007 14:31:47 -0000 1.58
+++ C4/Auth.pm 4 Apr 2007 16:46:22 -0000 1.59
@@ -27,7 +27,7 @@
use C4::Context;
use C4::Output; # to get the template
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2; # getpatroninformation
+use C4::Members;
use C4::Koha;
use C4::Branch; # GetBranches
@@ -37,7 +37,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.58 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.59 $' =~ /\d+/g;
shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
};
@@ -130,7 +130,7 @@
$borrowernumber = getborrowernumber($user);
my ( $borr, $alternativeflags ) =
- getpatroninformation( undef, $borrowernumber );
+ GetMemberDetails( $borrowernumber );
my @bordat;
$bordat[0] = $borr;
$template->param( "USER_INFO" => address@hidden );
Index: C4/Auth_with_ldap.pm
===================================================================
RCS file: /sources/koha/koha/C4/Auth_with_ldap.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- C4/Auth_with_ldap.pm 9 Mar 2007 14:31:47 -0000 1.6
+++ C4/Auth_with_ldap.pm 4 Apr 2007 16:46:22 -0000 1.7
@@ -27,7 +27,6 @@
use C4::Context;
use C4::Output; # to get the template
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2; # getpatroninformation
use C4::Members;
# use Net::LDAP;
@@ -136,7 +135,7 @@
$borrowernumber = getborrowernumber($user);
my ( $borr, $alternativeflags ) =
- getpatroninformation( undef, $borrowernumber );
+ GetMemberDetails( $borrowernumber );
my @bordat;
$bordat[0] = $borr;
$template->param( USER_INFO => address@hidden, );
Index: C4/Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.194
retrieving revision 1.195
diff -u -b -r1.194 -r1.195
--- C4/Biblio.pm 30 Mar 2007 12:00:42 -0000 1.194
+++ C4/Biblio.pm 4 Apr 2007 16:46:22 -0000 1.195
@@ -33,7 +33,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.194 $' =~ /\d+/g; shift(@v).".".join(
"_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.195 $' =~ /\d+/g; shift(@v).".".join(
"_", map { sprintf "%03d", $_ } @v ); };
@ISA = qw( Exporter );
@@ -52,9 +52,12 @@
&GetBiblioFromItemNumber
&GetMarcItem
+ &GetItem
&GetItemInfosOf
&GetItemStatus
&GetItemLocation
+ &GetLostItems
+ &GetItemsForInventory
&GetMarcNotes
&GetMarcSubjects
@@ -82,6 +85,7 @@
&ModZebra
&ModItemInMarc
&ModItemInMarconefield
+ &ModDateLastSeen
);
# To delete something
@@ -501,6 +505,24 @@
ModZebra($biblionumber,"specialUpdate","biblioserver");
}
+=head2 ModDateLastSeen
+
+&ModDateLastSeen($itemnum)
+Mark item as seen. Is called when an item is issued, returned or manually
marked during inventory/stocktaking
+C<$itemnum> is the item number
+
+=cut
+
+sub ModDateLastSeen {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+ "update items set itemlost=0, datelastseen = now() where
items.itemnumber = ?"
+ );
+ $sth->execute($itemnum);
+ return;
+}
=head2 DelBiblio
=over
@@ -970,6 +992,114 @@
return \%itemlocation;
}
+=head2 GetLostItems
+
+$items = GetLostItems($where,$orderby);
+
+This function get the items lost into C<$items>.
+
+=over 2
+
+=item input:
+C<$where> is a hashref. it containts a field of the items table as key
+and the value to match as value.
+C<$orderby> is a field of the items table.
+
+=item return:
+C<$items> is a reference to an array full of hasref which keys are items'
table column.
+
+=item usage in the perl script:
+
+my %where;
+$where{barcode} = 0001548;
+my $items = GetLostItems( \%where, "homebranch" );
+$template->param(itemsloop => $items);
+
+=back
+
+=cut
+
+sub GetLostItems {
+ # Getting input args.
+ my $where = shift;
+ my $orderby = shift;
+ my $dbh = C4::Context->dbh;
+
+ my $query = "
+ SELECT *
+ FROM items
+ WHERE itemlost IS NOT NULL
+ AND itemlost <> 0
+ ";
+ foreach my $key (keys %$where) {
+ $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
+ }
+ $query .= " ORDER BY ".$orderby if defined $orderby;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @items;
+ while ( my $row = $sth->fetchrow_hashref ){
+ push @items, $row;
+ }
+ return address@hidden;
+}
+
+=head2 GetItemsForInventory
+
+$itemlist =
GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
+
+Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
+
+The sub returns a list of hashes, containing itemnumber, author, title,
barcode & item callnumber.
+It is ordered by callnumber,title.
+
+The minlocation & maxlocation parameters are used to specify a range of item
callnumbers
+the datelastseen can be used to specify that you want to see items not seen
since a past date only.
+offset & size can be used to retrieve only a part of the whole listing (defaut
behaviour)
+
+=cut
+
+sub GetItemsForInventory {
+ my ( $minlocation, $maxlocation, $datelastseen, $branch, $offset, $size )
= @_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if ($datelastseen) {
+ my $query =
+ "SELECT
itemnumber,barcode,itemcallnumber,title,author,datelastseen
+ FROM items
+ LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
+ WHERE itemcallnumber>= ?
+ AND itemcallnumber <=?
+ AND (datelastseen< ? OR datelastseen IS NULL)";
+ $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
+ $query .= " ORDER BY itemcallnumber,title";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $minlocation, $maxlocation, $datelastseen );
+ }
+ else {
+ my $query ="
+ SELECT
itemnumber,barcode,itemcallnumber,title,author,datelastseen
+ FROM items
+ LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
+ WHERE itemcallnumber>= ?
+ AND itemcallnumber <=?";
+ $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
+ $query .= " ORDER BY itemcallnumber,title";
+ $sth = $dbh->prepare($query);
+ $sth->execute( $minlocation, $maxlocation );
+ }
+ my @results;
+ while ( my $row = $sth->fetchrow_hashref ) {
+ $offset-- if ($offset);
+ if ( ( !$offset ) && $size ) {
+ push @results, $row;
+ $size--;
+ }
+ }
+ return address@hidden;
+}
+
=head2 &GetBiblioItemData
=over 4
@@ -1110,6 +1240,39 @@
return ( $count, @results );
} # sub GetBiblio
+=head2 GetItem
+
+=over 4
+
+$data = &GetItem($itemnumber,$barcode);
+
+return Item information, for a given itemnumber or barcode
+
+=back
+
+=cut
+
+sub GetItem {
+ my ($itemnumber,$barcode) = @_;
+ my $dbh = C4::Context->dbh;
+ if ($itemnumber) {
+ my $sth = $dbh->prepare("
+ SELECT * FROM items
+ WHERE itemnumber = ?");
+ $sth->execute($itemnumber);
+ my $data = $sth->fetchrow_hashref;
+ return $data;
+ } else {
+ my $sth = $dbh->prepare("
+ SELECT * FROM items
+ WHERE barcode = ?"
+ );
+ $sth->execute($barcode);
+ my $data = $sth->fetchrow_hashref;
+ return $data;
+ }
+} # sub GetItem
+
=head2 get_itemnumbers_of
=over 4
@@ -1445,6 +1608,8 @@
return $newrecord;
}
+
+
=head2 GetMarcNotes
=over 4
@@ -3487,8 +3652,13 @@
=cut
-# $Id: Biblio.pm,v 1.194 2007/03/30 12:00:42 tipaul Exp $
+# $Id: Biblio.pm,v 1.195 2007/04/04 16:46:22 tipaul Exp $
# $Log: Biblio.pm,v $
+# Revision 1.195 2007/04/04 16:46:22 tipaul
+# HUGE COMMIT : code cleaning circulation.
+#
+# some stuff to do, i'll write a mail on koha-devel NOW !
+#
# Revision 1.194 2007/03/30 12:00:42 tipaul
# why the hell do we need to explicitly utf8 decode this string ? I really
don't know, but it seems it's mandatory, otherwise, tag descriptions are not
properly encoded...
#
Index: C4/BookShelves.pm
===================================================================
RCS file: /sources/koha/koha/C4/BookShelves.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- C4/BookShelves.pm 9 Mar 2007 14:31:47 -0000 1.20
+++ C4/BookShelves.pm 4 Apr 2007 16:46:22 -0000 1.21
@@ -3,7 +3,7 @@
package C4::BookShelves;
-# $Id: BookShelves.pm,v 1.20 2007/03/09 14:31:47 tipaul Exp $
+# $Id: BookShelves.pm,v 1.21 2007/04/04 16:46:22 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -25,11 +25,11 @@
use strict;
require Exporter;
use C4::Context;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.20 $' =~ /\d+/g; shift(@v) . "." . join(
"_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.21 $' =~ /\d+/g; shift(@v) . "." . join(
"_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -161,7 +161,7 @@
C<$shelfnumber>.
Returns a reference-to-array, whose elements are references-to-hash,
-as returned by C<C4::Circ2::getiteminformation>.
+as returned by C<C4::Biblio::GetBiblioFromItemNumber>.
=cut
@@ -422,6 +422,11 @@
#
# $Log: BookShelves.pm,v $
+# Revision 1.21 2007/04/04 16:46:22 tipaul
+# HUGE COMMIT : code cleaning circulation.
+#
+# some stuff to do, i'll write a mail on koha-devel NOW !
+#
# Revision 1.20 2007/03/09 14:31:47 tipaul
# rel_3_0 moved to HEAD
#
Index: C4/Date.pm
===================================================================
RCS file: /sources/koha/koha/C4/Date.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -b -r1.28 -r1.29
--- C4/Date.pm 10 Mar 2007 00:28:11 -0000 1.28
+++ C4/Date.pm 4 Apr 2007 16:46:22 -0000 1.29
@@ -31,6 +31,7 @@
&get_date_format_string_for_DHTMLcalendar
&format_date
&format_date_in_iso
+ &fixdate
);
@@ -183,4 +184,56 @@
return 1 if (length($olddate[0])==4 && length($olddate[1])<=2 &&
length($olddate[2])<=2);
return 0;
}
+
+=head2 fixdate
+
+( $date, $invalidduedate ) = fixdate( $year, $month, $day );
+
+=cut
+
+sub fixdate {
+ my ( $year, $month, $day ) = @_;
+ my $invalidduedate;
+ my $date;
+ if ( $year && $month && $day ) {
+ if ( ( $year eq 0 ) && ( $month eq 0 ) && ( $year eq 0 ) ) {
+
+ # $env{'datedue'}='';
+ }
+ else {
+ if ( ( $year eq 0 ) || ( $month eq 0 ) || ( $year eq 0 ) ) {
+ $invalidduedate = 1;
+ }
+ else {
+ if (
+ ( $day > 30 )
+ && ( ( $month == 4 )
+ || ( $month == 6 )
+ || ( $month == 9 )
+ || ( $month == 11 ) )
+ )
+ {
+ $invalidduedate = 1;
+ }
+ elsif ( ( $day > 29 ) && ( $month == 2 ) ) {
+ $invalidduedate = 1;
+ }
+ elsif (
+ ( $month == 2 )
+ && ( $day > 28 )
+ && ( ( $year % 4 )
+ && ( ( !( $year % 100 ) || ( $year % 400 ) ) ) )
+ )
+ {
+ $invalidduedate = 1;
+ }
+ else {
+ $date = "$year-$month-$day";
+ }
+ }
+ }
+ }
+ return ( $date, $invalidduedate );
+}
+
1;
Index: C4/Members.pm
===================================================================
RCS file: /sources/koha/koha/C4/Members.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -b -r1.40 -r1.41
--- C4/Members.pm 9 Mar 2007 14:31:47 -0000 1.40
+++ C4/Members.pm 4 Apr 2007 16:46:22 -0000 1.41
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Members.pm,v 1.40 2007/03/09 14:31:47 tipaul Exp $
+# $Id: Members.pm,v 1.41 2007/04/04 16:46:22 tipaul Exp $
use strict;
require Exporter;
@@ -26,10 +26,13 @@
use Digest::MD5 qw(md5_base64);
use Date::Calc qw/Today Add_Delta_YM/;
use C4::Log; # logaction
+use C4::Accounts;
+use C4::Overdues;
+use C4::Reserves2;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = do { my @v = '$Revision: 1.40 $' =~ /\d+/g; shift(@v) . "." . join(
"_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.41 $' =~ /\d+/g; shift(@v) . "." . join(
"_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -52,7 +55,7 @@
@ISA = qw(Exporter);
@EXPORT = qw(
- &BornameSearch &GetMember
+ &BornameSearch &GetMember &GetMemberDetails
&borrdata &borrdata2
&fixup_cardnumber &findguarantees &findguarantor &GuarantornameSearch
&modmember &newmember &changepassword &borrissues &allissues
@@ -236,6 +239,256 @@
return undef;
}
+=head2 GetMemberDetails
+
+($borrower, $flags) = &GetMemberDetails($borrowernumber, $cardnumber);
+
+Looks up a patron and returns information about him or her. If
+C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
+up the borrower by number; otherwise, it looks up the borrower by card
+number.
+
+C<$env> is effectively ignored, but should be a reference-to-hash.
+
+C<$borrower> is a reference-to-hash whose keys are the fields of the
+borrowers table in the Koha database. In addition,
+C<$borrower-E<gt>{flags}> is a hash giving more detailed information
+about the patron. Its keys act as flags :
+
+ if $borrower->{flags}->{LOST} {
+ # Patron's card was reported lost
+ }
+
+Each flag has a C<message> key, giving a human-readable explanation of
+the flag. If the state of a flag means that the patron should not be
+allowed to borrow any more books, then it will have a C<noissues> key
+with a true value.
+
+The possible flags are:
+
+=head3 CHARGES
+
+=over 4
+
+=item Shows the patron's credit or debt, if any.
+
+=back
+
+=head3 GNA
+
+=over 4
+
+=item (Gone, no address.) Set if the patron has left without giving a
+forwarding address.
+
+=back
+
+=head3 LOST
+
+=over 4
+
+=item Set if the patron's card has been reported as lost.
+
+=back
+
+=head3 DBARRED
+
+=over 4
+
+=item Set if the patron has been debarred.
+
+=back
+
+=head3 NOTES
+
+=over 4
+
+=item Any additional notes about the patron.
+
+=back
+
+=head3 ODUES
+
+=over 4
+
+=item Set if the patron has overdue items. This flag has several keys:
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
+overdue items. Its elements are references-to-hash, each describing an
+overdue item. The keys are selected fields from the issues, biblio,
+biblioitems, and items tables of the Koha database.
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
+the overdue items, one per line.
+
+=back
+
+=head3 WAITING
+
+=over 4
+
+=item Set if any items that the patron has reserved are available.
+
+C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
+available items. Each element is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database.
+
+=back
+
+=cut
+
+sub GetMemberDetails {
+ my ( $borrowernumber, $cardnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query;
+ my $sth;
+ if ($borrowernumber) {
+ $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
+ $sth->execute($borrowernumber);
+ }
+ elsif ($cardnumber) {
+ $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
+ $sth->execute($cardnumber);
+ }
+ else {
+ return undef;
+ }
+ my $borrower = $sth->fetchrow_hashref;
+ my $amount = C4::Accounts::checkaccount( $borrowernumber, $dbh );
+ $borrower->{'amountoutstanding'} = $amount;
+ my $flags = patronflags( $borrower, $dbh );
+ my $accessflagshash;
+
+ $sth = $dbh->prepare("select bit,flag from userflags");
+ $sth->execute;
+ while ( my ( $bit, $flag ) = $sth->fetchrow ) {
+ if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
+ $accessflagshash->{$flag} = 1;
+ }
+ }
+ $sth->finish;
+ $borrower->{'flags'} = $flags;
+ $borrower->{'authflags'} = $accessflagshash;
+
+ # find out how long the membership lasts
+ $sth =
+ $dbh->prepare(
+ "select enrolmentperiod from categories where categorycode = ?");
+ $sth->execute( $borrower->{'categorycode'} );
+ my $enrolment = $sth->fetchrow;
+ $borrower->{'enrolmentperiod'} = $enrolment;
+ return ($borrower); #, $flags, $accessflagshash);
+}
+
+=head2 patronflags
+
+ Not exported
+
+ NOTE!: If you change this function, be sure to update the POD for
+ &GetMemberDetails.
+
+ $flags = &patronflags($env, $patron, $dbh);
+
+ $flags->{CHARGES}
+ {message} Message showing patron's credit or debt
+ {noissues} Set if patron owes >$5.00
+ {GNA} Set if patron gone w/o address
+ {message} "Borrower has no valid address"
+ {noissues} Set.
+ {LOST} Set if patron's card reported lost
+ {message} Message to this effect
+ {noissues} Set.
+ {DBARRED} Set is patron is debarred
+ {message} Message to this effect
+ {noissues} Set.
+ {NOTES} Set if patron has notes
+ {message} Notes about patron
+ {ODUES} Set if patron has overdue books
+ {message} "Yes"
+ {itemlist} ref-to-array: list of overdue books
+ {itemlisttext} Text list of overdue items
+ {WAITING} Set if there are items available that the
+ patron reserved
+ {message} Message to this effect
+ {itemlist} ref-to-array: list of available items
+
+=cut
+
+sub patronflags {
+ my %flags;
+ my ( $patroninformation, $dbh ) = @_;
+ my $amount =
+ C4::Accounts::checkaccount( $patroninformation->{'borrowernumber'}, $dbh
);
+ if ( $amount > 0 ) {
+ my %flaginfo;
+ my $noissuescharge = C4::Context->preference("noissuescharge");
+ $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
+ if ( $amount > $noissuescharge ) {
+ $flaginfo{'noissues'} = 1;
+ }
+ $flags{'CHARGES'} = \%flaginfo;
+ }
+ elsif ( $amount < 0 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f",
-$amount;
+ $flags{'CHARGES'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'gonenoaddress'}
+ && $patroninformation->{'gonenoaddress'} == 1 )
+ {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower has no valid address.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'GNA'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower\'s card reported lost.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'LOST'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'debarred'}
+ && $patroninformation->{'debarred'} == 1 )
+ {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower is Debarred.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'DBARRED'} = \%flaginfo;
+ }
+ if ( $patroninformation->{'borrowernotes'}
+ && $patroninformation->{'borrowernotes'} )
+ {
+ my %flaginfo;
+ $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
+ $flags{'NOTES'} = \%flaginfo;
+ }
+ my ( $odues, $itemsoverdue ) =
+ checkoverdues( $patroninformation->{'borrowernumber'}, $dbh );
+ if ( $odues > 0 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Yes";
+ $flaginfo{'itemlist'} = $itemsoverdue;
+ foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
+ @$itemsoverdue )
+ {
+ $flaginfo{'itemlisttext'} .=
+ "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
+ }
+ $flags{'ODUES'} = \%flaginfo;
+ }
+ my $itemswaiting =
+ C4::Reserves2::GetWaitingReserves(
$patroninformation->{'borrowernumber'} );
+ my $nowaiting = scalar @$itemswaiting;
+ if ( $nowaiting > 0 ) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Reserved items available";
+ $flaginfo{'itemlist'} = $itemswaiting;
+ $flags{'WAITING'} = \%flaginfo;
+ }
+ return ( \%flags );
+}
+
+
=item borrdata
$borrower = &borrdata($cardnumber, $borrowernumber);
Index: C4/Print.pm
===================================================================
RCS file: /sources/koha/koha/C4/Print.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- C4/Print.pm 9 Mar 2007 14:31:47 -0000 1.19
+++ C4/Print.pm 4 Apr 2007 16:46:22 -0000 1.20
@@ -17,19 +17,19 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Print.pm,v 1.19 2007/03/09 14:31:47 tipaul Exp $
+# $Id: Print.pm,v 1.20 2007/04/04 16:46:22 tipaul Exp $
use strict;
require Exporter;
use C4::Context;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.19 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.20 $' =~ /\d+/g;
shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
};
@@ -65,12 +65,12 @@
C<&remoteprint> will print to the file F</tmp/kohaiss>.
C<$borrower> is a reference-to-hash giving information about a patron.
-This may be gotten from C<&getpatroninformation>. The patron's name
+This may be gotten from C<&GetMemberDetails>. The patron's name
will be printed in the output.
C<$items> is a reference-to-list, where each element is a
reference-to-hash describing a borrowed item. C<$items> may be gotten
-from C<¤tissues>.
+from C<&GetBorrowerIssues>.
=cut
@@ -197,12 +197,12 @@
#'
sub printslip {
my ( $env, $borrowernumber ) = @_;
- my ( $borrower, $flags ) = getpatroninformation( $env, $borrowernumber, 0
);
+ my ( $borrower, $flags ) = GetMemberDetails( $borrowernumber);
$env->{'todaysissues'} = 1;
- my ($borrowerissues) = currentissues( $env, $borrower );
+ my ($borrowerissues) = GetBorrowerIssues( $borrower );
$env->{'nottodaysissues'} = 1;
$env->{'todaysissues'} = 0;
- my ($borroweriss2) = currentissues( $env, $borrower );
+ my ($borroweriss2) = GetBorrowerIssues( $borrower );
$env->{'nottodaysissues'} = 0;
my $i = 0;
my @issues;
Index: C4/Reserves2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Reserves2.pm,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -b -r1.51 -r1.52
--- C4/Reserves2.pm 30 Mar 2007 13:30:38 -0000 1.51
+++ C4/Reserves2.pm 4 Apr 2007 16:46:22 -0000 1.52
@@ -20,20 +20,20 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Reserves2.pm,v 1.51 2007/03/30 13:30:38 tipaul Exp $
+# $Id: Reserves2.pm,v 1.52 2007/04/04 16:46:22 tipaul Exp $
use strict;
require Exporter;
use C4::Context;
use C4::Biblio;
use C4::Search;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
my $library_name = C4::Context->preference("LibraryName");
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.51 $' =~ /\d+/g; shift(@v) . "." . join(
"_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.52 $' =~ /\d+/g; shift(@v) . "." . join(
"_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -75,6 +75,8 @@
&CountReservesFromBorrower
&FixPriority
&FindReservesInQueue
+ GetReservesForBranch
+ GetReservesToBranch
);
# make all your functions, whether exported or not;
@@ -87,7 +89,6 @@
=cut
-#'
sub GlobalCancel {
my $messages;
my $nextreservinfo;
@@ -117,7 +118,7 @@
my $nextreservinfo;
my ( $restype, $checkreserves ) = CheckReserves($itemnumber);
if ($checkreserves) {
- my $iteminfo =
C4::Circulation::Circ2::getiteminformation($itemnumber,undef);
+ my $iteminfo = GetItem($itemnumber);
if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
$messages->{'transfert'} = $checkreserves->{'branchcode'};
#minus priorities of others reservs
@@ -167,37 +168,37 @@
#first step update the value of the first person on reserv
my $dbh = C4::Context->dbh;
- my $query = qq/
+ my $query = "
UPDATE reserves
SET priority = 0 , itemnumber = ?
WHERE cancellationdate IS NULL
AND borrowernumber=?
AND biblionumber=?
- /;
+ ";
my $sth_upd = $dbh->prepare($query);
$sth_upd->execute( $itemnumber, $borrowernumber, $biblionumber );
$sth_upd->finish;
# second step update all others reservs
- $query = qq/
+ $query = "
SELECT priority,borrowernumber,biblionumber,reservedate
FROM reserves
WHERE priority !='0'
AND biblionumber = ?
AND cancellationdate IS NULL
- /;
+ ";
my $sth_oth = $dbh->prepare($query);
$sth_oth->execute($biblionumber);
while ( my ( $priority, $borrowernumber, $biblionumber, $reservedate ) =
$sth_oth->fetchrow_array )
{
$priority--;
- $query = qq/
+ $query = "
UPDATE reserves
SET priority = ?
WHERE biblionumber = ?
AND borrowernumber = ?
AND reservedate = ?
- /;
+ ";
my $sth_upd_oth = $dbh->prepare($query);
$sth_upd_oth->execute( $priority, $biblionumber, $borrowernumber,
$reservedate );
@@ -219,13 +220,13 @@
#first : check if we have a reservation for this item .
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
- my $query = qq/
+ my $query = "
SELECT priority,borrowernumber
FROM reserves
WHERE itemnumber=?
AND cancellationdate IS NULL
AND found IS NULL AND priority='0'
- /;
+ ";
my $sth_find = $dbh->prepare($query);
$sth_find->execute($itemnumber);
my ( $priority, $borrowernumber ) = $sth_find->fetchrow_array;
@@ -233,13 +234,13 @@
return unless $borrowernumber;
# step 2 : if we have a borrowernumber, we update the value found to 'W' to
notify the borrower
- $query = qq/
+ $query = "
UPDATE reserves
SET found='W',waitingdate = now()
WHERE borrowernumber=?
AND itemnumber=?
AND found IS NULL
- /;
+ ";
my $sth_set = $dbh->prepare($query);
$sth_set->execute( $borrowernumber, $itemnumber );
$sth_set->finish;
@@ -258,13 +259,13 @@
my ( $itemnumber, $borrowernumber ) = @_;
if ($itemnumber) {
my $dbh = C4::Context->dbh;
- my $query = qq/
+ my $query = "
SELECT reservedate,borrowernumber
FROM reserves
WHERE itemnumber=?
AND cancellationdate IS NULL
AND (found <> 'F' OR found IS NULL)
- /;
+ ";
my $sth_res = $dbh->prepare($query);
$sth_res->execute($itemnumber);
my ( $reservedate, $borrowernumber ) = $sth_res->fetchrow_array;
@@ -272,14 +273,14 @@
}
if ($borrowernumber) {
my $dbh = C4::Context->dbh;
- my $query = qq/
+ my $query = "
SELECT *
FROM reserves
WHERE borrowernumber=?
AND cancellationdate IS NULL
AND (found != 'F' or found is null)
ORDER BY reservedate
- /;
+ ";
my $sth_find = $dbh->prepare($query);
$sth_find->execute($borrowernumber);
@@ -324,7 +325,7 @@
my @bind;
# Find the desired items in the reserves
- my $query = qq/
+ my $query = "
SELECT branchcode,
timestamp AS rtimestamp,
priority,
@@ -337,7 +338,7 @@
FROM reserves
WHERE cancellationdate IS NULL
AND (found <> \'F\' OR found IS NULL)
- /;
+ ";
if ( $biblionumber ne '' ) {
$query .= '
@@ -511,25 +512,25 @@
if ($item) {
my $qitem = $dbh->quote($item);
# Look up the item by itemnumber
- my $query = qq(
+ my $query = "
SELECT items.biblionumber, items.biblioitemnumber,
itemtypes.notforloan
FROM items, biblioitems, itemtypes
WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
AND biblioitems.itemtype = itemtypes.itemtype
AND itemnumber=$qitem
- );
+ ";
$sth = $dbh->prepare($query);
}
else {
my $qbc = $dbh->quote($barcode);
# Look up the item by barcode
- my $query = qq(
+ my $query = "
SELECT items.biblionumber, items.biblioitemnumber,
itemtypes.notforloan
FROM items, biblioitems, itemtypes
WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
AND biblioitems.itemtype = itemtypes.itemtype
AND barcode=$qbc
- );
+ ";
$sth = $dbh->prepare($query);
# FIXME - This function uses $item later on. Ought to set it here.
@@ -611,14 +612,14 @@
if ( ( $item and $borr ) and ( not $biblio ) ) {
# removing a waiting reserve record....
# update the database...
- my $query = qq/
+ my $query = "
UPDATE reserves
SET cancellationdate = now(),
found = Null,
priority = 0
WHERE itemnumber = ?
AND borrowernumber = ?
- /;
+ ";
my $sth = $dbh->prepare($query);
$sth->execute( $item, $borr );
$sth->finish;
@@ -844,17 +845,17 @@
# update reserves record....
if ($diffBranchSend) {
- $query = qq/
+ $query = "
UPDATE reserves
SET priority = 0,
itemnumber = ?
WHERE borrowernumber = ?
AND biblionumber = ?
AND timestamp = ?
- /;
+ ";
}
else {
- $query = qq/
+ $query = "
UPDATE reserves
SET priority = 0,
found = 'W',
@@ -863,7 +864,7 @@
WHERE borrowernumber = ?
AND biblionumber = ?
AND timestamp = ?
- /;
+ ";
}
$sth = $dbh->prepare($query);
$sth->execute( $item, $borr, $biblio, $timestamp );
@@ -889,13 +890,13 @@
my ($borr) = @_;
my $dbh = C4::Context->dbh;
my @itemswaiting;
- my $query = qq/
+ my $query = "
SELECT *
FROM reserves
WHERE borrowernumber = ?
AND reserves.found = 'W'
AND cancellationdate IS NULL
- /;
+ ";
my $sth = $dbh->prepare($query);
$sth->execute($borr);
while ( my $data = $sth->fetchrow_hashref ) {
@@ -1002,7 +1003,7 @@
#eval {
# updates take place here
if ( $fee > 0 ) {
- my $nextacctno = &getnextacctno( $env, $borrowernumber, $dbh );
+ my $nextacctno = &getnextacctno( $borrowernumber );
my $query = qq/
INSERT INTO accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
@@ -1383,6 +1384,63 @@
return ( $#results + 1, address@hidden );
}
+
+=head2 GetReservesToBranch
+
address@hidden = GetReservesToBranch( $frombranch, $excludingbranch );
+
+=cut
+
+sub GetReservesToBranch {
+ my ( $frombranch, $excludingbranch ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "SELECT borrowernumber,reservedate,itemnumber,timestamp
+ FROM reserves
+ WHERE priority='0' AND cancellationdate is null
+ AND branchcode=?
+ AND branchcode!=?
+ AND found IS NULL "
+ );
+ $sth->execute( $frombranch, $excludingbranch );
+ my @transreserv;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return (@transreserv);
+}
+
+=head2 GetReservesForBranch
+
address@hidden = GetReservesForBranch($frombranch);
+
+=cut
+
+sub GetReservesForBranch {
+ my ($frombranch) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "
+ SELECT borrowernumber,reservedate,itemnumber,waitingdate
+ FROM reserves
+ WHERE priority='0'
+ AND cancellationdate IS NULL
+ AND found='W'
+ AND branchcode=?
+ ORDER BY waitingdate" );
+ $sth->execute($frombranch);
+ my @transreserv;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
+ $i++;
+ }
+ $sth->finish;
+ return (@transreserv);
+}
+
=back
=head1 AUTHOR
Index: C4/Circulation/Fines.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Fines.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -b -r1.23 -r1.24
--- C4/Circulation/Fines.pm 30 Mar 2007 13:30:36 -0000 1.23
+++ C4/Circulation/Fines.pm 4 Apr 2007 16:46:22 -0000 1.24
@@ -1,6 +1,6 @@
package C4::Circulation::Fines;
-# $Id: Fines.pm,v 1.23 2007/03/30 13:30:36 tipaul Exp $
+# $Id: Fines.pm,v 1.24 2007/04/04 16:46:22 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -29,7 +29,7 @@
use C4::Log; # logaction
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.23 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.24 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -38,7 +38,7 @@
=head1 SYNOPSIS
- use C4::Circulation::Fines;
+ use C4::Overdues;
=head1 DESCRIPTION
@@ -439,11 +439,11 @@
# $sth3->finish;
# $accountno[0]++;
# begin transaction
- my $nextaccntno = getnextacctno(undef,$borrowernumber,$dbh);
+ my $nextaccntno = getnextacctno($borrowernumber);
my $sth2 = $dbh->prepare(
- "Insert into accountlines
+ "INSERT INTO accountlines
(borrowernumber,itemnumber,date,amount,
- description,accounttype,amountoutstanding,accountno) values
+ description,accounttype,amountoutstanding,accountno) VALUES
(?,?,now(),?,?,'FU',?,?)"
);
$sth2->execute( $borrowernumber, $itemnum, $amount,
@@ -764,11 +764,11 @@
sub CreateItemAccountLine {
my
($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level)address@hidden;
my $dbh = C4::Context->dbh;
- my $nextaccntno = getnextacctno(undef,$borrowernumber,$dbh);
- my $query= qq|INSERT into accountlines
+ my $nextaccntno = getnextacctno($borrowernumber);
+ my $query= "INSERT into accountlines
(borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
VALUES
- (?,?,?,?,?,?,?,?,?,?,?)|;
+ (?,?,?,?,?,?,?,?,?,?,?)";
my $sth=$dbh->prepare($query);
Index: catalogue/issuehistory.pl
===================================================================
RCS file: /sources/koha/koha/catalogue/issuehistory.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- catalogue/issuehistory.pl 9 Mar 2007 15:35:46 -0000 1.2
+++ catalogue/issuehistory.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: issuehistory.pl,v 1.2 2007/03/09 15:35:46 tipaul Exp $
+# $Id: issuehistory.pl,v 1.3 2007/04/04 16:46:23 tipaul Exp $
use strict;
require Exporter;
@@ -23,7 +23,7 @@
use C4::Auth;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2; # GetIssuesFromBiblio
+use C4::Circulation; # GetBiblioIssues
my $query = new CGI;
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
@@ -43,7 +43,7 @@
my $title = $params->{'title'};
my $author = $params->{'author'};
-my $issues = GetIssuesFromBiblio($biblionumber);
+my $issues = GetBiblioIssues($biblionumber);
my $total = scalar @$issues;
if ( $total && !$title ) {
Index: catalogue/moredetail.pl
===================================================================
RCS file: /sources/koha/koha/catalogue/moredetail.pl,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- catalogue/moredetail.pl 9 Mar 2007 14:32:39 -0000 1.10
+++ catalogue/moredetail.pl 4 Apr 2007 16:46:23 -0000 1.11
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: moredetail.pl,v 1.10 2007/03/09 14:32:39 tipaul Exp $
+# $Id: moredetail.pl,v 1.11 2007/04/04 16:46:23 tipaul Exp $
use strict;
require Exporter;
@@ -29,7 +29,7 @@
use C4::Auth;
use C4::Interface::CGI::Output;
use C4::Date;
-use C4::Circulation::Circ2; # to use itemissues
+use C4::Circulation; # to use itemissues
my $query=new CGI;
Index: circ/bookcount.pl
===================================================================
RCS file: /sources/koha/koha/circ/bookcount.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- circ/bookcount.pl 9 Mar 2007 15:37:12 -0000 1.2
+++ circ/bookcount.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: bookcount.pl,v 1.2 2007/03/09 15:37:12 tipaul Exp $
+# $Id: bookcount.pl,v 1.3 2007/04/04 16:46:23 tipaul Exp $
#written 7/3/2002 by Finlay
#script to display reports
@@ -25,7 +25,7 @@
use strict;
use CGI;
use C4::Context;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Output;
use C4::Koha;
use C4::Auth;
Index: circ/branchoverdues.pl
===================================================================
RCS file: /sources/koha/koha/circ/branchoverdues.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- circ/branchoverdues.pl 10 Mar 2007 06:28:07 -0000 1.4
+++ circ/branchoverdues.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: branchoverdues.pl,v 1.4 2007/03/10 06:28:07 kados Exp $
+# $Id: branchoverdues.pl,v 1.5 2007/04/04 16:46:23 tipaul Exp $
#
# This file is part of Koha.
#
@@ -23,7 +23,7 @@
use C4::Interface::CGI::Output;
use C4::Auth;
use C4::Date;
-use C4::Circulation::Circ2; # AddNotifyLine
+use C4::Overdues; # AddNotifyLine
use C4::Koha; # GetDepartment...
use Mail::Sendmail;
use Getopt::Long;
Index: circ/branchreserves.pl
===================================================================
RCS file: /sources/koha/koha/circ/branchreserves.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- circ/branchreserves.pl 3 Apr 2007 15:04:30 -0000 1.5
+++ circ/branchreserves.pl 4 Apr 2007 16:46:23 -0000 1.6
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: branchreserves.pl,v 1.5 2007/04/03 15:04:30 alaurin Exp $
+# $Id: branchreserves.pl,v 1.6 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -26,7 +26,7 @@
use C4::Branch; # GetBranchName
use C4::Auth;
use C4::Date;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Calc qw(
Today
@@ -77,8 +77,8 @@
# if we have a result
if ($nextreservinfo) {
- my $borrowerinfo = getpatroninformation( \%env, $nextreservinfo );
- my $iteminfo = C4::Circulation::Circ2::getiteminformation($item);
+ my $borrowerinfo = GetMemberDetails( $nextreservinfo );
+ my $iteminfo = GetBiblioFromItemNumber($item);
if ( $messages->{'transfert'} ) {
my $branchname = GetBranchName( $messages->{'transfert'} );
$template->param(
@@ -114,8 +114,8 @@
foreach my $num (@getreserves) {
my %getreserv;
my %env;
- my $gettitle = getiteminformation( $num->{'itemnumber'} );
- my $getborrower = getpatroninformation( \%env, $num->{'borrowernumber'} );
+ my $gettitle = GetBiblioFromItemNumber( $num->{'itemnumber'} );
+ my $getborrower = GetMemberDetails( $num->{'borrowernumber'} );
my $itemtypeinfo = getitemtypeinfo( $gettitle->{'itemtype'} );
$getreserv{'waitingdate'} = format_date( $num->{'waitingdate'} );
Index: circ/branchtransfers.pl
===================================================================
RCS file: /sources/koha/koha/circ/branchtransfers.pl,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -b -r1.27 -r1.28
--- circ/branchtransfers.pl 9 Mar 2007 14:34:31 -0000 1.27
+++ circ/branchtransfers.pl 4 Apr 2007 16:46:23 -0000 1.28
@@ -23,7 +23,7 @@
use strict;
use CGI;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Output;
use C4::Reserves2;
use C4::Auth;
@@ -157,7 +157,7 @@
$item{barcode} = $bc;
$item{frombrcd} = $frbcd;
$item{tobrcd} = $tobcd;
- my ($iteminformation) = getiteminformation( 0, $bc );
+ my ($iteminformation) = GetBiblioFromItemNumer( 0, $bc );
$item{'biblionumber'} = $iteminformation->{'biblionumber'};
$item{'title'} = $iteminformation->{'title'};
$item{'author'} = $iteminformation->{'author'};
@@ -193,7 +193,7 @@
if ($found) {
my $res = $messages->{'ResFound'};
$branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
- my ($borr) = getpatroninformation( \%env, $res->{'borrowernumber'}, 0 );
+ my ($borr) = GetMemberDetails( $res->{'borrowernumber'}, 0 );
$title = $borr->{'title'};
$surname = $borr->{'surname'};
$firstname = $borr->{'firstname'};
@@ -243,7 +243,7 @@
$err{errwasreturned} = 1;
$allmessages = 1;
my ($borrowerinfo) =
- getpatroninformation( \%env, $messages->{'WasReturned'}, 0 );
+ GetMemberDetails( $messages->{'WasReturned'}, 0 );
$title = $borrowerinfo->{'title'};
$surname = $borrowerinfo->{'surname'};
$firstname = $borrowerinfo->{'firstname'};
Index: circ/circulation.pl
===================================================================
RCS file: /sources/koha/koha/circ/circulation.pl,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -b -r1.102 -r1.103
--- circ/circulation.pl 30 Mar 2007 11:58:48 -0000 1.102
+++ circ/circulation.pl 4 Apr 2007 16:46:23 -0000 1.103
@@ -24,11 +24,10 @@
use strict;
use CGI;
-use C4::Circulation::Circ2;
-use C4::Members;
use C4::Output;
use C4::Print;
use C4::Auth;
+use C4::Date;
use C4::Interface::CGI::Output;
use C4::Branch; # GetBranches
use C4::Koha; # GetPrinter
@@ -40,9 +39,10 @@
Date_to_Days
);
+use C4::Circulation;
+use C4::Members;
use C4::Biblio;
use C4::Reserves2;
-use C4::Date;
#
# PARAMETERS READING
@@ -170,7 +170,7 @@
my @lines;
if ($borrowernumber) {
- $borrower = getpatroninformation( \%env, $borrowernumber, 0 );
+ $borrower = GetMemberDetails( $borrowernumber, 0 );
my ( $od, $issue, $fines ) = borrdata2( \%env, $borrowernumber );
# Warningdate is the date that the warning starts appearing
@@ -217,17 +217,17 @@
$barcode = cuecatbarcodedecode($barcode);
my ( $datedue, $invalidduedate ) = fixdate( $year, $month, $day );
if ($issueconfirmed) {
- issuebook( \%env, $borrower, $barcode, $datedue, $cancelreserve );
+ AddIssue( \%env, $borrower, $barcode, $datedue, $cancelreserve );
$inprocess = 1;
}
else {
my ( $error, $question ) =
- canbookbeissued( \%env, $borrower, $barcode, $year, $month, $day,
+ CanBookBeIssued( \%env, $borrower, $barcode, $year, $month, $day,
$inprocess );
my $noerror = 1;
my $noquestion = 1;
# Get the item title for more information
- my $getmessageiteminfo = getiteminformation( undef, $barcode );
+ my $getmessageiteminfo = GetBiblioFromItemNumber( undef, $barcode );
foreach my $impossible ( keys %$error ) {
$template->param(
@@ -250,7 +250,7 @@
year => $year
);
if ( $noerror && ( $noquestion || $issueconfirmed ) ) {
- issuebook( \%env, $borrower, $barcode, $datedue );
+ AddIssue( \%env, $borrower, $barcode, $datedue );
$inprocess = 1;
}
}
@@ -264,7 +264,7 @@
# reload the borrower info for the sake of reseting the flags.....
if ($borrowernumber) {
- $borrower = getpatroninformation( \%env, $borrowernumber, 0 );
+ $borrower = GetMemberDetails( $borrowernumber, 0 );
}
##################################################################################
@@ -282,10 +282,10 @@
my %getreserv;
my %getWaitingReserveInfo;
my %env;
- my $getiteminfo = getiteminformation( $num_res->{'itemnumber'} );
+ my $getiteminfo = GetBiblioFromItemNumber( $num_res->{'itemnumber'} );
my $itemtypeinfo = getitemtypeinfo( $getiteminfo->{'itemtype'} );
my ( $transfertwhen, $transfertfrom, $transfertto ) =
- checktransferts( $num_res->{'itemnumber'} );
+ GetTransfers( $num_res->{'itemnumber'} );
$getreserv{waiting} = 0;
$getreserv{transfered} = 0;
@@ -377,73 +377,69 @@
# get each issue of the borrower & separate them in todayissues & previous
issues
my @todaysissues;
my @previousissues;
- my $issueslist = getissues($borrower);
+ my $issueslist = GetBorrowerIssues($borrower);
# split in 2 arrays for today & previous
my $dbh = C4::Context->dbh;
- foreach my $it ( keys %$issueslist ) {
- my $issuedate = $issueslist->{$it}->{'timestamp'};
+ foreach my $it ( @$issueslist ) {
+ my $issuedate = $it->{'timestamp'};
$issuedate =~ s/-//g;
$issuedate = substr( $issuedate, 0, 8 );
# to let perl sort this correctly
- $issueslist->{$it}->{'timestamp'} =~ s/(-|\:| )//g;
+ $it->{'timestamp'} =~ s/(-|\:| )//g;
if ( $todaysdate == $issuedate ) {
(
- $issueslist->{$it}->{'charge'},
- $issueslist->{$it}->{'itemtype_charge'}
+ $it->{'charge'},
+ $it->{'itemtype_charge'}
)
- = calc_charges(
- $dbh,
- $issueslist->{$it}->{'itemnumber'},
+ = GetIssuingCharges(
+ $it->{'itemnumber'},
$borrower->{'borrowernumber'}
);
- $issueslist->{$it}->{'charge'} =
- sprintf( "%.2f", $issueslist->{$it}->{'charge'} );
+ $it->{'charge'} =
+ sprintf( "%.2f", $it->{'charge'} );
(
- $issueslist->{$it}->{'can_renew'},
- $issueslist->{$it}->{'can_renew_error'}
+ $it->{'can_renew'},
+ $it->{'can_renew_error'}
)
- = renewstatus(
- \%env,
+ = CanBookBeRenewed(
$borrower->{'borrowernumber'},
- $issueslist->{$it}->{'itemnumber'}
+ $it->{'itemnumber'}
);
my ( $restype, $reserves ) =
- CheckReserves( $issueslist->{$it}->{'itemnumber'} );
+ CheckReserves( $it->{'itemnumber'} );
if ($restype) {
- $issueslist->{$it}->{'can_renew'} = 0;
+ $it->{'can_renew'} = 0;
}
push @todaysissues, $issueslist->{$it};
}
else {
(
- $issueslist->{$it}->{'charge'},
- $issueslist->{$it}->{'itemtype_charge'}
+ $it->{'charge'},
+ $it->{'itemtype_charge'}
)
- = calc_charges(
- $dbh,
- $issueslist->{$it}->{'itemnumber'},
+ = GetIssuingCharges(
+ $it->{'itemnumber'},
$borrower->{'borrowernumber'}
);
- $issueslist->{$it}->{'charge'} =
- sprintf( "%.2f", $issueslist->{$it}->{'charge'} );
+ $it->{'charge'} =
+ sprintf( "%.2f", $it->{'charge'} );
(
- $issueslist->{$it}->{'can_renew'},
- $issueslist->{$it}->{'can_renew_error'}
+ $it->{'can_renew'},
+ $it->{'can_renew_error'}
)
- = renewstatus(
- \%env,
+ = CanBookBeRenewed(
$borrower->{'borrowernumber'},
- $issueslist->{$it}->{'itemnumber'}
+ $it->{'itemnumber'}
);
my ( $restype, $reserves ) =
- CheckReserves( $issueslist->{$it}->{'itemnumber'} );
+ CheckReserves( $it->{'itemnumber'} );
if ($restype) {
- $issueslist->{$it}->{'can_renew'} = 0;
+ $it->{'can_renew'} = 0;
}
- push @previousissues, $issueslist->{$it};
+ push @previousissues, $it;
}
}
my $od; # overdues
@@ -642,14 +638,15 @@
);
my $items = $flags->{$flag}->{'itemlist'};
- {
- my @itemswaiting;
- foreach my $item (@$items) {
- my ($iteminformation) =
- getiteminformation( $item->{'itemnumber'}, 0 );
- push @itemswaiting, $iteminformation;
- }
- }
+# useless ???
+# {
+# my @itemswaiting;
+# foreach my $item (@$items) {
+# my ($iteminformation) =
+# getiteminformation( $item->{'itemnumber'}, 0 );
+# push @itemswaiting, $iteminformation;
+# }
+# }
if ( $query->param('module') ne 'returns' ) {
$template->param( nonreturns => 'true' );
}
Index: circ/currenttransfers.pl
===================================================================
RCS file: /sources/koha/koha/circ/currenttransfers.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- circ/currenttransfers.pl 3 Apr 2007 15:41:36 -0000 1.5
+++ circ/currenttransfers.pl 4 Apr 2007 16:46:23 -0000 1.6
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: currenttransfers.pl,v 1.5 2007/04/03 15:41:36 alaurin Exp $
+# $Id: currenttransfers.pl,v 1.6 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -26,7 +26,7 @@
use C4::Branch;
use C4::Auth;
use C4::Date;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Interface::CGI::Output;
use Date::Calc qw(
Today
@@ -71,7 +71,7 @@
$branchloop{'branchname'} = $branches->{$br}->{'branchname'};
$branchloop{'branchcode'} = $branches->{$br}->{'branchcode'};
my @gettransfers =
- GetTransfersFromBib( $branches->{$br}->{'branchcode'}, $default );
+ GetTransfersFromTo( $branches->{$br}->{'branchcode'}, $default );
if (@gettransfers) {
foreach my $num (@gettransfers) {
@@ -91,7 +91,7 @@
if ( $warning > 0 ) {
$getransf{'messcompa'} = 1;
}
- my $gettitle = getiteminformation( $num->{'itemnumber'} );
+ my $gettitle = GetBiblioFromItemNumber( $num->{'itemnumber'} );
my $itemtypeinfo = getitemtypeinfo( $gettitle->{'itemtype'} );
$getransf{'title'} = $gettitle->{'title'};
@@ -108,7 +108,7 @@
my @checkreserv = GetReservations( $num->{'itemnumber'} );
if ( $checkreserv[0] ) {
my $getborrower =
- getpatroninformation( \%env, $checkreserv[1] );
+ GetMemberDetails( $checkreserv[1] );
$getransf{'borrowernum'} = $getborrower->{'borrowernumber'};
$getransf{'borrowername'} = $getborrower->{'surname'};
$getransf{'borrowerfirstname'} = $getborrower->{'firstname'};
Index: circ/returns.pl
===================================================================
RCS file: /sources/koha/koha/circ/returns.pl,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -b -r1.46 -r1.47
--- circ/returns.pl 9 Mar 2007 14:34:32 -0000 1.46
+++ circ/returns.pl 4 Apr 2007 16:46:23 -0000 1.47
@@ -27,7 +27,7 @@
use strict;
use CGI;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Date;
use C4::Output;
use C4::Print;
@@ -116,7 +116,7 @@
my $resbarcode = $query->param('resbarcode');
my $diffBranchReturned = $query->param('diffBranch');
# set to waiting....
- my $iteminfo = getiteminformation($item);
+ my $iteminfo = GetBiblioFromItemNumber($item);
my $diffBranchSend;
# addin in ReserveWaiting the possibility to check if the document is
expected in this library or not,
@@ -133,7 +133,7 @@
my ( $messages, $nextreservinfo ) = OtherReserves($item);
my $branchname = GetBranchName( $messages->{'transfert'} );
- my ($borr) = getpatroninformation( \%env, $nextreservinfo, 0 );
+ my ($borr) = GetMemberDetails( $nextreservinfo, 0 );
my $borcnum = $borr->{'cardnumber'};
my $name =
$borr->{'surname'} . ", " . $borr->{'title'} . " " .
$borr->{'firstname'};
@@ -166,7 +166,7 @@
# decode cuecat
$barcode = cuecatbarcodedecode($barcode);
( $returned, $messages, $iteminformation, $borrower ) =
- returnbook( $barcode, C4::Context->userenv->{'branch'} );
+ AddReturn( $barcode, C4::Context->userenv->{'branch'} );
if ($returned) {
$returneditems{0} = $barcode;
$riborrowernumber{0} = $borrower->{'borrowernumber'};
@@ -225,7 +225,7 @@
if ( $messages->{'WasTransfered'} ) {
- my ($iteminfo) = getiteminformation( 0, $barcode );
+ my $iteminfo = GetBiblioFromItemNumber( 0, $barcode );
$template->param(
found => 1,
@@ -247,10 +247,10 @@
my $res = $messages->{'ResFound'};
my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
- my ($borr) = getpatroninformation( \%env, $res->{'borrowernumber'}, 0 );
+ my ($borr) = GetMemberDetails( $res->{'borrowernumber'}, 0 );
my $name =
$borr->{'surname'} . " " . $borr->{'title'} . " " . $borr->{'firstname'};
- my ($iteminfo) = getiteminformation( 0, $barcode );
+ my $iteminfo = GetBiblioFromItemNumber( 0, $barcode );
$template->param(
wname => $name,
@@ -278,10 +278,10 @@
if ( $messages->{'ResFound'} and not $messages->{'WrongTransfer'}) {
my $res = $messages->{'ResFound'};
my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'};
- my ($borr) = getpatroninformation( \%env, $res->{'borrowernumber'}, 0 );
+ my ($borr) = GetMemberDetails( $res->{'borrowernumber'}, 0 );
my $name =
$borr->{'surname'} . " " . $borr->{'title'} . " " . $borr->{'firstname'};
- my ($iteminfo) = getiteminformation( 0, $barcode );
+ my $iteminfo = GetBiblioFromItemNumber( 0, $barcode );
if ( $res->{'ResFound'} eq "Waiting" ) {
if ( C4::Context->userenv->{'branch'} eq $res->{'branchcode'} ) {
@@ -441,8 +441,8 @@
my @waitingitemloop;
my $items = $flags->{$flag}->{'itemlist'};
foreach my $item (@$items) {
- my ($iteminformation) =
- getiteminformation( $item->{'itemnumber'}, 0 );
+ my $iteminformation =
+ GetBiblioFromItemNumber( $item->{'itemnumber'});
my %waitingitem;
$waitingitem{biblionum} = $iteminformation->{'biblionumber'};
$waitingitem{barcode} = $iteminformation->{'barcode'};
@@ -460,8 +460,8 @@
foreach my $item ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
@$items )
{
- my ($iteminformation) =
- getiteminformation( $item->{'itemnumber'}, 0 );
+ my $iteminformation =
+ GetBiblioFromItemNumber( $item->{'itemnumber'}, 0 );
my %overdueitem;
$overdueitem{duedate} = format_date( $item->{'date_due'} );
$overdueitem{biblionum} = $iteminformation->{'biblionumber'};
@@ -515,7 +515,7 @@
. sprintf( "%0.2d", $datearr[3] );
$ri{duedate} = format_date($duedate);
my ($borrower) =
- getpatroninformation( \%env, $riborrowernumber{$_}, 0 );
+ GetMemberDetails( $riborrowernumber{$_}, 0 );
$ri{borrowernumber} = $borrower->{'borrowernumber'};
$ri{borcnum} = $borrower->{'cardnumber'};
$ri{borfirstname} = $borrower->{'firstname'};
@@ -527,7 +527,7 @@
}
# my %ri;
- my ($iteminformation) = getiteminformation( 0, $barcode );
+ my $iteminformation = GetBiblioFromItemNumber( 0, $barcode );
$ri{itembiblionumber} = $iteminformation->{'biblionumber'};
$ri{itemtitle} = $iteminformation->{'title'};
$ri{itemauthor} = $iteminformation->{'author'};
Index: circ/selectbranchprinter.pl
===================================================================
RCS file: /sources/koha/koha/circ/selectbranchprinter.pl,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -b -r1.17 -r1.18
--- circ/selectbranchprinter.pl 9 Mar 2007 14:34:32 -0000 1.17
+++ circ/selectbranchprinter.pl 4 Apr 2007 16:46:23 -0000 1.18
@@ -19,7 +19,7 @@
use strict;
use CGI qw/:standard/;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Output;
use C4::Auth;
use C4::Print;
Index: circ/waitingreservestransfers.pl
===================================================================
RCS file: /sources/koha/koha/circ/waitingreservestransfers.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- circ/waitingreservestransfers.pl 3 Apr 2007 15:41:36 -0000 1.7
+++ circ/waitingreservestransfers.pl 4 Apr 2007 16:46:23 -0000 1.8
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: waitingreservestransfers.pl,v 1.7 2007/04/03 15:41:36 alaurin Exp $
+# $Id: waitingreservestransfers.pl,v 1.8 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -26,7 +26,7 @@
use C4::Branch; # GetBranches
use C4::Auth;
use C4::Date;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Calc qw(
Today
Add_Delta_Days
@@ -85,11 +85,11 @@
foreach my $num (@getreserves) {
my %getreserv;
my %env;
- my $gettitle = getiteminformation( $num->{'itemnumber'} );
+ my $gettitle = GetBiblioFromItemNumber( $num->{'itemnumber'} );
my $itemtypeinfo = getitemtypeinfo( $gettitle->{'itemtype'} );
if ( $gettitle->{'holdingbranch'} eq $default ) {
my $getborrower =
- getpatroninformation( \%env, $num->{'borrowernumber'} );
+ GetMemberDetails( $num->{'borrowernumber'} );
$getreserv{'reservedate'} =
format_date( $num->{'reservedate'} );
Index: members/deletemem.pl
===================================================================
RCS file: /sources/koha/koha/members/deletemem.pl,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- members/deletemem.pl 9 Mar 2007 14:56:55 -0000 1.10
+++ members/deletemem.pl 4 Apr 2007 16:46:23 -0000 1.11
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: deletemem.pl,v 1.10 2007/03/09 14:56:55 tipaul Exp $
+# $Id: deletemem.pl,v 1.11 2007/04/04 16:46:23 tipaul Exp $
#script to delete items
#written 2/5/00
@@ -30,7 +30,7 @@
use C4::Context;
use C4::Interface::CGI::Output;
use C4::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Auth;
use C4::Members;
@@ -49,12 +49,12 @@
$env{'nottodayissues'}=1;
my %member2;
$member2{'borrowernumber'}=$member;
-my $issues=currentissues(\%env,\%member2);
+my $issues=GetBorrowerIssues(\%member2);
my $i=0;
foreach (sort keys %$issues) {
$i++;
}
-my ($bor,$flags)=getpatroninformation(\%env, $member,'');
+my ($bor,$flags)=GetMemberDetails($member,'');
if (C4::Context->preference("IndependantBranches")) {
my $userenv = C4::Context->userenv;
unless ($userenv->{flags} == 1){
Index: members/member-flags.pl
===================================================================
RCS file: /sources/koha/koha/members/member-flags.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- members/member-flags.pl 9 Mar 2007 14:56:55 -0000 1.6
+++ members/member-flags.pl 4 Apr 2007 16:46:23 -0000 1.7
@@ -10,7 +10,7 @@
use C4::Output;
use C4::Auth;
use C4::Context;
-use C4::Circulation::Circ2;
+use C4::Circulation;
#use C4::Acquisitions;
use C4::Interface::CGI::Output;
@@ -38,7 +38,7 @@
$env{'nottodayissues'}=1;
my %member2;
$member2{'borrowernumber'}=$member;
-my $issues=currentissues(\%env,\%member2);
+my $issues=GetBorrowerIssues(\%member2);
my $i=0;
foreach (sort keys %$issues) {
$i++;
@@ -57,8 +57,8 @@
$sth->execute($flags, $member);
print
$input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$member");
} else {
-# my ($bor,$flags,$accessflags)=getpatroninformation(\%env, $member,'');
- my $bor = getpatroninformation(\%env, $member,'');
+# my ($bor,$flags,$accessflags)=GetMemberDetails($member,'');
+ my $bor = GetMemberDetails( $member,'');
my $flags = $bor->{'flags'};
my $accessflags = $bor->{'authflags'};
my $dbh=C4::Context->dbh();
Index: members/member-password.pl
===================================================================
RCS file: /sources/koha/koha/members/member-password.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- members/member-password.pl 9 Mar 2007 14:56:55 -0000 1.5
+++ members/member-password.pl 4 Apr 2007 16:46:23 -0000 1.6
@@ -10,7 +10,7 @@
use C4::Interface::CGI::Output;
use C4::Context;
use C4::Members;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use CGI;
use Digest::MD5 qw(md5_base64);
@@ -38,13 +38,13 @@
$env{'nottodayissues'}=1;
my %member2;
$member2{'borrowernumber'}=$member;
-my $issues=currentissues(\%env,\%member2);
+my $issues=GetBorrowerIssues(\%member2);
my $i=0;
foreach (sort keys %$issues) {
$i++;
}
-my ($bor,$flags)=getpatroninformation(\%env, $member,'');
+my ($bor,$flags)=GetMemberDetails( $member,'');
my $newpassword = $input->param('newpassword');
if ( $newpassword ) {
Index: members/moremember.pl
===================================================================
RCS file: /sources/koha/koha/members/moremember.pl,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -b -r1.30 -r1.31
--- members/moremember.pl 9 Mar 2007 14:56:55 -0000 1.30
+++ members/moremember.pl 4 Apr 2007 16:46:23 -0000 1.31
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: moremember.pl,v 1.30 2007/03/09 14:56:55 tipaul Exp $
+# $Id: moremember.pl,v 1.31 2007/04/04 16:46:23 tipaul Exp $
=head1 moremember.pl
@@ -43,7 +43,7 @@
use Date::Manip;
use C4::Date;
use C4::Reserves2;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Koha;
use C4::Letters;
use C4::Biblio;
@@ -223,15 +223,8 @@
$row{toggle} = $toggle++ % 2;
#find the charge for an item
- # FIXME - This is expecting
- # &C4::Circulation::Renewals2::calc_charges, but it's getting
- # &C4::Circulation::Circ2::calc_charges, which only returns one
- # element, so itemtype isn't being set.
- # But &C4::Circulation::Renewals2::calc_charges doesn't appear to
- # return the correct item type either (or a properly-formatted
- # charge, for that matter).
my ( $charge, $itemtype ) =
- calc_charges( $dbh, $issue->[$i]{'itemnumber'}, $borrowernumber );
+ GetIssuingCharges( $issue->[$i]{'itemnumber'}, $borrowernumber );
my $itemtypeinfo = getitemtypeinfo($itemtype);
$row{'itemtype_description'} = $itemtypeinfo->{description};
@@ -284,10 +277,10 @@
foreach my $num_res (@borrowerreserv) {
my %getreserv;
my %env;
- my $getiteminfo = getiteminformation( $num_res->{'itemnumber'} );
+ my $getiteminfo = GetBiblioFromItemNumber( $num_res->{'itemnumber'} );
my $itemtypeinfo = getitemtypeinfo( $getiteminfo->{'itemtype'} );
my ( $transfertwhen, $transfertfrom, $transfertto ) =
- checktransferts( $num_res->{'itemnumber'} );
+ GetTransfers( $num_res->{'itemnumber'} );
$getreserv{waiting} = 0;
$getreserv{transfered} = 0;
Index: members/pay.pl
===================================================================
RCS file: /sources/koha/koha/members/pay.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- members/pay.pl 9 Mar 2007 23:30:17 -0000 1.8
+++ members/pay.pl 4 Apr 2007 16:46:23 -0000 1.9
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: pay.pl,v 1.8 2007/03/09 23:30:17 kados Exp $
+# $Id: pay.pl,v 1.9 2007/04/04 16:46:23 tipaul Exp $
=head1 pay.pl
@@ -35,7 +35,7 @@
use C4::Accounts;
use C4::Stats;
use C4::Koha;
-use C4::Circulation::Fines;
+use C4::Overdues;
use C4::Branch; # GetBranches
my $input = new CGI;
Index: misc/fines.pl
===================================================================
RCS file: /sources/koha/koha/misc/fines.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- misc/fines.pl 9 Mar 2007 15:47:25 -0000 1.2
+++ misc/fines.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -25,11 +25,11 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: fines.pl,v 1.2 2007/03/09 15:47:25 tipaul Exp $
+# $Id: fines.pl,v 1.3 2007/04/04 16:46:23 tipaul Exp $
use C4::Context;
-use C4::Circulation::Circ2;
-use C4::Circulation::Fines;
+use C4::Circulation;
+use C4::Overdues;
use Date::Manip qw/Date_DaysSince1BC/;
use C4::Biblio;
Index: misc/fines2.pl
===================================================================
RCS file: /sources/koha/koha/misc/fines2.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- misc/fines2.pl 9 Mar 2007 14:58:36 -0000 1.13
+++ misc/fines2.pl 4 Apr 2007 16:46:23 -0000 1.14
@@ -25,11 +25,11 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: fines2.pl,v 1.13 2007/03/09 14:58:36 tipaul Exp $
+# $Id: fines2.pl,v 1.14 2007/04/04 16:46:23 tipaul Exp $
use C4::Context;
-use C4::Circulation::Circ2;
-use C4::Circulation::Fines;
+use C4::Circulation;
+use C4::Overdues;
use Date::Manip;
use C4::Biblio;
@@ -130,15 +130,15 @@
my $cost=ReplacementCost($data->[$i]->{'itemnumber'});
my $dbh = C4::Context->dbh;
my $env;
- my
$accountno=C4::Circulation::Circ2::getnextacctno($env,$data->[$i]->{'borrowernumber'},$dbh);
+ my
$accountno=C4::Circulation::Circ2::getnextacctno($data->[$i]->{'borrowernumber'});
my $item=GetBiblioFromItemNumber($data->[$i]->{'itemnumber'});
if ($item->{'itemlost'} ne '1' && $item->{'itemlost'} ne '2' ){
# FIXME
# this should be a separate function
#
- my $sth=$dbh->prepare("Insert into accountlines
+ my $sth=$dbh->prepare("INSERT INTO accountlines
(borrowernumber,itemnumber,accountno,date,amount,
- description,accounttype,amountoutstanding) values
+ description,accounttype,amountoutstanding) VALUES
(?,?,?,now(),?,?,'L',?)");
$sth->execute($data->[$i]->{'borrowernumber'},$data->[$i]->{'itemnumber'},
$accountno,$cost,"Lost item $item->{'title'} $item->{'barcode'}
$due",$cost);
Index: misc/cronjobs/notifyMailsOp.pl
===================================================================
RCS file: /sources/koha/koha/misc/cronjobs/notifyMailsOp.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- misc/cronjobs/notifyMailsOp.pl 9 Mar 2007 15:44:20 -0000 1.2
+++ misc/cronjobs/notifyMailsOp.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -3,7 +3,7 @@
use C4::Date;
use Mail::Sendmail; # comment out if not doing e-mail notices
use Getopt::Long;
-use C4::Circulation::Circ2;
+use C4::Circulation;
# use C4::Members;
# this module will notify only the mail case
# Now it's only programmed for ouest provence, you can modify it for yourself
@@ -204,7 +204,7 @@
# now deal with the debarred mode
# if ($debarred eq 1) {
-# Ã ajouter : si le lecteur est en mode debarred, ajouter la
fonction qui nous permettra cela
+# �ajouter : si le lecteur est en mode debarred, ajouter la
fonction qui nous permettra cela
# UpdateBorrowerDebarred($num->{'borrowernumber'});
# }
close(OUT);
Index: misc/notifys/contact_history.pl
===================================================================
RCS file: /sources/koha/koha/misc/notifys/contact_history.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- misc/notifys/contact_history.pl 9 Mar 2007 14:58:36 -0000 1.2
+++ misc/notifys/contact_history.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -26,8 +26,8 @@
use CGI;
-use C4::Circulation::Circ2;
-use C4::Circulation::Fines;
+use C4::Circulation;
+use C4::Overdues;
use Data::Dumper;
Index: misc/notifys/fines.pl
===================================================================
RCS file: /sources/koha/koha/misc/notifys/fines.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- misc/notifys/fines.pl 9 Mar 2007 14:58:36 -0000 1.4
+++ misc/notifys/fines.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -17,8 +17,8 @@
use C4::Members;
-use C4::Circulation::Circ2;
-use C4::Circulation::Fines;
+use C4::Circulation;
+use C4::Overdues;
use Date::Manip;
use Mail::Sendmail;
@@ -101,7 +101,7 @@
my $dbh=C4Connect();
my $env;
- my
$accountno=C4::Circulation::Circ2::getnextacctno($env,$overdue->{'borrowernumber'},$dbh);
+ my
$accountno=C4::Circulation::Circ2::getnextacctno($overdue->{'borrowernumber'});
my
$item=GetBiblioFromItemNumber($overdue->{'itemnumber'});
if ($item->{'itemlost'} ne '1' && $item->{'itemlost'}
ne '2' ){
$item->{'title'}=~ s/\'/\\'/g;
Index: misc/notifys/printnote.pl
===================================================================
RCS file: /sources/koha/koha/misc/notifys/printnote.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- misc/notifys/printnote.pl 9 Mar 2007 14:58:36 -0000 1.2
+++ misc/notifys/printnote.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -27,8 +27,8 @@
use CGI;
-use C4::Circulation::Circ2;
-use C4::Circulation::Fines;
+use C4::Circulation;
+use C4::Overdues;
my $input = new CGI;
my $borrowernumber = $input->param('borrowernumber');
Index: opac/opac-account.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-account.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- opac/opac-account.pl 9 Mar 2007 15:12:54 -0000 1.12
+++ opac/opac-account.pl 4 Apr 2007 16:46:23 -0000 1.13
@@ -22,7 +22,7 @@
use C4::Output;
use CGI;
use C4::Members;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Auth;
use C4::Interface::CGI::Output;
@@ -41,7 +41,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
my @bordat;
$bordat[0] = $borr;
Index: opac/opac-addbookbybiblionumber.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-addbookbybiblionumber.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- opac/opac-addbookbybiblionumber.pl 9 Mar 2007 15:12:54 -0000 1.6
+++ opac/opac-addbookbybiblionumber.pl 4 Apr 2007 16:46:23 -0000 1.7
@@ -3,7 +3,7 @@
#script to provide bookshelf management
# WARNING: This file uses 4-character tabs!
#
-# $Header: /sources/koha/koha/opac/opac-addbookbybiblionumber.pl,v 1.6
2007/03/09 15:12:54 tipaul Exp $
+# $Header: /sources/koha/koha/opac/opac-addbookbybiblionumber.pl,v 1.7
2007/04/04 16:46:23 tipaul Exp $
#
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use CGI;
use C4::Output;
use C4::BookShelves;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Auth;
use C4::Interface::CGI::Output;
Index: opac/opac-passwd.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-passwd.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- opac/opac-passwd.pl 9 Mar 2007 15:12:54 -0000 1.4
+++ opac/opac-passwd.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -25,7 +25,7 @@
use C4::Auth; # checkauth, getborrowernumber.
use C4::Context;
use Digest::MD5 qw(md5_base64);
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Interface::CGI::Output;
@@ -44,7 +44,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
my $sth =
$dbh->prepare("UPDATE borrowers SET password = ? WHERE borrowernumber=?");
Index: opac/opac-readingrecord.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-readingrecord.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- opac/opac-readingrecord.pl 9 Mar 2007 15:12:54 -0000 1.11
+++ opac/opac-readingrecord.pl 4 Apr 2007 16:46:23 -0000 1.12
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: opac-readingrecord.pl,v 1.11 2007/03/09 15:12:54 tipaul Exp $
+# $Id: opac-readingrecord.pl,v 1.12 2007/04/04 16:46:23 tipaul Exp $
use strict;
require Exporter;
@@ -23,7 +23,7 @@
use C4::Auth;
use C4::Koha;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Date;
use C4::Members;
@@ -42,7 +42,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
$template->param($borr);
Index: opac/opac-renew.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-renew.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- opac/opac-renew.pl 9 Mar 2007 15:12:54 -0000 1.4
+++ opac/opac-renew.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -5,7 +5,7 @@
#script to renew items from the web
use CGI;
-use C4::Circulation::Circ2;
+use C4::Circulation;
my $query = new CGI;
@@ -13,9 +13,9 @@
my $borrowernumber = $query->param("borrowernumber");
my %env;
-my $status = renewstatus( \%env, $borrowernumber, $itemnumber );
+my $status = CanBookBeRenewed( $borrowernumber, $itemnumber );
if ( $status == 1 ) {
- renewbook( \%env, $borrowernumber, $itemnumber );
+ AddRenewal( $borrowernumber, $itemnumber );
}
if ( $query->param('from') eq 'opac_user' ) {
Index: opac/opac-reserve.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-reserve.pl,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -b -r1.30 -r1.31
--- opac/opac-reserve.pl 9 Mar 2007 15:12:54 -0000 1.30
+++ opac/opac-reserve.pl 4 Apr 2007 16:46:23 -0000 1.31
@@ -21,7 +21,7 @@
use C4::Biblio;
use C4::Auth; # checkauth, getborrowernumber.
use C4::Koha;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Reserves2;
use C4::Interface::CGI::Output;
use C4::Date;
@@ -43,7 +43,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
# get biblionumber.....
my $biblionumber = $query->param('biblionumber');
Index: opac/opac-review.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-review.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- opac/opac-review.pl 29 Mar 2007 16:45:54 -0000 1.4
+++ opac/opac-review.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -23,7 +23,7 @@
use C4::Auth;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Review;
use C4::Biblio;
Index: opac/opac-shelves.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-shelves.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- opac/opac-shelves.pl 9 Mar 2007 15:12:54 -0000 1.9
+++ opac/opac-shelves.pl 4 Apr 2007 16:46:23 -0000 1.10
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: opac-shelves.pl,v 1.9 2007/03/09 15:12:54 tipaul Exp $
+# $Id: opac-shelves.pl,v 1.10 2007/04/04 16:46:23 tipaul Exp $
=head1 NAME
@@ -68,7 +68,7 @@
use CGI;
use C4::Output;
use C4::BookShelves;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Auth;
use C4::Interface::CGI::Output;
@@ -86,7 +86,7 @@
if ( $query->param('modifyshelfcontents') ) {
my $shelfnumber = $query->param('viewshelf');
my $barcode = $query->param('addbarcode');
- my ($item) = getiteminformation( 0, $barcode );
+ my ($item) = GetItemFromBarcode($barcode);
if ( ShelfPossibleAction( $loggedinuser, $shelfnumber, 'manage' ) ) {
AddToShelf( $item->{'itemnumber'}, $shelfnumber );
foreach ( $query->param ) {
@@ -229,6 +229,11 @@
#
# $Log: opac-shelves.pl,v $
+# Revision 1.10 2007/04/04 16:46:23 tipaul
+# HUGE COMMIT : code cleaning circulation.
+#
+# some stuff to do, i'll write a mail on koha-devel NOW !
+#
# Revision 1.9 2007/03/09 15:12:54 tipaul
# rel_3_0 moved to HEAD
#
Index: opac/opac-showreviews.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-showreviews.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- opac/opac-showreviews.pl 29 Mar 2007 16:45:54 -0000 1.4
+++ opac/opac-showreviews.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -21,7 +21,7 @@
use C4::Auth;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Review;
use C4::Biblio;
Index: opac/opac-user.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-user.pl,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -b -r1.24 -r1.25
--- opac/opac-user.pl 9 Mar 2007 15:12:54 -0000 1.24
+++ opac/opac-user.pl 4 Apr 2007 16:46:23 -0000 1.25
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: opac-user.pl,v 1.24 2007/03/09 15:12:54 tipaul Exp $
+# $Id: opac-user.pl,v 1.25 2007/04/04 16:46:23 tipaul Exp $
use strict;
require Exporter;
@@ -23,7 +23,7 @@
use C4::Auth;
use C4::Koha;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Reserves2;
use C4::Members;
use C4::Interface::CGI::Output;
@@ -45,7 +45,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
$borr->{'dateenrolled'} = format_date( $borr->{'dateenrolled'} );
$borr->{'expiry'} = format_date( $borr->{'expiry'} );
@@ -76,7 +76,7 @@
$template->param( borrowernumber => $borrowernumber );
#get issued items ....
-my $issues = getissues($borr);
+my $issues = GetBorrowerIssues($borr);
my $count = 0;
my $overdues_count = 0;
@@ -84,9 +84,7 @@
my @issuedat;
my $imgdir = getitemtypeimagesrc();
my $itemtypes = GetItemTypes();
-foreach my $key ( keys %$issues ) {
- my $issue = $issues->{$key};
- $issue->{'date_due'} = format_date( $issue->{'date_due'} );
+foreach my $issue ( @$issues ) {
# check for reserves
my ( $restype, $res ) = CheckReserves( $issue->{'itemnumber'} );
@@ -113,7 +111,7 @@
# check if item is renewable
my %env;
- my $status = renewstatus( \%env, $borrowernumber, $issue->{'itemnumber'} );
+ my $status = CanBookBeRenewed( $borrowernumber, $issue->{'itemnumber'} );
$issue->{'status'} = $status;
@@ -162,7 +160,7 @@
my $wcount = 0;
foreach my $res (@$reserves) {
if ( $res->{'itemnumber'} ) {
- my $item = getiteminformation( $res->{'itemnumber'}, '' );
+ my $item = GetItem( $res->{'itemnumber'});
$res->{'holdingbranch'} =
$branches->{ $item->{'holdingbranch'} }->{'branchname'};
$res->{'branch'} = $branches->{ $res->{'branchcode'} }->{'branchname'};
Index: opac/opac-userdetails.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-userdetails.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- opac/opac-userdetails.pl 9 Mar 2007 15:12:54 -0000 1.13
+++ opac/opac-userdetails.pl 4 Apr 2007 16:46:23 -0000 1.14
@@ -22,7 +22,7 @@
use C4::Auth;
use C4::Koha;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Interface::CGI::Output;
use C4::Date;
@@ -41,7 +41,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
$borr->{'dateenrolled'} = format_date( $borr->{'dateenrolled'} );
$borr->{'dateexpiry'} = format_date( $borr->{'dateexpiry'} );
Index: opac/opac-userupdate.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-userupdate.pl,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- opac/opac-userupdate.pl 9 Mar 2007 15:12:54 -0000 1.15
+++ opac/opac-userupdate.pl 4 Apr 2007 16:46:23 -0000 1.16
@@ -25,7 +25,7 @@
use C4::Auth; # checkauth, getborrowernumber.
use C4::Context;
use C4::Koha;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Interface::CGI::Output;
use C4::Date;
use C4::Members;
@@ -44,7 +44,7 @@
);
# get borrower information ....
-my ( $borr, $flags ) = getpatroninformation( undef, $borrowernumber );
+my ( $borr, $flags ) = GetMemberDetails( $borrowernumber );
# handle the new information....
# collect the form values and send an email.
Index: reports/acquisitions_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/acquisitions_stats.pl,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- reports/acquisitions_stats.pl 9 Mar 2007 15:13:36 -0000 1.13
+++ reports/acquisitions_stats.pl 4 Apr 2007 16:46:23 -0000 1.14
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: acquisitions_stats.pl,v 1.13 2007/03/09 15:13:36 tipaul Exp $
+# $Id: acquisitions_stats.pl,v 1.14 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -29,7 +29,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
=head1 NAME
Index: reports/bor_issues_top.pl
===================================================================
RCS file: /sources/koha/koha/reports/bor_issues_top.pl,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- reports/bor_issues_top.pl 9 Mar 2007 15:13:36 -0000 1.10
+++ reports/bor_issues_top.pl 4 Apr 2007 16:46:23 -0000 1.11
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: bor_issues_top.pl,v 1.10 2007/03/09 15:13:36 tipaul Exp $
+# $Id: bor_issues_top.pl,v 1.11 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Manip;
use C4::Members;
Index: reports/borrowers_out.pl
===================================================================
RCS file: /sources/koha/koha/reports/borrowers_out.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- reports/borrowers_out.pl 9 Mar 2007 15:13:36 -0000 1.8
+++ reports/borrowers_out.pl 4 Apr 2007 16:46:23 -0000 1.9
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: borrowers_out.pl,v 1.8 2007/03/09 15:13:36 tipaul Exp $
+# $Id: borrowers_out.pl,v 1.9 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Manip;
use C4::Members;
Index: reports/borrowers_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/borrowers_stats.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- reports/borrowers_stats.pl 9 Mar 2007 15:13:36 -0000 1.12
+++ reports/borrowers_stats.pl 4 Apr 2007 16:46:23 -0000 1.13
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: borrowers_stats.pl,v 1.12 2007/03/09 15:13:36 tipaul Exp $
+# $Id: borrowers_stats.pl,v 1.13 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -28,7 +28,7 @@
use C4::Koha;
use C4::Acquisition;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
=head1 NAME
Index: reports/cat_issues_top.pl
===================================================================
RCS file: /sources/koha/koha/reports/cat_issues_top.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- reports/cat_issues_top.pl 9 Mar 2007 15:13:36 -0000 1.12
+++ reports/cat_issues_top.pl 4 Apr 2007 16:46:23 -0000 1.13
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: cat_issues_top.pl,v 1.12 2007/03/09 15:13:36 tipaul Exp $
+# $Id: cat_issues_top.pl,v 1.13 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Manip;
use C4::Members;
Index: reports/catalogue_out.pl
===================================================================
RCS file: /sources/koha/koha/reports/catalogue_out.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- reports/catalogue_out.pl 9 Mar 2007 15:13:36 -0000 1.7
+++ reports/catalogue_out.pl 4 Apr 2007 16:46:23 -0000 1.8
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: catalogue_out.pl,v 1.7 2007/03/09 15:13:36 tipaul Exp $
+# $Id: catalogue_out.pl,v 1.8 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Manip;
=head1 NAME
Index: reports/catalogue_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/catalogue_stats.pl,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- reports/catalogue_stats.pl 9 Mar 2007 15:13:36 -0000 1.19
+++ reports/catalogue_stats.pl 4 Apr 2007 16:46:23 -0000 1.20
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: catalogue_stats.pl,v 1.19 2007/03/09 15:13:36 tipaul Exp $
+# $Id: catalogue_stats.pl,v 1.20 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
=head1 NAME
Index: reports/inventory.pl
===================================================================
RCS file: /sources/koha/koha/reports/inventory.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- reports/inventory.pl 9 Mar 2007 15:13:36 -0000 1.4
+++ reports/inventory.pl 4 Apr 2007 16:46:23 -0000 1.5
@@ -23,7 +23,7 @@
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Biblio;
use C4::Date;
@@ -93,7 +93,7 @@
$qonloan->execute($barcode);
if ($qonloan->rows){
my $data = $qonloan->fetchrow_hashref;
- my ($doreturn, $messages,
$iteminformation, $borrower) =returnbook($barcode, $data->{homebranch});
+ my ($doreturn, $messages,
$iteminformation, $borrower) =AddReturn($barcode, $data->{homebranch});
if ($doreturn){push @errorloop,
{'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}}
else {push @errorloop,
{'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}}
}
@@ -112,7 +112,7 @@
if ($markseen) {
foreach my $field ($input->param) {
if ($field =~ /SEEN-(.*)/) {
- &itemseen($1);
+ &ModDateLastSeen($1);
}
}
}
Index: reports/issues_avg_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/issues_avg_stats.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- reports/issues_avg_stats.pl 9 Mar 2007 15:13:36 -0000 1.7
+++ reports/issues_avg_stats.pl 4 Apr 2007 16:46:23 -0000 1.8
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: issues_avg_stats.pl,v 1.7 2007/03/09 15:13:36 tipaul Exp $
+# $Id: issues_avg_stats.pl,v 1.8 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Calc qw(Delta_Days);
=head1 NAME
Index: reports/issues_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/issues_stats.pl,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- reports/issues_stats.pl 9 Mar 2007 15:13:36 -0000 1.15
+++ reports/issues_stats.pl 4 Apr 2007 16:46:23 -0000 1.16
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: issues_stats.pl,v 1.15 2007/03/09 15:13:36 tipaul Exp $
+# $Id: issues_stats.pl,v 1.16 2007/04/04 16:46:23 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -27,7 +27,7 @@
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use Date::Manip;
=head1 NAME
Index: reports/manager.pl
===================================================================
RCS file: /sources/koha/koha/reports/manager.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- reports/manager.pl 10 Mar 2007 17:01:00 -0000 1.6
+++ reports/manager.pl 4 Apr 2007 16:46:23 -0000 1.7
@@ -23,7 +23,7 @@
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Circulation;
my $input = new CGI;
Index: reserve/placerequest.pl
===================================================================
RCS file: /sources/koha/koha/reserve/placerequest.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- reserve/placerequest.pl 9 Mar 2007 15:13:57 -0000 1.5
+++ reserve/placerequest.pl 4 Apr 2007 16:46:23 -0000 1.6
@@ -26,7 +26,7 @@
use CGI;
use C4::Output;
use C4::Reserves2;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Members;
my $input = new CGI;
@@ -49,7 +49,7 @@
if ($checkitem ne ''){
$rank[0] = '0';
my $item = $checkitem;
- $item = getiteminformation($item);
+ $item = GetItem($item);
if ( $item->{'holdingbranch'} eq $branch ){
$found = 'W';
}
Index: reserve/renewscript.pl
===================================================================
RCS file: /sources/koha/koha/reserve/renewscript.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- reserve/renewscript.pl 9 Mar 2007 15:47:41 -0000 1.5
+++ reserve/renewscript.pl 4 Apr 2007 16:46:23 -0000 1.6
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: renewscript.pl,v 1.5 2007/03/09 15:47:41 tipaul Exp $
+# $Id: renewscript.pl,v 1.6 2007/04/04 16:46:23 tipaul Exp $
#written 18/1/2000 by address@hidden
#script to renew items from the web
@@ -24,7 +24,7 @@
# Suite 330, Boston, MA 02111-1307 USA
use CGI;
-use C4::Circulation::Circ2;
+use C4::Circulation;
my $input = new CGI;
@@ -49,8 +49,8 @@
foreach my $itemno (@data) {
#check status before renewing issue
- if (renewstatus(\%env,$borrowernumber,$itemno)){
- renewbook(\%env,$borrowernumber,$itemno);
+ if (CanBookBeRenewed($borrowernumber,$itemno)){
+ AddRenewal($borrowernumber,$itemno);
}
}
Index: reserve/request.pl
===================================================================
RCS file: /sources/koha/koha/reserve/request.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- reserve/request.pl 9 Mar 2007 15:13:57 -0000 1.8
+++ reserve/request.pl 4 Apr 2007 16:46:23 -0000 1.9
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: request.pl,v 1.8 2007/03/09 15:13:57 tipaul Exp $
+# $Id: request.pl,v 1.9 2007/04/04 16:46:23 tipaul Exp $
#writen 2/1/00 by address@hidden
# Copyright 2000-2002 Katipo Communications
@@ -37,7 +37,7 @@
use C4::Reserves2;
use C4::Biblio;
use C4::Koha;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Date;
use C4::Members;
@@ -88,7 +88,7 @@
}
if ($cardnumber) {
- my $borrowerinfo = getpatroninformation( \%env, 0, $cardnumber );
+ my $borrowerinfo = GetMemberDetails( 0, $cardnumber );
my $expiry;
my $diffbranch;
my @getreservloop;
@@ -166,8 +166,8 @@
my $totalcount = $count;
my $alreadyreserved;
-# FIXME launch another time getpatroninformation perhaps until
-my $borrowerinfo = getpatroninformation( \%env, 0, $cardnumber );
+# FIXME launch another time GetMemberDetails perhaps until
+my $borrowerinfo = GetMemberDetails( 0, $cardnumber );
foreach my $res (@$reserves) {
if ( ( $res->{found} eq 'W' ) or ( $res->{priority} == 0 ) ) {
@@ -226,8 +226,6 @@
my $itemtypeinfos_of = get_itemtypeinfos_of(@itemtypes);
-my $return_date_of = get_current_return_date_of(@itemnumbers);
-
my @bibitemloop;
foreach my $biblioitemnumber (@biblioitemnumbers) {
@@ -251,22 +249,20 @@
$branchinfos_of->{ $item->{holdingbranch} }{branchname};
}
-# add inforrmation
+# add information
$item->{itemcallnumber} = $item->{itemcallnumber};
# if the item is currently on loan, we display its return date and
# change the background color
- my $date_due;
-
- if ( defined $return_date_of->{$itemnumber} ) {
- $date_due = format_date( $return_date_of->{$itemnumber} );
- $item->{date_due} = $date_due;
+ my $issues= GetItemIssue($itemnumber);
+ if ( $issues->{'date_due'} ) {
+ $item->{date_due} = format_date($issues->{'date_due'});
$item->{backgroundcolor} = 'onloan';
}
# checking reserve
my ($reservedate,$reservedfor,$expectedAt) =
GetFirstReserveDateFromItem($itemnumber);
- my $ItemBorrowerReserveInfo = getpatroninformation( \%env,
$reservedfor, 0);
+ my $ItemBorrowerReserveInfo = GetMemberDetails( $reservedfor, 0);
if ( defined $reservedate ) {
$item->{backgroundcolor} = 'reserved';
@@ -298,7 +294,7 @@
# Check of the transfered documents
my ( $transfertwhen, $transfertfrom, $transfertto ) =
- get_transfert_infos($itemnumber);
+ GetTransfers($itemnumber);
if ( $transfertwhen ne '' ) {
$item->{transfertwhen} = format_date($transfertwhen);
@@ -314,7 +310,7 @@
# An item is available only if:
if (
not defined $reservedate # not reserved yet
- and $date_due eq '' # not currently on loan
+ and $issues->{'date_due'} eq '' # not currently on loan
and not $item->{itemlost} # not lost
and not $item->{notforloan} # not forbidden to loan
and $transfertwhen eq '' # not currently on transfert
@@ -371,7 +367,7 @@
}
# get borrowers reserve info
-my $reserveborrowerinfo = getpatroninformation( \%env,
$res->{'borrowernumber'}, 0);
+my $reserveborrowerinfo = GetMemberDetails( $res->{'borrowernumber'}, 0);
$reserve{'date'} = format_date( $res->{'reservedate'} );
$reserve{'borrowernumber'} = $res->{'borrowernumber'};
Index: serials/routing-preview.pl
===================================================================
RCS file: /sources/koha/koha/serials/routing-preview.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- serials/routing-preview.pl 9 Mar 2007 15:14:25 -0000 1.3
+++ serials/routing-preview.pl 4 Apr 2007 16:46:23 -0000 1.4
@@ -11,7 +11,7 @@
use C4::Output;
use C4::Acquisition;
use C4::Reserves2;
-use C4::Circulation::Circ2;
+use C4::Circulation;
use C4::Interface::CGI::Output;
use C4::Context;
use C4::Members;
Index: tools/cleanborrowers.pl
===================================================================
RCS file: /sources/koha/koha/tools/cleanborrowers.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- tools/cleanborrowers.pl 9 Mar 2007 15:47:55 -0000 1.2
+++ tools/cleanborrowers.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -17,7 +17,7 @@
#
# Written by Antoine Farnault address@hidden on Nov. 2006.
-# $Id: cleanborrowers.pl,v 1.2 2007/03/09 15:47:55 tipaul Exp $
+# $Id: cleanborrowers.pl,v 1.3 2007/04/04 16:46:23 tipaul Exp $
=head1 cleanborrowers.pl
@@ -40,7 +40,7 @@
use C4::Members; # GetBorrowersWhoHavexxxBorrowed.
-use C4::Circulation::Circ2; # AnonymiseIssueHistory.
+use C4::Circulation; # AnonymiseIssueHistory.
use Date::Calc qw/Date_to_Days Today/;
my $cgi = new CGI;
Index: tools/inventory.pl
===================================================================
RCS file: /sources/koha/koha/tools/inventory.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- tools/inventory.pl 10 Mar 2007 07:12:15 -0000 1.3
+++ tools/inventory.pl 4 Apr 2007 16:46:23 -0000 1.4
@@ -23,7 +23,7 @@
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2;
+use C4::Biblio;
use C4::Date;
use C4::Koha;
use C4::Branch; # GetBranches
@@ -98,7 +98,7 @@
$qonloan->execute($barcode);
if ($qonloan->rows){
my $data = $qonloan->fetchrow_hashref;
- my ($doreturn, $messages, $iteminformation, $borrower)
=returnbook($barcode, $data->{homebranch});
+ my ($doreturn, $messages, $iteminformation, $borrower)
=AddReturn($barcode, $data->{homebranch});
if ($doreturn){push @errorloop,
{'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}}
else {push @errorloop,
{'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}}
}
@@ -117,12 +117,12 @@
if ($markseen) {
foreach my $field ($input->param) {
if ($field =~ /SEEN-(.*)/) {
- &itemseen($1);
+ &ModDateLastSeen($1);
}
}
}
if ($op) {
- my $res =
C4::Circulation::Circ2::GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$branchcode,$offset,$pagesize);
+ my $res =
GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$branchcode,$offset,$pagesize);
$template->param(loop =>$res,
nextoffset => ($offset+$pagesize),
prevoffset => ($offset?$offset-$pagesize:0),
Index: tools/itemslost.pl
===================================================================
RCS file: /sources/koha/koha/tools/itemslost.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- tools/itemslost.pl 9 Mar 2007 15:47:55 -0000 1.2
+++ tools/itemslost.pl 4 Apr 2007 16:46:23 -0000 1.3
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-#$Id: itemslost.pl,v 1.2 2007/03/09 15:47:55 tipaul Exp $
+#$Id: itemslost.pl,v 1.3 2007/04/04 16:46:23 tipaul Exp $
=head1 itemslost
@@ -27,7 +27,7 @@
use CGI;
use C4::Auth;
use C4::Interface::CGI::Output;
-use C4::Circulation::Circ2; # GetLostItems
+use C4::Biblio; # GetLostItems
use C4::Koha; # GetItemTypes
use C4::Branch; # GetBranches
Index: C4/Circulation/Circ2.pm
===================================================================
RCS file: C4/Circulation/Circ2.pm
diff -N C4/Circulation/Circ2.pm
--- C4/Circulation/Circ2.pm 30 Mar 2007 13:30:36 -0000 1.129
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,3234 +0,0 @@
-package C4::Circulation::Circ2;
-
-# Copyright 2000-2002 Katipo Communications
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-
-# $Id: Circ2.pm,v 1.129 2007/03/30 13:30:36 tipaul Exp $
-
-use strict;
-require Exporter;
-use C4::Context;
-use C4::Stats;
-use C4::Reserves2;
-use C4::Koha;
-use C4::Biblio;
-use C4::Accounts;
-use Date::Calc qw(
- Today
- Today_and_Now
- Add_Delta_YM
- Add_Delta_DHMS
- Date_to_Days
-);
-use POSIX qw(strftime);
-use C4::Branch; # GetBranches
-use C4::Log; # logaction
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.129 $' =~ /\d+/g; shift(@v).".".join(
"_", map { sprintf "%03d", $_ } @v ); };
-
-=head1 NAME
-
-C4::Circulation::Circ2 - Koha circulation module
-
-=head1 SYNOPSIS
-
-use C4::Circulation::Circ2;
-
-=head1 DESCRIPTION
-
-The functions in this module deal with circulation, issues, and
-returns, as well as general information about the library.
-Also deals with stocktaking.
-
-=head1 FUNCTIONS
-
-=cut
-
address@hidden = qw(Exporter);
-
-# FIXME subs that should probably be elsewhere
-push @EXPORT, qw(
- &getpatroninformation
- &getiteminformation
-);
-# subs to deal with issuing a book
-push @EXPORT, qw(
- &canbookbeissued
- &issuebook
- ¤tissues
- &getissues
- &renewstatus
- &renewbook
- &calc_charges
- &fixdate
- &GetIssuesFromBiblio
- &itemissues
- &AnonymiseIssueHistory
-);
-# subs to deal with returns
-push @EXPORT, qw(
- &returnbook
-);
-# subs to deal with reserves => Move to Reserves2.pm
-push @EXPORT, qw(
- &find_reserves
- &GetReservesForBranch
- &GetReservesToBranch
-);
-
-# subs to deal with transfers
-push @EXPORT, qw(
- &transferbook
- &get_transfert_infos
- &checktransferts
- &GetTransfersFromBib
- &updateWrongTransfer
-);
-
-# subs to remove
-push @EXPORT, qw(
- &decode
- &get_current_return_date_of
- &dotransfer
-);
-
-# to move in Biblio.pm
-push @EXPORT, qw(
- &itemseen
- &GetItemsForInventory
- &GetLostItems
-);
-
-# subs to deal with late issues => to move to Fines.pm
-push @EXPORT, qw(
- &GetOverduesForBranch
- &AddNotifyLine
- &RemoveNotifyLine
-);
-
-=head2 itemseen
-
-&itemseen($itemnum)
-Mark item as seen. Is called when an item is issued, returned or manually
marked during inventory/stocktaking
-C<$itemnum> is the item number
-
-=cut
-
-sub itemseen {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "update items set itemlost=0, datelastseen = now() where
items.itemnumber = ?"
- );
- $sth->execute($itemnum);
- return;
-}
-
-=head2 itemborrowed
-
-&itemseen($itemnum)
-Mark item as borrowed. Is called when an item is issued.
-C<$itemnum> is the item number
-
-=cut
-
-sub itemborrowed {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "update items set itemlost=0, datelastborrowed = now() where
items.itemnumber = ?"
- );
- $sth->execute($itemnum);
- return;
-}
-
-=head2 GetItemsForInventory
-
-$itemlist =
GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
-
-Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
-
-The sub returns a list of hashes, containing itemnumber, author, title,
barcode & item callnumber.
-It is ordered by callnumber,title.
-
-The minlocation & maxlocation parameters are used to specify a range of item
callnumbers
-the datelastseen can be used to specify that you want to see items not seen
since a past date only.
-offset & size can be used to retrieve only a part of the whole listing (defaut
behaviour)
-
-=cut
-
-sub GetItemsForInventory {
- my ( $minlocation, $maxlocation, $datelastseen, $branch, $offset, $size )
= @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($datelastseen) {
- my $query =
- "SELECT
itemnumber,barcode,itemcallnumber,title,author,datelastseen
- FROM items
- LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
- WHERE itemcallnumber>= ?
- AND itemcallnumber <=?
- AND (datelastseen< ? OR datelastseen IS NULL)";
- $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
- $query .= " ORDER BY itemcallnumber,title";
- $sth = $dbh->prepare($query);
- $sth->execute( $minlocation, $maxlocation, $datelastseen );
- }
- else {
- my $query ="
- SELECT
itemnumber,barcode,itemcallnumber,title,author,datelastseen
- FROM items
- LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
- WHERE itemcallnumber>= ?
- AND itemcallnumber <=?";
- $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
- $query .= " ORDER BY itemcallnumber,title";
- $sth = $dbh->prepare($query);
- $sth->execute( $minlocation, $maxlocation );
- }
- my @results;
- while ( my $row = $sth->fetchrow_hashref ) {
- $offset-- if ($offset);
- if ( ( !$offset ) && $size ) {
- push @results, $row;
- $size--;
- }
- }
- return address@hidden;
-}
-
-=head2 getpatroninformation
-
-($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
$cardnumber);
-
-Looks up a patron and returns information about him or her. If
-C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
-up the borrower by number; otherwise, it looks up the borrower by card
-number.
-
-C<$env> is effectively ignored, but should be a reference-to-hash.
-
-C<$borrower> is a reference-to-hash whose keys are the fields of the
-borrowers table in the Koha database. In addition,
-C<$borrower-E<gt>{flags}> is a hash giving more detailed information
-about the patron. Its keys act as flags :
-
- if $borrower->{flags}->{LOST} {
- # Patron's card was reported lost
- }
-
-Each flag has a C<message> key, giving a human-readable explanation of
-the flag. If the state of a flag means that the patron should not be
-allowed to borrow any more books, then it will have a C<noissues> key
-with a true value.
-
-The possible flags are:
-
-=head3 CHARGES
-
-=over 4
-
-=item Shows the patron's credit or debt, if any.
-
-=back
-
-=head3 GNA
-
-=over 4
-
-=item (Gone, no address.) Set if the patron has left without giving a
-forwarding address.
-
-=back
-
-=head3 LOST
-
-=over 4
-
-=item Set if the patron's card has been reported as lost.
-
-=back
-
-=head3 DBARRED
-
-=over 4
-
-=item Set if the patron has been debarred.
-
-=back
-
-=head3 NOTES
-
-=over 4
-
-=item Any additional notes about the patron.
-
-=back
-
-=head3 ODUES
-
-=over 4
-
-=item Set if the patron has overdue items. This flag has several keys:
-
-C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
-overdue items. Its elements are references-to-hash, each describing an
-overdue item. The keys are selected fields from the issues, biblio,
-biblioitems, and items tables of the Koha database.
-
-C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
-the overdue items, one per line.
-
-=back
-
-=head3 WAITING
-
-=over 4
-
-=item Set if any items that the patron has reserved are available.
-
-C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
-available items. Each element is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database.
-
-=back
-
-=cut
-
-sub getpatroninformation {
- my ( $env, $borrowernumber, $cardnumber ) = @_;
- my $dbh = C4::Context->dbh;
- my $query;
- my $sth;
- if ($borrowernumber) {
- $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
- $sth->execute($borrowernumber);
- }
- elsif ($cardnumber) {
- $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
- $sth->execute($cardnumber);
- }
- else {
- return undef;
- }
- my $borrower = $sth->fetchrow_hashref;
- my $amount = checkaccount( $env, $borrowernumber, $dbh );
- $borrower->{'amountoutstanding'} = $amount;
- my $flags = patronflags( $env, $borrower, $dbh );
- my $accessflagshash;
-
- $sth = $dbh->prepare("select bit,flag from userflags");
- $sth->execute;
- while ( my ( $bit, $flag ) = $sth->fetchrow ) {
- if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
- $accessflagshash->{$flag} = 1;
- }
- }
- $sth->finish;
- $borrower->{'flags'} = $flags;
- $borrower->{'authflags'} = $accessflagshash;
-
- # find out how long the membership lasts
- $sth =
- $dbh->prepare(
- "select enrolmentperiod from categories where categorycode = ?");
- $sth->execute( $borrower->{'categorycode'} );
- my $enrolment = $sth->fetchrow;
- $borrower->{'enrolmentperiod'} = $enrolment;
- return ($borrower); #, $flags, $accessflagshash);
-}
-
-=head2 decode
-
-=head3 $str = &decode($chunk);
-
-=over 4
-
-=item Decodes a segment of a string emitted by a CueCat barcode scanner and
-returns it.
-
-=back
-
-=cut
-
-# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
-sub decode {
- my ($encoded) = @_;
- my $seq =
- 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
- my @s = map { index( $seq, $_ ); } split( //, $encoded );
- my $l = ( $#s + 1 ) % 4;
- if ($l) {
- if ( $l == 1 ) {
- warn "Error!";
- return;
- }
- $l = 4 - $l;
- $#s += $l;
- }
- my $r = '';
- while ( $#s >= 0 ) {
- my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
- $r .=
- chr( ( $n >> 16 ) ^ 67 )
- .chr( ( $n >> 8 & 255 ) ^ 67 )
- .chr( ( $n & 255 ) ^ 67 );
- @s = @s[ 4 .. $#s ];
- }
- $r = substr( $r, 0, length($r) - $l );
- return $r;
-}
-
-=head2 getiteminformation
-
-$item = &getiteminformation($itemnumber, $barcode);
-
-Looks up information about an item, given either its item number or
-its barcode. If C<$itemnumber> is a nonzero value, it is used;
-otherwise, C<$barcode> is used.
-
-C<$item> is a reference-to-hash whose keys are fields from the biblio,
-items, and biblioitems tables of the Koha database. It may also
-contain the following keys:
-
-=head3 date_due
-
-=over 4
-
-=item The due date on this item, if it has been borrowed and not returned
-yet. The date is in YYYY-MM-DD format.
-
-=back
-
-=head3 notforloan
-
-=over 4
-
-=item True if the item may not be borrowed.
-
-=back
-
-=cut
-
-sub getiteminformation {
-
- # returns a hash of item information given either the itemnumber or the
barcode
- my ( $itemnumber, $barcode ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($itemnumber) {
- $sth =
- $dbh->prepare(
- "select *
- from biblio,items,biblioitems
- where items.itemnumber=? and biblio.biblionumber=items.biblionumber
and biblioitems.biblioitemnumber = items.biblioitemnumber"
- );
- $sth->execute($itemnumber);
- }
- elsif ($barcode) {
- $sth =
- $dbh->prepare(
- "select * from biblio,items,biblioitems where items.barcode=? and
biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber =
items.biblioitemnumber"
- );
- $sth->execute($barcode);
- }
- else {
- return undef;
- }
- my $iteminformation = $sth->fetchrow_hashref;
- $sth->finish;
- if ($iteminformation) {
- $sth =
- $dbh->prepare("select date_due from issues where itemnumber=? and
isnull(returndate)");
- $sth->execute( $iteminformation->{'itemnumber'} );
- my ($date_due) = $sth->fetchrow;
- $iteminformation->{'date_due'} = $date_due;
- $sth->finish;
- ( $iteminformation->{'dewey'} == 0 )
- && ( $iteminformation->{'dewey'} = '' );
- $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
- $sth->execute( $iteminformation->{'itemtype'} );
- my $itemtype = $sth->fetchrow_hashref;
-
- # if specific item notforloan, don't use itemtype notforloan field.
- # otherwise, use itemtype notforloan value to see if item can be
issued.
- $iteminformation->{'notforloan'} = $itemtype->{'notforloan'}
- unless $iteminformation->{'notforloan'};
- $sth->finish;
- }
- return ($iteminformation);
-}
-
-=head2 transferbook
-
-($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
$barcode, $ignore_reserves);
-
-Transfers an item to a new branch. If the item is currently on loan, it is
automatically returned before the actual transfer.
-
-C<$newbranch> is the code for the branch to which the item should be
transferred.
-
-C<$barcode> is the barcode of the item to be transferred.
-
-If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
-Otherwise, if an item is reserved, the transfer fails.
-
-Returns three values:
-
-=head3 $dotransfer
-
-is true if the transfer was successful.
-
-=head3 $messages
-
-is a reference-to-hash which may have any of the following keys:
-
-=over 4
-
-=item C<BadBarcode>
-
-There is no item in the catalog with the given barcode. The value is
C<$barcode>.
-
-=item C<IsPermanent>
-
-The item's home branch is permanent. This doesn't prevent the item from being
transferred, though. The value is the code of the item's home branch.
-
-=item C<DestinationEqualsHolding>
-
-The item is already at the branch to which it is being transferred. The
transfer is nonetheless considered to have failed. The value should be ignored.
-
-=item C<WasReturned>
-
-The item was on loan, and C<&transferbook> automatically returned it before
transferring it. The value is the borrower number of the patron who had the
item.
-
-=item C<ResFound>
-
-The item was reserved. The value is a reference-to-hash whose keys are fields
from the reserves table of the Koha database, and C<biblioitemnumber>. It also
has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
-
-=item C<WasTransferred>
-
-The item was eligible to be transferred. Barring problems communicating with
the database, the transfer should indeed have succeeded. The value should be
ignored.
-
-=back
-
-=cut
-
-#'
-# FIXME - This function tries to do too much, and its API is clumsy.
-# If it didn't also return books, it could be used to change the home
-# branch of a book while the book is on loan.
-#
-# Is there any point in returning the item information? The caller can
-# look that up elsewhere if ve cares.
-#
-# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
-# If the transfer succeeds, that's all the caller should need to know.
-# Thus, this function could simply return 1 or 0 to indicate success
-# or failure, and set $C4::Circulation::Circ2::errmsg in case of
-# failure. Or this function could return undef if successful, and an
-# error message in case of failure (this would feel more like C than
-# Perl, though).
-sub transferbook {
- my ( $tbr, $barcode, $ignoreRs ) = @_;
- my $messages;
- my %env;
- my $dotransfer = 1;
- my $branches = GetBranches();
- my $iteminformation = getiteminformation( 0, $barcode );
-
- # bad barcode..
- if ( not $iteminformation ) {
- $messages->{'BadBarcode'} = $barcode;
- $dotransfer = 0;
- }
-
- # get branches of book...
- my $hbr = $iteminformation->{'homebranch'};
- my $fbr = $iteminformation->{'holdingbranch'};
-
- # if is permanent...
- if ( $hbr && $branches->{$hbr}->{'PE'} ) {
- $messages->{'IsPermanent'} = $hbr;
- }
-
- # can't transfer book if is already there....
- # FIXME - Why not? Shouldn't it trivially succeed?
- if ( $fbr eq $tbr ) {
- $messages->{'DestinationEqualsHolding'} = 1;
- $dotransfer = 0;
- }
-
- # check if it is still issued to someone, return it...
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'}
);
- if ($currentborrower) {
- returnbook( $barcode, $fbr );
- $messages->{'WasReturned'} = $currentborrower;
- }
-
- # find reserves.....
- # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
- # That'll save a database query.
- my ( $resfound, $resrec ) =
- CheckReserves( $iteminformation->{'itemnumber'} );
- if ( $resfound and not $ignoreRs ) {
- $resrec->{'ResFound'} = $resfound;
-
- # $messages->{'ResFound'} = $resrec;
- $dotransfer = 1;
- }
-
- #actually do the transfer....
- if ($dotransfer) {
- dotransfer( $iteminformation->{'itemnumber'}, $fbr, $tbr );
-
- # don't need to update MARC anymore, we do it in batch now
- $messages->{'WasTransfered'} = 1;
- }
- return ( $dotransfer, $messages, $iteminformation );
-}
-
-# Not exported
-# FIXME - This is only used in &transferbook. Why bother making it a
-# separate function?
-sub dotransfer {
- my ( $itm, $fbr, $tbr ) = @_;
-
- my $dbh = C4::Context->dbh;
- $itm = $dbh->quote($itm);
- $fbr = $dbh->quote($fbr);
- $tbr = $dbh->quote($tbr);
-
- #new entry in branchtransfers....
- $dbh->do(
-"INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
- VALUES ($itm, $fbr, now(), $tbr)"
- );
-
- #update holdingbranch in items .....
- $dbh->do(
- "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber =
$itm");
- &itemseen($itm);
- &domarctransfer( $dbh, $itm );
- return;
-}
-
-##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
-sub domarctransfer {
- my ( $dbh, $itemnumber ) = @_;
- $itemnumber =~ s /\'//g; ##itemnumber seems to come with quotes-TG
- my $sth =
- $dbh->prepare(
- "select biblionumber,holdingbranch from items where
itemnumber=$itemnumber"
- );
- $sth->execute();
- while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
- &ModItemInMarconefield( $biblionumber, $itemnumber,
- 'items.holdingbranch', $holdingbranch );
- }
- return;
-}
-
-=head2 canbookbeissued
-
-Check if a book can be issued.
-
-my ($issuingimpossible,$needsconfirmation) =
canbookbeissued($env,$borrower,$barcode,$year,$month,$day);
-
-=over 4
-
-=item C<$env> Environment variable. Should be empty usually, but used by other
subs. Next code cleaning could drop it.
-
-=item C<$borrower> hash with borrower informations (from getpatroninformation)
-
-=item C<$barcode> is the bar code of the book being issued.
-
-=item C<$year> C<$month> C<$day> contains the date of the return (in case it's
forced by "stickyduedate".
-
-=back
-
-Returns :
-
-=over 4
-
-=item C<$issuingimpossible> a reference to a hash. It contains reasons why
issuing is impossible.
-Possible values are :
-
-=back
-
-=head3 INVALID_DATE
-
-sticky due date is invalid
-
-=head3 GNA
-
-borrower gone with no address
-
-=head3 CARD_LOST
-
-borrower declared it's card lost
-
-=head3 DEBARRED
-
-borrower debarred
-
-=head3 UNKNOWN_BARCODE
-
-barcode unknown
-
-=head3 NOT_FOR_LOAN
-
-item is not for loan
-
-=head3 WTHDRAWN
-
-item withdrawn.
-
-=head3 RESTRICTED
-
-item is restricted (set by ??)
-
-C<$issuingimpossible> a reference to a hash. It contains reasons why issuing
is impossible.
-Possible values are :
-
-=head3 DEBT
-
-borrower has debts.
-
-=head3 RENEW_ISSUE
-
-renewing, not issuing
-
-=head3 ISSUED_TO_ANOTHER
-
-issued to someone else.
-
-=head3 RESERVED
-
-reserved for someone else.
-
-=head3 INVALID_DATE
-
-sticky due date is invalid
-
-=head3 TOO_MANY
-
-if the borrower borrows to much things
-
-=cut
-
-# check if a book can be issued.
-# returns an array with errors if any
-
-sub TooMany ($$) {
- my $borrower = shift;
- my $iteminformation = shift;
- my $cat_borrower = $borrower->{'categorycode'};
- my $branch_borrower = $borrower->{'branchcode'};
- my $dbh = C4::Context->dbh;
-
- my $sth =
- $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
- $sth->execute( $iteminformation->{'biblionumber'} );
- my $type = $sth->fetchrow;
- $sth =
- $dbh->prepare(
-'select * from issuingrules where categorycode = ? and itemtype = ? and
branchcode = ?'
- );
-
-# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s
where i.borrowernumber = ? and i.returndate is null and i.itemnumber =
s.biblioitemnumber and s.itemtype like ?");
- my $sth2 =
- $dbh->prepare(
-"select COUNT(*) from issues i, biblioitems s1, items s2 where
i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber
and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"
- );
- my $sth3 =
- $dbh->prepare(
-'select COUNT(*) from issues where borrowernumber = ? and returndate is null'
- );
- my $alreadyissued;
-
- # check the 3 parameters
- $sth->execute( $cat_borrower, $type, $branch_borrower );
- my $result = $sth->fetchrow_hashref;
-
- # warn "==>".$result->{maxissueqty};
-
-# Currently, using defined($result) ie on an entire hash reports whether memory
-# for that aggregate has ever been allocated. As $result is used all over the
place
-# it would rarely return as undefined.
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- # check for branch=*
- $sth->execute( $cat_borrower, $type, "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- # check for itemtype=*
- $sth->execute( $cat_borrower, "*", $branch_borrower );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth3->execute( $borrower->{'borrowernumber'} );
- my ($alreadyissued) = $sth3->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
-
-# warn "HERE : $alreadyissued / ($result->{maxissueqty} for
$borrower->{'borrowernumber'}";
- return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- # check for borrowertype=*
- $sth->execute( "*", $type, $branch_borrower );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( "*", "*", $branch_borrower );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth3->execute( $borrower->{'borrowernumber'} );
- my $alreadyissued = $sth3->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( "*", $type, "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( $cat_borrower, "*", "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( "*", "*", "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth3->execute( $borrower->{'borrowernumber'} );
- my $alreadyissued = $sth3->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
- return;
-}
-
-=head2 itemissues
-
- @issues = &itemissues($biblioitemnumber, $biblio);
-
-Looks up information about who has borrowed the bookZ<>(s) with the
-given biblioitemnumber.
-
-C<$biblio> is ignored.
-
-C<&itemissues> returns an array of references-to-hash. The keys
-include the fields from the C<items> table in the Koha database.
-Additional keys include:
-
-=over 4
-
-=item C<date_due>
-
-If the item is currently on loan, this gives the due date.
-
-If the item is not on loan, then this is either "Available" or
-"Cancelled", if the item has been withdrawn.
-
-=item C<card>
-
-If the item is currently on loan, this gives the card number of the
-patron who currently has the item.
-
-=item C<timestamp0>, C<timestamp1>, C<timestamp2>
-
-These give the timestamp for the last three times the item was
-borrowed.
-
-=item C<card0>, C<card1>, C<card2>
-
-The card number of the last three patrons who borrowed this item.
-
-=item C<borrower0>, C<borrower1>, C<borrower2>
-
-The borrower number of the last three patrons who borrowed this item.
-
-=back
-
-=cut
-
-#'
-sub itemissues {
- my ( $bibitem, $biblio ) = @_;
- my $dbh = C4::Context->dbh;
-
- # FIXME - If this function die()s, the script will abort, and the
- # user won't get anything; depending on how far the script has
- # gotten, the user might get a blank page. It would be much better
- # to at least print an error message. The easiest way to do this
- # is to set $SIG{__DIE__}.
- my $sth =
- $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
- || die $dbh->errstr;
- my $i = 0;
- my @results;
-
- $sth->execute($bibitem) || die $sth->errstr;
-
- while ( my $data = $sth->fetchrow_hashref ) {
-
- # Find out who currently has this item.
- # FIXME - Wouldn't it be better to do this as a left join of
- # some sort? Currently, this code assumes that if
- # fetchrow_hashref() fails, then the book is on the shelf.
- # fetchrow_hashref() can fail for any number of reasons (e.g.,
- # database server crash), not just because no items match the
- # search criteria.
- my $sth2 = $dbh->prepare(
- "select * from issues,borrowers
-where itemnumber = ?
-and returndate is NULL
-and issues.borrowernumber = borrowers.borrowernumber"
- );
-
- $sth2->execute( $data->{'itemnumber'} );
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $data->{'date_due'} = $data2->{'date_due'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- }
- else {
- if ( $data->{'wthdrawn'} eq '1' ) {
- $data->{'date_due'} = 'Cancelled';
- }
- else {
- $data->{'date_due'} = 'Available';
- } # else
- } # else
-
- $sth2->finish;
-
- # Find the last 3 people who borrowed this item.
- $sth2 = $dbh->prepare(
- "select * from issues, borrowers
- where itemnumber = ?
- and issues.borrowernumber =
borrowers.borrowernumber
- and returndate is not NULL
- order by returndate desc,timestamp desc"
- );
-
-# $sth2 = $dbh->prepare("
-# SELECT *
-# FROM issues
-# LEFT JOIN borrowers ON issues.borrowernumber =
borrowers.borrowernumber
-# WHERE itemnumber = ?
-# AND returndate is not NULL
-# ORDER BY returndate DESC,timestamp DESC
-# ");
-
- $sth2->execute( $data->{'itemnumber'} );
- for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
- { # FIXME : error if there is less than 3 pple borrowing this item
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $data->{"timestamp$i2"} = $data2->{'timestamp'};
- $data->{"card$i2"} = $data2->{'cardnumber'};
- $data->{"borrower$i2"} = $data2->{'borrowernumber'};
- } # if
- } # for
-
- $sth2->finish;
- $results[$i] = $data;
- $i++;
- }
-
- $sth->finish;
- return (@results);
-}
-
-=head2 canbookbeissued
-
-$issuingimpossible, $needsconfirmation =
- canbookbeissued( $env, $borrower, $barcode, $year, $month, $day,
$inprocess );
-
-C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
-
-=cut
-
-sub canbookbeissued {
- my ( $env, $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
- my %needsconfirmation; # filled with problems that needs confirmations
- my %issuingimpossible
- ; # filled with problems that causes the issue to be IMPOSSIBLE
- my $iteminformation = getiteminformation( 0, $barcode );
- my $dbh = C4::Context->dbh;
-
- #
- # DUE DATE is OK ?
- #
- my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
- $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
-
- #
- # BORROWER STATUS
- #
- if ( $borrower->{flags}->{GNA} ) {
- $issuingimpossible{GNA} = 1;
- }
- if ( $borrower->{flags}->{'LOST'} ) {
- $issuingimpossible{CARD_LOST} = 1;
- }
- if ( $borrower->{flags}->{'DBARRED'} ) {
- $issuingimpossible{DEBARRED} = 1;
- }
- if ( Date_to_Days(Today) >
- Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
- {
-
- #
- #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0)
{
- $issuingimpossible{EXPIRED} = 1;
- }
-
- #
- # BORROWER STATUS
- #
-
- # DEBTS
- my $amount =
- checkaccount( $env, $borrower->{'borrowernumber'}, $dbh, $duedate );
- if ( C4::Context->preference("IssuingInProcess") ) {
- my $amountlimit = C4::Context->preference("noissuescharge");
- if ( $amount > $amountlimit && !$inprocess ) {
- $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
- }
- elsif ( $amount <= $amountlimit && !$inprocess ) {
- $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
- }
- }
- else {
- if ( $amount > 0 ) {
- $needsconfirmation{DEBT} = $amount;
- }
- }
-
- #
- # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
- #
- my $toomany = TooMany( $borrower, $iteminformation );
- $needsconfirmation{TOO_MANY} = $toomany if $toomany;
-
- #
- # ITEM CHECKING
- #
- unless ( $iteminformation->{barcode} ) {
- $issuingimpossible{UNKNOWN_BARCODE} = 1;
- }
- if ( $iteminformation->{'notforloan'}
- && $iteminformation->{'notforloan'} > 0 )
- {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ( $iteminformation->{'itemtype'}
- && $iteminformation->{'itemtype'} eq 'REF' )
- {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ( $iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1
)
- {
- $issuingimpossible{WTHDRAWN} = 1;
- }
- if ( $iteminformation->{'restricted'}
- && $iteminformation->{'restricted'} == 1 )
- {
- $issuingimpossible{RESTRICTED} = 1;
- }
- if ( C4::Context->preference("IndependantBranches") ) {
- my $userenv = C4::Context->userenv;
- if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
- $issuingimpossible{NOTSAMEBRANCH} = 1
- if ( $iteminformation->{'holdingbranch'} ne $userenv->{branch} );
- }
- }
-
- #
- # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
- #
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'}
);
- if ( $currentborrower && $currentborrower eq $borrower->{'borrowernumber'}
)
- {
-
- # Already issued to current borrower. Ask whether the loan should
- # be renewed.
- my ($renewstatus) = renewstatus(
- $env,
- $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'}
- );
- if ( $renewstatus == 0 ) { # no more renewals allowed
- $issuingimpossible{NO_MORE_RENEWALS} = 1;
- }
- else {
-
- # $needsconfirmation{RENEW_ISSUE} = 1;
- }
- }
- elsif ($currentborrower) {
-
- # issued to someone else
- my $currborinfo = getpatroninformation( 0, $currentborrower );
-
-# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'}
($currborinfo->{'cardnumber'})";
- $needsconfirmation{ISSUED_TO_ANOTHER} =
-"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'}
$currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
- }
-
- # See if the item is on reserve.
- my ( $restype, $res ) = CheckReserves( $iteminformation->{'itemnumber'} );
- if ($restype) {
- my $resbor = $res->{'borrowernumber'};
- if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting"
)
- {
-
- # The item is on reserve and waiting, but has been
- # reserved by some other patron.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- $needsconfirmation{RESERVE_WAITING} =
-"$resborrower->{'firstname'} $resborrower->{'surname'}
($resborrower->{'cardnumber'}, $branchname)";
-
-# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't
belong in a checking subroutine.
- }
- elsif ( $restype eq "Reserved" ) {
-
- # The item is on reserve for someone else.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- $needsconfirmation{RESERVED} =
-"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'}
($resborrower->{'cardnumber'})";
- }
- }
- if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
- {
- if ( $borrower->{'categorycode'} eq 'W' ) {
- my %issuingimpossible;
- return ( \%issuingimpossible, \%needsconfirmation );
- }
- else {
- return ( \%issuingimpossible, \%needsconfirmation );
- }
- }
- else {
- return ( \%issuingimpossible, \%needsconfirmation );
- }
-}
-
-=head2 issuebook
-
-Issue a book. Does no check, they are done in canbookbeissued. If we reach
this sub, it means the user confirmed if needed.
-
-&issuebook($env,$borrower,$barcode,$date)
-
-=over 4
-
-=item C<$env> Environment variable. Should be empty usually, but used by other
subs. Next code cleaning could drop it.
-
-=item C<$borrower> hash with borrower informations (from getpatroninformation)
-
-=item C<$barcode> is the bar code of the book being issued.
-
-=item C<$date> contains the max date of return. calculated if empty.
-
-=back
-
-=cut
-
-sub issuebook {
- my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_;
- my $dbh = C4::Context->dbh;
-if ($borrower and $barcode){
-# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0);
- my $iteminformation = getiteminformation( 0, $barcode );
-
-#
-# check if we just renew the issue.
-#
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'}
);
- if ( $currentborrower eq $borrower->{'borrowernumber'} ) {
- my ( $charge, $itemtype ) = calc_charges(
- $env,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}
- );
- if ( $charge > 0 ) {
- createcharge(
- $env, $dbh,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}, $charge
- );
- $iteminformation->{'charge'} = $charge;
- }
- &UpdateStats(
- $env, $env->{'branchcode'},
- 'renew', $charge,
- '', $iteminformation->{'itemnumber'},
- $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
- );
- renewbook(
- $env,
- $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'}
- );
- }
- else {
-
- #
- # NOT a renewal
- #
- if ( $currentborrower ne '' ) {
-
-# This book is currently on loan, but not to the person
-# who wants to borrow it now. mark it returned before issuing to the new
borrower
- returnbook(
- $iteminformation->{'barcode'},
- C4::Context->userenv->{'branch'}
- );
- }
-
- # See if the item is on reserve.
- my ( $restype, $res ) =
- CheckReserves( $iteminformation->{'itemnumber'} );
- if ($restype) {
- my $resbor = $res->{'borrowernumber'};
- if ( $resbor eq $borrower->{'borrowernumber'} ) {
-
- # The item is on reserve to the current patron
- FillReserve($res);
- }
- elsif ( $restype eq "Waiting" ) {
-
- # warn "Waiting";
- # The item is on reserve and waiting, but has been
- # reserved by some other patron.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- if ($cancelreserve) {
- CancelReserve( 0, $res->{'itemnumber'},
- $res->{'borrowernumber'} );
- }
- else {
-
- # set waiting reserve to first in reserve queue as book isn't waiting
now
- UpdateReserve(
- 1,
- $res->{'biblionumber'},
- $res->{'borrowernumber'},
- $res->{'branchcode'}
- );
- }
- }
- elsif ( $restype eq "Reserved" ) {
-
- # warn "Reserved";
- # The item is on reserve for someone else.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- if ($cancelreserve) {
-
- # cancel reserves on this item
- CancelReserve( 0, $res->{'itemnumber'},
- $res->{'borrowernumber'} );
-
-# also cancel reserve on biblio related to this item
-#my $st_Fbiblio = $dbh->prepare("select biblionumber from items where
itemnumber=?");
-#$st_Fbiblio->execute($res->{'itemnumber'});
-#my $biblionumber = $st_Fbiblio->fetchrow;
-#CancelReserve($biblionumber,0,$res->{'borrowernumber'});
-#warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
- }
- else {
-
-# my $tobrcd = ReserveWaiting($res->{'itemnumber'},
$res->{'borrowernumber'});
-# transferbook($tobrcd,$barcode, 1);
-# warn "transferbook";
- }
- }
- }
-# END OF THE RESTYPE WORK
-
-# Starting process for transfer job (checking transfert and validate it if we
have one)
-
- my ($datesent) = get_transfert_infos($iteminformation->{'itemnumber'});
-
- if ($datesent) {
-# updating line of branchtranfert to finish it, and changing the to
branch value, implement a comment for lisibility of this case (maybe for stats
....)
- my $sth =
- $dbh->prepare(
- "update branchtransfers set datearrived = now(),
- tobranch = ?,
- comments = 'Forced branchtransfert'
- where
- itemnumber= ? AND datearrived IS NULL"
- );
-
$sth->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
- $sth->finish;
- }
-
-# Ending process for transfert check
-
- # Record in the database the fact that the book was issued.
- my $sth =
- $dbh->prepare(
-"insert into issues (borrowernumber, itemnumber,issuedate, date_due,
branchcode) values (?,?,?,?,?)"
- );
- my $loanlength = getLoanLength(
- $borrower->{'categorycode'},
- $iteminformation->{'itemtype'},
- $borrower->{'branchcode'}
- );
- my $datedue = time + ($loanlength) * 86400;
- my @datearr = localtime($datedue);
- my $dateduef =
- ( 1900 + $datearr[5] ) . "-"
- . ( $datearr[4] + 1 ) . "-"
- . $datearr[3];
- if ($date) {
- $dateduef = $date;
- }
-
- # if ReturnBeforeExpiry ON the datedue can't be after borrower
expirydate
- if ( C4::Context->preference('ReturnBeforeExpiry')
- && $dateduef gt $borrower->{dateexpiry} )
- {
- $dateduef = $borrower->{dateexpiry};
- }
- $sth->execute(
- $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'},
- strftime( "%Y-%m-%d", localtime ),$dateduef, $env->{'branchcode'}
- );
- $sth->finish;
- $iteminformation->{'issues'}++;
- $sth =
- $dbh->prepare(
- "update items set issues=?, holdingbranch=? where itemnumber=?");
- $sth->execute(
- $iteminformation->{'issues'},
- C4::Context->userenv->{'branch'},
- $iteminformation->{'itemnumber'}
- );
- $sth->finish;
- &itemseen( $iteminformation->{'itemnumber'} );
- itemborrowed( $iteminformation->{'itemnumber'} );
-
- # If it costs to borrow this book, charge it to the patron's account.
- my ( $charge, $itemtype ) = calc_charges(
- $env,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}
- );
- if ( $charge > 0 ) {
- createcharge(
- $env, $dbh,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}, $charge
- );
- $iteminformation->{'charge'} = $charge;
- }
-
- # Record the fact that this book was issued.
- &UpdateStats(
- $env, $env->{'branchcode'},
- 'issue', $charge,
- '', $iteminformation->{'itemnumber'},
- $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
- );
- }
-
-
&logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$iteminformation->{'biblionumber'})
- if C4::Context->preference("IssueLog");
- }
-}
-
-=head2 getLoanLength
-
-Get loan length for an itemtype, a borrower type and a branch
-
-my $loanlength = &getLoanLength($borrowertype,$itemtype,branchcode)
-
-=cut
-
-sub getLoanLength {
- my ( $borrowertype, $itemtype, $branchcode ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
-"select issuelength from issuingrules where categorycode=? and itemtype=? and
branchcode=?"
- );
-
-# try to find issuelength & return the 1st available.
-# check with borrowertype, itemtype and branchcode, then without one of those
parameters
- $sth->execute( $borrowertype, $itemtype, $branchcode );
- my $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( $borrowertype, $itemtype, "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( $borrowertype, "*", $branchcode );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", $itemtype, $branchcode );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( $borrowertype, "*", "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", "*", $branchcode );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", $itemtype, "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", "*", "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- # if no rule is set => 21 days (hardcoded)
- return 21;
-}
-
-=head2 returnbook
-
-($doreturn, $messages, $iteminformation, $borrower) =
- &returnbook($barcode, $branch);
-
-Returns a book.
-
-C<$barcode> is the bar code of the book being returned. C<$branch> is
-the code of the branch where the book is being returned.
-
-C<&returnbook> returns a list of four items:
-
-C<$doreturn> is true iff the return succeeded.
-
-C<$messages> is a reference-to-hash giving the reason for failure:
-
-=over 4
-
-=item C<BadBarcode>
-
-No item with this barcode exists. The value is C<$barcode>.
-
-=item C<NotIssued>
-
-The book is not currently on loan. The value is C<$barcode>.
-
-=item C<IsPermanent>
-
-The book's home branch is a permanent collection. If you have borrowed
-this book, you are not allowed to return it. The value is the code for
-the book's home branch.
-
-=item C<wthdrawn>
-
-This book has been withdrawn/cancelled. The value should be ignored.
-
-=item C<ResFound>
-
-The item was reserved. The value is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database, and
-C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
-either C<Waiting>, C<Reserved>, or 0.
-
-=back
-
-C<$borrower> is a reference-to-hash, giving information about the
-patron who last borrowed the book.
-
-=cut
-
-# FIXME - This API is bogus. There's no need to return $borrower and
-# $iteminformation; the caller can ask about those separately, if it
-# cares (it'd be inefficient to make two database calls instead of
-# one, but &getpatroninformation and &getiteminformation can be
-# memoized if this is an issue).
-#
-# The ($doreturn, $messages) tuple is redundant: if the return
-# succeeded, that's all the caller needs to know. So &returnbook can
-# return 1 and 0 on success and failure, and set
-# $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
-# return undef for success, and an error message on error (though this
-# is more C-ish than Perl-ish).
-
-sub returnbook {
- my ( $barcode, $branch ) = @_;
- my %env;
- my $messages;
- my $dbh = C4::Context->dbh;
- my $doreturn = 1;
- my $validTransfert = 0;
- my $reserveDone = 0;
-
- die '$branch not defined' unless defined $branch; # just in case (bug 170)
- # get information on
item
- my ($iteminformation) = getiteminformation( 0, $barcode );
-
- if ( not $iteminformation ) {
- $messages->{'BadBarcode'} = $barcode;
- $doreturn = 0;
- }
-
- # find the borrower
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'}
);
- if ( ( not $currentborrower ) && $doreturn ) {
- $messages->{'NotIssued'} = $barcode;
- $doreturn = 0;
- }
-
- # check if the book is in a permanent collection....
- my $hbr = $iteminformation->{'homebranch'};
- my $branches = GetBranches();
- if ( $hbr && $branches->{$hbr}->{'PE'} ) {
- $messages->{'IsPermanent'} = $hbr;
- }
-
- # check that the book has been cancelled
- if ( $iteminformation->{'wthdrawn'} ) {
- $messages->{'wthdrawn'} = 1;itemnumber
- $doreturn = 0;
- }
-
-# new op dev : if the book returned in an other branch update the holding
branch
-
-# update issues, thereby returning book (should push this out into another
subroutine
- my ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
-
-# case of a return of document (deal with issues and holdingbranch)
-
- if ($doreturn) {
- my $sth =
- $dbh->prepare(
-"update issues set returndate = now() where (borrowernumber = ?) and
(itemnumber = ?) and (returndate is null)"
- );
- $sth->execute( $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'} );
- $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
- }
-
-# continue to deal with returns cases, but not only if we have an issue
-
-# the holdingbranch is updated if the document is returned in an other
location .
-if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
- {
-
UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
-# reload iteminformation holdingbranch with the userenv value
- $iteminformation->{'holdingbranch'} =
C4::Context->userenv->{'branch'};
- }
- itemseen( $iteminformation->{'itemnumber'} );
- ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
-
- # fix up the accounts.....
- if ( $iteminformation->{'itemlost'} ) {
- fixaccountforlostandreturned( $iteminformation, $borrower );
- $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
- }
-
- # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
- # check if we have a transfer for this document
- my ($datesent,$frombranch,$tobranch) = checktransferts(
$iteminformation->{'itemnumber'} );
-
- # if we have a return, we update the line of transfers with the
datearrived
- if ($datesent) {
- if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
- my $sth =
- $dbh->prepare(
- "update branchtransfers set datearrived = now() where
itemnumber= ? AND datearrived IS NULL"
- );
- $sth->execute( $iteminformation->{'itemnumber'} );
- $sth->finish;
-# now we check if there is a reservation with the validate of transfer
if we have one, we can set it with the status 'W'
- SetWaitingStatus( $iteminformation->{'itemnumber'} );
- }
- else {
- $messages->{'WrongTransfer'} = $tobranch;
- $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
- }
- $validTransfert = 1;
- }
-
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
-# fix up the overdues in accounts...
- fixoverduesonreturn( $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'} );
-
-# find reserves.....
-# if we don't have a reserve with the status W, we launch the
Checkreserves routine
- my ( $resfound, $resrec ) =
- CheckReserves( $iteminformation->{'itemnumber'} );
- if ($resfound) {
-
-# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'},
$resrec->{'borrowernumber'});
- $resrec->{'ResFound'} = $resfound;
- $messages->{'ResFound'} = $resrec;
- $reserveDone = 1;
- }
-
- # update stats?
- # Record the fact that this book was returned.
- UpdateStats(
- \%env, $branch, 'return', '0', '',
- $iteminformation->{'itemnumber'},
- $iteminformation->{'itemtype'},
- $borrower->{'borrowernumber'}
- );
-
-
&logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$currentborrower,$iteminformation->{'biblionumber'})
- if C4::Context->preference("ReturnLog");
-
- #adding message if holdingbranch is non equal a userenv branch to return
the document to homebranch
- #we check, if we don't have reserv or transfert for this document, if not,
return it to homebranch .
-
- if ( ($iteminformation->{'holdingbranch'} ne
$iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and
($validTransfert ne 1) and ($reserveDone ne 1) ){
- if (C4::Context->preference("AutomaticItemReturn") == 1) {
- dotransfer($iteminformation->{'itemnumber'},
C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
- $messages->{'WasTransfered'} = 1;
- warn "was transfered";
- }
- }
-
- return ( $doreturn, $messages, $iteminformation, $borrower );
-}
-
-=head2 fixaccountforlostandreturned
-
- &fixaccountforlostandreturned($iteminfo,$borrower);
-
-Calculates the charge for a book lost and returned (Not exported & used only
once)
-
-C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
-
-C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
-
-=cut
-
-sub fixaccountforlostandreturned {
- my ( $iteminfo, $borrower ) = @_;
- my %env;
- my $dbh = C4::Context->dbh;
- my $itm = $iteminfo->{'itemnumber'};
-
- # check for charge made for lost book
- my $sth =
- $dbh->prepare(
-"select * from accountlines where (itemnumber = ?) and (accounttype='L' or
accounttype='Rep') order by date desc"
- );
- $sth->execute($itm);
- if ( my $data = $sth->fetchrow_hashref ) {
-
- # writeoff this amount
- my $offset;
- my $amount = $data->{'amount'};
- my $acctno = $data->{'accountno'};
- my $amountleft;
- if ( $data->{'amountoutstanding'} == $amount ) {
- $offset = $data->{'amount'};
- $amountleft = 0;
- }
- else {
- $offset = $amount - $data->{'amountoutstanding'};
- $amountleft = $data->{'amountoutstanding'} - $amount;
- }
- my $usth = $dbh->prepare(
- "update accountlines set accounttype = 'LR',amountoutstanding='0'
- where (borrowernumber = ?)
- and (itemnumber = ?) and (accountno = ?) "
- );
- $usth->execute( $data->{'borrowernumber'}, $itm, $acctno );
- $usth->finish;
-
- #check if any credit is left if so writeoff other accounts
- my $nextaccntno =
- getnextacctno( \%env, $data->{'borrowernumber'}, $dbh );
- if ( $amountleft < 0 ) {
- $amountleft *= -1;
- }
- if ( $amountleft > 0 ) {
- my $msth = $dbh->prepare(
- "select * from accountlines where (borrowernumber = ?)
- and (amountoutstanding >0) order by date"
- );
- $msth->execute( $data->{'borrowernumber'} );
-
- # offset transactions
- my $newamtos;
- my $accdata;
- while ( ( $accdata = $msth->fetchrow_hashref )
- and ( $amountleft > 0 ) )
- {
- if ( $accdata->{'amountoutstanding'} < $amountleft ) {
- $newamtos = 0;
- $amountleft -= $accdata->{'amountoutstanding'};
- }
- else {
- $newamtos = $accdata->{'amountoutstanding'} -
$amountleft;
- $amountleft = 0;
- }
- my $thisacct = $accdata->{'accountno'};
- my $usth = $dbh->prepare(
- "update accountlines set amountoutstanding= ?
- where (borrowernumber = ?)
- and (accountno=?)"
- );
- $usth->execute( $newamtos, $data->{'borrowernumber'},
- '$thisacct' );
- $usth->finish;
- $usth = $dbh->prepare(
- "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values
- (?,?,?,?)"
- );
- $usth->execute(
- $data->{'borrowernumber'},
- $accdata->{'accountno'},
- $nextaccntno, $newamtos
- );
- $usth->finish;
- }
- $msth->finish;
- }
- if ( $amountleft > 0 ) {
- $amountleft *= -1;
- }
- my $desc = "Book Returned " . $iteminfo->{'barcode'};
- $usth = $dbh->prepare(
- "insert into accountlines
-
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values (?,?,now(),?,?,'CR',?)"
- );
- $usth->execute(
- $data->{'borrowernumber'},
- $nextaccntno, 0 - $amount,
- $desc, $amountleft
- );
- $usth->finish;
- $usth = $dbh->prepare(
- "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values (?,?,?,?)"
- );
- $usth->execute( $borrower->{'borrowernumber'},
- $data->{'accountno'}, $nextaccntno, $offset );
- $usth->finish;
- $usth = $dbh->prepare("update items set paidfor='' where
itemnumber=?");
- $usth->execute($itm);
- $usth->finish;
- }
- $sth->finish;
- return;
-}
-
-=head2 fixoverdueonreturn
-
- &fixoverdueonreturn($brn,$itm);
-
-C<$brn> borrowernumber
-
-C<$itm> itemnumber
-
-=cut
-
-sub fixoverduesonreturn {
- my ( $brn, $itm ) = @_;
- my $dbh = C4::Context->dbh;
-
- # check for overdue fine
- my $sth =
- $dbh->prepare(
-"select * from accountlines where (borrowernumber = ?) and (itemnumber = ?)
and (accounttype='FU' or accounttype='O')"
- );
- $sth->execute( $brn, $itm );
-
- # alter fine to show that the book has been returned
- if ( my $data = $sth->fetchrow_hashref ) {
- my $usth =
- $dbh->prepare(
-"update accountlines set accounttype='F' where (borrowernumber = ?) and
(itemnumber = ?) and (accountno = ?)"
- );
- $usth->execute( $brn, $itm, $data->{'accountno'} );
- $usth->finish();
- }
- $sth->finish();
- return;
-}
-
-=head2 patronflags
-
- Not exported
-
- NOTE!: If you change this function, be sure to update the POD for
- &getpatroninformation.
-
- $flags = &patronflags($env, $patron, $dbh);
-
- $flags->{CHARGES}
- {message} Message showing patron's credit or debt
- {noissues} Set if patron owes >$5.00
- {GNA} Set if patron gone w/o address
- {message} "Borrower has no valid address"
- {noissues} Set.
- {LOST} Set if patron's card reported lost
- {message} Message to this effect
- {noissues} Set.
- {DBARRED} Set is patron is debarred
- {message} Message to this effect
- {noissues} Set.
- {NOTES} Set if patron has notes
- {message} Notes about patron
- {ODUES} Set if patron has overdue books
- {message} "Yes"
- {itemlist} ref-to-array: list of overdue books
- {itemlisttext} Text list of overdue items
- {WAITING} Set if there are items available that the
- patron reserved
- {message} Message to this effect
- {itemlist} ref-to-array: list of available items
-
-=cut
-
-sub patronflags {
-
- # Original subroutine for Circ2.pm
- my %flags;
- my ( $env, $patroninformation, $dbh ) = @_;
- my $amount =
- checkaccount( $env, $patroninformation->{'borrowernumber'}, $dbh );
- if ( $amount > 0 ) {
- my %flaginfo;
- my $noissuescharge = C4::Context->preference("noissuescharge");
- $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
- if ( $amount > $noissuescharge ) {
- $flaginfo{'noissues'} = 1;
- }
- $flags{'CHARGES'} = \%flaginfo;
- }
- elsif ( $amount < 0 ) {
- my %flaginfo;
- $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f",
-$amount;
- $flags{'CHARGES'} = \%flaginfo;
- }
- if ( $patroninformation->{'gonenoaddress'}
- && $patroninformation->{'gonenoaddress'} == 1 )
- {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower has no valid address.';
- $flaginfo{'noissues'} = 1;
- $flags{'GNA'} = \%flaginfo;
- }
- if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower\'s card reported lost.';
- $flaginfo{'noissues'} = 1;
- $flags{'LOST'} = \%flaginfo;
- }
- if ( $patroninformation->{'debarred'}
- && $patroninformation->{'debarred'} == 1 )
- {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower is Debarred.';
- $flaginfo{'noissues'} = 1;
- $flags{'DBARRED'} = \%flaginfo;
- }
- if ( $patroninformation->{'borrowernotes'}
- && $patroninformation->{'borrowernotes'} )
- {
- my %flaginfo;
- $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
- $flags{'NOTES'} = \%flaginfo;
- }
- my ( $odues, $itemsoverdue ) =
- checkoverdues( $env, $patroninformation->{'borrowernumber'}, $dbh );
- if ( $odues > 0 ) {
- my %flaginfo;
- $flaginfo{'message'} = "Yes";
- $flaginfo{'itemlist'} = $itemsoverdue;
- foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
- @$itemsoverdue )
- {
- $flaginfo{'itemlisttext'} .=
- "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
- }
- $flags{'ODUES'} = \%flaginfo;
- }
- my $itemswaiting =
- C4::Reserves2::GetWaitingReserves(
$patroninformation->{'borrowernumber'} );
- my $nowaiting = scalar @$itemswaiting;
- if ( $nowaiting > 0 ) {
- my %flaginfo;
- $flaginfo{'message'} = "Reserved items available";
- $flaginfo{'itemlist'} = $itemswaiting;
- $flags{'WAITING'} = \%flaginfo;
- }
- return ( \%flags );
-}
-
-=head2 checkoverdues
-
-( $count, $overdueitems )=checkoverdues( $env, $borrowernumber, $dbh );
-
-Not exported
-
-=cut
-
-sub checkoverdues {
-
-# From Main.pm, modified to return a list of overdueitems, in addition to a
count
-#checks whether a borrower has overdue items
- my ( $env, $borrowernumber, $dbh ) = @_;
- my @datearr = localtime;
- my $today =
- ( $datearr[5] + 1900 ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
- my @overdueitems;
- my $count = 0;
- my $sth = $dbh->prepare(
- "SELECT * FROM issues,biblio,biblioitems,items
- WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
- AND items.biblionumber = biblio.biblionumber
- AND issues.itemnumber = items.itemnumber
- AND issues.borrowernumber = ?
- AND issues.returndate is NULL
- AND issues.date_due < ?"
- );
- $sth->execute( $borrowernumber, $today );
- while ( my $data = $sth->fetchrow_hashref ) {
- push( @overdueitems, $data );
- $count++;
- }
- $sth->finish;
- return ( $count, address@hidden );
-}
-
-=head2 currentborrower
-
-$borrower=currentborrower($itemnumber)
-
-Not exported
-
-=cut
-
-sub currentborrower {
-
- # Original subroutine for Circ2.pm
- my ($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $q_itemnumber = $dbh->quote($itemnumber);
- my $sth = $dbh->prepare(
- "select borrowers.borrowernumber from
- issues,borrowers where issues.itemnumber=$q_itemnumber and
- issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
- NULL"
- );
- $sth->execute;
- my ($borrower) = $sth->fetchrow;
- return ($borrower);
-}
-
-=head2 checkreserve_to_delete
-
-( $resbor, $resrec ) = &checkreserve_to_delete($env,$dbh,$itemnum);
-
-=cut
-
-sub checkreserve_to_delete {
-
- # Stolen from Main.pm
- # Check for reserves for biblio
- my ( $env, $dbh, $itemnum ) = @_;
- my $resbor = "";
- my $sth = $dbh->prepare(
- "select * from reserves,items
- where (items.itemnumber = ?)
- and (reserves.cancellationdate is NULL)
- and (items.biblionumber = reserves.biblionumber)
- and ((reserves.found = 'W')
- or (reserves.found is null))
- order by priority"
- );
- $sth->execute($itemnum);
- my $resrec;
- my $data = $sth->fetchrow_hashref;
- while ( $data && $resbor eq '' ) {
- $resrec = $data;
- my $const = $data->{'constrainttype'};
- if ( $const eq "a" ) {
- $resbor = $data->{'borrowernumber'};
- }
- else {
- my $found = 0;
- my $csth = $dbh->prepare(
- "select * from reserveconstraints,items
- where (borrowernumber=?)
- and reservedate=?
- and reserveconstraints.biblionumber=?
- and (items.itemnumber=? and
- items.biblioitemnumber = reserveconstraints.biblioitemnumber)"
- );
- $csth->execute(
- $data->{'borrowernumber'},
- $data->{'biblionumber'},
- $data->{'reservedate'}, $itemnum
- );
- if ( my $cdata = $csth->fetchrow_hashref ) { $found = 1; }
- if ( $const eq 'o' ) {
- if ( $found eq 1 ) { $resbor = $data->{'borrowernumber'}; }
- }
- else {
- if ( $found eq 0 ) { $resbor = $data->{'borrowernumber'}; }
- }
- $csth->finish();
- }
- $data = $sth->fetchrow_hashref;
- }
- $sth->finish;
- return ( $resbor, $resrec );
-}
-
-=head2 currentissues
-
-$issues = ¤tissues($env, $borrower);
-
-Returns a list of books currently on loan to a patron.
-
-If C<$env-E<gt>{todaysissues}> is set and true, C<¤tissues> only
-returns information about books issued today. If
-C<$env-E<gt>{nottodaysissues}> is set and true, C<¤tissues> only
-returns information about books issued before today. If both are
-specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
-specified, C<¤tissues> returns all of the patron's issues.
-
-C<$borrower->{borrowernumber}> is the borrower number of the patron
-whose issues we want to list.
-
-C<¤tissues> returns a PHP-style array: C<$issues> is a
-reference-to-hash whose keys are integers in the range 1...I<n>, where
-I<n> is the number of items on issue (either today or before today).
-C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
-the fields of the biblio, biblioitems, items, and issues fields of the
-Koha database for that particular item.
-
-=cut
-
-#'
-sub currentissues {
-
- # New subroutine for Circ2.pm
- my ( $env, $borrower ) = @_;
- my $dbh = C4::Context->dbh;
- my %currentissues;
- my $counter = 1;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my $crit = '';
-
- # Figure out whether to get the books issued today, or earlier.
- # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
- # both be specified, but are mutually-exclusive. This is bogus.
- # Make this a flag. Or better yet, return everything in (reverse)
- # chronological order and let the caller figure out which books
- # were issued today.
- if ( $env->{'todaysissues'} ) {
-
- # FIXME - Could use
- # $today = POSIX::strftime("%Y%m%d", localtime);
- # FIXME - Since $today will be used in either case, move it
- # out of the two if-blocks.
- my @datearr = localtime( time() );
- my $today = ( 1900 + $datearr[5] ) . sprintf "%02d",
- ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3];
-
- # FIXME - MySQL knows about dates. Just use
- # and issues.timestamp = curdate();
- $crit = " and issues.timestamp like '$today%' ";
- }
- if ( $env->{'nottodaysissues'} ) {
-
- # FIXME - Could use
- # $today = POSIX::strftime("%Y%m%d", localtime);
- # FIXME - Since $today will be used in either case, move it
- # out of the two if-blocks.
- my @datearr = localtime( time() );
- my $today = ( 1900 + $datearr[5] ) . sprintf "%02d",
- ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3];
-
- # FIXME - MySQL knows about dates. Just use
- # and issues.timestamp < curdate();
- $crit = " and !(issues.timestamp like '$today%') ";
- }
-
- # FIXME - Does the caller really need every single field from all
- # four tables?
- my $sth = $dbh->prepare(
- "select * from issues,items,biblioitems,biblio where
- borrowernumber=? and issues.itemnumber=items.itemnumber and
- items.biblionumber=biblio.biblionumber and
- items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
- $crit order by issues.date_due"
- );
- $sth->execute($borrowernumber);
- while ( my $data = $sth->fetchrow_hashref ) {
-
- # FIXME - The Dewey code is a string, not a number.
- $data->{'dewey'} =~ s/0*$//;
- ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' );
-
- # FIXME - Could use
- # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
- # or better yet, just reuse $today which was calculated above.
- # This function isn't going to run until midnight, is it?
- # Alternately, use
- # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
- # if ($data->{'date_due'} lt $todaysdate)
- # ...
- # Either way, the date should be be formatted outside of the
- # loop.
- my @datearr = localtime( time() );
- my $todaysdate =
- ( 1900 + $datearr[5] )
- . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
- . sprintf( "%0.2d", $datearr[3] );
- my $datedue = $data->{'date_due'};
- $datedue =~ s/-//g;
- if ( $datedue < $todaysdate ) {
- $data->{'overdue'} = 1;
- }
- my $itemnumber = $data->{'itemnumber'};
-
- # FIXME - Consecutive integers as hash keys? You have GOT to
- # be kidding me! Use an array, fercrissakes!
- $currentissues{$counter} = $data;
- $counter++;
- }
- $sth->finish;
- return ( \%currentissues );
-}
-
-=head2 getissues
-
-$issues = &getissues($borrowernumber);
-
-Returns the set of books currently on loan to a patron.
-
-C<$borrowernumber> is the patron's borrower number.
-
-C<&getissues> returns a PHP-style array: C<$issues> is a
-reference-to-hash whose keys are integers in the range 0..I<n>-1,
-where I<n> is the number of books the patron currently has on loan.
-
-The values of C<$issues> are references-to-hash whose keys are
-selected fields from the issues, items, biblio, and biblioitems tables
-of the Koha database.
-
-=cut
-
-#'
-sub getissues {
-
- # New subroutine for Circ2.pm
- my ($borrower) = @_;
- my $dbh = C4::Context->dbh;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my %currentissues;
- my $select = "
- SELECT items.*,
- issues.timestamp AS timestamp,
- issues.date_due AS date_due,
- items.barcode AS barcode,
- biblio.title AS title,
- biblio.author AS author,
- biblioitems.dewey AS dewey,
- itemtypes.description AS itemtype,
- biblioitems.subclass AS subclass,
- biblioitems.ccode AS ccode,
- biblioitems.isbn AS isbn,
- biblioitems.classification AS classification
- FROM items
- LEFT JOIN issues ON issues.itemnumber = items.itemnumber
- LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
- LEFT JOIN biblioitems ON items.biblioitemnumber =
biblioitems.biblioitemnumber
- LEFT JOIN itemtypes ON itemtypes.itemtype =
biblioitems.itemtype
- WHERE issues.borrowernumber = ?
- AND issues.returndate IS NULL
- ORDER BY issues.date_due DESC
- ";
- my $sth = $dbh->prepare($select);
- $sth->execute($borrowernumber);
- my $counter = 0;
-
- while ( my $data = $sth->fetchrow_hashref ) {
- $data->{'dewey'} =~ s/0*$//;
- ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' );
-
- # FIXME - The Dewey code is a string, not a number.
- # FIXME - Use POSIX::strftime to get a text version of today's
- # date. That's what it's for.
- # FIXME - Move the date calculation outside of the loop.
- my @datearr = localtime( time() );
- my $todaysdate =
- ( 1900 + $datearr[5] )
- . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
- . sprintf( "%0.2d", $datearr[3] );
-
- # FIXME - Instead of converting the due date to YYYYMMDD, just
- # use
- # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
- # ...
- # if ($date->{date_due} lt $todaysdate)
- my $datedue = $data->{'date_due'};
- $datedue =~ s/-//g;
- if ( $datedue < $todaysdate ) {
- $data->{'overdue'} = 1;
- }
- $currentissues{$counter} = $data;
- $counter++;
-
- # FIXME - This is ludicrous. If you want to return an
- # array of values, just use an array. That's what
- # they're there for.
- }
- $sth->finish;
- return ( \%currentissues );
-}
-
-=head2 GetIssuesFromBiblio
-
-$issues = GetIssuesFromBiblio($biblionumber);
-
-this function get all issues from a biblionumber.
-
-Return:
-C<$issues> is a reference to array which each value is ref-to-hash. This
ref-to-hash containts all column from
-tables issues and the firstname,surname & cardnumber from borrowers.
-
-=cut
-
-sub GetIssuesFromBiblio {
- my $biblionumber = shift;
- return undef unless $biblionumber;
- my $dbh = C4::Context->dbh;
- my $query = "
- SELECT issues.*,biblio.biblionumber,biblio.title,
biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
- FROM issues
- LEFT JOIN borrowers ON borrowers.borrowernumber =
issues.borrowernumber
- LEFT JOIN items ON issues.itemnumber = items.itemnumber
- LEFT JOIN biblioitems ON items.itemnumber =
biblioitems.biblioitemnumber
- LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
- WHERE biblio.biblionumber = ?
- ORDER BY issues.timestamp
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute($biblionumber);
-
- my @issues;
- while ( my $data = $sth->fetchrow_hashref ) {
- push @issues, $data;
- }
- return address@hidden;
-}
-
-=head2 renewstatus
-
-$ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber);
-
-Find out whether a borrowed item may be renewed.
-
-C<$env> is ignored.
-
-C<$dbh> is a DBI handle to the Koha database.
-
-C<$borrowernumber> is the borrower number of the patron who currently
-has the item on loan.
-
-C<$itemnumber> is the number of the item to renew.
-
-C<$renewstatus> returns a true value iff the item may be renewed. The
-item must currently be on loan to the specified borrower; renewals
-must be allowed for the item's type; and the borrower must not have
-already renewed the loan.
-
-=cut
-
-sub renewstatus {
-
- # check renewal status
- my ( $env, $borrowernumber, $itemno ) = @_;
- my $dbh = C4::Context->dbh;
- my $renews = 1;
- my $renewokay = 0;
-
- # Look in the issues table for this item, lent to this borrower,
- # and not yet returned.
-
- # FIXME - I think this function could be redone to use only one SQL call.
- my $sth1 = $dbh->prepare(
- "select * from issues
- where (borrowernumber = ?)
- and (itemnumber = ?)
- and returndate is null"
- );
- $sth1->execute( $borrowernumber, $itemno );
- if ( my $data1 = $sth1->fetchrow_hashref ) {
-
- # Found a matching item
-
- # See if this item may be renewed. This query is convoluted
- # because it's a bit messy: given the item number, we need to find
- # the biblioitem, which gives us the itemtype, which tells us
- # whether it may be renewed.
- my $sth2 = $dbh->prepare(
- "SELECT renewalsallowed from items,biblioitems,itemtypes
- where (items.itemnumber = ?)
- and (items.biblioitemnumber = biblioitems.biblioitemnumber)
- and (biblioitems.itemtype = itemtypes.itemtype)"
- );
- $sth2->execute($itemno);
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $renews = $data2->{'renewalsallowed'};
- }
- if ( $renews && $renews > $data1->{'renewals'} ) {
- $renewokay = 1;
- }
- $sth2->finish;
- my ( $resfound, $resrec ) = CheckReserves($itemno);
- if ($resfound) {
- $renewokay = 0;
- }
- ( $resfound, $resrec ) = CheckReserves($itemno);
- if ($resfound) {
- $renewokay = 0;
- }
-
- }
- $sth1->finish;
- return ($renewokay);
-}
-
-=head2 renewbook
-
-&renewbook($env, $borrowernumber, $itemnumber, $datedue);
-
-Renews a loan.
-
-C<$env-E<gt>{branchcode}> is the code of the branch where the
-renewal is taking place.
-
-C<$env-E<gt>{usercode}> is the value to log in C<statistics.usercode>
-in the Koha database.
-
-C<$borrowernumber> is the borrower number of the patron who currently
-has the item.
-
-C<$itemnumber> is the number of the item to renew.
-
-C<$datedue> can be used to set the due date. If C<$datedue> is the
-empty string, C<&renewbook> will calculate the due date automatically
-from the book's item type. If you wish to set the due date manually,
-C<$datedue> should be in the form YYYY-MM-DD.
-
-=cut
-
-sub renewbook {
-
- # mark book as renewed
- my ( $env, $borrowernumber, $itemno, $datedue ) = @_;
- my $dbh = C4::Context->dbh;
-
- # If the due date wasn't specified, calculate it by adding the
- # book's loan length to today's date.
- if ( $datedue eq "" ) {
-
- #debug_msg($env, "getting date");
- my $iteminformation = getiteminformation( $itemno, 0 );
- my $borrower = getpatroninformation( $env, $borrowernumber, 0 );
- my $loanlength = getLoanLength(
- $borrower->{'categorycode'},
- $iteminformation->{'itemtype'},
- $borrower->{'branchcode'}
- );
- my ( $due_year, $due_month, $due_day ) =
- Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
- $datedue = "$due_year-$due_month-$due_day";
-
- #$datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d");
- }
-
- # Find the issues record for this book
- my $sth =
- $dbh->prepare(
-"select * from issues where borrowernumber=? and itemnumber=? and returndate
is null"
- );
- $sth->execute( $borrowernumber, $itemno );
- my $issuedata = $sth->fetchrow_hashref;
- $sth->finish;
-
- # Update the issues record to have the new due date, and a new count
- # of how many times it has been renewed.
- my $renews = $issuedata->{'renewals'} + 1;
- $sth = $dbh->prepare(
- "update issues set date_due = ?, renewals = ?
- where borrowernumber=? and itemnumber=? and returndate is null"
- );
- $sth->execute( $datedue, $renews, $borrowernumber, $itemno );
- $sth->finish;
-
- # Log the renewal
- UpdateStats( $env, $env->{'branchcode'}, 'renew', '', '', $itemno );
-
- # Charge a new rental fee, if applicable?
- my ( $charge, $type ) = calc_charges( $env, $itemno, $borrowernumber );
- if ( $charge > 0 ) {
- my $accountno = getnextacctno( $env, $borrowernumber, $dbh );
- my $item = getiteminformation($itemno);
- $sth = $dbh->prepare(
-"Insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
- values (?,?,now(),?,?,?,?,?)"
- );
- $sth->execute( $borrowernumber, $accountno, $charge,
- "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
- 'Rent', $charge, $itemno );
- $sth->finish;
- }
-
- # return();
-}
-
-=head2 calc_charges
-
-($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
-
-Calculate how much it would cost for a given patron to borrow a given
-item, including any applicable discounts.
-
-C<$env> is ignored.
-
-C<$itemnumber> is the item number of item the patron wishes to borrow.
-
-C<$borrowernumber> is the patron's borrower number.
-
-C<&calc_charges> returns two values: C<$charge> is the rental charge,
-and C<$item_type> is the code for the item's item type (e.g., C<VID>
-if it's a video).
-
-=cut
-
-sub calc_charges {
-
- # calculate charges due
- my ( $env, $itemno, $borrowernumber ) = @_;
- my $charge = 0;
- my $dbh = C4::Context->dbh;
- my $item_type;
-
- # Get the book's item type and rental charge (via its biblioitem).
- my $sth1 = $dbh->prepare(
- "select itemtypes.itemtype,rentalcharge from
items,biblioitems,itemtypes
- where (items.itemnumber =?)
- and (biblioitems.biblioitemnumber =
items.biblioitemnumber)
- and (biblioitems.itemtype =
itemtypes.itemtype)"
- );
- $sth1->execute($itemno);
- if ( my $data1 = $sth1->fetchrow_hashref ) {
- $item_type = $data1->{'itemtype'};
- $charge = $data1->{'rentalcharge'};
- my $q2 = "select rentaldiscount from issuingrules,borrowers
- where (borrowers.borrowernumber = ?)
- and (borrowers.categorycode = issuingrules.categorycode)
- and (issuingrules.itemtype = ?)";
- my $sth2 = $dbh->prepare($q2);
- $sth2->execute( $borrowernumber, $item_type );
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- my $discount = $data2->{'rentaldiscount'};
- if ( $discount eq 'NULL' ) {
- $discount = 0;
- }
- $charge = ( $charge * ( 100 - $discount ) ) / 100;
- }
- $sth2->finish;
- }
-
- $sth1->finish;
- return ( $charge, $item_type );
-}
-
-=head2 createcharge
-
-&createcharge( $env, $dbh, $itemno, $borrowernumber, $charge )
-
-=cut
-
-# FIXME - A virtually identical function appears in
-# C4::Circulation::Issues. Pick one and stick with it.
-sub createcharge {
-
- #Stolen from Issues.pm
- my ( $env, $dbh, $itemno, $borrowernumber, $charge ) = @_;
- my $nextaccntno = getnextacctno( $env, $borrowernumber, $dbh );
- my $query ="
- INSERT INTO accountlines
- (borrowernumber, itemnumber, accountno,
- date, amount, description, accounttype,
- amountoutstanding)
- VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute( $borrowernumber, $itemno, $nextaccntno, $charge, $charge );
- $sth->finish;
-}
-
-=head2 find_reserves
-
-($status, $record) = &find_reserves($itemnumber);
-
-Looks up an item in the reserves.
-
-C<$itemnumber> is the itemnumber to look up.
-
-C<$status> is true iff the search was successful.
-
-C<$record> is a reference-to-hash describing the reserve. Its keys are
-the fields from the reserves table of the Koha database.
-
-=cut
-
-#'
-# FIXME - This API is bogus: just return the record, or undef if none
-# was found.
-# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
-# that one looks rather different.
-sub find_reserves {
-
- # Stolen from Returns.pm
- warn "!!!!! SHOULD NOT BE HERE : Circ2::find_reserves is deprecated !!!";
- my ($itemno) = @_;
- my %env;
- my $dbh = C4::Context->dbh;
- my ($itemdata) = getiteminformation( $itemno, 0 );
- my $bibno = $dbh->quote( $itemdata->{'biblionumber'} );
- my $bibitm = $dbh->quote( $itemdata->{'biblioitemnumber'} );
- my $sth =
- $dbh->prepare(
-"select * from reserves where ((found = 'W') or (found is null)) and
biblionumber = ? and cancellationdate is NULL order by priority, reservedate"
- );
- $sth->execute($bibno);
- my $resfound = 0;
- my $resrec;
- my $lastrec;
-
- # print $query;
-
- # FIXME - I'm not really sure what's going on here, but since we
- # only want one result, wouldn't it be possible (and far more
- # efficient) to do something clever in SQL that only returns one
- # set of values?
- while ( ( $resrec = $sth->fetchrow_hashref ) && ( not $resfound ) ) {
-
- # FIXME - Unlike Pascal, Perl allows you to exit loops
- # early. Take out the "&& (not $resfound)" and just
- # use "last" at the appropriate point in the loop.
- # (Oh, and just in passing: if you'd used "!" instead
- # of "not", you wouldn't have needed the parentheses.)
- $lastrec = $resrec;
- my $brn = $dbh->quote( $resrec->{'borrowernumber'} );
- my $rdate = $dbh->quote( $resrec->{'reservedate'} );
- my $bibno = $dbh->quote( $resrec->{'biblionumber'} );
- if ( $resrec->{'found'} eq "W" ) {
- if ( $resrec->{'itemnumber'} eq $itemno ) {
- $resfound = 1;
- }
- }
- else {
- # FIXME - Use 'elsif' to avoid unnecessary indentation.
- if ( $resrec->{'constrainttype'} eq "a" ) {
- $resfound = 1;
- }
- else {
- my $consth =
- $dbh->prepare(
- "SELECT * FROM reserveconstraints
- WHERE borrowernumber = ?
- AND reservedate = ?
- AND biblionumber = ?
- AND biblioitemnumber = ?"
- );
- $consth->execute( $brn, $rdate, $bibno, $bibitm );
- if ( my $conrec = $consth->fetchrow_hashref ) {
- if ( $resrec->{'constrainttype'} eq "o" ) {
- $resfound = 1;
- }
- }
- $consth->finish;
- }
- }
- if ($resfound) {
- my $updsth =
- $dbh->prepare(
- "UPDATE reserves
- SET found = 'W',
- itemnumber = ?
- WHERE borrowernumber = ?
- AND reservedate = ?
- AND biblionumber = ?"
- );
- $updsth->execute( $itemno, $brn, $rdate, $bibno );
- $updsth->finish;
-
- # FIXME - "last;" here to break out of the loop early.
- }
- }
- $sth->finish;
- return ( $resfound, $lastrec );
-}
-
-=head2 fixdate
-
-( $date, $invalidduedate ) = fixdate( $year, $month, $day );
-
-=cut
-
-sub fixdate {
- my ( $year, $month, $day ) = @_;
- my $invalidduedate;
- my $date;
- if ( $year && $month && $day ) {
- if ( ( $year eq 0 ) && ( $month eq 0 ) && ( $year eq 0 ) ) {
-
- # $env{'datedue'}='';
- }
- else {
- if ( ( $year eq 0 ) || ( $month eq 0 ) || ( $year eq 0 ) ) {
- $invalidduedate = 1;
- }
- else {
- if (
- ( $day > 30 )
- && ( ( $month == 4 )
- || ( $month == 6 )
- || ( $month == 9 )
- || ( $month == 11 ) )
- )
- {
- $invalidduedate = 1;
- }
- elsif ( ( $day > 29 ) && ( $month == 2 ) ) {
- $invalidduedate = 1;
- }
- elsif (
- ( $month == 2 )
- && ( $day > 28 )
- && ( ( $year % 4 )
- && ( ( !( $year % 100 ) || ( $year % 400 ) ) ) )
- )
- {
- $invalidduedate = 1;
- }
- else {
- $date = "$year-$month-$day";
- }
- }
- }
- }
- return ( $date, $invalidduedate );
-}
-
-=head2 get_current_return_date_of
-
-&get_current_return_date_of(@itemnumber);
-
-=cut
-
-sub get_current_return_date_of {
- my (@itemnumbers) = @_;
- my $query = '
- SELECT
- date_due,
- itemnumber
- FROM issues
- WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
- AND returndate IS NULL
- ';
- return get_infos_of( $query, 'itemnumber', 'date_due' );
-}
-
-=head2 get_transfert_infos
-
-get_transfert_infos($itemnumber);
-
-=cut
-
-sub get_transfert_infos {
- my ($itemnumber) = @_;
-
- my $dbh = C4::Context->dbh;
-
- my $query = '
- SELECT datesent,
- frombranch,
- tobranch
- FROM branchtransfers
- WHERE itemnumber = ?
- AND datearrived IS NULL
- ';
- my $sth = $dbh->prepare($query);
- $sth->execute($itemnumber);
- my @row = $sth->fetchrow_array();
- $sth->finish;
- return @row;
-}
-
-=head2 DeleteTransfer
-
-&DeleteTransfer($itemnumber);
-
-=cut
-
-sub DeleteTransfer {
- my ($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "DELETE FROM branchtransfers
- WHERE itemnumber=?
- AND datearrived IS NULL "
- );
- $sth->execute($itemnumber);
- $sth->finish;
-}
-
-=head2 GetTransfersFromBib
-
address@hidden = GetTransfersFromBib($frombranch,$tobranch);
-
-=cut
-
-sub GetTransfersFromBib {
- my ( $frombranch, $tobranch ) = @_;
- return unless ( $frombranch && $tobranch );
- my $dbh = C4::Context->dbh;
- my $query = "
- SELECT itemnumber,datesent,frombranch
- FROM branchtransfers
- WHERE frombranch=?
- AND tobranch=?
- AND datearrived IS NULL
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute( $frombranch, $tobranch );
- my @gettransfers;
- my $i = 0;
-
- while ( my $data = $sth->fetchrow_hashref ) {
- $gettransfers[$i] = $data;
- $i++;
- }
- $sth->finish;
- return (@gettransfers);
-}
-
-=head2 GetReservesToBranch
-
address@hidden = GetReservesToBranch( $frombranch, $default );
-
-=cut
-
-sub GetReservesToBranch {
- my ( $frombranch, $default ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "SELECT borrowernumber,reservedate,itemnumber,timestamp
- FROM reserves
- WHERE priority='0' AND cancellationdate is null
- AND branchcode=?
- AND branchcode!=?
- AND found IS NULL "
- );
- $sth->execute( $frombranch, $default );
- my @transreserv;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $transreserv[$i] = $data;
- $i++;
- }
- $sth->finish;
- return (@transreserv);
-}
-
-=head2 GetReservesForBranch
-
address@hidden = GetReservesForBranch($frombranch);
-
-=cut
-
-sub GetReservesForBranch {
- my ($frombranch) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare( "
- SELECT borrowernumber,reservedate,itemnumber,waitingdate
- FROM reserves
- WHERE priority='0'
- AND cancellationdate IS NULL
- AND found='W'
- AND branchcode=?
- ORDER BY waitingdate" );
- $sth->execute($frombranch);
- my @transreserv;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $transreserv[$i] = $data;
- $i++;
- }
- $sth->finish;
- return (@transreserv);
-}
-
-=head2 checktransferts
-
address@hidden = checktransferts($itemnumber);
-
-=cut
-
-sub checktransferts {
- my ($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "SELECT datesent,frombranch,tobranch FROM branchtransfers
- WHERE itemnumber = ? AND datearrived IS NULL"
- );
- $sth->execute($itemnumber);
- my @tranferts = $sth->fetchrow_array;
- $sth->finish;
-
- return (@tranferts);
-}
-
-=head2 CheckItemNotify
-
-Sql request to check if the document has alreday been notified
-this function is not exported, only used with GetOverduesForBranch
-
-=cut
-
-sub CheckItemNotify {
- my ($notify_id,$notify_level,$itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("
- SELECT COUNT(*) FROM notifys
- WHERE notify_id = ?
- AND notify_level = ?
- AND itemnumber = ? ");
- $sth->execute($notify_id,$notify_level,$itemnumber);
- my $notified = $sth->fetchrow;
-$sth->finish;
-return ($notified);
-}
-
-=head2 GetOverduesForBranch
-
-Sql request for display all information for branchoverdues.pl
-2 possibilities : with or without department .
-display is filtered by branch
-
-=cut
-
-sub GetOverduesForBranch {
- my ( $branch, $department) = @_;
- if ( not $department ) {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("
- SELECT
- borrowers.surname,
- borrowers.firstname,
- biblio.title,
- itemtypes.description,
- issues.date_due,
- issues.returndate,
- branches.branchname,
- items.barcode,
- borrowers.phone,
- borrowers.email,
- items.itemcallnumber,
- borrowers.borrowernumber,
- items.itemnumber,
- biblio.biblionumber,
- issues.branchcode,
- accountlines.notify_id,
- accountlines.notify_level,
- items.location,
- accountlines.amountoutstanding
- FROM
issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
- WHERE ( issues.returndate is null)
- AND ( accountlines.amountoutstanding != '0.000000')
- AND ( accountlines.accounttype = 'FU')
- AND ( issues.borrowernumber = accountlines.borrowernumber )
- AND ( issues.itemnumber = accountlines.itemnumber )
- AND ( borrowers.borrowernumber = issues.borrowernumber )
- AND ( biblio.biblionumber = biblioitems.biblionumber )
- AND ( biblioitems.biblionumber = items.biblionumber )
- AND ( itemtypes.itemtype = biblioitems.itemtype )
- AND ( items.itemnumber = issues.itemnumber )
- AND ( branches.branchcode = issues.branchcode )
- AND (issues.branchcode = ?)
- AND (issues.date_due <= NOW())
- ORDER BY borrowers.surname
- ");
- $sth->execute($branch);
- my @getoverdues;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- #check if the document has already been notified
- my $countnotify =
CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
- if ($countnotify eq '0'){
- $getoverdues[$i] = $data;
- $i++;
- }
- }
- return (@getoverdues);
- $sth->finish;
- }
- else {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare( "
- SELECT borrowers.surname,
- borrowers.firstname,
- biblio.title,
- itemtypes.description,
- issues.date_due,
- issues.returndate,
- branches.branchname,
- items.barcode,
- borrowers.phone,
- borrowers.email,
- items.itemcallnumber,
- borrowers.borrowernumber,
- items.itemnumber,
- biblio.biblionumber,
- issues.branchcode,
- accountlines.notify_id,
- accountlines.notify_level,
- items.location,
- accountlines.amountoutstanding
- FROM
issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
- WHERE ( issues.returndate is null )
- AND ( accountlines.amountoutstanding != '0.000000')
- AND ( accountlines.accounttype = 'FU')
- AND ( issues.borrowernumber = accountlines.borrowernumber )
- AND ( issues.itemnumber = accountlines.itemnumber )
- AND ( borrowers.borrowernumber = issues.borrowernumber )
- AND ( biblio.biblionumber = biblioitems.biblionumber )
- AND ( biblioitems.biblionumber = items.biblionumber )
- AND ( itemtypes.itemtype = biblioitems.itemtype )
- AND ( items.itemnumber = issues.itemnumber )
- AND ( branches.branchcode = issues.branchcode )
- AND (issues.branchcode = ? AND items.location = ?)
- AND (issues.date_due <= NOW())
- ORDER BY borrowers.surname
- " );
- $sth->execute( $branch, $department);
- my @getoverdues;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- #check if the document has already been notified
- my $countnotify =
CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
- if ($countnotify eq '0'){
- $getoverdues[$i] = $data;
- $i++;
- }
- }
- $sth->finish;
- return (@getoverdues);
- }
-}
-
-
-=head2 AddNotifyLine
-
-&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
-
-Creat a line into notify, if the method is phone, the notification_send_date
is implemented to
-
-=cut
-
-sub AddNotifyLine {
- my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) =
@_;
- if ( $method eq "phone" ) {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "INSERT INTO notifys
(borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
- VALUES (?,?,now(),now(),?,?,?)"
- );
- $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
- $notifyId );
- $sth->finish;
- }
- else {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "INSERT INTO notifys
(borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
- VALUES (?,?,now(),?,?,?)"
- );
- $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
- $notifyId );
- $sth->finish;
- }
- return 1;
-}
-
-=head2 RemoveNotifyLine
-
-&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
-
-Cancel a notification
-
-=cut
-
-sub RemoveNotifyLine {
- my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "DELETE FROM notifys
- WHERE
- borrowernumber=?
- AND itemnumber=?
- AND notify_date=?"
- );
- $sth->execute( $borrowernumber, $itemnumber, $notify_date );
- $sth->finish;
- return 1;
-}
-
-=head2 AnonymiseIssueHistory
-
-$rows = AnonymiseIssueHistory($borrowernumber,$date)
-
-This function write NULL instead of C<$borrowernumber> given on input arg into
the table issues.
-if C<$borrowernumber> is not set, it will delete the issue history for all
borrower older than C<$date>.
-
-return the number of affected rows.
-
-=cut
-
-sub AnonymiseIssueHistory {
- my $date = shift;
- my $borrowernumber = shift;
- my $dbh = C4::Context->dbh;
- my $query = "
- UPDATE issues
- SET borrowernumber = NULL
- WHERE returndate < '".$date."'
- AND borrowernumber IS NOT NULL
- ";
- $query .= " AND borrowernumber = '".$borrowernumber."'" if defined
$borrowernumber;
- my $rows_affected = $dbh->do($query);
- return $rows_affected;
-}
-
-=head2 GetItemsLost
-
-$items = GetItemsLost($where,$orderby);
-
-This function get the items lost into C<$items>.
-
-=over 2
-
-=item input:
-C<$where> is a hashref. it containts a field of the items table as key
-and the value to match as value.
-C<$orderby> is a field of the items table.
-
-=item return:
-C<$items> is a reference to an array full of hasref which keys are items'
table column.
-
-=item usage in the perl script:
-
-my %where;
-$where{barcode} = 0001548;
-my $items = GetLostItems( \%where, "homebranch" );
-$template->param(itemsloop => $items);
-
-=back
-
-=cut
-
-sub GetLostItems {
- # Getting input args.
- my $where = shift;
- my $orderby = shift;
- my $dbh = C4::Context->dbh;
-
- my $query = "
- SELECT *
- FROM items
- WHERE itemlost IS NOT NULL
- AND itemlost <> 0
- ";
- foreach my $key (keys %$where) {
- $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
- }
- $query .= " ORDER BY ".$orderby if defined $orderby;
-
- my $sth = $dbh->prepare($query);
- $sth->execute;
- my @items;
- while ( my $row = $sth->fetchrow_hashref ){
- push @items, $row;
- }
- return address@hidden;
-}
-
-=head2 updateWrongTransfer
-
-$items =
updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
-
-This function validate the line of brachtransfer but with the wrong
destination (mistake from a librarian ...), and create a new line in
branchtransfer from the actual library to the original library of reservation
-
-=cut
-
-sub updateWrongTransfer {
- my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
- my $dbh = C4::Context->dbh;
-# first step validate the actual line of transfert .
- my $sth =
- $dbh->prepare(
- "update branchtransfers set datearrived =
now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived
IS NULL"
- );
- $sth->execute($FromLibrary,$itemNumber);
- $sth->finish;
-
-# second step create a new line of branchtransfer to the right location .
- dotransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
-
-#third step changing holdingbranch of item
- UpdateHoldingbranch($FromLibrary,$itemNumber);
-}
-
-=head2 UpdateHoldingbranch
-
-$items = UpdateHoldingbranch($branch,$itmenumber);
-Simple methode for updating hodlingbranch in items BDD line
-=cut
-
-sub UpdateHoldingbranch {
- my ( $branch,$itmenumber ) = @_;
- my $dbh = C4::Context->dbh;
-# first step validate the actual line of transfert .
- my $sth =
- $dbh->prepare(
- "update items set holdingbranch = ? where itemnumber= ?"
- );
- $sth->execute($branch,$itmenumber);
- $sth->finish;
-
-
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Koha Developement team <address@hidden>
-
-=cut
-
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Koha-cvs] koha bookshelves/addbookbybiblionumber.pl books...,
paul poulain <=