X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FCirculation%2FCirc2.pm;h=d4fea350531856eb7b2cbf0d44e700b102cbab85;hb=2ffd5b7228f4e638583162d483e1dd2febeafe1b;hp=3d1ba9529d8ec9af936c512b284080677a1a5d30;hpb=c136f56045c82709914dada592b8b23d1f57ec51;p=koha.git diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 3d1ba9529d..d4fea35053 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -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$ - -#package to deal with Returns -#written 3/11/99 by olwen@katipo.co.nz - - # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -26,23 +17,31 @@ package C4::Circulation::Circ2; # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA +# $Id$ + use strict; -# use warnings; require Exporter; -use DBI; use C4::Context; use C4::Stats; use C4::Reserves2; use C4::Koha; -use C4::Accounts2; -use C4::Biblio; -use Date::Manip; use C4::Biblio; +use C4::Accounts2; +use Date::Calc qw( + Today + Today_and_Now + Add_Delta_YM + Add_Delta_DHMS + Date_to_Days +); +use POSIX qw(strftime); +use C4::Branch; # GetBranches +use C4::Log; # logaction use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking -$VERSION = 0.01; +$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); }; =head1 NAME @@ -50,7 +49,7 @@ C4::Circulation::Circ2 - Koha circulation module =head1 SYNOPSIS - use C4::Circulation::Circ2; +use C4::Circulation::Circ2; =head1 DESCRIPTION @@ -60,38 +59,43 @@ Also deals with stocktaking. =head1 FUNCTIONS -=over 2 - =cut -@ISA = qw(Exporter); +@ISA = qw(Exporter); @EXPORT = qw( - &getpatroninformation - ¤tissues - &getissues - &getiteminformation - &renewstatus - &renewbook - &canbookbeissued - &issuebook - &returnbook - &find_reserves - &transferbook - &decode - &calc_charges - &listitemsforinventory - &itemseen - &fixdate - get_current_return_date_of - get_transfert_infos - &checktransferts - &GetReservesForBranch - &GetReservesToBranch - &GetTransfersFromBib - &getBranchIp - &dotranfer - ); -# &GetBranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm + &getpatroninformation + ¤tissues + &getissues + &getiteminformation + &renewstatus + &renewbook + &canbookbeissued + &issuebook + &returnbook + &find_reserves + &transferbook + &decode + &calc_charges + &GetItemsForInventory + &itemseen + &fixdate + &get_current_return_date_of + &get_transfert_infos + &checktransferts + &GetReservesForBranch + &GetReservesToBranch + &GetTransfersFromBib + &getBranchIp + &dotransfer + &GetOverduesForBranch + &AddNotifyLine + &RemoveNotifyLine + &GetIssuesFromBiblio + &AnonymiseIssueHistory + &GetLostItems + &itemissues + &updateWrongTransfer +); =head2 itemseen @@ -102,11 +106,14 @@ C<$itemnum> is the item number =cut sub itemseen { - my ($itemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("update items set itemlost=0, datelastseen = now() where items.itemnumber = ?"); - $sth->execute($itemnum); - return; + my ($itemnum) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( + "update items set itemlost=0, datelastseen = now() where items.itemnumber = ?" + ); + $sth->execute($itemnum); + return; } =head2 itemborrowed @@ -118,32 +125,74 @@ C<$itemnum> is the item number =cut sub itemborrowed { - my ($itemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?"); - $sth->execute($itemnum); - return; + my ($itemnum) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( + "update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?" + ); + $sth->execute($itemnum); + return; } -sub listitemsforinventory { - my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select itemnumber,barcode,itemcallnumber,title,author from items,biblio where items.biblionumber=biblio.biblionumber and itemcallnumber>= ? and itemcallnumber <=? and (datelastseen< ? or datelastseen is null) order by itemcallnumber,title"); - $sth->execute($minlocation,$maxlocation,$datelastseen); - my @results; - while (my $row = $sth->fetchrow_hashref) { - $offset-- if ($offset); - if ((!$offset) && $size) { - push @results,$row; - $size--; - } - } - return \@results; +=head2 GetItemsForInventory + +$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size) + +Retrieve a list of title/authors/barcode/callnumber, for biblio inventory. + +The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber. +It is ordered by callnumber,title. + +The minlocation & maxlocation parameters are used to specify a range of item callnumbers +the datelastseen can be used to specify that you want to see items not seen since a past date only. +offset & size can be used to retrieve only a part of the whole listing (defaut behaviour) + +=cut + +sub GetItemsForInventory { + my ( $minlocation, $maxlocation, $datelastseen, $branch, $offset, $size ) = @_; + my $dbh = C4::Context->dbh; + my $sth; + if ($datelastseen) { + my $query = + "SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen + FROM items + LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber + WHERE itemcallnumber>= ? + AND itemcallnumber <=? + AND (datelastseen< ? OR datelastseen IS NULL)"; + $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch; + $query .= " ORDER BY itemcallnumber,title"; + $sth = $dbh->prepare($query); + $sth->execute( $minlocation, $maxlocation, $datelastseen ); + } + else { + my $query =" + SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen + FROM items + LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber + WHERE itemcallnumber>= ? + AND itemcallnumber <=?"; + $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch; + $query .= " ORDER BY itemcallnumber,title"; + $sth = $dbh->prepare($query); + $sth->execute( $minlocation, $maxlocation ); + } + my @results; + while ( my $row = $sth->fetchrow_hashref ) { + $offset-- if ($offset); + if ( ( !$offset ) && $size ) { + push @results, $row; + $size--; + } + } + return \@results; } =head2 getpatroninformation - ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber); +($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber); Looks up a patron and returns information about him or her. If C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks @@ -157,9 +206,9 @@ borrowers table in the Koha database. In addition, C<$borrower-E{flags}> is a hash giving more detailed information about the patron. Its keys act as flags : - if $borrower->{flags}->{LOST} { - # Patron's card was reported lost - } + if $borrower->{flags}->{LOST} { + # Patron's card was reported lost + } Each flag has a C key, giving a human-readable explanation of the flag. If the state of a flag means that the patron should not be @@ -172,7 +221,7 @@ The possible flags are: =over 4 -Shows the patron's credit or debt, if any. +=item Shows the patron's credit or debt, if any. =back @@ -180,7 +229,7 @@ Shows the patron's credit or debt, if any. =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 @@ -189,7 +238,7 @@ forwarding address. =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 @@ -197,7 +246,7 @@ Set if the patron's card has been reported as lost. =over 4 -Set if the patron has been debarred. +=item Set if the patron has been debarred. =back @@ -205,7 +254,7 @@ Set if the patron has been debarred. =over 4 -Any additional notes about the patron. +=item Any additional notes about the patron. =back @@ -213,7 +262,7 @@ Any additional notes about the patron. =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{ODUES}{itemlist}> is a reference-to-array listing the overdue items. Its elements are references-to-hash, each describing an @@ -229,7 +278,7 @@ the overdue items, one per line. =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{WAITING}{itemlist}> is a reference-to-array listing the available items. Each element is a reference-to-hash whose keys are @@ -237,110 +286,100 @@ fields from the reserves table of the Koha database. =back -=back - =cut - sub getpatroninformation { -# returns - my ($env, $borrowernumber,$cardnumber) = @_; - my $dbh = C4::Context->dbh; - my $query; - my $sth; - if ($borrowernumber) { - $sth = $dbh->prepare("select * from borrowers where borrowernumber=?"); - $sth->execute($borrowernumber); - } elsif ($cardnumber) { - $sth = $dbh->prepare("select * from borrowers where cardnumber=?"); - $sth->execute($cardnumber); - } else { - $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine"; - return(); - } - my $borrower = $sth->fetchrow_hashref; - my $amount = checkaccount($env, $borrowernumber, $dbh); - $borrower->{'amountoutstanding'} = $amount; - my $flags = patronflags($env, $borrower, $dbh); - my $accessflagshash; - - $sth=$dbh->prepare("select bit,flag from userflags"); - $sth->execute; - while (my ($bit, $flag) = $sth->fetchrow) { - if ($borrower->{'flags'} && $borrower->{'flags'} & 2**$bit) { - $accessflagshash->{$flag}=1; - } - } - $sth->finish; - $borrower->{'flags'}=$flags; - $borrower->{'authflags'} = $accessflagshash; - - # find out how long the membership lasts - my $sth=$dbh->prepare("select enrolmentperiod from categories where categorycode = ?"); - $sth->execute($borrower->{'categorycode'}); - my $enrolment = $sth->fetchrow; - $borrower->{'enrolmentperiod'} = $enrolment; - return ($borrower); #, $flags, $accessflagshash); + my ( $env, $borrowernumber, $cardnumber ) = @_; + my $dbh = C4::Context->dbh; + my $query; + my $sth; + if ($borrowernumber) { + $sth = $dbh->prepare("select * from borrowers where borrowernumber=?"); + $sth->execute($borrowernumber); + } + elsif ($cardnumber) { + $sth = $dbh->prepare("select * from borrowers where cardnumber=?"); + $sth->execute($cardnumber); + } + else { + return undef; + } + my $borrower = $sth->fetchrow_hashref; + my $amount = checkaccount( $env, $borrowernumber, $dbh ); + $borrower->{'amountoutstanding'} = $amount; + my $flags = patronflags( $env, $borrower, $dbh ); + my $accessflagshash; + + $sth = $dbh->prepare("select bit,flag from userflags"); + $sth->execute; + while ( my ( $bit, $flag ) = $sth->fetchrow ) { + if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) { + $accessflagshash->{$flag} = 1; + } + } + $sth->finish; + $borrower->{'flags'} = $flags; + $borrower->{'authflags'} = $accessflagshash; + + # find out how long the membership lasts + $sth = + $dbh->prepare( + "select enrolmentperiod from categories where categorycode = ?"); + $sth->execute( $borrower->{'categorycode'} ); + my $enrolment = $sth->fetchrow; + $borrower->{'enrolmentperiod'} = $enrolment; + return ($borrower); #, $flags, $accessflagshash); } =head2 decode -=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) - { - print "Error!"; - return; - } - $l = 4-$l; - $#s += $l; - } - my $r = ''; - while ($#s >= 0) - { - my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3]; - $r .=chr(($n >> 16) ^ 67) . - chr(($n >> 8 & 255) ^ 67) . - chr(($n & 255) ^ 67); - @s = @s[4..$#s]; - } - $r = substr($r,0,length($r)-$l); - return $r; + my ($encoded) = @_; + my $seq = + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-'; + my @s = map { index( $seq, $_ ); } split( //, $encoded ); + my $l = ( $#s + 1 ) % 4; + if ($l) { + if ( $l == 1 ) { + warn "Error!"; + return; + } + $l = 4 - $l; + $#s += $l; + } + my $r = ''; + while ( $#s >= 0 ) { + my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3]; + $r .= + chr( ( $n >> 16 ) ^ 67 ) + .chr( ( $n >> 8 & 255 ) ^ 67 ) + .chr( ( $n & 255 ) ^ 67 ); + @s = @s[ 4 .. $#s ]; + } + $r = substr( $r, 0, length($r) - $l ); + return $r; } =head2 getiteminformation -=over 4 - -$item = &getiteminformation($env, $itemnumber, $barcode); +$item = &getiteminformation($itemnumber, $barcode); Looks up information about an item, given either its item number or its barcode. If C<$itemnumber> is a nonzero value, it is used; otherwise, C<$barcode> is used. -C<$env> is effectively ignored, but should be a reference-to-hash. - C<$item> is a reference-to-hash whose keys are fields from the biblio, items, and biblioitems tables of the Koha database. It may also contain the following keys: @@ -349,7 +388,7 @@ contain the following keys: =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 @@ -358,55 +397,63 @@ yet. The date is in YYYY-MM-DD format. =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 ($env, $itemnumber, $barcode) = @_; - my $dbh = C4::Context->dbh; - my $sth; - if ($itemnumber) { - $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"); - $sth->execute($itemnumber); - } elsif ($barcode) { - $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"); - $sth->execute($barcode); - } else { - $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode"; - # Error condition. - return(); - } - my $iteminformation=$sth->fetchrow_hashref; - $sth->finish; - if ($iteminformation) { - $sth=$dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)"); - $sth->execute($iteminformation->{'itemnumber'}); - my ($date_due) = $sth->fetchrow; - $iteminformation->{'date_due'}=$date_due; - $sth->finish; - ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}=''); - $sth=$dbh->prepare("select * from itemtypes where itemtype=?"); - $sth->execute($iteminformation->{'itemtype'}); - my $itemtype=$sth->fetchrow_hashref; - # if specific item notforloan, don't use itemtype notforloan field. - # otherwise, use itemtype notforloan value to see if item can be issued. - $iteminformation->{'notforloan'}=$itemtype->{'notforloan'} unless $iteminformation->{'notforloan'}; - $sth->finish; - } - return($iteminformation); + + # returns a hash of item information given either the itemnumber or the barcode + my ( $itemnumber, $barcode ) = @_; + my $dbh = C4::Context->dbh; + my $sth; + if ($itemnumber) { + $sth = + $dbh->prepare( + "select * + from biblio,items,biblioitems + where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber" + ); + $sth->execute($itemnumber); + } + elsif ($barcode) { + $sth = + $dbh->prepare( + "select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber" + ); + $sth->execute($barcode); + } + else { + return undef; + } + my $iteminformation = $sth->fetchrow_hashref; + $sth->finish; + if ($iteminformation) { + $sth = + $dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)"); + $sth->execute( $iteminformation->{'itemnumber'} ); + my ($date_due) = $sth->fetchrow; + $iteminformation->{'date_due'} = $date_due; + $sth->finish; + ( $iteminformation->{'dewey'} == 0 ) + && ( $iteminformation->{'dewey'} = '' ); + $sth = $dbh->prepare("select * from itemtypes where itemtype=?"); + $sth->execute( $iteminformation->{'itemtype'} ); + my $itemtype = $sth->fetchrow_hashref; + + # if specific item notforloan, don't use itemtype notforloan field. + # otherwise, use itemtype notforloan value to see if item can be issued. + $iteminformation->{'notforloan'} = $itemtype->{'notforloan'} + unless $iteminformation->{'notforloan'}; + $sth->finish; + } + return ($iteminformation); } =head2 transferbook -=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. @@ -425,41 +472,37 @@ Returns three values: is true if the transfer was successful. =head3 $messages - + is a reference-to-hash which may have any of the following keys: =over 4 -C +=item C There is no item in the catalog with the given barcode. The value is C<$barcode>. -C +=item C 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 +=item C 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 +=item C 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 +=item C 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. It also has the key C, whose value is either C or C. -C +=item C 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 #' @@ -478,92 +521,103 @@ The item was eligible to be transferred. Barring problems communicating with the # 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 $messages; - my %env; - my $dotransfer = 1; - my $branches = GetBranches(); - my $iteminformation = getiteminformation(\%env, 0, $barcode); - # bad barcode.. - if (not $iteminformation) { - $messages->{'BadBarcode'} = $barcode; - $dotransfer = 0; - } - # get branches of book... - my $hbr = $iteminformation->{'homebranch'}; - my $fbr = $iteminformation->{'holdingbranch'}; - # if is permanent... - if ($hbr && $branches->{$hbr}->{'PE'}) { - $messages->{'IsPermanent'} = $hbr; - } - # can't transfer book if is already there.... - # FIXME - Why not? Shouldn't it trivially succeed? - if ($fbr eq $tbr) { - $messages->{'DestinationEqualsHolding'} = 1; - $dotransfer = 0; - } - # check if it is still issued to someone, return it... - my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); - if ($currentborrower) { - returnbook($barcode, $fbr); - $messages->{'WasReturned'} = $currentborrower; - } - # find reserves..... - # FIXME - Don't call &CheckReserves unless $ignoreRs is true. - # That'll save a database query. - my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'}); - if ($resfound and not $ignoreRs) { - $resrec->{'ResFound'} = $resfound; -# $messages->{'ResFound'} = $resrec; - $dotransfer = 1; - } - - if ($dotransfer) { - dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr); - my $dbh= C4::Context->dbh; - my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.holdingbranch"); - my $bibid = MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $iteminformation->{'biblionumber'} ); - my $marcitem = MARCgetitem($dbh, $bibid, $iteminformation->{'itemnumber'}); - if ($marcitem->field($tagfield)){ - $marcitem->field($tagfield)->update($tagsubfield=> $tbr); - MARCmoditem($dbh,$marcitem,$bibid,$iteminformation->{'itemnumber'}); - } - $messages->{'WasTransfered'} = 1; - } - return ($dotransfer, $messages, $iteminformation); + my ( $tbr, $barcode, $ignoreRs ) = @_; + my $messages; + my %env; + my $dotransfer = 1; + my $branches = GetBranches(); + my $iteminformation = getiteminformation( 0, $barcode ); + + # bad barcode.. + if ( not $iteminformation ) { + $messages->{'BadBarcode'} = $barcode; + $dotransfer = 0; + } + + # get branches of book... + my $hbr = $iteminformation->{'homebranch'}; + my $fbr = $iteminformation->{'holdingbranch'}; + + # if is permanent... + if ( $hbr && $branches->{$hbr}->{'PE'} ) { + $messages->{'IsPermanent'} = $hbr; + } + + # can't transfer book if is already there.... + # FIXME - Why not? Shouldn't it trivially succeed? + if ( $fbr eq $tbr ) { + $messages->{'DestinationEqualsHolding'} = 1; + $dotransfer = 0; + } + + # check if it is still issued to someone, return it... + my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} ); + if ($currentborrower) { + returnbook( $barcode, $fbr ); + $messages->{'WasReturned'} = $currentborrower; + } + + # find reserves..... + # FIXME - Don't call &CheckReserves unless $ignoreRs is true. + # That'll save a database query. + my ( $resfound, $resrec ) = + CheckReserves( $iteminformation->{'itemnumber'} ); + if ( $resfound and not $ignoreRs ) { + $resrec->{'ResFound'} = $resfound; + + # $messages->{'ResFound'} = $resrec; + $dotransfer = 1; + } + + #actually do the transfer.... + if ($dotransfer) { + dotransfer( $iteminformation->{'itemnumber'}, $fbr, $tbr ); + + # don't need to update MARC anymore, we do it in batch now + $messages->{'WasTransfered'} = 1; + } + return ( $dotransfer, $messages, $iteminformation ); } # Not exported # FIXME - This is only used in &transferbook. Why bother making it a # separate function? sub dotransfer { - my ($itm, $fbr, $tbr) = @_; - my $dbh = C4::Context->dbh; - $itm = $dbh->quote($itm); - $fbr = $dbh->quote($fbr); - $tbr = $dbh->quote($tbr); - #new entry in branchtransfers.... - $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch) - VALUES ($itm, $fbr, now(), $tbr)"); - #update holdingbranch in items ..... - $dbh->do("UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm"); - &itemseen($itm); - &domarctransfer($dbh,$itm); - return; + my ( $itm, $fbr, $tbr ) = @_; + + my $dbh = C4::Context->dbh; + $itm = $dbh->quote($itm); + $fbr = $dbh->quote($fbr); + $tbr = $dbh->quote($tbr); + + #new entry in branchtransfers.... + $dbh->do( +"INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch) + VALUES ($itm, $fbr, now(), $tbr)" + ); + + #update holdingbranch in items ..... + $dbh->do( + "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm"); + &itemseen($itm); + &domarctransfer( $dbh, $itm ); + return; } ##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006 -sub domarctransfer{ - -my ($dbh,$itemnumber) = @_; -$itemnumber=~s /\'//g; ##itemnumber seems to come with quotes-TG -my $sth=$dbh->prepare("select biblionumber,holdingbranch from items where itemnumber=$itemnumber"); - $sth->execute(); -while (my ($biblionumber,$holdingbranch)=$sth->fetchrow ){ -&MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'items.holdingbranch',$holdingbranch,0); -} -return; +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( $biblionumber, $itemnumber, + 'items.holdingbranch', $holdingbranch, 0 ); + } + return; } =head2 canbookbeissued @@ -574,13 +628,13 @@ my ($issuingimpossible,$needsconfirmation) = canbookbeissued($env,$borrower,$bar =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 @@ -588,9 +642,11 @@ Returns : =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 @@ -600,7 +656,7 @@ sticky due date is invalid borrower gone with no address =head3 CARD_LOST - + borrower declared it's card lost =head3 DEBARRED @@ -623,8 +679,6 @@ item withdrawn. item is restricted (set by ??) -=back - C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. Possible values are : @@ -657,458 +711,788 @@ if the borrower borrows to much things # check if a book can be issued. # returns an array with errors if any -sub TooMany ($$){ - my $borrower = shift; - my $iteminformation = shift; - my $cat_borrower = $borrower->{'categorycode'}; - my $branch_borrower = $borrower->{'branchcode'}; - my $dbh = C4::Context->dbh; - - - my $sth = $dbh->prepare('select itemtype from biblioitems where biblionumber = ?'); - $sth->execute($iteminformation->{'biblionumber'}); - my $type = $sth->fetchrow; - $sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'); -# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?"); - my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"); - my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null'); - my $alreadyissued; - # check the 3 parameters - $sth->execute($cat_borrower, $type, $branch_borrower); - my $result = $sth->fetchrow_hashref; -# warn "==>".$result->{maxissueqty}; - - # Currently, using defined($result) ie on an entire hash reports whether memory - # for that aggregate has ever been allocated. As $result is used all over the place - # it would rarely return as undefined. - if (defined($result->{maxissueqty})) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); - my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("a $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } - # check for branch=* - $sth->execute($cat_borrower, $type, ""); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); - my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("b $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } - # check for itemtype=* - $sth->execute($cat_borrower, "*", $branch_borrower); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth3->execute($borrower->{'borrowernumber'}); - my ($alreadyissued) = $sth3->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ -# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}"; - return ("c $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } - # check for borrowertype=* - $sth->execute("*", $type, $branch_borrower); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); - my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("d $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } - - $sth->execute("*", "*", $branch_borrower); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth3->execute($borrower->{'borrowernumber'}); - my $alreadyissued = $sth3->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("e $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } +sub TooMany ($$) { + my $borrower = shift; + my $iteminformation = shift; + my $cat_borrower = $borrower->{'categorycode'}; + my $branch_borrower = $borrower->{'branchcode'}; + my $dbh = C4::Context->dbh; + + my $sth = + $dbh->prepare('select itemtype from biblioitems where biblionumber = ?'); + $sth->execute( $iteminformation->{'biblionumber'} ); + my $type = $sth->fetchrow; + $sth = + $dbh->prepare( +'select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?' + ); + +# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?"); + my $sth2 = + $dbh->prepare( +"select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber" + ); + my $sth3 = + $dbh->prepare( +'select COUNT(*) from issues where borrowernumber = ? and returndate is null' + ); + my $alreadyissued; + + # check the 3 parameters + $sth->execute( $cat_borrower, $type, $branch_borrower ); + my $result = $sth->fetchrow_hashref; + + # warn "==>".$result->{maxissueqty}; + +# Currently, using defined($result) ie on an entire hash reports whether memory +# for that aggregate has ever been allocated. As $result is used all over the place +# it would rarely return as undefined. + if ( defined( $result->{maxissueqty} ) ) { + $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" ); + my $alreadyissued = $sth2->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } - $sth->execute("*", $type, ""); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty}) && $result->{maxissueqty}>=0) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); - my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("f $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } + # check for branch=* + $sth->execute( $cat_borrower, $type, "" ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) ) { + $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" ); + my $alreadyissued = $sth2->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } - $sth->execute($cat_borrower, "*", ""); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); - my $alreadyissued = $sth2->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("g $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } + # check for itemtype=* + $sth->execute( $cat_borrower, "*", $branch_borrower ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) ) { + $sth3->execute( $borrower->{'borrowernumber'} ); + my ($alreadyissued) = $sth3->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { - $sth->execute("*", "*", ""); - $result = $sth->fetchrow_hashref; - if (defined($result->{maxissueqty})) { - $sth3->execute($borrower->{'borrowernumber'}); - my $alreadyissued = $sth3->fetchrow; - if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("h $alreadyissued / ".($result->{maxissueqty}+0)); - } else { - return; - } - } - return; -} +# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}"; + return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } + # check for borrowertype=* + $sth->execute( "*", $type, $branch_borrower ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) ) { + $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" ); + my $alreadyissued = $sth2->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } -sub canbookbeissued { - my ($env,$borrower,$barcode,$year,$month,$day,$inprocess) = @_; - my %needsconfirmation; # filled with problems that needs confirmations - my %issuingimpossible; # filled with problems that causes the issue to be IMPOSSIBLE - my $iteminformation = getiteminformation($env, 0, $barcode); - my $dbh = C4::Context->dbh; -# -# DUE DATE is OK ? -# - my ($duedate, $invalidduedate) = fixdate($year, $month, $day); - $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate); + $sth->execute( "*", "*", $branch_borrower ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) ) { + $sth3->execute( $borrower->{'borrowernumber'} ); + my $alreadyissued = $sth3->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } -# -# BORROWER STATUS -# - if ($borrower->{flags}->{GNA}) { - $issuingimpossible{GNA} = 1; - } - if ($borrower->{flags}->{'LOST'}) { - $issuingimpossible{CARD_LOST} = 1; - } - if ($borrower->{flags}->{'DBARRED'}) { - $issuingimpossible{DEBARRED} = 1; - } - if (&Date_Cmp(&ParseDate($borrower->{dateexpiry}),&ParseDate("today"))<0) { - $issuingimpossible{EXPIRED} = 1; - } -# -# BORROWER STATUS -# + $sth->execute( "*", $type, "" ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) { + $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" ); + my $alreadyissued = $sth2->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } -# DEBTS - my $amount = checkaccount($env,$borrower->{'borrowernumber'}, $dbh,$duedate); - if(C4::Context->preference("IssuingInProcess")){ - my $amountlimit = C4::Context->preference("noissuescharge"); - if ($amount > $amountlimit && !$inprocess) { - $issuingimpossible{DEBT} = sprintf("%.2f",$amount); - } elsif ($amount <= $amountlimit && !$inprocess) { - $needsconfirmation{DEBT} = sprintf("%.2f",$amount); - } - } else { - if ($amount >0) { - $needsconfirmation{DEBT} = $amount; - } - } + $sth->execute( $cat_borrower, "*", "" ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) ) { + $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" ); + my $alreadyissued = $sth2->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } -# -# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS -# - my $toomany = TooMany($borrower, $iteminformation); - $needsconfirmation{TOO_MANY} = $toomany if $toomany; + $sth->execute( "*", "*", "" ); + $result = $sth->fetchrow_hashref; + if ( defined( $result->{maxissueqty} ) ) { + $sth3->execute( $borrower->{'borrowernumber'} ); + my $alreadyissued = $sth3->fetchrow; + if ( $result->{'maxissueqty'} <= $alreadyissued ) { + return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) ); + } + else { + return; + } + } + return; +} -# -# ITEM CHECKING -# - unless ($iteminformation->{barcode}) { - $issuingimpossible{UNKNOWN_BARCODE} = 1; - } - if ($iteminformation->{'notforloan'} && $iteminformation->{'notforloan'} > 0) { - $issuingimpossible{NOT_FOR_LOAN} = 1; - } - if ($iteminformation->{'itemtype'} &&$iteminformation->{'itemtype'} eq 'REF') { - $issuingimpossible{NOT_FOR_LOAN} = 1; - } - if ($iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1) { - $issuingimpossible{WTHDRAWN} = 1; - } - if ($iteminformation->{'restricted'} && $iteminformation->{'restricted'} == 1) { - $issuingimpossible{RESTRICTED} = 1; - } - if (C4::Context->preference("IndependantBranches")){ - my $userenv = C4::Context->userenv; - if (($userenv)&&($userenv->{flags} != 1)){ - $issuingimpossible{NOTSAMEBRANCH} = 1 if ($iteminformation->{'holdingbranch'} ne $userenv->{branch} ) ; - } - } +=head2 itemissues + @issues = &itemissues($biblioitemnumber, $biblio); +Looks up information about who has borrowed the bookZ<>(s) with the +given biblioitemnumber. +C<$biblio> is ignored. -# -# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER -# - my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); - if ($currentborrower && $currentborrower eq $borrower->{'borrowernumber'}) { -# Already issued to current borrower. Ask whether the loan should -# be renewed. - my ($renewstatus) = renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); - if ($renewstatus == 0) { # no more renewals allowed - $issuingimpossible{NO_MORE_RENEWALS} = 1; - } else { - # $needsconfirmation{RENEW_ISSUE} = 1; - } - } elsif ($currentborrower) { -# issued to someone else - my $currborinfo = getpatroninformation(0,$currentborrower); -# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; - $needsconfirmation{ISSUED_TO_ANOTHER} = "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; - } -# See if the item is on reserve. - my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); - if ($restype) { - my $resbor = $res->{'borrowernumber'}; - if ($resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting") { - # The item is on reserve and waiting, but has been - # reserved by some other patron. - my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); - my $branches = GetBranches(); - my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; - $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; - # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine. - } elsif ($restype eq "Reserved") { - # The item is on reserve for someone else. - my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); - my $branches = GetBranches(); - my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; - $needsconfirmation{RESERVED} = "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; - } - } - if(C4::Context->preference("LibraryName") eq "Horowhenua Library Trust"){ - if ($borrower->{'categorycode'} eq 'W'){ - my %issuingimpossible; - return(\%issuingimpossible,\%needsconfirmation); - } else { - return(\%issuingimpossible,\%needsconfirmation); - } - } else { - return(\%issuingimpossible,\%needsconfirmation); - } -} +C<&itemissues> returns an array of references-to-hash. The keys +include the fields from the C table in the Koha database. +Additional keys include: -=head2 issuebook +=over 4 -Issue a book. Does no check, they are done in canbookbeissued. If we reach this sub, it means the user confirmed if needed. +=item C -&issuebook($env,$borrower,$barcode,$date) +If the item is currently on loan, this gives the due date. -=over 4 +If the item is not on loan, then this is either "Available" or +"Cancelled", if the item has been withdrawn. -C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it. +=item C -C<$borrower> hash with borrower informations (from getpatroninformation) +If the item is currently on loan, this gives the card number of the +patron who currently has the item. -C<$barcode> is the bar code of the book being issued. +=item C, C, C -C<$date> contains the max date of return. calculated if empty. +These give the timestamp for the last three times the item was +borrowed. -=cut +=item C, C, C -# -# issuing book. We already have checked it can be issued, so, just issue it ! -# -sub issuebook { - my ($env,$borrower,$barcode,$date,$cancelreserve) = @_; - my $dbh = C4::Context->dbh; -# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0); - my $iteminformation = getiteminformation($env, 0, $barcode); -# warn "B : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; -# -# check if we just renew the issue. -# - my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); - if ($currentborrower eq $borrower->{'borrowernumber'}) { - my ($charge,$itemtype) = calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}); - if ($charge > 0) { - createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge); - $iteminformation->{'charge'} = $charge; - } - &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); - renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); - } else { -# -# NOT a renewal -# - if ($currentborrower ne '') { - # This book is currently on loan, but not to the person - # who wants to borrow it now. mark it returned before issuing to the new borrower - returnbook($iteminformation->{'barcode'}, $env->{'branchcode'}); - } - # See if the item is on reserve. - my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); - if ($restype) { - my $resbor = $res->{'borrowernumber'}; - if ($resbor eq $borrower->{'borrowernumber'}) { - # The item is on reserve to the current patron - FillReserve($res); - warn "FillReserve"; - } elsif ($restype eq "Waiting") { - warn "Waiting"; - # The item is on reserve and waiting, but has been - # reserved by some other patron. - my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); - my $branches = GetBranches(); - my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; - if ($cancelreserve){ - CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); - } else { - # set waiting reserve to first in reserve queue as book isn't waiting now - UpdateReserve(1, $res->{'biblionumber'}, $res->{'borrowernumber'}, $res->{'branchcode'}); - } - } elsif ($restype eq "Reserved") { -# warn "Reserved"; - # The item is on reserve for someone else. - my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); - my $branches = GetBranches(); - my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; - if ($cancelreserve) { - # cancel reserves on this item - CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); - # also cancel reserve on biblio related to this item - #my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?"); - #$st_Fbiblio->execute($res->{'itemnumber'}); - #my $biblionumber = $st_Fbiblio->fetchrow; - #CancelReserve($biblionumber,0,$res->{'borrowernumber'}); - #warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}"; - } else { -# my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'}); -# transferbook($tobrcd,$barcode, 1); -# warn "transferbook"; - } - } - } - # 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 @datearr = localtime($datedue); - my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; - if ($date) { - $dateduef=$date; - } - # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate - if (C4::Context->preference('ReturnBeforeExpiry') && $dateduef gt $borrower->{expiry}) { - $dateduef=$borrower->{expiry}; - } - $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->finish; - &itemseen($iteminformation->{'itemnumber'}); - itemborrowed($iteminformation->{'itemnumber'}); - # If it costs to borrow this book, charge it to the patron's account. - my ($charge,$itemtype)=calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}); - if ($charge > 0) { - createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge); - $iteminformation->{'charge'}=$charge; - } - # Record the fact that this book was issued. - &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); - } -} +The card number of the last three patrons who borrowed this item. -=head2 getLoanLength +=item C, C, C -Get loan length for an itemtype, a borrower type and a branch +The borrower number of the last three patrons who borrowed this item. -my $loanlength = &getLoanLength($borrowertype,$itemtype,branchcode) +=back =cut -sub getLoanLength { - my ($borrowertype,$itemtype,$branchcode) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"); - # try to find issuelength & return the 1st available. - # check with borrowertype, itemtype and branchcode, then without one of those parameters - $sth->execute($borrowertype,$itemtype,$branchcode); - my $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - - $sth->execute($borrowertype,$itemtype,""); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - - $sth->execute($borrowertype,"*",$branchcode); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; +#' +sub itemissues { + my ( $bibitem, $biblio ) = @_; + my $dbh = C4::Context->dbh; + + # FIXME - If this function die()s, the script will abort, and the + # user won't get anything; depending on how far the script has + # gotten, the user might get a blank page. It would be much better + # to at least print an error message. The easiest way to do this + # is to set $SIG{__DIE__}. + my $sth = + $dbh->prepare("Select * from items where items.biblioitemnumber = ?") + || die $dbh->errstr; + my $i = 0; + my @results; + + $sth->execute($bibitem) || die $sth->errstr; + + while ( my $data = $sth->fetchrow_hashref ) { + + # Find out who currently has this item. + # FIXME - Wouldn't it be better to do this as a left join of + # some sort? Currently, this code assumes that if + # fetchrow_hashref() fails, then the book is on the shelf. + # fetchrow_hashref() can fail for any number of reasons (e.g., + # database server crash), not just because no items match the + # search criteria. + my $sth2 = $dbh->prepare( + "select * from issues,borrowers +where itemnumber = ? +and returndate is NULL +and issues.borrowernumber = borrowers.borrowernumber" + ); - $sth->execute("*",$itemtype,$branchcode); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + $sth2->execute( $data->{'itemnumber'} ); + if ( my $data2 = $sth2->fetchrow_hashref ) { + $data->{'date_due'} = $data2->{'date_due'}; + $data->{'card'} = $data2->{'cardnumber'}; + $data->{'borrower'} = $data2->{'borrowernumber'}; + } + else { + if ( $data->{'wthdrawn'} eq '1' ) { + $data->{'date_due'} = 'Cancelled'; + } + else { + $data->{'date_due'} = 'Available'; + } # else + } # else - $sth->execute($borrowertype,"*",""); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + $sth2->finish; - $sth->execute("*","*",$branchcode); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + # Find the last 3 people who borrowed this item. + $sth2 = $dbh->prepare( + "select * from issues, borrowers + where itemnumber = ? + and issues.borrowernumber = borrowers.borrowernumber + and returndate is not NULL + order by returndate desc,timestamp desc" + ); - $sth->execute("*",$itemtype,""); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; +# $sth2 = $dbh->prepare(" +# SELECT * +# FROM issues +# LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber +# WHERE itemnumber = ? +# AND returndate is not NULL +# ORDER BY returndate DESC,timestamp DESC +# "); + + $sth2->execute( $data->{'itemnumber'} ); + for ( my $i2 = 0 ; $i2 < 2 ; $i2++ ) + { # FIXME : error if there is less than 3 pple borrowing this item + if ( my $data2 = $sth2->fetchrow_hashref ) { + $data->{"timestamp$i2"} = $data2->{'timestamp'}; + $data->{"card$i2"} = $data2->{'cardnumber'}; + $data->{"borrower$i2"} = $data2->{'borrowernumber'}; + } # if + } # for - $sth->execute("*","*",""); - $loanlength = $sth->fetchrow_hashref; - return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + $sth2->finish; + $results[$i] = $data; + $i++; + } - # if no rule is set => 21 days (hardcoded) - return 21; + $sth->finish; + return (@results); } -=head2 returnbook - ($doreturn, $messages, $iteminformation, $borrower) = - &returnbook($barcode, $branch); +=head2 canbookbeissued -Returns a book. +$issuingimpossible, $needsconfirmation = + canbookbeissued( $env, $borrower, $barcode, $year, $month, $day, $inprocess ); -C<$barcode> is the bar code of the book being returned. C<$branch> is -the code of the branch where the book is being returned. +C<$issuingimpossible> and C<$needsconfirmation> are some hashref. -C<&returnbook> returns a list of four items: +=cut -C<$doreturn> is true iff the return succeeded. +sub canbookbeissued { + my ( $env, $borrower, $barcode, $year, $month, $day, $inprocess ) = @_; + my %needsconfirmation; # filled with problems that needs confirmations + my %issuingimpossible + ; # filled with problems that causes the issue to be IMPOSSIBLE + my $iteminformation = getiteminformation( 0, $barcode ); + my $dbh = C4::Context->dbh; + + # + # DUE DATE is OK ? + # + my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day ); + $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate); + + # + # BORROWER STATUS + # + if ( $borrower->{flags}->{GNA} ) { + $issuingimpossible{GNA} = 1; + } + if ( $borrower->{flags}->{'LOST'} ) { + $issuingimpossible{CARD_LOST} = 1; + } + if ( $borrower->{flags}->{'DBARRED'} ) { + $issuingimpossible{DEBARRED} = 1; + } + if ( Date_to_Days(Today) > + Date_to_Days( split "-", $borrower->{'dateexpiry'} ) ) + { -C<$messages> is a reference-to-hash giving the reason for failure: + # + #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0) { + $issuingimpossible{EXPIRED} = 1; + } -=over 4 + # + # BORROWER STATUS + # + + # DEBTS + my $amount = + checkaccount( $env, $borrower->{'borrowernumber'}, $dbh, $duedate ); + if ( C4::Context->preference("IssuingInProcess") ) { + my $amountlimit = C4::Context->preference("noissuescharge"); + if ( $amount > $amountlimit && !$inprocess ) { + $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); + } + elsif ( $amount <= $amountlimit && !$inprocess ) { + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); + } + } + else { + if ( $amount > 0 ) { + $needsconfirmation{DEBT} = $amount; + } + } -=item C + # + # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS + # + my $toomany = TooMany( $borrower, $iteminformation ); + $needsconfirmation{TOO_MANY} = $toomany if $toomany; + + # + # ITEM CHECKING + # + unless ( $iteminformation->{barcode} ) { + $issuingimpossible{UNKNOWN_BARCODE} = 1; + } + if ( $iteminformation->{'notforloan'} + && $iteminformation->{'notforloan'} > 0 ) + { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } + if ( $iteminformation->{'itemtype'} + && $iteminformation->{'itemtype'} eq 'REF' ) + { + $issuingimpossible{NOT_FOR_LOAN} = 1; + } + if ( $iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1 ) + { + $issuingimpossible{WTHDRAWN} = 1; + } + if ( $iteminformation->{'restricted'} + && $iteminformation->{'restricted'} == 1 ) + { + $issuingimpossible{RESTRICTED} = 1; + } + if ( C4::Context->preference("IndependantBranches") ) { + my $userenv = C4::Context->userenv; + if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { + $issuingimpossible{NOTSAMEBRANCH} = 1 + if ( $iteminformation->{'holdingbranch'} ne $userenv->{branch} ); + } + } -No item with this barcode exists. The value is C<$barcode>. + # + # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER + # + my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} ); + if ( $currentborrower && $currentborrower eq $borrower->{'borrowernumber'} ) + { + + # Already issued to current borrower. Ask whether the loan should + # be renewed. + my ($renewstatus) = renewstatus( + $env, + $borrower->{'borrowernumber'}, + $iteminformation->{'itemnumber'} + ); + if ( $renewstatus == 0 ) { # no more renewals allowed + $issuingimpossible{NO_MORE_RENEWALS} = 1; + } + else { -=item C + # $needsconfirmation{RENEW_ISSUE} = 1; + } + } + elsif ($currentborrower) { -The book is not currently on loan. The value is C<$barcode>. + # issued to someone else + my $currborinfo = getpatroninformation( 0, $currentborrower ); -=item C +# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; + $needsconfirmation{ISSUED_TO_ANOTHER} = +"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; + } + + # See if the item is on reserve. + my ( $restype, $res ) = CheckReserves( $iteminformation->{'itemnumber'} ); + if ($restype) { + my $resbor = $res->{'borrowernumber'}; + if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" ) + { + + # The item is on reserve and waiting, but has been + # reserved by some other patron. + my ( $resborrower, $flags ) = + getpatroninformation( $env, $resbor, 0 ); + my $branches = GetBranches(); + my $branchname = + $branches->{ $res->{'branchcode'} }->{'branchname'}; + $needsconfirmation{RESERVE_WAITING} = +"$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; + +# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine. + } + elsif ( $restype eq "Reserved" ) { + + # The item is on reserve for someone else. + my ( $resborrower, $flags ) = + getpatroninformation( $env, $resbor, 0 ); + my $branches = GetBranches(); + my $branchname = + $branches->{ $res->{'branchcode'} }->{'branchname'}; + $needsconfirmation{RESERVED} = +"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; + } + } + if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) + { + if ( $borrower->{'categorycode'} eq 'W' ) { + my %issuingimpossible; + return ( \%issuingimpossible, \%needsconfirmation ); + } + else { + return ( \%issuingimpossible, \%needsconfirmation ); + } + } + else { + return ( \%issuingimpossible, \%needsconfirmation ); + } +} + +=head2 issuebook + +Issue a book. Does no check, they are done in canbookbeissued. If we reach this sub, it means the user confirmed if needed. + +&issuebook($env,$borrower,$barcode,$date) + +=over 4 + +=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it. + +=item C<$borrower> hash with borrower informations (from getpatroninformation) + +=item C<$barcode> is the bar code of the book being issued. + +=item C<$date> contains the max date of return. calculated if empty. + +=back + +=cut + +sub issuebook { + my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_; + my $dbh = C4::Context->dbh; + +# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0); + my $iteminformation = getiteminformation( 0, $barcode ); + +# +# check if we just renew the issue. +# + my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} ); + if ( $currentborrower eq $borrower->{'borrowernumber'} ) { + my ( $charge, $itemtype ) = calc_charges( + $env, + $iteminformation->{'itemnumber'}, + $borrower->{'borrowernumber'} + ); + if ( $charge > 0 ) { + createcharge( + $env, $dbh, + $iteminformation->{'itemnumber'}, + $borrower->{'borrowernumber'}, $charge + ); + $iteminformation->{'charge'} = $charge; + } + &UpdateStats( + $env, $env->{'branchcode'}, + 'renew', $charge, + '', $iteminformation->{'itemnumber'}, + $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'} + ); + renewbook( + $env, + $borrower->{'borrowernumber'}, + $iteminformation->{'itemnumber'} + ); + } + else { + + # + # NOT a renewal + # + if ( $currentborrower ne '' ) { + +# This book is currently on loan, but not to the person +# who wants to borrow it now. mark it returned before issuing to the new borrower + returnbook( + $iteminformation->{'barcode'}, + C4::Context->userenv->{'branch'} + ); + } + + # See if the item is on reserve. + my ( $restype, $res ) = + CheckReserves( $iteminformation->{'itemnumber'} ); + if ($restype) { + my $resbor = $res->{'borrowernumber'}; + if ( $resbor eq $borrower->{'borrowernumber'} ) { + + # The item is on reserve to the current patron + FillReserve($res); + } + elsif ( $restype eq "Waiting" ) { + + # warn "Waiting"; + # The item is on reserve and waiting, but has been + # reserved by some other patron. + my ( $resborrower, $flags ) = + getpatroninformation( $env, $resbor, 0 ); + my $branches = GetBranches(); + my $branchname = + $branches->{ $res->{'branchcode'} }->{'branchname'}; + if ($cancelreserve) { + CancelReserve( 0, $res->{'itemnumber'}, + $res->{'borrowernumber'} ); + } + else { + + # set waiting reserve to first in reserve queue as book isn't waiting now + UpdateReserve( + 1, + $res->{'biblionumber'}, + $res->{'borrowernumber'}, + $res->{'branchcode'} + ); + } + } + elsif ( $restype eq "Reserved" ) { + + # warn "Reserved"; + # The item is on reserve for someone else. + my ( $resborrower, $flags ) = + getpatroninformation( $env, $resbor, 0 ); + my $branches = GetBranches(); + my $branchname = + $branches->{ $res->{'branchcode'} }->{'branchname'}; + if ($cancelreserve) { + + # cancel reserves on this item + CancelReserve( 0, $res->{'itemnumber'}, + $res->{'borrowernumber'} ); + +# also cancel reserve on biblio related to this item +#my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?"); +#$st_Fbiblio->execute($res->{'itemnumber'}); +#my $biblionumber = $st_Fbiblio->fetchrow; +#CancelReserve($biblionumber,0,$res->{'borrowernumber'}); +#warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}"; + } + else { + +# my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'}); +# transferbook($tobrcd,$barcode, 1); +# warn "transferbook"; + } + } + } +# END OF THE RESTYPE WORK + +# Starting process for transfer job (checking transfert and validate it if we have one) + + my ($datesent) = get_transfert_infos($iteminformation->{'itemnumber'}); + + if ($datesent) { +# updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....) + my $sth = + $dbh->prepare( + "update branchtransfers set datearrived = now(), + tobranch = ?, + comments = 'Forced branchtransfert' + where + itemnumber= ? AND datearrived IS NULL" + ); + $sth->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); + $sth->finish; + } + +# Ending process for transfert check + + # Record in the database the fact that the book was issued. + my $sth = + $dbh->prepare( +"insert into issues (borrowernumber, itemnumber,issuedate, date_due, branchcode) values (?,?,?,?,?)" + ); + my $loanlength = getLoanLength( + $borrower->{'categorycode'}, + $iteminformation->{'itemtype'}, + $borrower->{'branchcode'} + ); + my $datedue = time + ($loanlength) * 86400; + my @datearr = localtime($datedue); + my $dateduef = + ( 1900 + $datearr[5] ) . "-" + . ( $datearr[4] + 1 ) . "-" + . $datearr[3]; + if ($date) { + $dateduef = $date; + } + + # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate + if ( C4::Context->preference('ReturnBeforeExpiry') + && $dateduef gt $borrower->{dateexpiry} ) + { + $dateduef = $borrower->{dateexpiry}; + } + $sth->execute( + $borrower->{'borrowernumber'}, + $iteminformation->{'itemnumber'}, + strftime( "%Y-%m-%d", localtime ),$dateduef, $env->{'branchcode'} + ); + $sth->finish; + $iteminformation->{'issues'}++; + $sth = + $dbh->prepare( + "update items set issues=?, holdingbranch=? where itemnumber=?"); + $sth->execute( + $iteminformation->{'issues'}, + C4::Context->userenv->{'branch'}, + $iteminformation->{'itemnumber'} + ); + $sth->finish; + &itemseen( $iteminformation->{'itemnumber'} ); + itemborrowed( $iteminformation->{'itemnumber'} ); + + # If it costs to borrow this book, charge it to the patron's account. + my ( $charge, $itemtype ) = calc_charges( + $env, + $iteminformation->{'itemnumber'}, + $borrower->{'borrowernumber'} + ); + if ( $charge > 0 ) { + createcharge( + $env, $dbh, + $iteminformation->{'itemnumber'}, + $borrower->{'borrowernumber'}, $charge + ); + $iteminformation->{'charge'} = $charge; + } + + # Record the fact that this book was issued. + &UpdateStats( + $env, $env->{'branchcode'}, + 'issue', $charge, + '', $iteminformation->{'itemnumber'}, + $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'} + ); + } + + &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$iteminformation->{'biblionumber'}) + if C4::Context->preference("IssueLog"); + +} + +=head2 getLoanLength + +Get loan length for an itemtype, a borrower type and a branch + +my $loanlength = &getLoanLength($borrowertype,$itemtype,branchcode) + +=cut + +sub getLoanLength { + my ( $borrowertype, $itemtype, $branchcode ) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( +"select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?" + ); + +# try to find issuelength & return the 1st available. +# check with borrowertype, itemtype and branchcode, then without one of those parameters + $sth->execute( $borrowertype, $itemtype, $branchcode ); + my $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( $borrowertype, $itemtype, "" ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( $borrowertype, "*", $branchcode ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( "*", $itemtype, $branchcode ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( $borrowertype, "*", "" ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( "*", "*", $branchcode ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( "*", $itemtype, "" ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + $sth->execute( "*", "*", "" ); + $loanlength = $sth->fetchrow_hashref; + return $loanlength->{issuelength} + if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; + + # if no rule is set => 21 days (hardcoded) + return 21; +} + +=head2 returnbook + +($doreturn, $messages, $iteminformation, $borrower) = + &returnbook($barcode, $branch); + +Returns a book. + +C<$barcode> is the bar code of the book being returned. C<$branch> is +the code of the branch where the book is being returned. + +C<&returnbook> returns a list of four items: + +C<$doreturn> is true iff the return succeeded. + +C<$messages> is a reference-to-hash giving the reason for failure: + +=over 4 + +=item C + +No item with this barcode exists. The value is C<$barcode>. + +=item C + +The book is not currently on loan. The value is C<$barcode>. + +=item C The book's home branch is a permanent collection. If you have borrowed this book, you are not allowed to return it. The value is the code for @@ -1146,107 +1530,147 @@ patron who last borrowed the book. # is more C-ish than Perl-ish). sub returnbook { - 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(\%env, 0, $barcode); - if (not $iteminformation) { - $messages->{'BadBarcode'} = $barcode; - $doreturn = 0; - } - # find the borrower - my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); - if ((not $currentborrower) && $doreturn) { - $messages->{'NotIssued'} = $barcode; - $doreturn = 0; - } - # check if the book is in a permanent collection.... - my $hbr = $iteminformation->{'homebranch'}; - my $branches = GetBranches(); - if ($hbr && $branches->{$hbr}->{'PE'}) { - $messages->{'IsPermanent'} = $hbr; - } - # check that the book has been cancelled - if ($iteminformation->{'wthdrawn'}) { - $messages->{'wthdrawn'} = 1; - $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); - 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'}); - -# 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'}); - $sth_upd_location->finish; - $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'}; - } - - $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? - } - 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? -# } - - # fix up the accounts..... - if ($iteminformation->{'itemlost'}) { - fixaccountforlostandreturned($iteminformation, $borrower); - $messages->{'WasLost'} = 1; # FIXME is the "= 1" right? - } -# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # -# check if we have a transfer for this document - my $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'}); - } -# 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'}); - $messages->{'WasTransfered'} = 1; - } - } -# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # - # fix up the overdues in accounts... - fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); - # find reserves..... -# if we don't have a reserve with the status W, we launch the Checkreserves routine - my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'}); - if ($resfound) { - # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'}); - $resrec->{'ResFound'} = $resfound; - $messages->{'ResFound'} = $resrec; - } - # 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); + my ( $barcode, $branch ) = @_; + my %env; + my $messages; + my $dbh = C4::Context->dbh; + my $doreturn = 1; + my $validTransfert = 0; + my $reserveDone = 0; + + die '$branch not defined' unless defined $branch; # just in case (bug 170) + # get information on item + my ($iteminformation) = getiteminformation( 0, $barcode ); + + if ( not $iteminformation ) { + $messages->{'BadBarcode'} = $barcode; + $doreturn = 0; + } + + # find the borrower + my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} ); + if ( ( not $currentborrower ) && $doreturn ) { + $messages->{'NotIssued'} = $barcode; + $doreturn = 0; + } + + # check if the book is in a permanent collection.... + my $hbr = $iteminformation->{'homebranch'}; + my $branches = GetBranches(); + if ( $hbr && $branches->{$hbr}->{'PE'} ) { + $messages->{'IsPermanent'} = $hbr; + } + + # check that the book has been cancelled + if ( $iteminformation->{'wthdrawn'} ) { + $messages->{'wthdrawn'} = 1;itemnumber + $doreturn = 0; + } + +# new op dev : if the book returned in an other branch update the holding branch + +# update issues, thereby returning book (should push this out into another subroutine + my ($borrower) = getpatroninformation( \%env, $currentborrower, 0 ); + +# case of a return of document (deal with issues and holdingbranch) + + if ($doreturn) { + my $sth = + $dbh->prepare( +"update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)" + ); + $sth->execute( $borrower->{'borrowernumber'}, + $iteminformation->{'itemnumber'} ); + $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? + } + +# continue to deal with returns cases, but not only if we have an issue + +# the holdingbranch is updated if the document is returned in an other location . +if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) + { + UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); +# reload iteminformation holdingbranch with the userenv value + $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'}; + } + itemseen( $iteminformation->{'itemnumber'} ); + ($borrower) = getpatroninformation( \%env, $currentborrower, 0 ); + + # fix up the accounts..... + if ( $iteminformation->{'itemlost'} ) { + fixaccountforlostandreturned( $iteminformation, $borrower ); + $messages->{'WasLost'} = 1; # FIXME is the "= 1" right? + } + + # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # + # check if we have a transfer for this document + my ($datesent,$frombranch,$tobranch) = checktransferts( $iteminformation->{'itemnumber'} ); + + # if we have a return, we update the line of transfers with the datearrived + if ($datesent) { + if ( $tobranch eq C4::Context->userenv->{'branch'} ) { + my $sth = + $dbh->prepare( + "update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL" + ); + $sth->execute( $iteminformation->{'itemnumber'} ); + $sth->finish; +# now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W' + SetWaitingStatus( $iteminformation->{'itemnumber'} ); + } + else { + $messages->{'WrongTransfer'} = $tobranch; + $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'}; + } + $validTransfert = 1; + } + +# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# fix up the overdues in accounts... + fixoverduesonreturn( $borrower->{'borrowernumber'}, + $iteminformation->{'itemnumber'} ); + +# find reserves..... +# if we don't have a reserve with the status W, we launch the Checkreserves routine + my ( $resfound, $resrec ) = + CheckReserves( $iteminformation->{'itemnumber'} ); + if ($resfound) { + +# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'}); + $resrec->{'ResFound'} = $resfound; + $messages->{'ResFound'} = $resrec; + $reserveDone = 1; + } + + # update stats? + # Record the fact that this book was returned. + UpdateStats( + \%env, $branch, 'return', '0', '', + $iteminformation->{'itemnumber'}, + $iteminformation->{'itemtype'}, + $borrower->{'borrowernumber'} + ); + + &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$currentborrower,$iteminformation->{'biblionumber'}) + if C4::Context->preference("ReturnLog"); + + #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch + #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch . + + if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){ + if (C4::Context->preference("AutomaticItemReturn") == 1) { + dotransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'}); + $messages->{'WasTransfered'} = 1; + warn "was transfered"; + } + } + + return ( $doreturn, $messages, $iteminformation, $borrower ); } =head2 fixaccountforlostandreturned - &fixaccountforlostandreturned($iteminfo,$borrower); + &fixaccountforlostandreturned($iteminfo,$borrower); Calculates the charge for a book lost and returned (Not exported & used only once) @@ -1257,93 +1681,125 @@ C<$borrower> is a hashref to borrower. Only {borrowernumber is used. =cut sub fixaccountforlostandreturned { - my ($iteminfo, $borrower) = @_; - my %env; - my $dbh = C4::Context->dbh; - my $itm = $iteminfo->{'itemnumber'}; - # check for charge made for lost book - my $sth = $dbh->prepare("select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc"); - $sth->execute($itm); - if (my $data = $sth->fetchrow_hashref) { - # writeoff this amount - my $offset; - my $amount = $data->{'amount'}; - my $acctno = $data->{'accountno'}; - my $amountleft; - if ($data->{'amountoutstanding'} == $amount) { - $offset = $data->{'amount'}; - $amountleft = 0; - } else { - $offset = $amount - $data->{'amountoutstanding'}; - $amountleft = $data->{'amountoutstanding'} - $amount; - } - my $usth = $dbh->prepare("update accountlines set accounttype = 'LR',amountoutstanding='0' - where (borrowernumber = ?) - and (itemnumber = ?) and (accountno = ?) "); - $usth->execute($data->{'borrowernumber'},$itm,$acctno); - $usth->finish; - #check if any credit is left if so writeoff other accounts - my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh); - if ($amountleft < 0){ - $amountleft*=-1; - } - if ($amountleft > 0){ - my $msth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) - and (amountoutstanding >0) order by date"); - $msth->execute($data->{'borrowernumber'}); - # offset transactions - my $newamtos; - my $accdata; - while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){ - if ($accdata->{'amountoutstanding'} < $amountleft) { - $newamtos = 0; - $amountleft -= $accdata->{'amountoutstanding'}; - } else { - $newamtos = $accdata->{'amountoutstanding'} - $amountleft; - $amountleft = 0; - } - my $thisacct = $accdata->{'accountno'}; - my $usth = $dbh->prepare("update accountlines set amountoutstanding= ? - where (borrowernumber = ?) - and (accountno=?)"); - $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct'); - $usth->finish; - $usth = $dbh->prepare("insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values - (?,?,?,?)"); - $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos); - $usth->finish; - } - $msth->finish; - } - if ($amountleft > 0){ - $amountleft*=-1; - } - my $desc="Book Returned ".$iteminfo->{'barcode'}; - $usth = $dbh->prepare("insert into accountlines - (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) - values (?,?,now(),?,?,'CR',?)"); - $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft); - $usth->finish; - $usth = $dbh->prepare("insert into accountoffsets - (borrowernumber, accountno, offsetaccount, offsetamount) - values (?,?,?,?)"); - $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset); - $usth->finish; - $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?"); - $usth->execute($itm); - $usth->finish; - } - $sth->finish; - return; + my ( $iteminfo, $borrower ) = @_; + my %env; + my $dbh = C4::Context->dbh; + my $itm = $iteminfo->{'itemnumber'}; + + # check for charge made for lost book + my $sth = + $dbh->prepare( +"select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc" + ); + $sth->execute($itm); + if ( my $data = $sth->fetchrow_hashref ) { + + # writeoff this amount + my $offset; + my $amount = $data->{'amount'}; + my $acctno = $data->{'accountno'}; + my $amountleft; + if ( $data->{'amountoutstanding'} == $amount ) { + $offset = $data->{'amount'}; + $amountleft = 0; + } + else { + $offset = $amount - $data->{'amountoutstanding'}; + $amountleft = $data->{'amountoutstanding'} - $amount; + } + my $usth = $dbh->prepare( + "update accountlines set accounttype = 'LR',amountoutstanding='0' + where (borrowernumber = ?) + and (itemnumber = ?) and (accountno = ?) " + ); + $usth->execute( $data->{'borrowernumber'}, $itm, $acctno ); + $usth->finish; + + #check if any credit is left if so writeoff other accounts + my $nextaccntno = + getnextacctno( \%env, $data->{'borrowernumber'}, $dbh ); + if ( $amountleft < 0 ) { + $amountleft *= -1; + } + if ( $amountleft > 0 ) { + my $msth = $dbh->prepare( + "select * from accountlines where (borrowernumber = ?) + and (amountoutstanding >0) order by date" + ); + $msth->execute( $data->{'borrowernumber'} ); + + # offset transactions + my $newamtos; + my $accdata; + while ( ( $accdata = $msth->fetchrow_hashref ) + and ( $amountleft > 0 ) ) + { + if ( $accdata->{'amountoutstanding'} < $amountleft ) { + $newamtos = 0; + $amountleft -= $accdata->{'amountoutstanding'}; + } + else { + $newamtos = $accdata->{'amountoutstanding'} - $amountleft; + $amountleft = 0; + } + my $thisacct = $accdata->{'accountno'}; + my $usth = $dbh->prepare( + "update accountlines set amountoutstanding= ? + where (borrowernumber = ?) + and (accountno=?)" + ); + $usth->execute( $newamtos, $data->{'borrowernumber'}, + '$thisacct' ); + $usth->finish; + $usth = $dbh->prepare( + "insert into accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + values + (?,?,?,?)" + ); + $usth->execute( + $data->{'borrowernumber'}, + $accdata->{'accountno'}, + $nextaccntno, $newamtos + ); + $usth->finish; + } + $msth->finish; + } + if ( $amountleft > 0 ) { + $amountleft *= -1; + } + my $desc = "Book Returned " . $iteminfo->{'barcode'}; + $usth = $dbh->prepare( + "insert into accountlines + (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) + values (?,?,now(),?,?,'CR',?)" + ); + $usth->execute( + $data->{'borrowernumber'}, + $nextaccntno, 0 - $amount, + $desc, $amountleft + ); + $usth->finish; + $usth = $dbh->prepare( + "insert into accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + values (?,?,?,?)" + ); + $usth->execute( $borrower->{'borrowernumber'}, + $data->{'accountno'}, $nextaccntno, $offset ); + $usth->finish; + $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?"); + $usth->execute($itm); + $usth->finish; + } + $sth->finish; + return; } =head2 fixoverdueonreturn - &fixoverdueonreturn($brn,$itm); - -?? + &fixoverdueonreturn($brn,$itm); C<$brn> borrowernumber @@ -1352,201 +1808,263 @@ C<$itm> itemnumber =cut sub fixoverduesonreturn { - my ($brn, $itm) = @_; - my $dbh = C4::Context->dbh; - # check for overdue fine - my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')"); - $sth->execute($brn,$itm); - # alter fine to show that the book has been returned - if (my $data = $sth->fetchrow_hashref) { - my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (acccountno = ?)"); - $usth->execute($brn,$itm,$data->{'accountno'}); - $usth->finish(); - } - $sth->finish(); - return; + my ( $brn, $itm ) = @_; + my $dbh = C4::Context->dbh; + + # check for overdue fine + my $sth = + $dbh->prepare( +"select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')" + ); + $sth->execute( $brn, $itm ); + + # alter fine to show that the book has been returned + if ( my $data = $sth->fetchrow_hashref ) { + my $usth = + $dbh->prepare( +"update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)" + ); + $usth->execute( $brn, $itm, $data->{'accountno'} ); + $usth->finish(); + } + $sth->finish(); + return; } -# 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 - my %flags; - my ($env, $patroninformation, $dbh) = @_; - my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh); - if ($amount > 0) { - my %flaginfo; - my $noissuescharge = C4::Context->preference("noissuescharge"); - $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; - if ($amount > $noissuescharge) { - $flaginfo{'noissues'} = 1; - } - $flags{'CHARGES'} = \%flaginfo; - } elsif ($amount < 0){ - my %flaginfo; - $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount; - $flags{'CHARGES'} = \%flaginfo; - } - if ($patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1) { - my %flaginfo; - $flaginfo{'message'} = 'Borrower has no valid address.'; - $flaginfo{'noissues'} = 1; - $flags{'GNA'} = \%flaginfo; - } - if ($patroninformation->{'lost'} && $patroninformation->{'lost'} == 1) { - my %flaginfo; - $flaginfo{'message'} = 'Borrower\'s card reported lost.'; - $flaginfo{'noissues'} = 1; - $flags{'LOST'} = \%flaginfo; - } - if ($patroninformation->{'debarred'} && $patroninformation->{'debarred'} == 1) { - my %flaginfo; - $flaginfo{'message'} = 'Borrower is Debarred.'; - $flaginfo{'noissues'} = 1; - $flags{'DBARRED'} = \%flaginfo; - } - if ($patroninformation->{'borrowernotes'} && $patroninformation->{'borrowernotes'}) { - my %flaginfo; - $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; - $flags{'NOTES'} = \%flaginfo; - } - my ($odues, $itemsoverdue) - = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh); - if ($odues > 0) { - my %flaginfo; - $flaginfo{'message'} = "Yes"; - $flaginfo{'itemlist'} = $itemsoverdue; - foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) { - $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; - } - $flags{'ODUES'} = \%flaginfo; - } - my ($nowaiting, $itemswaiting) - = CheckWaiting($patroninformation->{'borrowernumber'}); - if ($nowaiting > 0) { - my %flaginfo; - $flaginfo{'message'} = "Reserved items available"; - $flaginfo{'itemlist'} = $itemswaiting; - $flags{'WAITING'} = \%flaginfo; - } - return(\%flags); + + # Original subroutine for Circ2.pm + my %flags; + my ( $env, $patroninformation, $dbh ) = @_; + my $amount = + checkaccount( $env, $patroninformation->{'borrowernumber'}, $dbh ); + if ( $amount > 0 ) { + my %flaginfo; + my $noissuescharge = C4::Context->preference("noissuescharge"); + $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount; + if ( $amount > $noissuescharge ) { + $flaginfo{'noissues'} = 1; + } + $flags{'CHARGES'} = \%flaginfo; + } + elsif ( $amount < 0 ) { + my %flaginfo; + $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount; + $flags{'CHARGES'} = \%flaginfo; + } + if ( $patroninformation->{'gonenoaddress'} + && $patroninformation->{'gonenoaddress'} == 1 ) + { + my %flaginfo; + $flaginfo{'message'} = 'Borrower has no valid address.'; + $flaginfo{'noissues'} = 1; + $flags{'GNA'} = \%flaginfo; + } + if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) { + my %flaginfo; + $flaginfo{'message'} = 'Borrower\'s card reported lost.'; + $flaginfo{'noissues'} = 1; + $flags{'LOST'} = \%flaginfo; + } + if ( $patroninformation->{'debarred'} + && $patroninformation->{'debarred'} == 1 ) + { + my %flaginfo; + $flaginfo{'message'} = 'Borrower is Debarred.'; + $flaginfo{'noissues'} = 1; + $flags{'DBARRED'} = \%flaginfo; + } + if ( $patroninformation->{'borrowernotes'} + && $patroninformation->{'borrowernotes'} ) + { + my %flaginfo; + $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; + $flags{'NOTES'} = \%flaginfo; + } + my ( $odues, $itemsoverdue ) = + checkoverdues( $env, $patroninformation->{'borrowernumber'}, $dbh ); + if ( $odues > 0 ) { + my %flaginfo; + $flaginfo{'message'} = "Yes"; + $flaginfo{'itemlist'} = $itemsoverdue; + foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} } + @$itemsoverdue ) + { + $flaginfo{'itemlisttext'} .= + "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; + } + $flags{'ODUES'} = \%flaginfo; + } + my $itemswaiting = + C4::Reserves2::GetWaitingReserves( $patroninformation->{'borrowernumber'} ); + my $nowaiting = scalar @$itemswaiting; + if ( $nowaiting > 0 ) { + my %flaginfo; + $flaginfo{'message'} = "Reserved items available"; + $flaginfo{'itemlist'} = $itemswaiting; + $flags{'WAITING'} = \%flaginfo; + } + return ( \%flags ); } +=head2 checkoverdues + +( $count, $overdueitems )=checkoverdues( $env, $borrowernumber, $dbh ); + +Not exported + +=cut -# 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, $bornum, $dbh)=@_; - my @datearr = localtime; - my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3]; - my @overdueitems; - my $count = 0; - my $sth = $dbh->prepare("SELECT * FROM issues,biblio,biblioitems,items - WHERE items.biblioitemnumber = biblioitems.biblioitemnumber - AND items.biblionumber = biblio.biblionumber - AND issues.itemnumber = items.itemnumber - AND issues.borrowernumber = ? - AND issues.returndate is NULL - AND issues.date_due < ?"); - $sth->execute($bornum,$today); - while (my $data = $sth->fetchrow_hashref) { - push (@overdueitems, $data); - $count++; - } - $sth->finish; - return ($count, \@overdueitems); +#checks whether a borrower has overdue items + my ( $env, $borrowernumber, $dbh ) = @_; + my @datearr = localtime; + my $today = + ( $datearr[5] + 1900 ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3]; + my @overdueitems; + my $count = 0; + my $sth = $dbh->prepare( + "SELECT * FROM issues,biblio,biblioitems,items + WHERE items.biblioitemnumber = biblioitems.biblioitemnumber + AND items.biblionumber = biblio.biblionumber + AND issues.itemnumber = items.itemnumber + AND issues.borrowernumber = ? + AND issues.returndate is NULL + AND issues.date_due < ?" + ); + $sth->execute( $borrowernumber, $today ); + while ( my $data = $sth->fetchrow_hashref ) { + push( @overdueitems, $data ); + $count++; + } + $sth->finish; + return ( $count, \@overdueitems ); } -# Not exported +=head2 currentborrower + +$borrower=currentborrower($itemnumber) + +Not exported + +=cut + sub currentborrower { -# Original subroutine for Circ2.pm - my ($itemnumber) = @_; - my $dbh = C4::Context->dbh; - my $q_itemnumber = $dbh->quote($itemnumber); - my $sth=$dbh->prepare("select borrowers.borrowernumber from - issues,borrowers where issues.itemnumber=$q_itemnumber and - issues.borrowernumber=borrowers.borrowernumber and issues.returndate is - NULL"); - $sth->execute; - my ($borrower) = $sth->fetchrow; - return($borrower); + + # Original subroutine for Circ2.pm + my ($itemnumber) = @_; + my $dbh = C4::Context->dbh; + my $q_itemnumber = $dbh->quote($itemnumber); + my $sth = $dbh->prepare( + "select borrowers.borrowernumber from + issues,borrowers where issues.itemnumber=$q_itemnumber and + issues.borrowernumber=borrowers.borrowernumber and issues.returndate is + NULL" + ); + $sth->execute; + my ($borrower) = $sth->fetchrow; + return ($borrower); } -# 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)=@_; - my $resbor = ""; - my $sth = $dbh->prepare("select * from reserves,items - where (items.itemnumber = ?) - and (reserves.cancellationdate is NULL) - and (items.biblionumber = reserves.biblionumber) - and ((reserves.found = 'W') - or (reserves.found is null)) - order by priority"); - $sth->execute($itemnum); - my $resrec; - my $data=$sth->fetchrow_hashref; - while ($data && $resbor eq '') { - $resrec=$data; - my $const = $data->{'constrainttype'}; - if ($const eq "a") { - $resbor = $data->{'borrowernumber'}; - } else { - my $found = 0; - my $csth = $dbh->prepare("select * from reserveconstraints,items - where (borrowernumber=?) - and reservedate=? - and reserveconstraints.biblionumber=? - and (items.itemnumber=? and - items.biblioitemnumber = reserveconstraints.biblioitemnumber)"); - $csth->execute($data->{'borrowernumber'},$data->{'biblionumber'},$data->{'reservedate'},$itemnum); - if (my $cdata=$csth->fetchrow_hashref) {$found = 1;} - if ($const eq 'o') { - if ($found eq 1) {$resbor = $data->{'borrowernumber'};} - } else { - if ($found eq 0) {$resbor = $data->{'borrowernumber'};} - } - $csth->finish(); - } - $data=$sth->fetchrow_hashref; - } - $sth->finish; - return ($resbor,$resrec); + + # Stolen from Main.pm + # Check for reserves for biblio + my ( $env, $dbh, $itemnum ) = @_; + my $resbor = ""; + my $sth = $dbh->prepare( + "select * from reserves,items + where (items.itemnumber = ?) + and (reserves.cancellationdate is NULL) + and (items.biblionumber = reserves.biblionumber) + and ((reserves.found = 'W') + or (reserves.found is null)) + order by priority" + ); + $sth->execute($itemnum); + my $resrec; + my $data = $sth->fetchrow_hashref; + while ( $data && $resbor eq '' ) { + $resrec = $data; + my $const = $data->{'constrainttype'}; + if ( $const eq "a" ) { + $resbor = $data->{'borrowernumber'}; + } + else { + my $found = 0; + my $csth = $dbh->prepare( + "select * from reserveconstraints,items + where (borrowernumber=?) + and reservedate=? + and reserveconstraints.biblionumber=? + and (items.itemnumber=? and + items.biblioitemnumber = reserveconstraints.biblioitemnumber)" + ); + $csth->execute( + $data->{'borrowernumber'}, + $data->{'biblionumber'}, + $data->{'reservedate'}, $itemnum + ); + if ( my $cdata = $csth->fetchrow_hashref ) { $found = 1; } + if ( $const eq 'o' ) { + if ( $found eq 1 ) { $resbor = $data->{'borrowernumber'}; } + } + else { + if ( $found eq 0 ) { $resbor = $data->{'borrowernumber'}; } + } + $csth->finish(); + } + $data = $sth->fetchrow_hashref; + } + $sth->finish; + return ( $resbor, $resrec ); } =head2 currentissues - $issues = ¤tissues($env, $borrower); +$issues = ¤tissues($env, $borrower); Returns a list of books currently on loan to a patron. @@ -1571,85 +2089,100 @@ Koha database for that particular item. #' sub currentissues { -# New subroutine for Circ2.pm - my ($env, $borrower) = @_; - my $dbh = C4::Context->dbh; - my %currentissues; - my $counter=1; - my $borrowernumber = $borrower->{'borrowernumber'}; - my $crit=''; - - # Figure out whether to get the books issued today, or earlier. - # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can - # both be specified, but are mutually-exclusive. This is bogus. - # Make this a flag. Or better yet, return everything in (reverse) - # chronological order and let the caller figure out which books - # were issued today. - if ($env->{'todaysissues'}) { - # FIXME - Could use - # $today = POSIX::strftime("%Y%m%d", localtime); - # FIXME - Since $today will be used in either case, move it - # out of the two if-blocks. - my @datearr = localtime(time()); - my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3]; - # FIXME - MySQL knows about dates. Just use - # and issues.timestamp = curdate(); - $crit=" and issues.timestamp like '$today%' "; - } - if ($env->{'nottodaysissues'}) { - # FIXME - Could use - # $today = POSIX::strftime("%Y%m%d", localtime); - # FIXME - Since $today will be used in either case, move it - # out of the two if-blocks. - my @datearr = localtime(time()); - my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3]; - # FIXME - MySQL knows about dates. Just use - # and issues.timestamp < curdate(); - $crit=" and !(issues.timestamp like '$today%') "; - } - # FIXME - Does the caller really need every single field from all - # four tables? - my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio where - borrowernumber=? and issues.itemnumber=items.itemnumber and - items.biblionumber=biblio.biblionumber and - items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null - $crit order by issues.date_due"); - $sth->execute($borrowernumber); - while (my $data = $sth->fetchrow_hashref) { - # FIXME - The Dewey code is a string, not a number. - $data->{'dewey'}=~s/0*$//; - ($data->{'dewey'} == 0) && ($data->{'dewey'}=''); - # FIXME - Could use - # $todaysdate = POSIX::strftime("%Y%m%d", localtime) - # or better yet, just reuse $today which was calculated above. - # This function isn't going to run until midnight, is it? - # Alternately, use - # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime) - # if ($data->{'date_due'} lt $todaysdate) - # ... - # Either way, the date should be be formatted outside of the - # loop. - my @datearr = localtime(time()); - my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]); - my $datedue=$data->{'date_due'}; - $datedue=~s/-//g; - if ($datedue < $todaysdate) { - $data->{'overdue'}=1; - } - my $itemnumber=$data->{'itemnumber'}; - # FIXME - Consecutive integers as hash keys? You have GOT to - # be kidding me! Use an array, fercrissakes! - $currentissues{$counter}=$data; - $counter++; - } - $sth->finish; - return(\%currentissues); + # New subroutine for Circ2.pm + my ( $env, $borrower ) = @_; + my $dbh = C4::Context->dbh; + my %currentissues; + my $counter = 1; + my $borrowernumber = $borrower->{'borrowernumber'}; + my $crit = ''; + + # Figure out whether to get the books issued today, or earlier. + # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can + # both be specified, but are mutually-exclusive. This is bogus. + # Make this a flag. Or better yet, return everything in (reverse) + # chronological order and let the caller figure out which books + # were issued today. + if ( $env->{'todaysissues'} ) { + + # FIXME - Could use + # $today = POSIX::strftime("%Y%m%d", localtime); + # FIXME - Since $today will be used in either case, move it + # out of the two if-blocks. + my @datearr = localtime( time() ); + my $today = ( 1900 + $datearr[5] ) . sprintf "%02d", + ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3]; + + # FIXME - MySQL knows about dates. Just use + # and issues.timestamp = curdate(); + $crit = " and issues.timestamp like '$today%' "; + } + if ( $env->{'nottodaysissues'} ) { + + # FIXME - Could use + # $today = POSIX::strftime("%Y%m%d", localtime); + # FIXME - Since $today will be used in either case, move it + # out of the two if-blocks. + my @datearr = localtime( time() ); + my $today = ( 1900 + $datearr[5] ) . sprintf "%02d", + ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3]; + + # FIXME - MySQL knows about dates. Just use + # and issues.timestamp < curdate(); + $crit = " and !(issues.timestamp like '$today%') "; + } + + # FIXME - Does the caller really need every single field from all + # four tables? + my $sth = $dbh->prepare( + "select * from issues,items,biblioitems,biblio where + borrowernumber=? and issues.itemnumber=items.itemnumber and + items.biblionumber=biblio.biblionumber and + items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null + $crit order by issues.date_due" + ); + $sth->execute($borrowernumber); + while ( my $data = $sth->fetchrow_hashref ) { + + # FIXME - The Dewey code is a string, not a number. + $data->{'dewey'} =~ s/0*$//; + ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' ); + + # FIXME - Could use + # $todaysdate = POSIX::strftime("%Y%m%d", localtime) + # or better yet, just reuse $today which was calculated above. + # This function isn't going to run until midnight, is it? + # Alternately, use + # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime) + # if ($data->{'date_due'} lt $todaysdate) + # ... + # Either way, the date should be be formatted outside of the + # loop. + my @datearr = localtime( time() ); + my $todaysdate = + ( 1900 + $datearr[5] ) + . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) + . sprintf( "%0.2d", $datearr[3] ); + my $datedue = $data->{'date_due'}; + $datedue =~ s/-//g; + if ( $datedue < $todaysdate ) { + $data->{'overdue'} = 1; + } + my $itemnumber = $data->{'itemnumber'}; + + # FIXME - Consecutive integers as hash keys? You have GOT to + # be kidding me! Use an array, fercrissakes! + $currentissues{$counter} = $data; + $counter++; + } + $sth->finish; + return ( \%currentissues ); } =head2 getissues - $issues = &getissues($borrowernumber); +$issues = &getissues($borrowernumber); Returns the set of books currently on loan to a patron. @@ -1664,84 +2197,115 @@ selected fields from the issues, items, biblio, and biblioitems tables of the Koha database. =cut + #' sub getissues { -# New subroutine for Circ2.pm - my ($borrower) = @_; - my $dbh = C4::Context->dbh; - my $borrowernumber = $borrower->{'borrowernumber'}; - my %currentissues; - my $select = "SELECT items.*,issues.timestamp AS timestamp, - issues.date_due AS date_due, - items.barcode AS barcode, - biblio.title AS title, - biblio.author AS author, - biblioitems.dewey AS dewey, - itemtypes.description AS itemtype, - biblioitems.subclass AS subclass, - biblioitems.classification AS classification - FROM issues,items,biblioitems,biblio, itemtypes - WHERE issues.borrowernumber = ? - AND issues.itemnumber = items.itemnumber - AND items.biblionumber = biblio.biblionumber - AND items.biblioitemnumber = biblioitems.biblioitemnumber - AND itemtypes.itemtype = biblioitems.itemtype - AND issues.returndate IS NULL - ORDER BY issues.date_due DESC"; - # print $select; - my $sth=$dbh->prepare($select); - $sth->execute($borrowernumber); - my $counter = 0; - while (my $data = $sth->fetchrow_hashref) { - $data->{'dewey'} =~ s/0*$//; - ($data->{'dewey'} == 0) && ($data->{'dewey'} = ''); - # FIXME - The Dewey code is a string, not a number. - # FIXME - Use POSIX::strftime to get a text version of today's - # date. That's what it's for. - # FIXME - Move the date calculation outside of the loop. - my @datearr = localtime(time()); - my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]); - - # FIXME - Instead of converting the due date to YYYYMMDD, just - # use - # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime); - # ... - # if ($date->{date_due} lt $todaysdate) - my $datedue = $data->{'date_due'}; - $datedue =~ s/-//g; - if ($datedue < $todaysdate) { - $data->{'overdue'} = 1; - } - $currentissues{$counter} = $data; - $counter++; - # FIXME - This is ludicrous. If you want to return an - # array of values, just use an array. That's what - # they're there for. - } - $sth->finish; - return(\%currentissues); + + # New subroutine for Circ2.pm + my ($borrower) = @_; + my $dbh = C4::Context->dbh; + my $borrowernumber = $borrower->{'borrowernumber'}; + my %currentissues; + my $select = " + SELECT items.*, + issues.timestamp AS timestamp, + issues.date_due AS date_due, + items.barcode AS barcode, + biblio.title AS title, + biblio.author AS author, + biblioitems.dewey AS dewey, + itemtypes.description AS itemtype, + biblioitems.subclass AS subclass, + biblioitems.ccode AS ccode, + biblioitems.isbn AS isbn, + biblioitems.classification AS classification + FROM items + LEFT JOIN issues ON issues.itemnumber = items.itemnumber + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber + LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber + LEFT JOIN itemtypes ON itemtypes.itemtype = biblioitems.itemtype + WHERE issues.borrowernumber = ? + AND issues.returndate IS NULL + ORDER BY issues.date_due DESC + "; + my $sth = $dbh->prepare($select); + $sth->execute($borrowernumber); + my $counter = 0; + + while ( my $data = $sth->fetchrow_hashref ) { + $data->{'dewey'} =~ s/0*$//; + ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' ); + + # FIXME - The Dewey code is a string, not a number. + # FIXME - Use POSIX::strftime to get a text version of today's + # date. That's what it's for. + # FIXME - Move the date calculation outside of the loop. + my @datearr = localtime( time() ); + my $todaysdate = + ( 1900 + $datearr[5] ) + . sprintf( "%0.2d", ( $datearr[4] + 1 ) ) + . sprintf( "%0.2d", $datearr[3] ); + + # FIXME - Instead of converting the due date to YYYYMMDD, just + # use + # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime); + # ... + # if ($date->{date_due} lt $todaysdate) + my $datedue = $data->{'date_due'}; + $datedue =~ s/-//g; + if ( $datedue < $todaysdate ) { + $data->{'overdue'} = 1; + } + $currentissues{$counter} = $data; + $counter++; + + # FIXME - This is ludicrous. If you want to return an + # array of values, just use an array. That's what + # they're there for. + } + $sth->finish; + return ( \%currentissues ); } -# Not exported -sub checkwaiting { -#Stolen from Main.pm -# check for reserves waiting - my ($env,$dbh,$bornum)=@_; - my @itemswaiting; - my $sth = $dbh->prepare("select * from reserves where (borrowernumber = ?) and (reserves.found='W') and cancellationdate is NULL"); - $sth->execute($bornum); - my $cnt=0; - if (my $data=$sth->fetchrow_hashref) { - $itemswaiting[$cnt] =$data; - $cnt ++ - } - $sth->finish; - return ($cnt,\@itemswaiting); +=head2 GetIssuesFromBiblio + +$issues = GetIssuesFromBiblio($biblionumber); + +this function get all issues from a biblionumber. + +Return: +C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from +tables issues and the firstname,surname & cardnumber from borrowers. + +=cut + +sub GetIssuesFromBiblio { + my $biblionumber = shift; + return undef unless $biblionumber; + my $dbh = C4::Context->dbh; + my $query = " + SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname + FROM issues + LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber + LEFT JOIN items ON issues.itemnumber = items.itemnumber + LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber + LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber + WHERE biblio.biblionumber = ? + ORDER BY issues.timestamp + "; + my $sth = $dbh->prepare($query); + $sth->execute($biblionumber); + + my @issues; + while ( my $data = $sth->fetchrow_hashref ) { + push @issues, $data; + } + return \@issues; } =head2 renewstatus - $ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber); +$ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber); Find out whether a borrowed item may be renewed. @@ -1762,56 +2326,63 @@ already renewed the loan. =cut sub renewstatus { - # check renewal status - my ($env,$bornum,$itemno)=@_; - my $dbh = C4::Context->dbh; - my $renews = 1; - my $renewokay = 0; - # Look in the issues table for this item, lent to this borrower, - # and not yet returned. - - # FIXME - I think this function could be redone to use only one SQL call. - my $sth1 = $dbh->prepare("select * from issues - where (borrowernumber = ?) - and (itemnumber = ?) - and returndate is null"); - $sth1->execute($bornum,$itemno); - if (my $data1 = $sth1->fetchrow_hashref) { - # Found a matching item - - # See if this item may be renewed. This query is convoluted - # because it's a bit messy: given the item number, we need to find - # the biblioitem, which gives us the itemtype, which tells us - # whether it may be renewed. - my $sth2 = $dbh->prepare("SELECT renewalsallowed from items,biblioitems,itemtypes - where (items.itemnumber = ?) - and (items.biblioitemnumber = biblioitems.biblioitemnumber) - and (biblioitems.itemtype = itemtypes.itemtype)"); - $sth2->execute($itemno); - if (my $data2=$sth2->fetchrow_hashref) { - $renews = $data2->{'renewalsallowed'}; - } - if ($renews && $renews > $data1->{'renewals'}) { - $renewokay = 1; - } - $sth2->finish; - my ($resfound, $resrec) = CheckReserves($itemno); - if ($resfound) { - $renewokay = 0; - } - ($resfound, $resrec) = CheckReserves($itemno); - if ($resfound) { - $renewokay = 0; - } - } - $sth1->finish; - return($renewokay); + # check renewal status + my ( $env, $borrowernumber, $itemno ) = @_; + my $dbh = C4::Context->dbh; + my $renews = 1; + my $renewokay = 0; + + # Look in the issues table for this item, lent to this borrower, + # and not yet returned. + + # FIXME - I think this function could be redone to use only one SQL call. + my $sth1 = $dbh->prepare( + "select * from issues + where (borrowernumber = ?) + and (itemnumber = ?) + and returndate is null" + ); + $sth1->execute( $borrowernumber, $itemno ); + if ( my $data1 = $sth1->fetchrow_hashref ) { + + # Found a matching item + + # See if this item may be renewed. This query is convoluted + # because it's a bit messy: given the item number, we need to find + # the biblioitem, which gives us the itemtype, which tells us + # whether it may be renewed. + my $sth2 = $dbh->prepare( + "SELECT renewalsallowed from items,biblioitems,itemtypes + where (items.itemnumber = ?) + and (items.biblioitemnumber = biblioitems.biblioitemnumber) + and (biblioitems.itemtype = itemtypes.itemtype)" + ); + $sth2->execute($itemno); + if ( my $data2 = $sth2->fetchrow_hashref ) { + $renews = $data2->{'renewalsallowed'}; + } + if ( $renews && $renews > $data1->{'renewals'} ) { + $renewokay = 1; + } + $sth2->finish; + my ( $resfound, $resrec ) = CheckReserves($itemno); + if ($resfound) { + $renewokay = 0; + } + ( $resfound, $resrec ) = CheckReserves($itemno); + if ($resfound) { + $renewokay = 0; + } + + } + $sth1->finish; + return ($renewokay); } =head2 renewbook - &renewbook($env, $borrowernumber, $itemnumber, $datedue); +&renewbook($env, $borrowernumber, $itemnumber, $datedue); Renews a loan. @@ -1834,57 +2405,73 @@ C<$datedue> should be in the form YYYY-MM-DD. =cut sub renewbook { - # mark book as renewed - my ($env,$bornum,$itemno,$datedue)=@_; - my $dbh = C4::Context->dbh; - # If the due date wasn't specified, calculate it by adding the - # book's loan length to today's date. - if ($datedue eq "" ) { - #debug_msg($env, "getting date"); - my $iteminformation = getiteminformation($env, $itemno,0); - my $borrower = getpatroninformation($env,$bornum,0); - my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); - $datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d"); - } + # mark book as renewed + my ( $env, $borrowernumber, $itemno, $datedue ) = @_; + my $dbh = C4::Context->dbh; - # Find the issues record for this book - my $sth=$dbh->prepare("select * from issues where borrowernumber=? and itemnumber=? and returndate is null"); - $sth->execute($bornum,$itemno); - my $issuedata=$sth->fetchrow_hashref; - $sth->finish; + # If the due date wasn't specified, calculate it by adding the + # book's loan length to today's date. + if ( $datedue eq "" ) { + + #debug_msg($env, "getting date"); + my $iteminformation = getiteminformation( $itemno, 0 ); + my $borrower = getpatroninformation( $env, $borrowernumber, 0 ); + my $loanlength = getLoanLength( + $borrower->{'categorycode'}, + $iteminformation->{'itemtype'}, + $borrower->{'branchcode'} + ); + my ( $due_year, $due_month, $due_day ) = + Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 ); + $datedue = "$due_year-$due_month-$due_day"; - # 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,$bornum,$itemno); - $sth->finish; + #$datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d"); + } - # Log the renewal - UpdateStats($env,$env->{'branchcode'},'renew','','',$itemno); - - # Charge a new rental fee, if applicable? - my ($charge,$type)=calc_charges($env, $itemno, $bornum); - if ($charge > 0){ - my $accountno=getnextacctno($env,$bornum,$dbh); - my $item=getiteminformation($env, $itemno); - $sth=$dbh->prepare("Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) - values (?,?,now(),?,?,?,?,?)"); - $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $item->{'title'} $item->{'barcode'}",'Rent',$charge,$itemno); - $sth->finish; - # print $account; - } - - # return(); -} + # Find the issues record for this book + my $sth = + $dbh->prepare( +"select * from issues where borrowernumber=? and itemnumber=? and returndate is null" + ); + $sth->execute( $borrowernumber, $itemno ); + my $issuedata = $sth->fetchrow_hashref; + $sth->finish; + # Update the issues record to have the new due date, and a new count + # of how many times it has been renewed. + my $renews = $issuedata->{'renewals'} + 1; + $sth = $dbh->prepare( + "update issues set date_due = ?, renewals = ? + where borrowernumber=? and itemnumber=? and returndate is null" + ); + $sth->execute( $datedue, $renews, $borrowernumber, $itemno ); + $sth->finish; + # Log the renewal + UpdateStats( $env, $env->{'branchcode'}, 'renew', '', '', $itemno ); + + # Charge a new rental fee, if applicable? + my ( $charge, $type ) = calc_charges( $env, $itemno, $borrowernumber ); + if ( $charge > 0 ) { + my $accountno = getnextacctno( $env, $borrowernumber, $dbh ); + my $item = getiteminformation($itemno); + $sth = $dbh->prepare( +"Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber) + values (?,?,now(),?,?,?,?,?)" + ); + $sth->execute( $borrowernumber, $accountno, $charge, + "Renewal of Rental Item $item->{'title'} $item->{'barcode'}", + 'Rent', $charge, $itemno ); + $sth->finish; + } -=item calc_charges + # return(); +} - ($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber); +=head2 calc_charges + +($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber); Calculate how much it would cost for a given patron to borrow a given item, including any applicable discounts. @@ -1902,66 +2489,72 @@ if it's a video). =cut sub calc_charges { - # calculate charges due - my ($env, $itemno, $bornum)=@_; - my $charge=0; - my $dbh = C4::Context->dbh; - my $item_type; - - # Get the book's item type and rental charge (via its biblioitem). - my $sth1= $dbh->prepare("select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes - where (items.itemnumber =?) - and (biblioitems.biblioitemnumber = items.biblioitemnumber) - and (biblioitems.itemtype = itemtypes.itemtype)"); - $sth1->execute($itemno); - if (my $data1=$sth1->fetchrow_hashref) { - $item_type = $data1->{'itemtype'}; - $charge = $data1->{'rentalcharge'}; - my $q2 = "select rentaldiscount from issuingrules,borrowers - where (borrowers.borrowernumber = ?) - and (borrowers.categorycode = issuingrules.categorycode) - and (issuingrules.itemtype = ?)"; - my $sth2=$dbh->prepare($q2); - $sth2->execute($bornum,$item_type); - if (my $data2=$sth2->fetchrow_hashref) { - my $discount = $data2->{'rentaldiscount'}; - if ($discount eq 'NULL') { - $discount=0; - } - $charge = ($charge *(100 - $discount)) / 100; - # warn "discount is $discount"; - } - $sth2->finish; + + # calculate charges due + my ( $env, $itemno, $borrowernumber ) = @_; + my $charge = 0; + my $dbh = C4::Context->dbh; + my $item_type; + + # Get the book's item type and rental charge (via its biblioitem). + my $sth1 = $dbh->prepare( + "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes + where (items.itemnumber =?) + and (biblioitems.biblioitemnumber = items.biblioitemnumber) + and (biblioitems.itemtype = itemtypes.itemtype)" + ); + $sth1->execute($itemno); + if ( my $data1 = $sth1->fetchrow_hashref ) { + $item_type = $data1->{'itemtype'}; + $charge = $data1->{'rentalcharge'}; + my $q2 = "select rentaldiscount from issuingrules,borrowers + where (borrowers.borrowernumber = ?) + and (borrowers.categorycode = issuingrules.categorycode) + and (issuingrules.itemtype = ?)"; + my $sth2 = $dbh->prepare($q2); + $sth2->execute( $borrowernumber, $item_type ); + if ( my $data2 = $sth2->fetchrow_hashref ) { + my $discount = $data2->{'rentaldiscount'}; + if ( $discount eq 'NULL' ) { + $discount = 0; + } + $charge = ( $charge * ( 100 - $discount ) ) / 100; } + $sth2->finish; + } - $sth1->finish; - return ($charge,$item_type); + $sth1->finish; + return ( $charge, $item_type ); } +=head2 createcharge + +&createcharge( $env, $dbh, $itemno, $borrowernumber, $charge ) + +=cut # FIXME - A virtually identical function appears in # C4::Circulation::Issues. Pick one and stick with it. sub createcharge { -#Stolen from Issues.pm - my ($env,$dbh,$itemno,$bornum,$charge) = @_; - my $nextaccntno = getnextacctno($env,$bornum,$dbh); - my $sth = $dbh->prepare(<execute($bornum, $itemno, $nextaccntno, $charge, $charge); + + #Stolen from Issues.pm + my ( $env, $dbh, $itemno, $borrowernumber, $charge ) = @_; + my $nextaccntno = getnextacctno( $env, $borrowernumber, $dbh ); + my $query =" + INSERT INTO accountlines + (borrowernumber, itemnumber, accountno, + date, amount, description, accounttype, + amountoutstanding) + VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?) + "; + my $sth = $dbh->prepare($query); + $sth->execute( $borrowernumber, $itemno, $nextaccntno, $charge, $charge ); $sth->finish; } +=head2 find_reserves -=item find_reserves - - ($status, $record) = &find_reserves($itemnumber); +($status, $record) = &find_reserves($itemnumber); Looks up an item in the reserves. @@ -1973,221 +2566,640 @@ C<$record> is a reference-to-hash describing the reserve. Its keys are the fields from the reserves table of the Koha database. =cut + #' # FIXME - This API is bogus: just return the record, or undef if none # was found. # FIXME - There's also a &C4::Circulation::Returns::find_reserves, but # that one looks rather different. sub find_reserves { -# Stolen from Returns.pm + + # 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(\%env, $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)) { - # FIXME - Unlike Pascal, Perl allows you to exit loops - # early. Take out the "&& (not $resfound)" and just - # use "last" at the appropriate point in the loop. - # (Oh, and just in passing: if you'd used "!" instead - # of "not", you wouldn't have needed the parentheses.) - $lastrec = $resrec; - my $brn = $dbh->quote($resrec->{'borrowernumber'}); - my $rdate = $dbh->quote($resrec->{'reservedate'}); - my $bibno = $dbh->quote($resrec->{'biblionumber'}); - if ($resrec->{'found'} eq "W") { - if ($resrec->{'itemnumber'} eq $itemno) { - $resfound = 1; - } - } else { - # FIXME - Use 'elsif' to avoid unnecessary indentation. - if ($resrec->{'constrainttype'} eq "a") { - $resfound = 1; - } else { - my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?"); - $consth->execute($brn,$rdate,$bibno,$bibitm); - if (my $conrec = $consth->fetchrow_hashref) { - if ($resrec->{'constrainttype'} eq "o") { - $resfound = 1; - } - } - $consth->finish; - } - } - if ($resfound) { - my $updsth = $dbh->prepare("update reserves set found = 'W', itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber = ?"); - $updsth->execute($itemno,$brn,$rdate,$bibno); - $updsth->finish; - # FIXME - "last;" here to break out of the loop early. - } + while ( ( $resrec = $sth->fetchrow_hashref ) && ( not $resfound ) ) { + + # FIXME - Unlike Pascal, Perl allows you to exit loops + # early. Take out the "&& (not $resfound)" and just + # use "last" at the appropriate point in the loop. + # (Oh, and just in passing: if you'd used "!" instead + # of "not", you wouldn't have needed the parentheses.) + $lastrec = $resrec; + my $brn = $dbh->quote( $resrec->{'borrowernumber'} ); + my $rdate = $dbh->quote( $resrec->{'reservedate'} ); + my $bibno = $dbh->quote( $resrec->{'biblionumber'} ); + if ( $resrec->{'found'} eq "W" ) { + if ( $resrec->{'itemnumber'} eq $itemno ) { + $resfound = 1; + } + } + else { + # FIXME - Use 'elsif' to avoid unnecessary indentation. + if ( $resrec->{'constrainttype'} eq "a" ) { + $resfound = 1; + } + else { + my $consth = + $dbh->prepare( + "SELECT * FROM reserveconstraints + WHERE borrowernumber = ? + AND reservedate = ? + AND biblionumber = ? + AND biblioitemnumber = ?" + ); + $consth->execute( $brn, $rdate, $bibno, $bibitm ); + if ( my $conrec = $consth->fetchrow_hashref ) { + if ( $resrec->{'constrainttype'} eq "o" ) { + $resfound = 1; + } + } + $consth->finish; + } + } + if ($resfound) { + my $updsth = + $dbh->prepare( + "UPDATE reserves + SET found = 'W', + itemnumber = ? + WHERE borrowernumber = ? + AND reservedate = ? + AND biblionumber = ?" + ); + $updsth->execute( $itemno, $brn, $rdate, $bibno ); + $updsth->finish; + + # FIXME - "last;" here to break out of the loop early. + } } $sth->finish; - return ($resfound,$lastrec); + 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))) { - $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"; - } - } - } + if ( $year && $month && $day ) { + if ( ( $year eq 0 ) && ( $month eq 0 ) && ( $year eq 0 ) ) { + + # $env{'datedue'}=''; + } + else { + if ( ( $year eq 0 ) || ( $month eq 0 ) || ( $year eq 0 ) ) { + $invalidduedate = 1; + } + else { + if ( + ( $day > 30 ) + && ( ( $month == 4 ) + || ( $month == 6 ) + || ( $month == 9 ) + || ( $month == 11 ) ) + ) + { + $invalidduedate = 1; + } + elsif ( ( $day > 29 ) && ( $month == 2 ) ) { + $invalidduedate = 1; + } + elsif ( + ( $month == 2 ) + && ( $day > 28 ) + && ( ( $year % 4 ) + && ( ( !( $year % 100 ) || ( $year % 400 ) ) ) ) + ) + { + $invalidduedate = 1; + } + else { + $date = "$year-$month-$day"; + } + } + } } - return ($date, $invalidduedate); - + return ( $date, $invalidduedate ); } +=head2 get_current_return_date_of + +&get_current_return_date_of(@itemnumber); + +=cut + sub get_current_return_date_of { my (@itemnumbers) = @_; - my $query = ' -SELECT date_due, - itemnumber - FROM issues - WHERE itemnumber IN ('.join(',', @itemnumbers).') AND returndate IS NULL -'; - return get_infos_of($query, 'itemnumber', 'date_due'); + SELECT + date_due, + itemnumber + FROM issues + WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ') + AND returndate IS NULL + '; + return get_infos_of( $query, 'itemnumber', 'date_due' ); } +=head2 get_transfert_infos + +get_transfert_infos($itemnumber); + +=cut + sub get_transfert_infos { my ($itemnumber) = @_; my $dbh = C4::Context->dbh; my $query = ' -SELECT datesent, - frombranch, - tobranch - FROM branchtransfers - WHERE itemnumber = ? - AND datearrived IS NULL -'; + SELECT datesent, + frombranch, + tobranch + FROM branchtransfers + WHERE itemnumber = ? + AND datearrived IS NULL + '; my $sth = $dbh->prepare($query); $sth->execute($itemnumber); - my @row = $sth->fetchrow_array(); - $sth->finish; - return @row; } +=head2 DeleteTransfer + +&DeleteTransfer($itemnumber); + +=cut sub DeleteTransfer { - my($itemnumber) = @_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("DELETE FROM branchtransfers - where itemnumber=? - AND datearrived is null "); - $sth->execute($itemnumber); - $sth->finish; + my ($itemnumber) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + "DELETE FROM branchtransfers + WHERE itemnumber=? + AND datearrived IS NULL " + ); + $sth->execute($itemnumber); + $sth->finish; } +=head2 GetTransfersFromBib + +@results = GetTransfersFromBib($frombranch,$tobranch); + +=cut + sub GetTransfersFromBib { - my($frombranch,$tobranch) = @_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT itemnumber,datesent,frombranch FROM - branchtransfers - where frombranch=? - AND tobranch=? - AND datearrived is null "); - $sth->execute($frombranch,$tobranch); - my @gettransfers; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $gettransfers[$i]=$data; - $i++; - } - $sth->finish; - return(@gettransfers); + my ( $frombranch, $tobranch ) = @_; + return unless ( $frombranch && $tobranch ); + my $dbh = C4::Context->dbh; + my $query = " + SELECT itemnumber,datesent,frombranch + FROM branchtransfers + WHERE frombranch=? + AND tobranch=? + AND datearrived IS NULL + "; + my $sth = $dbh->prepare($query); + $sth->execute( $frombranch, $tobranch ); + my @gettransfers; + my $i = 0; + + while ( my $data = $sth->fetchrow_hashref ) { + $gettransfers[$i] = $data; + $i++; + } + $sth->finish; + return (@gettransfers); } +=head2 GetReservesToBranch + +@transreserv = GetReservesToBranch( $frombranch, $default ); + +=cut + sub GetReservesToBranch { - my($frombranch,$default) = @_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT borrowernumber,reservedate,itemnumber,timestamp FROM - reserves - where priority='0' AND cancellationdate is null - AND branchcode=? - AND branchcode!=? - AND found is null "); - $sth->execute($frombranch,$default); - my @transreserv; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $transreserv[$i]=$data; - $i++; - } - $sth->finish; - return(@transreserv); + my ( $frombranch, $default ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + "SELECT borrowernumber,reservedate,itemnumber,timestamp + FROM reserves + WHERE priority='0' AND cancellationdate is null + AND branchcode=? + AND branchcode!=? + AND found IS NULL " + ); + $sth->execute( $frombranch, $default ); + my @transreserv; + my $i = 0; + while ( my $data = $sth->fetchrow_hashref ) { + $transreserv[$i] = $data; + $i++; + } + $sth->finish; + return (@transreserv); } +=head2 GetReservesForBranch + +@transreserv = GetReservesForBranch($frombranch); + +=cut + sub GetReservesForBranch { - my($frombranch) = @_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT borrowernumber,reservedate,itemnumber,waitingdate FROM - reserves - where priority='0' AND cancellationdate is null - AND found='W' - AND branchcode=? order by reservedate"); - $sth->execute($frombranch); - my @transreserv; - my $i=0; - while (my $data=$sth->fetchrow_hashref){ - $transreserv[$i]=$data; - $i++; - } - $sth->finish; - return(@transreserv); + my ($frombranch) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( " + SELECT borrowernumber,reservedate,itemnumber,waitingdate + FROM reserves + WHERE priority='0' + AND cancellationdate IS NULL + AND found='W' + AND branchcode=? + ORDER BY waitingdate" ); + $sth->execute($frombranch); + my @transreserv; + my $i = 0; + while ( my $data = $sth->fetchrow_hashref ) { + $transreserv[$i] = $data; + $i++; + } + $sth->finish; + return (@transreserv); } -sub checktransferts{ - my($itemnumber) = @_; +=head2 checktransferts + +@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" + ); + $sth->execute($itemnumber); + my @tranferts = $sth->fetchrow_array; + $sth->finish; + + return (@tranferts); +} + +=head2 CheckItemNotify + +Sql request to check if the document has alreday been notified +this function is not exported, only used with GetOverduesForBranch + +=cut + +sub CheckItemNotify { + my ($notify_id,$notify_level,$itemnumber) = @_; my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT datesent,frombranch,tobranch FROM branchtransfers - WHERE itemnumber = ? AND datearrived IS NULL"); - $sth->execute($itemnumber); - my @tranferts = $sth->fetchrow_array; + my $sth = $dbh->prepare(" + SELECT COUNT(*) FROM notifys + WHERE notify_id = ? + AND notify_level = ? + AND itemnumber = ? "); + $sth->execute($notify_id,$notify_level,$itemnumber); + my $notified = $sth->fetchrow; +$sth->finish; +return ($notified); +} + +=head2 GetOverduesForBranch + +Sql request for display all information for branchoverdues.pl +2 possibilities : with or without departement . +display is filtered by branch + +=cut + +sub GetOverduesForBranch { + 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,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines + WHERE ( issues.returndate is null) + AND ( accountlines.amountoutstanding != '0.000000') + AND ( accountlines.accounttype = 'FU') + AND ( issues.borrowernumber = accountlines.borrowernumber ) + AND ( issues.itemnumber = accountlines.itemnumber ) + AND ( borrowers.borrowernumber = issues.borrowernumber ) + AND ( biblio.biblionumber = biblioitems.biblionumber ) + AND ( biblioitems.biblionumber = items.biblionumber ) + AND ( itemtypes.itemtype = biblioitems.itemtype ) + AND ( items.itemnumber = issues.itemnumber ) + AND ( branches.branchcode = issues.branchcode ) + AND (issues.branchcode = ?) + AND (issues.date_due <= NOW()) + ORDER BY borrowers.surname + "); + $sth->execute($branch); + my @getoverdues; + my $i = 0; + while ( my $data = $sth->fetchrow_hashref ) { + #check if the document has already been notified + my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'}); + if ($countnotify eq '0'){ + $getoverdues[$i] = $data; + $i++; + } + } + return (@getoverdues); $sth->finish; + } + else { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( " + SELECT borrowers.surname, + borrowers.firstname, + biblio.title, + itemtypes.description, + issues.date_due, + issues.returndate, + branches.branchname, + items.barcode, + borrowers.phone, + borrowers.email, + items.itemcallnumber, + borrowers.borrowernumber, + items.itemnumber, + biblio.biblionumber, + issues.branchcode, + accountlines.notify_id, + accountlines.notify_level, + items.location, + accountlines.amountoutstanding + FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines + WHERE ( issues.returndate is null ) + AND ( accountlines.amountoutstanding != '0.000000') + AND ( accountlines.accounttype = 'FU') + AND ( issues.borrowernumber = accountlines.borrowernumber ) + AND ( issues.itemnumber = accountlines.itemnumber ) + AND ( borrowers.borrowernumber = issues.borrowernumber ) + AND ( biblio.biblionumber = biblioitems.biblionumber ) + AND ( biblioitems.biblionumber = items.biblionumber ) + AND ( itemtypes.itemtype = biblioitems.itemtype ) + AND ( items.itemnumber = issues.itemnumber ) + AND ( branches.branchcode = issues.branchcode ) + AND (issues.branchcode = ? AND items.location = ?) + AND (issues.date_due <= NOW()) + ORDER BY borrowers.surname + " ); + $sth->execute( $branch, $departement); + my @getoverdues; + my $i = 0; + while ( my $data = $sth->fetchrow_hashref ) { + #check if the document has already been notified + my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'}); + if ($countnotify eq '0'){ + $getoverdues[$i] = $data; + $i++; + } + } + $sth->finish; + return (@getoverdues); + } +} + + +=head2 AddNotifyLine + +&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId) + +Creat a line into notify, if the method is phone, the notification_send_date is implemented to + +=cut - return (@tranferts); +sub AddNotifyLine { + my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_; + if ( $method eq "phone" ) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id) + VALUES (?,?,now(),now(),?,?,?)" + ); + $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method, + $notifyId ); + $sth->finish; + } + else { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id) + VALUES (?,?,now(),?,?,?)" + ); + $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method, + $notifyId ); + $sth->finish; + } + return 1; } -1; -__END__ +=head2 RemoveNotifyLine + +&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date ); + +Cancel a notification + +=cut + +sub RemoveNotifyLine { + my ( $borrowernumber, $itemnumber, $notify_date ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( + "DELETE FROM notifys + WHERE + borrowernumber=? + AND itemnumber=? + AND notify_date=?" + ); + $sth->execute( $borrowernumber, $itemnumber, $notify_date ); + $sth->finish; + return 1; +} + +=head2 AnonymiseIssueHistory + +$rows = AnonymiseIssueHistory($borrowernumber,$date) + +This function write NULL instead of C<$borrowernumber> given on input arg into the table issues. +if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>. + +return the number of affected rows. + +=cut + +sub AnonymiseIssueHistory { + my $date = shift; + my $borrowernumber = shift; + my $dbh = C4::Context->dbh; + my $query = " + UPDATE issues + SET borrowernumber = NULL + WHERE returndate < '".$date."' + AND borrowernumber IS NOT NULL + "; + $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber; + my $rows_affected = $dbh->do($query); + return $rows_affected; +} + +=head2 GetItemsLost + +$items = GetItemsLost($where,$orderby); + +This function get the items lost into C<$items>. + +=over 2 + +=item input: +C<$where> is a hashref. it containts a field of the items table as key +and the value to match as value. +C<$orderby> is a field of the items table. + +=item return: +C<$items> is a reference to an array full of hasref which keys are items' table column. + +=item usage in the perl script: + +my %where; +$where{barcode} = 0001548; +my $items = GetLostItems( \%where, "homebranch" ); +$template->param(itemsloop => $items); =back +=cut + +sub GetLostItems { + # Getting input args. + my $where = shift; + my $orderby = shift; + my $dbh = C4::Context->dbh; + + my $query = " + SELECT * + FROM items + WHERE itemlost IS NOT NULL + AND itemlost <> 0 + "; + foreach my $key (keys %$where) { + $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'"; + } + $query .= " ORDER BY ".$orderby if defined $orderby; + + my $sth = $dbh->prepare($query); + $sth->execute; + my @items; + while ( my $row = $sth->fetchrow_hashref ){ + push @items, $row; + } + return \@items; +} + +=head2 updateWrongTransfer + +$items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); + +This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation + +=cut + +sub updateWrongTransfer { + my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_; + my $dbh = C4::Context->dbh; +# first step validate the actual line of transfert . + my $sth = + $dbh->prepare( + "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL" + ); + $sth->execute($FromLibrary,$itemNumber); + $sth->finish; + +# second step create a new line of branchtransfer to the right location . + dotransfer($itemNumber, $FromLibrary, $waitingAtLibrary); + +#third step changing holdingbranch of item + UpdateHoldingbranch($FromLibrary,$itemNumber); +} + +=head2 UpdateHoldingbranch + +$items = UpdateHoldingbranch($branch,$itmenumber); +Simple methode for updating hodlingbranch in items BDD line +=cut + +sub UpdateHoldingbranch { + my ( $branch,$itmenumber ) = @_; + my $dbh = C4::Context->dbh; +# first step validate the actual line of transfert . + my $sth = + $dbh->prepare( + "update items set holdingbranch = ? where itemnumber= ?" + ); + $sth->execute($branch,$itmenumber); + $sth->finish; + + +} + +1; + +__END__ + =head1 AUTHOR Koha Developement team