[Koha-cvs] koha/C4/Circulation Circ2.pm [rel_3_0]
Antoine Farnault
antoine at koha-fr.org
Mon Nov 27 11:25:53 CET 2006
CVSROOT: /sources/koha
Module name: koha
Branch: rel_3_0
Changes by: Antoine Farnault <toins> 06/11/27 10:25:52
Modified files:
C4/Circulation : Circ2.pm
Log message:
Removing warn compilation. Cleaning some functions & SQL query.
Fixing all POD errors and adding POD where it was missed.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.114.2.16&r2=1.114.2.17
Patches:
Index: Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.114.2.16
retrieving revision 1.114.2.17
diff -u -b -r1.114.2.16 -r1.114.2.17
--- Circ2.pm 17 Nov 2006 14:57:21 -0000 1.114.2.16
+++ Circ2.pm 27 Nov 2006 10:25:52 -0000 1.114.2.17
@@ -1,14 +1,5 @@
-# -*- tab-width: 8 -*-
-# Please use 8-character tabs for this file (indents are every 4 characters)
-
package C4::Circulation::Circ2;
-# $Id: Circ2.pm,v 1.114.2.16 2006/11/17 14:57:21 tipaul Exp $
-
-#package to deal with Returns
-#written 3/11/99 by olwen at katipo.co.nz
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
@@ -26,6 +17,8 @@
# 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.114.2.17 2006/11/27 10:25:52 toins Exp $
+
use strict;
require Exporter;
use C4::Context;
@@ -45,7 +38,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.114.2.16 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.114.2.17 $' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -63,8 +56,6 @@
=head1 FUNCTIONS
-=over 2
-
=cut
@ISA = qw(Exporter);
@@ -85,8 +76,8 @@
&GetItemsForInventory
&itemseen
&fixdate
- get_current_return_date_of
- get_transfert_infos
+ &get_current_return_date_of
+ &get_transfert_infos
&checktransferts
&GetReservesForBranch
&GetReservesToBranch
@@ -98,8 +89,7 @@
&RemoveNotifyLine
&GetIssuesFromBiblio
&AnonymiseIssueHistory
- );
-# &GetBranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
+);
=head2 itemseen
@@ -112,7 +102,10 @@
sub itemseen {
my ($itemnum) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("update items set itemlost=0, datelastseen = now() where items.itemnumber = ?");
+ my $sth =
+ $dbh->prepare(
+ "update items set itemlost=0, datelastseen = now() where items.itemnumber = ?"
+ );
$sth->execute($itemnum);
return;
}
@@ -128,12 +121,15 @@
sub itemborrowed {
my ($itemnum) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?");
+ my $sth =
+ $dbh->prepare(
+ "update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?"
+ );
$sth->execute($itemnum);
return;
}
-=head2
+=head2 GetItemsForInventory
$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
@@ -149,28 +145,38 @@
=cut
sub GetItemsForInventory {
- my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_;
+ my ( $minlocation, $maxlocation, $datelastseen, $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) ORDER BY itemcallnumber,title";
+ 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)
+ ORDER BY itemcallnumber,title";
$sth = $dbh->prepare($query);
-# warn "DATELA :$datelastseen";
- $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 <=? ORDER BY itemcallnumber,title";
+ $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 <=?
+ ORDER BY itemcallnumber,title
+ ";
$sth = $dbh->prepare($query);
- $sth->execute($minlocation,$maxlocation);
+ $sth->execute( $minlocation, $maxlocation );
}
my @results;
- while (my $row = $sth->fetchrow_hashref) {
+ while ( my $row = $sth->fetchrow_hashref ) {
$offset-- if ($offset);
- if ((!$offset) && $size) {
- push @results,$row;
+ if ( ( !$offset ) && $size ) {
+ push @results, $row;
$size--;
}
}
@@ -208,7 +214,7 @@
=over 4
-Shows the patron's credit or debt, if any.
+=item Shows the patron's credit or debt, if any.
=back
@@ -216,7 +222,7 @@
=over 4
-(Gone, no address.) Set if the patron has left without giving a
+=item (Gone, no address.) Set if the patron has left without giving a
forwarding address.
=back
@@ -225,7 +231,7 @@
=over 4
-Set if the patron's card has been reported as lost.
+=item Set if the patron's card has been reported as lost.
=back
@@ -233,7 +239,7 @@
=over 4
-Set if the patron has been debarred.
+=item Set if the patron has been debarred.
=back
@@ -241,7 +247,7 @@
=over 4
-Any additional notes about the patron.
+=item Any additional notes about the patron.
=back
@@ -249,7 +255,7 @@
=over 4
-Set if the patron has overdue items. This flag has several keys:
+=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
@@ -265,7 +271,7 @@
=over 4
-Set if any items that the patron has reserved are available.
+=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
@@ -273,46 +279,46 @@
=back
-=back
-
=cut
-
sub getpatroninformation {
-# returns
- my ($env, $borrowernumber,$cardnumber) = @_;
+ 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) {
+ }
+ elsif ($cardnumber) {
$sth = $dbh->prepare("select * from borrowers where cardnumber=?");
$sth->execute($cardnumber);
- } else {
+ }
+ else {
return undef;
}
my $borrower = $sth->fetchrow_hashref;
- my $amount = checkaccount($env, $borrowernumber, $dbh);
+ my $amount = checkaccount( $env, $borrowernumber, $dbh );
$borrower->{'amountoutstanding'} = $amount;
- my $flags = patronflags($env, $borrower, $dbh);
+ my $flags = patronflags( $env, $borrower, $dbh );
my $accessflagshash;
- $sth=$dbh->prepare("select bit,flag from userflags");
+ $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;
+ while ( my ( $bit, $flag ) = $sth->fetchrow ) {
+ if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
+ $accessflagshash->{$flag} = 1;
}
}
$sth->finish;
- $borrower->{'flags'}=$flags;
+ $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'});
+ $sth =
+ $dbh->prepare(
+ "select enrolmentperiod from categories where categorycode = ?");
+ $sth->execute( $borrower->{'categorycode'} );
my $enrolment = $sth->fetchrow;
$borrower->{'enrolmentperiod'} = $enrolment;
return ($borrower); #, $flags, $accessflagshash);
@@ -320,54 +326,47 @@
=head2 decode
-=over 4
-
=head3 $str = &decode($chunk);
=over 4
-Decodes a segment of a string emitted by a CueCat barcode scanner and
+=item Decodes a segment of a string emitted by a CueCat barcode scanner and
returns it.
=back
-=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)
- {
+ 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;
+ $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];
+ 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);
+ $r = substr( $r, 0, length($r) - $l );
return $r;
}
=head2 getiteminformation
-=over 4
-
$item = &getiteminformation($itemnumber, $barcode);
Looks up information about an item, given either its item number or
@@ -382,7 +381,7 @@
=over 4
-The due date on this item, if it has been borrowed and not returned
+=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
@@ -391,52 +390,63 @@
=over 4
-True if the item may not be borrowed.
-
-=back
+=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) = @_;
+
+ # 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 =
+ $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");
+ }
+ 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 {
+ }
+ else {
return undef;
}
- my $iteminformation=$sth->fetchrow_hashref;
+ 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'});
+ $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;
+ $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;
+ ( $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'};
+ $iteminformation->{'notforloan'} = $itemtype->{'notforloan'}
+ unless $iteminformation->{'notforloan'};
$sth->finish;
}
- return($iteminformation);
+ return ($iteminformation);
}
=head2 transferbook
-=over 4
-
($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.
@@ -460,36 +470,32 @@
=over 4
-C<BadBarcode>
+=item C<BadBarcode>
There is no item in the catalog with the given barcode. The value is C<$barcode>.
-C<IsPermanent>
+=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.
-C<DestinationEqualsHolding>
+=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.
-C<WasReturned>
+=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.
-C<ResFound>
+=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>.
-C<WasTransferred>
+=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
-=back
-
-=back
-
=cut
#'
@@ -508,85 +514,102 @@
# error message in case of failure (this would feel more like C than
# Perl, though).
sub transferbook {
-# transfer book code....
- my ($tbr, $barcode, $ignoreRs) = @_;
+ my ( $tbr, $barcode, $ignoreRs ) = @_;
my $messages;
my %env;
my $dotransfer = 1;
my $branches = GetBranches();
- my $iteminformation = getiteminformation(0, $barcode);
+ my $iteminformation = getiteminformation( 0, $barcode );
+
# bad barcode..
- if (not $iteminformation) {
+ 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'}) {
+ 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) {
+ if ( $fbr eq $tbr ) {
$messages->{'DestinationEqualsHolding'} = 1;
$dotransfer = 0;
}
+
# check if it is still issued to someone, return it...
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
+ my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
if ($currentborrower) {
- returnbook($barcode, $fbr);
+ 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) {
+ my ( $resfound, $resrec ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
+ if ( $resfound and not $ignoreRs ) {
$resrec->{'ResFound'} = $resfound;
-# $messages->{'ResFound'} = $resrec;
+
+ # $messages->{'ResFound'} = $resrec;
$dotransfer = 1;
}
+
#actually do the transfer....
if ($dotransfer) {
- dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
+ 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);
+ 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 ( $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)");
+ $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");
+ $dbh->do(
+ "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm");
&itemseen($itm);
- &domarctransfer($dbh,$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");
+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 ){
-&MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'items.holdingbranch',$holdingbranch,0);
-}
-return;
+ while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
+ &MARCmoditemonefield( $dbh, $biblionumber, $itemnumber,
+ 'items.holdingbranch', $holdingbranch, 0 );
+ }
+ return;
}
=head2 canbookbeissued
@@ -597,13 +620,13 @@
=over 4
-C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
+=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
-C<$borrower> hash with borrower informations (from getpatroninformation)
+=item C<$borrower> hash with borrower informations (from getpatroninformation)
-C<$barcode> is the bar code of the book being issued.
+=item C<$barcode> is the bar code of the book being issued.
-C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
+=item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
=back
@@ -611,9 +634,11 @@
=over 4
-C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
+=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
@@ -646,8 +671,6 @@
item is restricted (set by ??)
-=back
-
C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :
@@ -680,258 +703,331 @@
# check if a book can be issued.
# returns an array with errors if any
-sub TooMany ($$){
+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 $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 = ?');
+ $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 $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);
+ $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%");
+ # 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 {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
+
# check for branch=*
- $sth->execute($cat_borrower, $type, "");
+ $sth->execute( $cat_borrower, $type, "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("b $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
+
# check for itemtype=*
- $sth->execute($cat_borrower, "*", $branch_borrower);
+ $sth->execute( $cat_borrower, "*", $branch_borrower );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
my ($alreadyissued) = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+
# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
- return ("c $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
+
# check for borrowertype=*
- $sth->execute("*", $type, $branch_borrower);
+ $sth->execute( "*", $type, $branch_borrower );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("d $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute("*", "*", $branch_borrower);
+ $sth->execute( "*", "*", $branch_borrower );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("e $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute("*", $type, "");
+ $sth->execute( "*", $type, "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty}) && $result->{maxissueqty}>=0) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ 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 {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute($cat_borrower, "*", "");
+ $sth->execute( $cat_borrower, "*", "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("g $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute("*", "*", "");
+ $sth->execute( "*", "*", "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("h $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
return;
}
+=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 ( $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 %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);
+
+ #
+ # DUE DATE is OK ?
+ #
+ my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
$issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
-#
-# BORROWER STATUS
-#
- if ($borrower->{flags}->{GNA}) {
+ #
+ # BORROWER STATUS
+ #
+ if ( $borrower->{flags}->{GNA} ) {
$issuingimpossible{GNA} = 1;
}
- if ($borrower->{flags}->{'LOST'}) {
+ if ( $borrower->{flags}->{'LOST'} ) {
$issuingimpossible{CARD_LOST} = 1;
}
- if ($borrower->{flags}->{'DBARRED'}) {
+ if ( $borrower->{flags}->{'DBARRED'} ) {
$issuingimpossible{DEBARRED} = 1;
}
- if (Date_to_Days(Today()) > Date_to_Days(split /-/, $borrower->{'dateexpiry'})) {
+ 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")){
+ #
+ # 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);
+ if ( $amount > $amountlimit && !$inprocess ) {
+ $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
}
- } else {
- if ($amount >0) {
+ 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);
+ #
+ # 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}) {
+ #
+ # ITEM CHECKING
+ #
+ unless ( $iteminformation->{barcode} ) {
$issuingimpossible{UNKNOWN_BARCODE} = 1;
}
- if ($iteminformation->{'notforloan'} && $iteminformation->{'notforloan'} > 0) {
+ if ( $iteminformation->{'notforloan'}
+ && $iteminformation->{'notforloan'} > 0 )
+ {
$issuingimpossible{NOT_FOR_LOAN} = 1;
}
- if ($iteminformation->{'itemtype'} &&$iteminformation->{'itemtype'} eq 'REF') {
+ if ( $iteminformation->{'itemtype'}
+ && $iteminformation->{'itemtype'} eq 'REF' )
+ {
$issuingimpossible{NOT_FOR_LOAN} = 1;
}
- if ($iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1) {
+ if ( $iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1 )
+ {
$issuingimpossible{WTHDRAWN} = 1;
}
- if ($iteminformation->{'restricted'} && $iteminformation->{'restricted'} == 1) {
+ if ( $iteminformation->{'restricted'}
+ && $iteminformation->{'restricted'} == 1 )
+ {
$issuingimpossible{RESTRICTED} = 1;
}
- if (C4::Context->preference("IndependantBranches")){
+ if ( C4::Context->preference("IndependantBranches") ) {
my $userenv = C4::Context->userenv;
- if (($userenv)&&($userenv->{flags} != 1)){
- $issuingimpossible{NOTSAMEBRANCH} = 1 if ($iteminformation->{'holdingbranch'} ne $userenv->{branch} ) ;
+ 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'} )
+ {
-
-
-#
-# 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
+ # 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 {
+ }
+ else {
+
# $needsconfirmation{RENEW_ISSUE} = 1;
}
- } elsif ($currentborrower) {
-# issued to someone else
- my $currborinfo = getpatroninformation(0,$currentborrower);
+ }
+ 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'})";
+ $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'});
+
+ # 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") {
+ 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 ( $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") {
+ 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 ( $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'})";
+ 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'){
+ if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
+ {
+ if ( $borrower->{'categorycode'} eq 'W' ) {
my %issuingimpossible;
- return(\%issuingimpossible,\%needsconfirmation);
- } else {
- return(\%issuingimpossible,\%needsconfirmation);
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
}
- } else {
- return(\%issuingimpossible,\%needsconfirmation);
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
}
}
@@ -943,118 +1039,203 @@
=over 4
-C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
+=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)
-C<$borrower> hash with borrower informations (from getpatroninformation)
+=item C<$barcode> is the bar code of the book being issued.
-C<$barcode> is the bar code of the book being issued.
+=item C<$date> contains the max date of return. calculated if empty.
-C<$date> contains the max date of return. calculated if empty.
+=back
=cut
-#
-# issuing book. We already have checked it can be issued, so, just issue it !
-#
sub issuebook {
- my ($env,$borrower,$barcode,$date,$cancelreserve) = @_;
+ my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_;
my $dbh = C4::Context->dbh;
+
# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0);
- my $iteminformation = getiteminformation(0, $barcode);
-# warn "B : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'};
+ 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);
+ 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'});
+ &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'});
+ my ( $restype, $res ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
if ($restype) {
my $resbor = $res->{'borrowernumber'};
- if ($resbor eq $borrower->{'borrowernumber'}) {
+ if ( $resbor eq $borrower->{'borrowernumber'} ) {
+
# The item is on reserve to the current patron
FillReserve($res);
-# warn "FillReserve";
- } elsif ($restype eq "Waiting") {
-# warn "Waiting";
+ }
+ 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 ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- if ($cancelreserve){
- CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- } else {
+ 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'});
+ UpdateReserve(
+ 1,
+ $res->{'biblionumber'},
+ $res->{'borrowernumber'},
+ $res->{'branchcode'}
+ );
}
- } elsif ($restype eq "Reserved") {
-# warn "Reserved";
+ }
+ elsif ( $restype eq "Reserved" ) {
+
+ # warn "Reserved";
# The item is on reserve for someone else.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
+ 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 {
+ 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";
}
}
}
+
# Record in the database the fact that the book was issued.
- my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values (?,?,?,?)");
- my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
- my $datedue=time+($loanlength)*86400;
+ my $sth =
+ $dbh->prepare(
+"insert into issues (borrowernumber, itemnumber, 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];
+ my $dateduef =
+ ( 1900 + $datearr[5] ) . "-"
+ . ( $datearr[4] + 1 ) . "-"
+ . $datearr[3];
if ($date) {
- $dateduef=$date;
+ $dateduef = $date;
}
+
# if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
- if (C4::Context->preference('ReturnBeforeExpiry') && $dateduef gt $borrower->{expiry}) {
- $dateduef=$borrower->{expiry};
+ if ( C4::Context->preference('ReturnBeforeExpiry')
+ && $dateduef gt $borrower->{expiry} )
+ {
+ $dateduef = $borrower->{expiry};
}
- $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'});
+ $sth->execute(
+ $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'},
+ $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 =
+ $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'});
+ &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;
+ 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'});
+ &UpdateStats(
+ $env, $env->{'branchcode'},
+ 'issue', $charge,
+ '', $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
+ );
}
}
@@ -1067,46 +1248,59 @@
=cut
sub getLoanLength {
- my ($borrowertype,$itemtype,$branchcode) = @_;
+ 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 $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';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute($borrowertype,$itemtype,"");
+ $sth->execute( $borrowertype, $itemtype, "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute($borrowertype,"*",$branchcode);
+ $sth->execute( $borrowertype, "*", $branchcode );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*",$itemtype,$branchcode);
+ $sth->execute( "*", $itemtype, $branchcode );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute($borrowertype,"*","");
+ $sth->execute( $borrowertype, "*", "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*","*",$branchcode);
+ $sth->execute( "*", "*", $branchcode );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*",$itemtype,"");
+ $sth->execute( "*", $itemtype, "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*","*","");
+ $sth->execute( "*", "*", "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ 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) =
@@ -1171,102 +1365,151 @@
# is more C-ish than Perl-ish).
sub returnbook {
- my ($barcode, $branch) = @_;
+ my ( $barcode, $branch ) = @_;
my %env;
my $messages;
my $dbh = C4::Context->dbh;
my $doreturn = 1;
die '$branch not defined' unless defined $branch; # just in case (bug 170)
# get information on item
- my ($iteminformation) = getiteminformation(0, $barcode);
- if (not $iteminformation) {
+ 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) {
+ 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'}) {
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
$messages->{'IsPermanent'} = $hbr;
}
+
# check that the book has been cancelled
- if ($iteminformation->{'wthdrawn'}) {
+ if ( $iteminformation->{'wthdrawn'} ) {
$messages->{'wthdrawn'} = 1;
$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);
+# update issues, thereby returning book (should push this out into another subroutine
+ my ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
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'});
+ my $sth =
+ $dbh->prepare(
+"update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"
+ );
+ $sth->execute( $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'} );
# FIXME the holdingbranch is updated if the document is returned in an other location .
- if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'}){
- my $sth_upd_location = $dbh->prepare("UPDATE items SET holdingbranch=? WHERE itemnumber=?");
- $sth_upd_location->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
+ if ( $iteminformation->{'holdingbranch'} ne
+ C4::Context->userenv->{'branch'} )
+ {
+ my $sth_upd_location =
+ $dbh->prepare(
+ "UPDATE items SET holdingbranch=? WHERE itemnumber=?");
+ $sth_upd_location->execute(
+ C4::Context->userenv->{'branch'},
+ $iteminformation->{'itemnumber'}
+ );
$sth_upd_location->finish;
- $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
+ $iteminformation->{'holdingbranch'} =
+ C4::Context->userenv->{'branch'};
}
$messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
}
- itemseen($iteminformation->{'itemnumber'});
- ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
+ itemseen( $iteminformation->{'itemnumber'} );
+ ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
+
# transfer book to the current branch
-# FIXME function transfered still always used ????
-# my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
-# if ($transfered) {
-# $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
-# }
+ # FIXME function transfered still always used ????
+ # my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
+ # if ($transfered) {
+ # $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
+ # }
# fix up the accounts.....
- if ($iteminformation->{'itemlost'}) {
- fixaccountforlostandreturned($iteminformation, $borrower);
+ if ( $iteminformation->{'itemlost'} ) {
+ fixaccountforlostandreturned( $iteminformation, $borrower );
$messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
}
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
-# check if we have a transfer for this document
- my $checktransfer = checktransferts($iteminformation->{'itemnumber'});
-# if we have a return, we update the line of transfers with the datearrived
- if ($checktransfer){
- my $sth = $dbh->prepare("update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL");
- $sth->execute($iteminformation->{'itemnumber'});
+
+ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+ # check if we have a transfer for this document
+ my $checktransfer = checktransferts( $iteminformation->{'itemnumber'} );
+
+ # if we have a return, we update the line of transfers with the datearrived
+ if ($checktransfer) {
+ 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'
- my $updateWaiting = SetWaitingStatus($iteminformation->{'itemnumber'});
+ my $updateWaiting =
+ SetWaitingStatus( $iteminformation->{'itemnumber'} );
}
+
# if we don't have a transfer on run, we check if the document is not in his homebranch and there is not a reservation, we transfer this one to his home branch directly if system preference Automaticreturn is turn on .
else {
- my $checkreserves = CheckReserves($iteminformation->{'itemnumber'});
- if (($iteminformation->{'homebranch'} ne $iteminformation->{'holdingbranch'}) and (not $checkreserves) and (C4::Context->preference("AutomaticItemReturn") == 1)){
- my $automatictransfer = dotransfer($iteminformation->{'itemnumber'},$iteminformation->{'holdingbranch'},$iteminformation->{'homebranch'});
+ my $checkreserves = CheckReserves( $iteminformation->{'itemnumber'} );
+ if (
+ (
+ $iteminformation->{'homebranch'} ne
+ $iteminformation->{'holdingbranch'}
+ )
+ and ( not $checkreserves )
+ and ( C4::Context->preference("AutomaticItemReturn") == 1 )
+ )
+ {
+ my $automatictransfer = dotransfer(
+ $iteminformation->{'itemnumber'},
+ $iteminformation->{'holdingbranch'},
+ $iteminformation->{'homebranch'}
+ );
$messages->{'WasTransfered'} = 1;
}
}
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
- # fix up the overdues in accounts...
- fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- # find reserves.....
+
+# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+# 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'});
+ my ( $resfound, $resrec ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
if ($resfound) {
- # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
+
+# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
$resrec->{'ResFound'} = $resfound;
$messages->{'ResFound'} = $resrec;
}
+
# update stats?
# Record the fact that this book was returned.
- UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
- return ($doreturn, $messages, $iteminformation, $borrower);
+ UpdateStats(
+ \%env, $branch, 'return', '0', '',
+ $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'},
+ $borrower->{'borrowernumber'}
+ );
+ return ( $doreturn, $messages, $iteminformation, $borrower );
}
=head2 fixaccountforlostandreturned
@@ -1282,79 +1525,113 @@
=cut
sub fixaccountforlostandreturned {
- my ($iteminfo, $borrower) = @_;
+ 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");
+ 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) {
+ 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) {
+ if ( $data->{'amountoutstanding'} == $amount ) {
$offset = $data->{'amount'};
$amountleft = 0;
- } else {
+ }
+ else {
$offset = $amount - $data->{'amountoutstanding'};
$amountleft = $data->{'amountoutstanding'} - $amount;
}
- my $usth = $dbh->prepare("update accountlines set accounttype = 'LR',amountoutstanding='0'
+ my $usth = $dbh->prepare(
+ "update accountlines set accounttype = 'LR',amountoutstanding='0'
where (borrowernumber = ?)
- and (itemnumber = ?) and (accountno = ?) ");
- $usth->execute($data->{'borrowernumber'},$itm,$acctno);
+ 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'});
+ 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) {
+ while ( ( $accdata = $msth->fetchrow_hashref )
+ and ( $amountleft > 0 ) )
+ {
+ if ( $accdata->{'amountoutstanding'} < $amountleft ) {
$newamtos = 0;
$amountleft -= $accdata->{'amountoutstanding'};
- } else {
+ }
+ else {
$newamtos = $accdata->{'amountoutstanding'} - $amountleft;
$amountleft = 0;
}
my $thisacct = $accdata->{'accountno'};
- my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
+ my $usth = $dbh->prepare(
+ "update accountlines set amountoutstanding= ?
where (borrowernumber = ?)
- and (accountno=?)");
- $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
+ and (accountno=?)"
+ );
+ $usth->execute( $newamtos, $data->{'borrowernumber'},
+ '$thisacct' );
$usth->finish;
- $usth = $dbh->prepare("insert into accountoffsets
+ $usth = $dbh->prepare(
+ "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
values
- (?,?,?,?)");
- $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
+ (?,?,?,?)"
+ );
+ $usth->execute(
+ $data->{'borrowernumber'},
+ $accdata->{'accountno'},
+ $nextaccntno, $newamtos
+ );
$usth->finish;
}
$msth->finish;
}
- if ($amountleft > 0){
- $amountleft*=-1;
+ if ( $amountleft > 0 ) {
+ $amountleft *= -1;
}
- my $desc="Book Returned ".$iteminfo->{'barcode'};
- $usth = $dbh->prepare("insert into accountlines
+ 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);
+ values (?,?,now(),?,?,'CR',?)"
+ );
+ $usth->execute(
+ $data->{'borrowernumber'},
+ $nextaccntno, 0 - $amount,
+ $desc, $amountleft
+ );
$usth->finish;
- $usth = $dbh->prepare("insert into accountoffsets
+ $usth = $dbh->prepare(
+ "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
- values (?,?,?,?)");
- $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
+ values (?,?,?,?)"
+ );
+ $usth->execute( $borrower->{'borrowernumber'},
+ $data->{'accountno'}, $nextaccntno, $offset );
$usth->finish;
$usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
$usth->execute($itm);
@@ -1368,8 +1645,6 @@
&fixoverdueonreturn($brn,$itm);
-??
-
C<$brn> borrowernumber
C<$itm> itemnumber
@@ -1377,196 +1652,258 @@
=cut
sub fixoverduesonreturn {
- my ($brn, $itm) = @_;
+ 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);
+ 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 (acccountno = ?)");
- $usth->execute($brn,$itm,$data->{'accountno'});
+ if ( my $data = $sth->fetchrow_hashref ) {
+ my $usth =
+ $dbh->prepare(
+"update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (acccountno = ?)"
+ );
+ $usth->execute( $brn, $itm, $data->{'accountno'} );
$usth->finish();
}
$sth->finish();
return;
}
-# 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
+=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
+
+ # Original subroutine for Circ2.pm
my %flags;
- my ($env, $patroninformation, $dbh) = @_;
- my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
- if ($amount > 0) {
+ 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{'message'} = sprintf "Patron owes \$%.02f", $amount;
+ if ( $amount > $noissuescharge ) {
$flaginfo{'noissues'} = 1;
}
$flags{'CHARGES'} = \%flaginfo;
- } elsif ($amount < 0){
+ }
+ elsif ( $amount < 0 ) {
my %flaginfo;
$flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
$flags{'CHARGES'} = \%flaginfo;
}
- if ($patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1) {
+ 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) {
+ 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) {
+ if ( $patroninformation->{'debarred'}
+ && $patroninformation->{'debarred'} == 1 )
+ {
my %flaginfo;
$flaginfo{'message'} = 'Borrower is Debarred.';
$flaginfo{'noissues'} = 1;
$flags{'DBARRED'} = \%flaginfo;
}
- if ($patroninformation->{'borrowernotes'} && $patroninformation->{'borrowernotes'}) {
+ 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 ( $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";
+ foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
+ @$itemsoverdue )
+ {
+ $flaginfo{'itemlisttext'} .=
+ "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
}
$flags{'ODUES'} = \%flaginfo;
}
- my $itemswaiting=GetWaitingReserves($patroninformation->{'borrowernumber'});
+ my $itemswaiting =
+ GetWaitingReserves( $patroninformation->{'borrowernumber'} );
my $nowaiting = scalar @$itemswaiting;
- if ($nowaiting > 0) {
+ if ( $nowaiting > 0 ) {
my %flaginfo;
$flaginfo{'message'} = "Reserved items available";
$flaginfo{'itemlist'} = $itemswaiting;
$flags{'WAITING'} = \%flaginfo;
}
- return(\%flags);
+ return ( \%flags );
}
+=head2 checkoverdues
+
+( $count, $overdueitems )=checkoverdues( $env, $borrowernumber, $dbh );
+
+Not exported
+
+=cut
-# Not exported
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 ( $env, $borrowernumber, $dbh ) = @_;
my @datearr = localtime;
- my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
+ 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
+ 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);
+ AND issues.date_due < ?"
+ );
+ $sth->execute( $borrowernumber, $today );
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @overdueitems, $data );
$count++;
}
$sth->finish;
- return ($count, \@overdueitems);
+ return ( $count, \@overdueitems );
}
-# Not exported
+=head2 currentborrower
+
+$borrower=currentborrower($itemnumber)
+
+Not exported
+
+=cut
+
sub currentborrower {
-# Original subroutine for Circ2.pm
+
+ # 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
+ 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");
+ NULL"
+ );
$sth->execute;
my ($borrower) = $sth->fetchrow;
- return($borrower);
+ return ($borrower);
}
-# FIXME - Not exported, but used in 'updateitem.pl' anyway.
+=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)=@_;
+
+ # Stolen from Main.pm
+ # Check for reserves for biblio
+ my ( $env, $dbh, $itemnum ) = @_;
my $resbor = "";
- my $sth = $dbh->prepare("select * from reserves,items
+ 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");
+ order by priority"
+ );
$sth->execute($itemnum);
my $resrec;
- my $data=$sth->fetchrow_hashref;
- while ($data && $resbor eq '') {
- $resrec=$data;
+ my $data = $sth->fetchrow_hashref;
+ while ( $data && $resbor eq '' ) {
+ $resrec = $data;
my $const = $data->{'constrainttype'};
- if ($const eq "a") {
+ if ( $const eq "a" ) {
$resbor = $data->{'borrowernumber'};
- } else {
+ }
+ else {
my $found = 0;
- my $csth = $dbh->prepare("select * from reserveconstraints,items
+ 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'};}
+ 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;
+ $data = $sth->fetchrow_hashref;
}
$sth->finish;
- return ($resbor,$resrec);
+ return ( $resbor, $resrec );
}
=head2 currentissues
@@ -1596,13 +1933,14 @@
#'
sub currentissues {
-# New subroutine for Circ2.pm
- my ($env, $borrower) = @_;
+
+ # New subroutine for Circ2.pm
+ my ( $env, $borrower ) = @_;
my $dbh = C4::Context->dbh;
my %currentissues;
- my $counter=1;
+ my $counter = 1;
my $borrowernumber = $borrower->{'borrowernumber'};
- my $crit='';
+ my $crit = '';
# Figure out whether to get the books issued today, or earlier.
# FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
@@ -1610,41 +1948,51 @@
# 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'}) {
+ 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];
+ 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%' ";
+ $crit = " and issues.timestamp like '$today%' ";
}
- if ($env->{'nottodaysissues'}) {
+ 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];
+ 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%') ";
+ $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
+ 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");
+ $crit order by issues.date_due"
+ );
$sth->execute($borrowernumber);
- while (my $data = $sth->fetchrow_hashref) {
+ 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'}='');
+ $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.
@@ -1655,21 +2003,25 @@
# ...
# 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 @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'};
+ my $itemnumber = $data->{'itemnumber'};
+
# FIXME - Consecutive integers as hash keys? You have GOT to
# be kidding me! Use an array, fercrissakes!
- $currentissues{$counter}=$data;
+ $currentissues{$counter} = $data;
$counter++;
}
$sth->finish;
- return(\%currentissues);
+ return ( \%currentissues );
}
=head2 getissues
@@ -1692,7 +2044,8 @@
#'
sub getissues {
-# New subroutine for Circ2.pm
+
+ # New subroutine for Circ2.pm
my ($borrower) = @_;
my $dbh = C4::Context->dbh;
my $borrowernumber = $borrower->{'borrowernumber'};
@@ -1719,18 +2072,23 @@
AND issues.returndate IS NULL
ORDER BY issues.date_due DESC
";
- my $sth=$dbh->prepare($select);
+ my $sth = $dbh->prepare($select);
$sth->execute($borrowernumber);
my $counter = 0;
- while (my $data = $sth->fetchrow_hashref) {
+
+ while ( my $data = $sth->fetchrow_hashref ) {
$data->{'dewey'} =~ s/0*$//;
- ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
+ ( $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]);
+ 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
@@ -1739,17 +2097,18 @@
# if ($date->{date_due} lt $todaysdate)
my $datedue = $data->{'date_due'};
$datedue =~ s/-//g;
- if ($datedue < $todaysdate) {
+ 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);
+ return ( \%currentissues );
}
=head2 GetIssuesFromBiblio
@@ -1781,8 +2140,8 @@
$sth->execute($biblionumber);
my @issues;
- while(my $data = $sth->fetchrow_hashref){
- push @issues,$data;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @issues, $data;
}
return \@issues;
}
@@ -1810,51 +2169,58 @@
=cut
sub renewstatus {
+
# check renewal status
- my ($env,$borrowernumber,$itemno)=@_;
+ 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
+ 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) {
+ 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
+ my $sth2 = $dbh->prepare(
+ "SELECT renewalsallowed from items,biblioitems,itemtypes
where (items.itemnumber = ?)
and (items.biblioitemnumber = biblioitems.biblioitemnumber)
- and (biblioitems.itemtype = itemtypes.itemtype)");
+ and (biblioitems.itemtype = itemtypes.itemtype)"
+ );
$sth2->execute($itemno);
- if (my $data2=$sth2->fetchrow_hashref) {
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
$renews = $data2->{'renewalsallowed'};
}
- if ($renews && $renews > $data1->{'renewals'}) {
+ if ( $renews && $renews > $data1->{'renewals'} ) {
$renewokay = 1;
}
$sth2->finish;
- my ($resfound, $resrec) = CheckReserves($itemno);
+ my ( $resfound, $resrec ) = CheckReserves($itemno);
if ($resfound) {
$renewokay = 0;
}
- ($resfound, $resrec) = CheckReserves($itemno);
+ ( $resfound, $resrec ) = CheckReserves($itemno);
if ($resfound) {
$renewokay = 0;
}
}
$sth1->finish;
- return($renewokay);
+ return ($renewokay);
}
=head2 renewbook
@@ -1882,57 +2248,71 @@
=cut
sub renewbook {
+
# mark book as renewed
- my ($env,$borrowernumber,$itemno,$datedue)=@_;
+ 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 "" ) {
+ 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);
+ 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;
+ 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);
+ 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);
+ 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);
+ 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;
- # print $account;
}
# return();
}
-
-
-=item calc_charges
+=head2 calc_charges
($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
@@ -1952,64 +2332,70 @@
=cut
sub calc_charges {
+
# calculate charges due
- my ($env, $itemno, $borrowernumber)=@_;
- my $charge=0;
+ 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
+ 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)");
+ and (biblioitems.itemtype = itemtypes.itemtype)"
+ );
$sth1->execute($itemno);
- if (my $data1=$sth1->fetchrow_hashref) {
+ 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 $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;
+ if ( $discount eq 'NULL' ) {
+ $discount = 0;
}
- $charge = ($charge *(100 - $discount)) / 100;
- # warn "discount is $discount";
+ $charge = ( $charge * ( 100 - $discount ) ) / 100;
}
$sth2->finish;
}
$sth1->finish;
- return ($charge,$item_type);
+ 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 $sth = $dbh->prepare(<<EOT);
+
+ #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',
- ?)
-EOT
- $sth->execute($borrowernumber, $itemno, $nextaccntno, $charge, $charge);
+ VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $borrowernumber, $itemno, $nextaccntno, $charge, $charge );
$sth->finish;
}
-
-=item find_reserves
+=head2 find_reserves
($status, $record) = &find_reserves($itemnumber);
@@ -2023,54 +2409,70 @@
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 !!!";
+
+ # 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");
+ 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;
+
+ # 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)) {
+ 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) {
+ 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 {
+ }
+ else {
# FIXME - Use 'elsif' to avoid unnecessary indentation.
- if ($resrec->{'constrainttype'} eq "a") {
+ 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") {
+ }
+ 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;
}
}
@@ -2078,158 +2480,238 @@
}
}
if ($resfound) {
- my $updsth = $dbh->prepare("update reserves set found = 'W', itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber = ?");
- $updsth->execute($itemno,$brn,$rdate,$bibno);
+ 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);
+ return ( $resfound, $lastrec );
}
+=head2 fixdate
+
+( $date, $invalidduedate ) = fixdate( $year, $month, $day );
+
+=cut
+
sub fixdate {
- my ($year, $month, $day) = @_;
+ 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))) {
+ 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;
}
- elsif (($day > 29) && ($month == 2)) {
- $invalidduedate=1;
+ else {
+ if (
+ ( $day > 30 )
+ && ( ( $month == 4 )
+ || ( $month == 6 )
+ || ( $month == 9 )
+ || ( $month == 11 ) )
+ )
+ {
+ $invalidduedate = 1;
}
- elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) {
- $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";
+ $date = "$year-$month-$day";
}
}
}
}
- return ($date, $invalidduedate);
-
+ 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,
+ SELECT
+ date_due,
itemnumber
-FROM issues
-WHERE itemnumber IN ('.join(',', @itemnumbers).') AND returndate IS NULL
-';
- return get_infos_of($query, 'itemnumber', 'date_due');
+ 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,
+ SELECT datesent,
frombranch,
tobranch
-FROM branchtransfers
-WHERE itemnumber = ?
+ 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 ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("DELETE FROM branchtransfers
- where itemnumber=?
- AND datearrived is null ");
+ my $sth = $dbh->prepare(
+ "DELETE FROM branchtransfers
+ WHERE itemnumber=?
+ AND datearrived IS NULL "
+ );
$sth->execute($itemnumber);
$sth->finish;
}
+=head2 GetTransfersFromBib
+
+ at results = GetTransfersFromBib($frombranch,$tobranch);
+
+=cut
+
sub GetTransfersFromBib {
- my($frombranch,$tobranch) = @_;
+ my ( $frombranch, $tobranch ) = @_;
+ return unless ( $frombranch && $tobranch );
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT itemnumber,datesent,frombranch FROM
- branchtransfers
- where frombranch=?
+ my $query = "
+ SELECT itemnumber,datesent,frombranch
+ FROM branchtransfers
+ WHERE frombranch=?
AND tobranch=?
- AND datearrived is null ");
- $sth->execute($frombranch,$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;
+ my $i = 0;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $gettransfers[$i] = $data;
$i++;
}
$sth->finish;
- return(@gettransfers);
+ return (@gettransfers);
}
+=head2 GetReservesToBranch
+
+ at transreserv = GetReservesToBranch( $frombranch, $default );
+
+=cut
+
sub GetReservesToBranch {
- my($frombranch,$default) = @_;
+ 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
+ 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);
+ AND found IS NULL "
+ );
+ $sth->execute( $frombranch, $default );
my @transreserv;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $transreserv[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
$i++;
}
$sth->finish;
- return(@transreserv);
+ return (@transreserv);
}
+=head2 GetReservesForBranch
+
+ at transreserv = GetReservesForBranch($frombranch);
+
+=cut
+
sub GetReservesForBranch {
my ($frombranch) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("
+ 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 reservedate");
+ ORDER BY reservedate" );
$sth->execute($frombranch);
my @transreserv;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $transreserv[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
$i++;
}
$sth->finish;
- return(@transreserv);
+ return (@transreserv);
}
-sub checktransferts{
- my($itemnumber) = @_;
+=head2 checktransferts
+
+ at tranferts = 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");
+ 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;
@@ -2238,67 +2720,150 @@
}
=head2 GetOverduesForBranch
+
Sql request for display all information for branchoverdues.pl
2 possibilities : with or without departement .
display is filtered by branch
+
=cut
sub GetOverduesForBranch {
- my($branch,$departement) = @_;
- if (not $departement){
+ my ( $branch, $departement ) = @_;
+ if ( not $departement ) {
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 issues , borrowers borrowers , biblio biblio , biblioitems biblioitems , itemtypes itemtypes , items items , branches branches , accountlines 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 NOT EXISTS (SELECT * FROM notifys WHERE ( accountlines . notify_id = notifys . notify_id ) AND ( accountlines . notify_level = notifys . notify_level ) AND ( accountlines . itemnumber = notifys . itemnumber ) )
-ORDER BY borrowers . surname
+ 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 NOT EXISTS (
+ SELECT * FROM notifys
+ WHERE ( accountlines.notify_id = notifys.notify_id )
+ AND ( accountlines.notify_level = notifys.notify_level )
+ AND ( accountlines.itemnumber = notifys.itemnumber ) )
+ ORDER BY borrowers.surname
");
$sth->execute($branch);
my @getoverdues;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $getoverdues[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $getoverdues[$i] = $data;
$i++;
}
$sth->finish;
- return(@getoverdues);
+ return (@getoverdues);
}
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 , accounlines . notify_id , accounlines . notify_level , items . location , accounlines . amountoutstanding FROM issues issues , borrowers borrowers , biblio biblio , biblioitems biblioitems , itemtypes itemtypes , items items , branches branches , accountlines accounlines WHERE ((( issues . returndate is null) AND ( accounlines . amountoutstanding != '0.000000') AND ( accounlines . accounttype = 'FU'))) AND (( issues . borrowernumber = accounlines . borrowernumber ) AND ( issues . itemnumber = accounlines . 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 NOT EXISTS (SELECT * FROM notifys WHERE ( accounlines . notify_id = notifys . notify_id ) AND ( accounlines . notify_level = notifys . notify_level ) AND ( accounlines . itemnumber = notifys . itemnumber ) )
-ORDER BY borrowers . surname
- ");
- $sth->execute($branch,$departement);
+ 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,
+ accounlines.notify_id,
+ accounlines.notify_level,
+ items.location,
+ accounlines.amountoutstanding
+ FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accounlines
+ WHERE ((( issues.returndate is null)
+ AND ( accounlines.amountoutstanding != '0.000000')
+ AND ( accounlines.accounttype = 'FU')))
+ AND (( issues.borrowernumber = accounlines.borrowernumber )
+ AND ( issues.itemnumber = accounlines.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 NOT EXISTS (
+ SELECT * FROM notifys
+ WHERE ( accounlines.notify_id = notifys.notify_id )
+ AND ( accounlines.notify_level = notifys.notify_level )
+ AND ( accounlines.itemnumber = notifys.itemnumber ) )
+ ORDER BY borrowers.surname
+ " );
+ $sth->execute( $branch, $departement );
my @getoverdues;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $getoverdues[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $getoverdues[$i] = $data;
$i++;
}
$sth->finish;
- return(@getoverdues);
+ 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 ( $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);
+ 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);
+ 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;
@@ -2306,24 +2871,28 @@
=head2 RemoveNotifyLine
+&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
+
Cancel a notification
=cut
sub RemoveNotifyLine {
- my($borrowernumber,$itemnumber,$notify_date) = @_;
+ my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("DELETE FROM notifys
+ my $sth = $dbh->prepare(
+ "DELETE FROM notifys
WHERE
borrowernumber=?
AND itemnumber=?
- AND notify_date=?");
- $sth->execute($borrowernumber,$itemnumber,$notify_date);
+ AND notify_date=?"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $notify_date );
$sth->finish;
return 1;
}
-=head 2 AnonymiseIssueHistory
+=head2 AnonymiseIssueHistory
AnonymiseIssueHistory($borrowernumber,$date)
@@ -2346,8 +2915,7 @@
";
$query .= " AND timestamp < '".$date."'" if $date;
my $sth = $dbh->prepare($query);
- $sth->execute;
- warn "query is=".$query;
+ $sth->execute($borrowernumber);
return $sth->errstr if $sth->errstr;
return undef;
}
@@ -2356,8 +2924,6 @@
__END__
-=back
-
=head1 AUTHOR
Koha Developement team <info at koha.org>
More information about the Koha-cvs
mailing list