+++ /dev/null
-package C4::Circulation::Circ2;
-
-# Copyright 2000-2002 Katipo Communications
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-
-# $Id$
-
-use strict;
-require Exporter;
-use C4::Context;
-use C4::Stats;
-use C4::Reserves2;
-use C4::Koha;
-use C4::Biblio;
-use C4::Accounts;
-use Date::Calc qw(
- Today
- Today_and_Now
- Add_Delta_YM
- Add_Delta_DHMS
- Date_to_Days
-);
-use POSIX qw(strftime);
-use C4::Branch; # GetBranches
-use C4::Log; # logaction
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-# set the version for version checking
-$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
-
-=head1 NAME
-
-C4::Circulation::Circ2 - Koha circulation module
-
-=head1 SYNOPSIS
-
-use C4::Circulation::Circ2;
-
-=head1 DESCRIPTION
-
-The functions in this module deal with circulation, issues, and
-returns, as well as general information about the library.
-Also deals with stocktaking.
-
-=head1 FUNCTIONS
-
-=cut
-
-@ISA = qw(Exporter);
-
-# FIXME subs that should probably be elsewhere
-push @EXPORT, qw(
- &getpatroninformation
- &getiteminformation
-);
-# subs to deal with issuing a book
-push @EXPORT, qw(
- &canbookbeissued
- &issuebook
- ¤tissues
- &getissues
- &renewstatus
- &renewbook
- &calc_charges
- &fixdate
- &GetIssuesFromBiblio
- &itemissues
- &AnonymiseIssueHistory
-);
-# subs to deal with returns
-push @EXPORT, qw(
- &returnbook
-);
-# subs to deal with reserves => Move to Reserves2.pm
-push @EXPORT, qw(
- &find_reserves
- &GetReservesForBranch
- &GetReservesToBranch
-);
-
-# subs to deal with transfers
-push @EXPORT, qw(
- &transferbook
- &get_transfert_infos
- &checktransferts
- &GetTransfersFromBib
- &updateWrongTransfer
-);
-
-# subs to remove
-push @EXPORT, qw(
- &decode
- &get_current_return_date_of
- &dotransfer
-);
-
-# to move in Biblio.pm
-push @EXPORT, qw(
- &itemseen
- &GetItemsForInventory
- &GetLostItems
-);
-
-# subs to deal with late issues => to move to Fines.pm
-push @EXPORT, qw(
- &GetOverduesForBranch
- &AddNotifyLine
- &RemoveNotifyLine
-);
-
-=head2 itemseen
-
-&itemseen($itemnum)
-Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
-C<$itemnum> is the item number
-
-=cut
-
-sub itemseen {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "update items set itemlost=0, datelastseen = now() where items.itemnumber = ?"
- );
- $sth->execute($itemnum);
- return;
-}
-
-=head2 itemborrowed
-
-&itemseen($itemnum)
-Mark item as borrowed. Is called when an item is issued.
-C<$itemnum> is the item number
-
-=cut
-
-sub itemborrowed {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?"
- );
- $sth->execute($itemnum);
- return;
-}
-
-=head2 GetItemsForInventory
-
-$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
-
-Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
-
-The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
-It is ordered by callnumber,title.
-
-The minlocation & maxlocation parameters are used to specify a range of item callnumbers
-the datelastseen can be used to specify that you want to see items not seen since a past date only.
-offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
-
-=cut
-
-sub GetItemsForInventory {
- my ( $minlocation, $maxlocation, $datelastseen, $branch, $offset, $size ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($datelastseen) {
- my $query =
- "SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen
- FROM items
- LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
- WHERE itemcallnumber>= ?
- AND itemcallnumber <=?
- AND (datelastseen< ? OR datelastseen IS NULL)";
- $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
- $query .= " ORDER BY itemcallnumber,title";
- $sth = $dbh->prepare($query);
- $sth->execute( $minlocation, $maxlocation, $datelastseen );
- }
- else {
- my $query ="
- SELECT itemnumber,barcode,itemcallnumber,title,author,datelastseen
- FROM items
- LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
- WHERE itemcallnumber>= ?
- AND itemcallnumber <=?";
- $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
- $query .= " ORDER BY itemcallnumber,title";
- $sth = $dbh->prepare($query);
- $sth->execute( $minlocation, $maxlocation );
- }
- my @results;
- while ( my $row = $sth->fetchrow_hashref ) {
- $offset-- if ($offset);
- if ( ( !$offset ) && $size ) {
- push @results, $row;
- $size--;
- }
- }
- return \@results;
-}
-
-=head2 getpatroninformation
-
-($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
-
-Looks up a patron and returns information about him or her. If
-C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
-up the borrower by number; otherwise, it looks up the borrower by card
-number.
-
-C<$env> is effectively ignored, but should be a reference-to-hash.
-
-C<$borrower> is a reference-to-hash whose keys are the fields of the
-borrowers table in the Koha database. In addition,
-C<$borrower-E<gt>{flags}> is a hash giving more detailed information
-about the patron. Its keys act as flags :
-
- if $borrower->{flags}->{LOST} {
- # Patron's card was reported lost
- }
-
-Each flag has a C<message> key, giving a human-readable explanation of
-the flag. If the state of a flag means that the patron should not be
-allowed to borrow any more books, then it will have a C<noissues> key
-with a true value.
-
-The possible flags are:
-
-=head3 CHARGES
-
-=over 4
-
-=item Shows the patron's credit or debt, if any.
-
-=back
-
-=head3 GNA
-
-=over 4
-
-=item (Gone, no address.) Set if the patron has left without giving a
-forwarding address.
-
-=back
-
-=head3 LOST
-
-=over 4
-
-=item Set if the patron's card has been reported as lost.
-
-=back
-
-=head3 DBARRED
-
-=over 4
-
-=item Set if the patron has been debarred.
-
-=back
-
-=head3 NOTES
-
-=over 4
-
-=item Any additional notes about the patron.
-
-=back
-
-=head3 ODUES
-
-=over 4
-
-=item Set if the patron has overdue items. This flag has several keys:
-
-C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
-overdue items. Its elements are references-to-hash, each describing an
-overdue item. The keys are selected fields from the issues, biblio,
-biblioitems, and items tables of the Koha database.
-
-C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
-the overdue items, one per line.
-
-=back
-
-=head3 WAITING
-
-=over 4
-
-=item Set if any items that the patron has reserved are available.
-
-C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
-available items. Each element is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database.
-
-=back
-
-=cut
-
-sub getpatroninformation {
- my ( $env, $borrowernumber, $cardnumber ) = @_;
- my $dbh = C4::Context->dbh;
- my $query;
- my $sth;
- if ($borrowernumber) {
- $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
- $sth->execute($borrowernumber);
- }
- elsif ($cardnumber) {
- $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
- $sth->execute($cardnumber);
- }
- else {
- return undef;
- }
- my $borrower = $sth->fetchrow_hashref;
- my $amount = checkaccount( $env, $borrowernumber, $dbh );
- $borrower->{'amountoutstanding'} = $amount;
- my $flags = patronflags( $env, $borrower, $dbh );
- my $accessflagshash;
-
- $sth = $dbh->prepare("select bit,flag from userflags");
- $sth->execute;
- while ( my ( $bit, $flag ) = $sth->fetchrow ) {
- if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
- $accessflagshash->{$flag} = 1;
- }
- }
- $sth->finish;
- $borrower->{'flags'} = $flags;
- $borrower->{'authflags'} = $accessflagshash;
-
- # find out how long the membership lasts
- $sth =
- $dbh->prepare(
- "select enrolmentperiod from categories where categorycode = ?");
- $sth->execute( $borrower->{'categorycode'} );
- my $enrolment = $sth->fetchrow;
- $borrower->{'enrolmentperiod'} = $enrolment;
- return ($borrower); #, $flags, $accessflagshash);
-}
-
-=head2 decode
-
-=head3 $str = &decode($chunk);
-
-=over 4
-
-=item Decodes a segment of a string emitted by a CueCat barcode scanner and
-returns it.
-
-=back
-
-=cut
-
-# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
-sub decode {
- my ($encoded) = @_;
- my $seq =
- 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
- my @s = map { index( $seq, $_ ); } split( //, $encoded );
- my $l = ( $#s + 1 ) % 4;
- if ($l) {
- if ( $l == 1 ) {
- warn "Error!";
- return;
- }
- $l = 4 - $l;
- $#s += $l;
- }
- my $r = '';
- while ( $#s >= 0 ) {
- my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
- $r .=
- chr( ( $n >> 16 ) ^ 67 )
- .chr( ( $n >> 8 & 255 ) ^ 67 )
- .chr( ( $n & 255 ) ^ 67 );
- @s = @s[ 4 .. $#s ];
- }
- $r = substr( $r, 0, length($r) - $l );
- return $r;
-}
-
-=head2 getiteminformation
-
-$item = &getiteminformation($itemnumber, $barcode);
-
-Looks up information about an item, given either its item number or
-its barcode. If C<$itemnumber> is a nonzero value, it is used;
-otherwise, C<$barcode> is used.
-
-C<$item> is a reference-to-hash whose keys are fields from the biblio,
-items, and biblioitems tables of the Koha database. It may also
-contain the following keys:
-
-=head3 date_due
-
-=over 4
-
-=item The due date on this item, if it has been borrowed and not returned
-yet. The date is in YYYY-MM-DD format.
-
-=back
-
-=head3 notforloan
-
-=over 4
-
-=item True if the item may not be borrowed.
-
-=back
-
-=cut
-
-sub getiteminformation {
-
- # returns a hash of item information given either the itemnumber or the barcode
- my ( $itemnumber, $barcode ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($itemnumber) {
- $sth =
- $dbh->prepare(
- "select *
- from biblio,items,biblioitems
- where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"
- );
- $sth->execute($itemnumber);
- }
- elsif ($barcode) {
- $sth =
- $dbh->prepare(
- "select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber"
- );
- $sth->execute($barcode);
- }
- else {
- return undef;
- }
- my $iteminformation = $sth->fetchrow_hashref;
- $sth->finish;
- if ($iteminformation) {
- $sth =
- $dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)");
- $sth->execute( $iteminformation->{'itemnumber'} );
- my ($date_due) = $sth->fetchrow;
- $iteminformation->{'date_due'} = $date_due;
- $sth->finish;
- ( $iteminformation->{'dewey'} == 0 )
- && ( $iteminformation->{'dewey'} = '' );
- $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
- $sth->execute( $iteminformation->{'itemtype'} );
- my $itemtype = $sth->fetchrow_hashref;
-
- # if specific item notforloan, don't use itemtype notforloan field.
- # otherwise, use itemtype notforloan value to see if item can be issued.
- $iteminformation->{'notforloan'} = $itemtype->{'notforloan'}
- unless $iteminformation->{'notforloan'};
- $sth->finish;
- }
- return ($iteminformation);
-}
-
-=head2 transferbook
-
-($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
-
-Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
-
-C<$newbranch> is the code for the branch to which the item should be transferred.
-
-C<$barcode> is the barcode of the item to be transferred.
-
-If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
-Otherwise, if an item is reserved, the transfer fails.
-
-Returns three values:
-
-=head3 $dotransfer
-
-is true if the transfer was successful.
-
-=head3 $messages
-
-is a reference-to-hash which may have any of the following keys:
-
-=over 4
-
-=item C<BadBarcode>
-
-There is no item in the catalog with the given barcode. The value is C<$barcode>.
-
-=item C<IsPermanent>
-
-The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
-
-=item C<DestinationEqualsHolding>
-
-The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
-
-=item C<WasReturned>
-
-The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
-
-=item C<ResFound>
-
-The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
-
-=item C<WasTransferred>
-
-The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
-
-=back
-
-=cut
-
-#'
-# FIXME - This function tries to do too much, and its API is clumsy.
-# If it didn't also return books, it could be used to change the home
-# branch of a book while the book is on loan.
-#
-# Is there any point in returning the item information? The caller can
-# look that up elsewhere if ve cares.
-#
-# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
-# If the transfer succeeds, that's all the caller should need to know.
-# Thus, this function could simply return 1 or 0 to indicate success
-# or failure, and set $C4::Circulation::Circ2::errmsg in case of
-# failure. Or this function could return undef if successful, and an
-# error message in case of failure (this would feel more like C than
-# Perl, though).
-sub transferbook {
- my ( $tbr, $barcode, $ignoreRs ) = @_;
- my $messages;
- my %env;
- my $dotransfer = 1;
- my $branches = GetBranches();
- my $iteminformation = getiteminformation( 0, $barcode );
-
- # bad barcode..
- if ( not $iteminformation ) {
- $messages->{'BadBarcode'} = $barcode;
- $dotransfer = 0;
- }
-
- # get branches of book...
- my $hbr = $iteminformation->{'homebranch'};
- my $fbr = $iteminformation->{'holdingbranch'};
-
- # if is permanent...
- if ( $hbr && $branches->{$hbr}->{'PE'} ) {
- $messages->{'IsPermanent'} = $hbr;
- }
-
- # can't transfer book if is already there....
- # FIXME - Why not? Shouldn't it trivially succeed?
- if ( $fbr eq $tbr ) {
- $messages->{'DestinationEqualsHolding'} = 1;
- $dotransfer = 0;
- }
-
- # check if it is still issued to someone, return it...
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
- if ($currentborrower) {
- returnbook( $barcode, $fbr );
- $messages->{'WasReturned'} = $currentborrower;
- }
-
- # find reserves.....
- # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
- # That'll save a database query.
- my ( $resfound, $resrec ) =
- CheckReserves( $iteminformation->{'itemnumber'} );
- if ( $resfound and not $ignoreRs ) {
- $resrec->{'ResFound'} = $resfound;
-
- # $messages->{'ResFound'} = $resrec;
- $dotransfer = 1;
- }
-
- #actually do the transfer....
- if ($dotransfer) {
- dotransfer( $iteminformation->{'itemnumber'}, $fbr, $tbr );
-
- # don't need to update MARC anymore, we do it in batch now
- $messages->{'WasTransfered'} = 1;
- }
- return ( $dotransfer, $messages, $iteminformation );
-}
-
-# Not exported
-# FIXME - This is only used in &transferbook. Why bother making it a
-# separate function?
-sub dotransfer {
- my ( $itm, $fbr, $tbr ) = @_;
-
- my $dbh = C4::Context->dbh;
- $itm = $dbh->quote($itm);
- $fbr = $dbh->quote($fbr);
- $tbr = $dbh->quote($tbr);
-
- #new entry in branchtransfers....
- $dbh->do(
-"INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
- VALUES ($itm, $fbr, now(), $tbr)"
- );
-
- #update holdingbranch in items .....
- $dbh->do(
- "UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm");
- &itemseen($itm);
- &domarctransfer( $dbh, $itm );
- return;
-}
-
-##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
-sub domarctransfer {
- my ( $dbh, $itemnumber ) = @_;
- $itemnumber =~ s /\'//g; ##itemnumber seems to come with quotes-TG
- my $sth =
- $dbh->prepare(
- "select biblionumber,holdingbranch from items where itemnumber=$itemnumber"
- );
- $sth->execute();
- while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
- &ModItemInMarconefield( $biblionumber, $itemnumber,
- 'items.holdingbranch', $holdingbranch );
- }
- return;
-}
-
-=head2 canbookbeissued
-
-Check if a book can be issued.
-
-my ($issuingimpossible,$needsconfirmation) = canbookbeissued($env,$borrower,$barcode,$year,$month,$day);
-
-=over 4
-
-=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
-
-=item C<$borrower> hash with borrower informations (from getpatroninformation)
-
-=item C<$barcode> is the bar code of the book being issued.
-
-=item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
-
-=back
-
-Returns :
-
-=over 4
-
-=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
-Possible values are :
-
-=back
-
-=head3 INVALID_DATE
-
-sticky due date is invalid
-
-=head3 GNA
-
-borrower gone with no address
-
-=head3 CARD_LOST
-
-borrower declared it's card lost
-
-=head3 DEBARRED
-
-borrower debarred
-
-=head3 UNKNOWN_BARCODE
-
-barcode unknown
-
-=head3 NOT_FOR_LOAN
-
-item is not for loan
-
-=head3 WTHDRAWN
-
-item withdrawn.
-
-=head3 RESTRICTED
-
-item is restricted (set by ??)
-
-C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
-Possible values are :
-
-=head3 DEBT
-
-borrower has debts.
-
-=head3 RENEW_ISSUE
-
-renewing, not issuing
-
-=head3 ISSUED_TO_ANOTHER
-
-issued to someone else.
-
-=head3 RESERVED
-
-reserved for someone else.
-
-=head3 INVALID_DATE
-
-sticky due date is invalid
-
-=head3 TOO_MANY
-
-if the borrower borrows to much things
-
-=cut
-
-# check if a book can be issued.
-# returns an array with errors if any
-
-sub TooMany ($$) {
- my $borrower = shift;
- my $iteminformation = shift;
- my $cat_borrower = $borrower->{'categorycode'};
- my $branch_borrower = $borrower->{'branchcode'};
- my $dbh = C4::Context->dbh;
-
- my $sth =
- $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
- $sth->execute( $iteminformation->{'biblionumber'} );
- my $type = $sth->fetchrow;
- $sth =
- $dbh->prepare(
-'select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'
- );
-
-# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?");
- my $sth2 =
- $dbh->prepare(
-"select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"
- );
- my $sth3 =
- $dbh->prepare(
-'select COUNT(*) from issues where borrowernumber = ? and returndate is null'
- );
- my $alreadyissued;
-
- # check the 3 parameters
- $sth->execute( $cat_borrower, $type, $branch_borrower );
- my $result = $sth->fetchrow_hashref;
-
- # warn "==>".$result->{maxissueqty};
-
-# Currently, using defined($result) ie on an entire hash reports whether memory
-# for that aggregate has ever been allocated. As $result is used all over the place
-# it would rarely return as undefined.
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- # check for branch=*
- $sth->execute( $cat_borrower, $type, "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- # check for itemtype=*
- $sth->execute( $cat_borrower, "*", $branch_borrower );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth3->execute( $borrower->{'borrowernumber'} );
- my ($alreadyissued) = $sth3->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
-
-# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
- return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- # check for borrowertype=*
- $sth->execute( "*", $type, $branch_borrower );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( "*", "*", $branch_borrower );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth3->execute( $borrower->{'borrowernumber'} );
- my $alreadyissued = $sth3->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( "*", $type, "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( $cat_borrower, "*", "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
- my $alreadyissued = $sth2->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
-
- $sth->execute( "*", "*", "" );
- $result = $sth->fetchrow_hashref;
- if ( defined( $result->{maxissueqty} ) ) {
- $sth3->execute( $borrower->{'borrowernumber'} );
- my $alreadyissued = $sth3->fetchrow;
- if ( $result->{'maxissueqty'} <= $alreadyissued ) {
- return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
- }
- else {
- return;
- }
- }
- return;
-}
-
-=head2 itemissues
-
- @issues = &itemissues($biblioitemnumber, $biblio);
-
-Looks up information about who has borrowed the bookZ<>(s) with the
-given biblioitemnumber.
-
-C<$biblio> is ignored.
-
-C<&itemissues> returns an array of references-to-hash. The keys
-include the fields from the C<items> table in the Koha database.
-Additional keys include:
-
-=over 4
-
-=item C<date_due>
-
-If the item is currently on loan, this gives the due date.
-
-If the item is not on loan, then this is either "Available" or
-"Cancelled", if the item has been withdrawn.
-
-=item C<card>
-
-If the item is currently on loan, this gives the card number of the
-patron who currently has the item.
-
-=item C<timestamp0>, C<timestamp1>, C<timestamp2>
-
-These give the timestamp for the last three times the item was
-borrowed.
-
-=item C<card0>, C<card1>, C<card2>
-
-The card number of the last three patrons who borrowed this item.
-
-=item C<borrower0>, C<borrower1>, C<borrower2>
-
-The borrower number of the last three patrons who borrowed this item.
-
-=back
-
-=cut
-
-#'
-sub itemissues {
- my ( $bibitem, $biblio ) = @_;
- my $dbh = C4::Context->dbh;
-
- # FIXME - If this function die()s, the script will abort, and the
- # user won't get anything; depending on how far the script has
- # gotten, the user might get a blank page. It would be much better
- # to at least print an error message. The easiest way to do this
- # is to set $SIG{__DIE__}.
- my $sth =
- $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
- || die $dbh->errstr;
- my $i = 0;
- my @results;
-
- $sth->execute($bibitem) || die $sth->errstr;
-
- while ( my $data = $sth->fetchrow_hashref ) {
-
- # Find out who currently has this item.
- # FIXME - Wouldn't it be better to do this as a left join of
- # some sort? Currently, this code assumes that if
- # fetchrow_hashref() fails, then the book is on the shelf.
- # fetchrow_hashref() can fail for any number of reasons (e.g.,
- # database server crash), not just because no items match the
- # search criteria.
- my $sth2 = $dbh->prepare(
- "select * from issues,borrowers
-where itemnumber = ?
-and returndate is NULL
-and issues.borrowernumber = borrowers.borrowernumber"
- );
-
- $sth2->execute( $data->{'itemnumber'} );
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $data->{'date_due'} = $data2->{'date_due'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- }
- else {
- if ( $data->{'wthdrawn'} eq '1' ) {
- $data->{'date_due'} = 'Cancelled';
- }
- else {
- $data->{'date_due'} = 'Available';
- } # else
- } # else
-
- $sth2->finish;
-
- # Find the last 3 people who borrowed this item.
- $sth2 = $dbh->prepare(
- "select * from issues, borrowers
- where itemnumber = ?
- and issues.borrowernumber = borrowers.borrowernumber
- and returndate is not NULL
- order by returndate desc,timestamp desc"
- );
-
-# $sth2 = $dbh->prepare("
-# SELECT *
-# FROM issues
-# LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
-# WHERE itemnumber = ?
-# AND returndate is not NULL
-# ORDER BY returndate DESC,timestamp DESC
-# ");
-
- $sth2->execute( $data->{'itemnumber'} );
- for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
- { # FIXME : error if there is less than 3 pple borrowing this item
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $data->{"timestamp$i2"} = $data2->{'timestamp'};
- $data->{"card$i2"} = $data2->{'cardnumber'};
- $data->{"borrower$i2"} = $data2->{'borrowernumber'};
- } # if
- } # for
-
- $sth2->finish;
- $results[$i] = $data;
- $i++;
- }
-
- $sth->finish;
- return (@results);
-}
-
-=head2 canbookbeissued
-
-$issuingimpossible, $needsconfirmation =
- canbookbeissued( $env, $borrower, $barcode, $year, $month, $day, $inprocess );
-
-C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
-
-=cut
-
-sub canbookbeissued {
- my ( $env, $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
- my %needsconfirmation; # filled with problems that needs confirmations
- my %issuingimpossible
- ; # filled with problems that causes the issue to be IMPOSSIBLE
- my $iteminformation = getiteminformation( 0, $barcode );
- my $dbh = C4::Context->dbh;
-
- #
- # DUE DATE is OK ?
- #
- my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
- $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
-
- #
- # BORROWER STATUS
- #
- if ( $borrower->{flags}->{GNA} ) {
- $issuingimpossible{GNA} = 1;
- }
- if ( $borrower->{flags}->{'LOST'} ) {
- $issuingimpossible{CARD_LOST} = 1;
- }
- if ( $borrower->{flags}->{'DBARRED'} ) {
- $issuingimpossible{DEBARRED} = 1;
- }
- if ( Date_to_Days(Today) >
- Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
- {
-
- #
- #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0) {
- $issuingimpossible{EXPIRED} = 1;
- }
-
- #
- # BORROWER STATUS
- #
-
- # DEBTS
- my $amount =
- checkaccount( $env, $borrower->{'borrowernumber'}, $dbh, $duedate );
- if ( C4::Context->preference("IssuingInProcess") ) {
- my $amountlimit = C4::Context->preference("noissuescharge");
- if ( $amount > $amountlimit && !$inprocess ) {
- $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
- }
- elsif ( $amount <= $amountlimit && !$inprocess ) {
- $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
- }
- }
- else {
- if ( $amount > 0 ) {
- $needsconfirmation{DEBT} = $amount;
- }
- }
-
- #
- # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
- #
- my $toomany = TooMany( $borrower, $iteminformation );
- $needsconfirmation{TOO_MANY} = $toomany if $toomany;
-
- #
- # ITEM CHECKING
- #
- unless ( $iteminformation->{barcode} ) {
- $issuingimpossible{UNKNOWN_BARCODE} = 1;
- }
- if ( $iteminformation->{'notforloan'}
- && $iteminformation->{'notforloan'} > 0 )
- {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ( $iteminformation->{'itemtype'}
- && $iteminformation->{'itemtype'} eq 'REF' )
- {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ( $iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1 )
- {
- $issuingimpossible{WTHDRAWN} = 1;
- }
- if ( $iteminformation->{'restricted'}
- && $iteminformation->{'restricted'} == 1 )
- {
- $issuingimpossible{RESTRICTED} = 1;
- }
- if ( C4::Context->preference("IndependantBranches") ) {
- my $userenv = C4::Context->userenv;
- if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
- $issuingimpossible{NOTSAMEBRANCH} = 1
- if ( $iteminformation->{'holdingbranch'} ne $userenv->{branch} );
- }
- }
-
- #
- # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
- #
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
- if ( $currentborrower && $currentborrower eq $borrower->{'borrowernumber'} )
- {
-
- # Already issued to current borrower. Ask whether the loan should
- # be renewed.
- my ($renewstatus) = renewstatus(
- $env,
- $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'}
- );
- if ( $renewstatus == 0 ) { # no more renewals allowed
- $issuingimpossible{NO_MORE_RENEWALS} = 1;
- }
- else {
-
- # $needsconfirmation{RENEW_ISSUE} = 1;
- }
- }
- elsif ($currentborrower) {
-
- # issued to someone else
- my $currborinfo = getpatroninformation( 0, $currentborrower );
-
-# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
- $needsconfirmation{ISSUED_TO_ANOTHER} =
-"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
- }
-
- # See if the item is on reserve.
- my ( $restype, $res ) = CheckReserves( $iteminformation->{'itemnumber'} );
- if ($restype) {
- my $resbor = $res->{'borrowernumber'};
- if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
- {
-
- # The item is on reserve and waiting, but has been
- # reserved by some other patron.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- $needsconfirmation{RESERVE_WAITING} =
-"$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
-
-# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
- }
- elsif ( $restype eq "Reserved" ) {
-
- # The item is on reserve for someone else.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- $needsconfirmation{RESERVED} =
-"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
- }
- }
- if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
- {
- if ( $borrower->{'categorycode'} eq 'W' ) {
- my %issuingimpossible;
- return ( \%issuingimpossible, \%needsconfirmation );
- }
- else {
- return ( \%issuingimpossible, \%needsconfirmation );
- }
- }
- else {
- return ( \%issuingimpossible, \%needsconfirmation );
- }
-}
-
-=head2 issuebook
-
-Issue a book. Does no check, they are done in canbookbeissued. If we reach this sub, it means the user confirmed if needed.
-
-&issuebook($env,$borrower,$barcode,$date)
-
-=over 4
-
-=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
-
-=item C<$borrower> hash with borrower informations (from getpatroninformation)
-
-=item C<$barcode> is the bar code of the book being issued.
-
-=item C<$date> contains the max date of return. calculated if empty.
-
-=back
-
-=cut
-
-sub issuebook {
- my ( $env, $borrower, $barcode, $date, $cancelreserve ) = @_;
- my $dbh = C4::Context->dbh;
-if ($borrower and $barcode){
-# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0);
- my $iteminformation = getiteminformation( 0, $barcode );
-
-#
-# check if we just renew the issue.
-#
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
- if ( $currentborrower eq $borrower->{'borrowernumber'} ) {
- my ( $charge, $itemtype ) = calc_charges(
- $env,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}
- );
- if ( $charge > 0 ) {
- createcharge(
- $env, $dbh,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}, $charge
- );
- $iteminformation->{'charge'} = $charge;
- }
- &UpdateStats(
- $env, $env->{'branchcode'},
- 'renew', $charge,
- '', $iteminformation->{'itemnumber'},
- $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
- );
- renewbook(
- $env,
- $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'}
- );
- }
- else {
-
- #
- # NOT a renewal
- #
- if ( $currentborrower ne '' ) {
-
-# This book is currently on loan, but not to the person
-# who wants to borrow it now. mark it returned before issuing to the new borrower
- returnbook(
- $iteminformation->{'barcode'},
- C4::Context->userenv->{'branch'}
- );
- }
-
- # See if the item is on reserve.
- my ( $restype, $res ) =
- CheckReserves( $iteminformation->{'itemnumber'} );
- if ($restype) {
- my $resbor = $res->{'borrowernumber'};
- if ( $resbor eq $borrower->{'borrowernumber'} ) {
-
- # The item is on reserve to the current patron
- FillReserve($res);
- }
- elsif ( $restype eq "Waiting" ) {
-
- # warn "Waiting";
- # The item is on reserve and waiting, but has been
- # reserved by some other patron.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- if ($cancelreserve) {
- CancelReserve( 0, $res->{'itemnumber'},
- $res->{'borrowernumber'} );
- }
- else {
-
- # set waiting reserve to first in reserve queue as book isn't waiting now
- UpdateReserve(
- 1,
- $res->{'biblionumber'},
- $res->{'borrowernumber'},
- $res->{'branchcode'}
- );
- }
- }
- elsif ( $restype eq "Reserved" ) {
-
- # warn "Reserved";
- # The item is on reserve for someone else.
- my ( $resborrower, $flags ) =
- getpatroninformation( $env, $resbor, 0 );
- my $branches = GetBranches();
- my $branchname =
- $branches->{ $res->{'branchcode'} }->{'branchname'};
- if ($cancelreserve) {
-
- # cancel reserves on this item
- CancelReserve( 0, $res->{'itemnumber'},
- $res->{'borrowernumber'} );
-
-# also cancel reserve on biblio related to this item
-#my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?");
-#$st_Fbiblio->execute($res->{'itemnumber'});
-#my $biblionumber = $st_Fbiblio->fetchrow;
-#CancelReserve($biblionumber,0,$res->{'borrowernumber'});
-#warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
- }
- else {
-
-# my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
-# transferbook($tobrcd,$barcode, 1);
-# warn "transferbook";
- }
- }
- }
-# END OF THE RESTYPE WORK
-
-# Starting process for transfer job (checking transfert and validate it if we have one)
-
- my ($datesent) = get_transfert_infos($iteminformation->{'itemnumber'});
-
- if ($datesent) {
-# updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
- my $sth =
- $dbh->prepare(
- "update branchtransfers set datearrived = now(),
- tobranch = ?,
- comments = 'Forced branchtransfert'
- where
- itemnumber= ? AND datearrived IS NULL"
- );
- $sth->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
- $sth->finish;
- }
-
-# Ending process for transfert check
-
- # Record in the database the fact that the book was issued.
- my $sth =
- $dbh->prepare(
-"insert into issues (borrowernumber, itemnumber,issuedate, date_due, branchcode) values (?,?,?,?,?)"
- );
- my $loanlength = getLoanLength(
- $borrower->{'categorycode'},
- $iteminformation->{'itemtype'},
- $borrower->{'branchcode'}
- );
- my $datedue = time + ($loanlength) * 86400;
- my @datearr = localtime($datedue);
- my $dateduef =
- ( 1900 + $datearr[5] ) . "-"
- . ( $datearr[4] + 1 ) . "-"
- . $datearr[3];
- if ($date) {
- $dateduef = $date;
- }
-
- # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
- if ( C4::Context->preference('ReturnBeforeExpiry')
- && $dateduef gt $borrower->{dateexpiry} )
- {
- $dateduef = $borrower->{dateexpiry};
- }
- $sth->execute(
- $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'},
- strftime( "%Y-%m-%d", localtime ),$dateduef, $env->{'branchcode'}
- );
- $sth->finish;
- $iteminformation->{'issues'}++;
- $sth =
- $dbh->prepare(
- "update items set issues=?, holdingbranch=? where itemnumber=?");
- $sth->execute(
- $iteminformation->{'issues'},
- C4::Context->userenv->{'branch'},
- $iteminformation->{'itemnumber'}
- );
- $sth->finish;
- &itemseen( $iteminformation->{'itemnumber'} );
- itemborrowed( $iteminformation->{'itemnumber'} );
-
- # If it costs to borrow this book, charge it to the patron's account.
- my ( $charge, $itemtype ) = calc_charges(
- $env,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}
- );
- if ( $charge > 0 ) {
- createcharge(
- $env, $dbh,
- $iteminformation->{'itemnumber'},
- $borrower->{'borrowernumber'}, $charge
- );
- $iteminformation->{'charge'} = $charge;
- }
-
- # Record the fact that this book was issued.
- &UpdateStats(
- $env, $env->{'branchcode'},
- 'issue', $charge,
- '', $iteminformation->{'itemnumber'},
- $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
- );
- }
-
- &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$iteminformation->{'biblionumber'})
- if C4::Context->preference("IssueLog");
- }
-}
-
-=head2 getLoanLength
-
-Get loan length for an itemtype, a borrower type and a branch
-
-my $loanlength = &getLoanLength($borrowertype,$itemtype,branchcode)
-
-=cut
-
-sub getLoanLength {
- my ( $borrowertype, $itemtype, $branchcode ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
-"select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
- );
-
-# try to find issuelength & return the 1st available.
-# check with borrowertype, itemtype and branchcode, then without one of those parameters
- $sth->execute( $borrowertype, $itemtype, $branchcode );
- my $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( $borrowertype, $itemtype, "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( $borrowertype, "*", $branchcode );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", $itemtype, $branchcode );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( $borrowertype, "*", "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", "*", $branchcode );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", $itemtype, "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- $sth->execute( "*", "*", "" );
- $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength}
- if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
-
- # if no rule is set => 21 days (hardcoded)
- return 21;
-}
-
-=head2 returnbook
-
-($doreturn, $messages, $iteminformation, $borrower) =
- &returnbook($barcode, $branch);
-
-Returns a book.
-
-C<$barcode> is the bar code of the book being returned. C<$branch> is
-the code of the branch where the book is being returned.
-
-C<&returnbook> returns a list of four items:
-
-C<$doreturn> is true iff the return succeeded.
-
-C<$messages> is a reference-to-hash giving the reason for failure:
-
-=over 4
-
-=item C<BadBarcode>
-
-No item with this barcode exists. The value is C<$barcode>.
-
-=item C<NotIssued>
-
-The book is not currently on loan. The value is C<$barcode>.
-
-=item C<IsPermanent>
-
-The book's home branch is a permanent collection. If you have borrowed
-this book, you are not allowed to return it. The value is the code for
-the book's home branch.
-
-=item C<wthdrawn>
-
-This book has been withdrawn/cancelled. The value should be ignored.
-
-=item C<ResFound>
-
-The item was reserved. The value is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database, and
-C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
-either C<Waiting>, C<Reserved>, or 0.
-
-=back
-
-C<$borrower> is a reference-to-hash, giving information about the
-patron who last borrowed the book.
-
-=cut
-
-# FIXME - This API is bogus. There's no need to return $borrower and
-# $iteminformation; the caller can ask about those separately, if it
-# cares (it'd be inefficient to make two database calls instead of
-# one, but &getpatroninformation and &getiteminformation can be
-# memoized if this is an issue).
-#
-# The ($doreturn, $messages) tuple is redundant: if the return
-# succeeded, that's all the caller needs to know. So &returnbook can
-# return 1 and 0 on success and failure, and set
-# $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
-# return undef for success, and an error message on error (though this
-# is more C-ish than Perl-ish).
-
-sub returnbook {
- my ( $barcode, $branch ) = @_;
- my %env;
- my $messages;
- my $dbh = C4::Context->dbh;
- my $doreturn = 1;
- my $validTransfert = 0;
- my $reserveDone = 0;
-
- die '$branch not defined' unless defined $branch; # just in case (bug 170)
- # get information on item
- my ($iteminformation) = getiteminformation( 0, $barcode );
-
- if ( not $iteminformation ) {
- $messages->{'BadBarcode'} = $barcode;
- $doreturn = 0;
- }
-
- # find the borrower
- my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
- if ( ( not $currentborrower ) && $doreturn ) {
- $messages->{'NotIssued'} = $barcode;
- $doreturn = 0;
- }
-
- # check if the book is in a permanent collection....
- my $hbr = $iteminformation->{'homebranch'};
- my $branches = GetBranches();
- if ( $hbr && $branches->{$hbr}->{'PE'} ) {
- $messages->{'IsPermanent'} = $hbr;
- }
-
- # check that the book has been cancelled
- if ( $iteminformation->{'wthdrawn'} ) {
- $messages->{'wthdrawn'} = 1;itemnumber
- $doreturn = 0;
- }
-
-# new op dev : if the book returned in an other branch update the holding branch
-
-# update issues, thereby returning book (should push this out into another subroutine
- my ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
-
-# case of a return of document (deal with issues and holdingbranch)
-
- if ($doreturn) {
- my $sth =
- $dbh->prepare(
-"update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"
- );
- $sth->execute( $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'} );
- $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
- }
-
-# continue to deal with returns cases, but not only if we have an issue
-
-# the holdingbranch is updated if the document is returned in an other location .
-if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
- {
- UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
-# reload iteminformation holdingbranch with the userenv value
- $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
- }
- itemseen( $iteminformation->{'itemnumber'} );
- ($borrower) = getpatroninformation( \%env, $currentborrower, 0 );
-
- # fix up the accounts.....
- if ( $iteminformation->{'itemlost'} ) {
- fixaccountforlostandreturned( $iteminformation, $borrower );
- $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
- }
-
- # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
- # check if we have a transfer for this document
- my ($datesent,$frombranch,$tobranch) = checktransferts( $iteminformation->{'itemnumber'} );
-
- # if we have a return, we update the line of transfers with the datearrived
- if ($datesent) {
- if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
- my $sth =
- $dbh->prepare(
- "update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL"
- );
- $sth->execute( $iteminformation->{'itemnumber'} );
- $sth->finish;
-# now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W'
- SetWaitingStatus( $iteminformation->{'itemnumber'} );
- }
- else {
- $messages->{'WrongTransfer'} = $tobranch;
- $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
- }
- $validTransfert = 1;
- }
-
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
-# fix up the overdues in accounts...
- fixoverduesonreturn( $borrower->{'borrowernumber'},
- $iteminformation->{'itemnumber'} );
-
-# find reserves.....
-# if we don't have a reserve with the status W, we launch the Checkreserves routine
- my ( $resfound, $resrec ) =
- CheckReserves( $iteminformation->{'itemnumber'} );
- if ($resfound) {
-
-# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
- $resrec->{'ResFound'} = $resfound;
- $messages->{'ResFound'} = $resrec;
- $reserveDone = 1;
- }
-
- # update stats?
- # Record the fact that this book was returned.
- UpdateStats(
- \%env, $branch, 'return', '0', '',
- $iteminformation->{'itemnumber'},
- $iteminformation->{'itemtype'},
- $borrower->{'borrowernumber'}
- );
-
- &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$currentborrower,$iteminformation->{'biblionumber'})
- if C4::Context->preference("ReturnLog");
-
- #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
- #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
-
- if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
- if (C4::Context->preference("AutomaticItemReturn") == 1) {
- dotransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
- $messages->{'WasTransfered'} = 1;
- warn "was transfered";
- }
- }
-
- return ( $doreturn, $messages, $iteminformation, $borrower );
-}
-
-=head2 fixaccountforlostandreturned
-
- &fixaccountforlostandreturned($iteminfo,$borrower);
-
-Calculates the charge for a book lost and returned (Not exported & used only once)
-
-C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
-
-C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
-
-=cut
-
-sub fixaccountforlostandreturned {
- my ( $iteminfo, $borrower ) = @_;
- my %env;
- my $dbh = C4::Context->dbh;
- my $itm = $iteminfo->{'itemnumber'};
-
- # check for charge made for lost book
- my $sth =
- $dbh->prepare(
-"select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc"
- );
- $sth->execute($itm);
- if ( my $data = $sth->fetchrow_hashref ) {
-
- # writeoff this amount
- my $offset;
- my $amount = $data->{'amount'};
- my $acctno = $data->{'accountno'};
- my $amountleft;
- if ( $data->{'amountoutstanding'} == $amount ) {
- $offset = $data->{'amount'};
- $amountleft = 0;
- }
- else {
- $offset = $amount - $data->{'amountoutstanding'};
- $amountleft = $data->{'amountoutstanding'} - $amount;
- }
- my $usth = $dbh->prepare(
- "update accountlines set accounttype = 'LR',amountoutstanding='0'
- where (borrowernumber = ?)
- and (itemnumber = ?) and (accountno = ?) "
- );
- $usth->execute( $data->{'borrowernumber'}, $itm, $acctno );
- $usth->finish;
-
- #check if any credit is left if so writeoff other accounts
- my $nextaccntno =
- getnextacctno( \%env, $data->{'borrowernumber'}, $dbh );
- if ( $amountleft < 0 ) {
- $amountleft *= -1;
- }
- if ( $amountleft > 0 ) {
- my $msth = $dbh->prepare(
- "select * from accountlines where (borrowernumber = ?)
- and (amountoutstanding >0) order by date"
- );
- $msth->execute( $data->{'borrowernumber'} );
-
- # offset transactions
- my $newamtos;
- my $accdata;
- while ( ( $accdata = $msth->fetchrow_hashref )
- and ( $amountleft > 0 ) )
- {
- if ( $accdata->{'amountoutstanding'} < $amountleft ) {
- $newamtos = 0;
- $amountleft -= $accdata->{'amountoutstanding'};
- }
- else {
- $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
- $amountleft = 0;
- }
- my $thisacct = $accdata->{'accountno'};
- my $usth = $dbh->prepare(
- "update accountlines set amountoutstanding= ?
- where (borrowernumber = ?)
- and (accountno=?)"
- );
- $usth->execute( $newamtos, $data->{'borrowernumber'},
- '$thisacct' );
- $usth->finish;
- $usth = $dbh->prepare(
- "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values
- (?,?,?,?)"
- );
- $usth->execute(
- $data->{'borrowernumber'},
- $accdata->{'accountno'},
- $nextaccntno, $newamtos
- );
- $usth->finish;
- }
- $msth->finish;
- }
- if ( $amountleft > 0 ) {
- $amountleft *= -1;
- }
- my $desc = "Book Returned " . $iteminfo->{'barcode'};
- $usth = $dbh->prepare(
- "insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values (?,?,now(),?,?,'CR',?)"
- );
- $usth->execute(
- $data->{'borrowernumber'},
- $nextaccntno, 0 - $amount,
- $desc, $amountleft
- );
- $usth->finish;
- $usth = $dbh->prepare(
- "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values (?,?,?,?)"
- );
- $usth->execute( $borrower->{'borrowernumber'},
- $data->{'accountno'}, $nextaccntno, $offset );
- $usth->finish;
- $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
- $usth->execute($itm);
- $usth->finish;
- }
- $sth->finish;
- return;
-}
-
-=head2 fixoverdueonreturn
-
- &fixoverdueonreturn($brn,$itm);
-
-C<$brn> borrowernumber
-
-C<$itm> itemnumber
-
-=cut
-
-sub fixoverduesonreturn {
- my ( $brn, $itm ) = @_;
- my $dbh = C4::Context->dbh;
-
- # check for overdue fine
- my $sth =
- $dbh->prepare(
-"select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')"
- );
- $sth->execute( $brn, $itm );
-
- # alter fine to show that the book has been returned
- if ( my $data = $sth->fetchrow_hashref ) {
- my $usth =
- $dbh->prepare(
-"update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"
- );
- $usth->execute( $brn, $itm, $data->{'accountno'} );
- $usth->finish();
- }
- $sth->finish();
- return;
-}
-
-=head2 patronflags
-
- Not exported
-
- NOTE!: If you change this function, be sure to update the POD for
- &getpatroninformation.
-
- $flags = &patronflags($env, $patron, $dbh);
-
- $flags->{CHARGES}
- {message} Message showing patron's credit or debt
- {noissues} Set if patron owes >$5.00
- {GNA} Set if patron gone w/o address
- {message} "Borrower has no valid address"
- {noissues} Set.
- {LOST} Set if patron's card reported lost
- {message} Message to this effect
- {noissues} Set.
- {DBARRED} Set is patron is debarred
- {message} Message to this effect
- {noissues} Set.
- {NOTES} Set if patron has notes
- {message} Notes about patron
- {ODUES} Set if patron has overdue books
- {message} "Yes"
- {itemlist} ref-to-array: list of overdue books
- {itemlisttext} Text list of overdue items
- {WAITING} Set if there are items available that the
- patron reserved
- {message} Message to this effect
- {itemlist} ref-to-array: list of available items
-
-=cut
-
-sub patronflags {
-
- # Original subroutine for Circ2.pm
- my %flags;
- my ( $env, $patroninformation, $dbh ) = @_;
- my $amount =
- checkaccount( $env, $patroninformation->{'borrowernumber'}, $dbh );
- if ( $amount > 0 ) {
- my %flaginfo;
- my $noissuescharge = C4::Context->preference("noissuescharge");
- $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
- if ( $amount > $noissuescharge ) {
- $flaginfo{'noissues'} = 1;
- }
- $flags{'CHARGES'} = \%flaginfo;
- }
- elsif ( $amount < 0 ) {
- my %flaginfo;
- $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
- $flags{'CHARGES'} = \%flaginfo;
- }
- if ( $patroninformation->{'gonenoaddress'}
- && $patroninformation->{'gonenoaddress'} == 1 )
- {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower has no valid address.';
- $flaginfo{'noissues'} = 1;
- $flags{'GNA'} = \%flaginfo;
- }
- if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower\'s card reported lost.';
- $flaginfo{'noissues'} = 1;
- $flags{'LOST'} = \%flaginfo;
- }
- if ( $patroninformation->{'debarred'}
- && $patroninformation->{'debarred'} == 1 )
- {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower is Debarred.';
- $flaginfo{'noissues'} = 1;
- $flags{'DBARRED'} = \%flaginfo;
- }
- if ( $patroninformation->{'borrowernotes'}
- && $patroninformation->{'borrowernotes'} )
- {
- my %flaginfo;
- $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
- $flags{'NOTES'} = \%flaginfo;
- }
- my ( $odues, $itemsoverdue ) =
- checkoverdues( $env, $patroninformation->{'borrowernumber'}, $dbh );
- if ( $odues > 0 ) {
- my %flaginfo;
- $flaginfo{'message'} = "Yes";
- $flaginfo{'itemlist'} = $itemsoverdue;
- foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
- @$itemsoverdue )
- {
- $flaginfo{'itemlisttext'} .=
- "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
- }
- $flags{'ODUES'} = \%flaginfo;
- }
- my $itemswaiting =
- C4::Reserves2::GetWaitingReserves( $patroninformation->{'borrowernumber'} );
- my $nowaiting = scalar @$itemswaiting;
- if ( $nowaiting > 0 ) {
- my %flaginfo;
- $flaginfo{'message'} = "Reserved items available";
- $flaginfo{'itemlist'} = $itemswaiting;
- $flags{'WAITING'} = \%flaginfo;
- }
- return ( \%flags );
-}
-
-=head2 checkoverdues
-
-( $count, $overdueitems )=checkoverdues( $env, $borrowernumber, $dbh );
-
-Not exported
-
-=cut
-
-sub checkoverdues {
-
-# From Main.pm, modified to return a list of overdueitems, in addition to a count
-#checks whether a borrower has overdue items
- my ( $env, $borrowernumber, $dbh ) = @_;
- my @datearr = localtime;
- my $today =
- ( $datearr[5] + 1900 ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
- my @overdueitems;
- my $count = 0;
- my $sth = $dbh->prepare(
- "SELECT * FROM issues,biblio,biblioitems,items
- WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
- AND items.biblionumber = biblio.biblionumber
- AND issues.itemnumber = items.itemnumber
- AND issues.borrowernumber = ?
- AND issues.returndate is NULL
- AND issues.date_due < ?"
- );
- $sth->execute( $borrowernumber, $today );
- while ( my $data = $sth->fetchrow_hashref ) {
- push( @overdueitems, $data );
- $count++;
- }
- $sth->finish;
- return ( $count, \@overdueitems );
-}
-
-=head2 currentborrower
-
-$borrower=currentborrower($itemnumber)
-
-Not exported
-
-=cut
-
-sub currentborrower {
-
- # Original subroutine for Circ2.pm
- my ($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $q_itemnumber = $dbh->quote($itemnumber);
- my $sth = $dbh->prepare(
- "select borrowers.borrowernumber from
- issues,borrowers where issues.itemnumber=$q_itemnumber and
- issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
- NULL"
- );
- $sth->execute;
- my ($borrower) = $sth->fetchrow;
- return ($borrower);
-}
-
-=head2 checkreserve_to_delete
-
-( $resbor, $resrec ) = &checkreserve_to_delete($env,$dbh,$itemnum);
-
-=cut
-
-sub checkreserve_to_delete {
-
- # Stolen from Main.pm
- # Check for reserves for biblio
- my ( $env, $dbh, $itemnum ) = @_;
- my $resbor = "";
- my $sth = $dbh->prepare(
- "select * from reserves,items
- where (items.itemnumber = ?)
- and (reserves.cancellationdate is NULL)
- and (items.biblionumber = reserves.biblionumber)
- and ((reserves.found = 'W')
- or (reserves.found is null))
- order by priority"
- );
- $sth->execute($itemnum);
- my $resrec;
- my $data = $sth->fetchrow_hashref;
- while ( $data && $resbor eq '' ) {
- $resrec = $data;
- my $const = $data->{'constrainttype'};
- if ( $const eq "a" ) {
- $resbor = $data->{'borrowernumber'};
- }
- else {
- my $found = 0;
- my $csth = $dbh->prepare(
- "select * from reserveconstraints,items
- where (borrowernumber=?)
- and reservedate=?
- and reserveconstraints.biblionumber=?
- and (items.itemnumber=? and
- items.biblioitemnumber = reserveconstraints.biblioitemnumber)"
- );
- $csth->execute(
- $data->{'borrowernumber'},
- $data->{'biblionumber'},
- $data->{'reservedate'}, $itemnum
- );
- if ( my $cdata = $csth->fetchrow_hashref ) { $found = 1; }
- if ( $const eq 'o' ) {
- if ( $found eq 1 ) { $resbor = $data->{'borrowernumber'}; }
- }
- else {
- if ( $found eq 0 ) { $resbor = $data->{'borrowernumber'}; }
- }
- $csth->finish();
- }
- $data = $sth->fetchrow_hashref;
- }
- $sth->finish;
- return ( $resbor, $resrec );
-}
-
-=head2 currentissues
-
-$issues = ¤tissues($env, $borrower);
-
-Returns a list of books currently on loan to a patron.
-
-If C<$env-E<gt>{todaysissues}> is set and true, C<¤tissues> only
-returns information about books issued today. If
-C<$env-E<gt>{nottodaysissues}> is set and true, C<¤tissues> only
-returns information about books issued before today. If both are
-specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
-specified, C<¤tissues> returns all of the patron's issues.
-
-C<$borrower->{borrowernumber}> is the borrower number of the patron
-whose issues we want to list.
-
-C<¤tissues> returns a PHP-style array: C<$issues> is a
-reference-to-hash whose keys are integers in the range 1...I<n>, where
-I<n> is the number of items on issue (either today or before today).
-C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
-the fields of the biblio, biblioitems, items, and issues fields of the
-Koha database for that particular item.
-
-=cut
-
-#'
-sub currentissues {
-
- # New subroutine for Circ2.pm
- my ( $env, $borrower ) = @_;
- my $dbh = C4::Context->dbh;
- my %currentissues;
- my $counter = 1;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my $crit = '';
-
- # Figure out whether to get the books issued today, or earlier.
- # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
- # both be specified, but are mutually-exclusive. This is bogus.
- # Make this a flag. Or better yet, return everything in (reverse)
- # chronological order and let the caller figure out which books
- # were issued today.
- if ( $env->{'todaysissues'} ) {
-
- # FIXME - Could use
- # $today = POSIX::strftime("%Y%m%d", localtime);
- # FIXME - Since $today will be used in either case, move it
- # out of the two if-blocks.
- my @datearr = localtime( time() );
- my $today = ( 1900 + $datearr[5] ) . sprintf "%02d",
- ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3];
-
- # FIXME - MySQL knows about dates. Just use
- # and issues.timestamp = curdate();
- $crit = " and issues.timestamp like '$today%' ";
- }
- if ( $env->{'nottodaysissues'} ) {
-
- # FIXME - Could use
- # $today = POSIX::strftime("%Y%m%d", localtime);
- # FIXME - Since $today will be used in either case, move it
- # out of the two if-blocks.
- my @datearr = localtime( time() );
- my $today = ( 1900 + $datearr[5] ) . sprintf "%02d",
- ( $datearr[4] + 1 ) . sprintf "%02d", $datearr[3];
-
- # FIXME - MySQL knows about dates. Just use
- # and issues.timestamp < curdate();
- $crit = " and !(issues.timestamp like '$today%') ";
- }
-
- # FIXME - Does the caller really need every single field from all
- # four tables?
- my $sth = $dbh->prepare(
- "select * from issues,items,biblioitems,biblio where
- borrowernumber=? and issues.itemnumber=items.itemnumber and
- items.biblionumber=biblio.biblionumber and
- items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
- $crit order by issues.date_due"
- );
- $sth->execute($borrowernumber);
- while ( my $data = $sth->fetchrow_hashref ) {
-
- # FIXME - The Dewey code is a string, not a number.
- $data->{'dewey'} =~ s/0*$//;
- ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' );
-
- # FIXME - Could use
- # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
- # or better yet, just reuse $today which was calculated above.
- # This function isn't going to run until midnight, is it?
- # Alternately, use
- # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
- # if ($data->{'date_due'} lt $todaysdate)
- # ...
- # Either way, the date should be be formatted outside of the
- # loop.
- my @datearr = localtime( time() );
- my $todaysdate =
- ( 1900 + $datearr[5] )
- . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
- . sprintf( "%0.2d", $datearr[3] );
- my $datedue = $data->{'date_due'};
- $datedue =~ s/-//g;
- if ( $datedue < $todaysdate ) {
- $data->{'overdue'} = 1;
- }
- my $itemnumber = $data->{'itemnumber'};
-
- # FIXME - Consecutive integers as hash keys? You have GOT to
- # be kidding me! Use an array, fercrissakes!
- $currentissues{$counter} = $data;
- $counter++;
- }
- $sth->finish;
- return ( \%currentissues );
-}
-
-=head2 getissues
-
-$issues = &getissues($borrowernumber);
-
-Returns the set of books currently on loan to a patron.
-
-C<$borrowernumber> is the patron's borrower number.
-
-C<&getissues> returns a PHP-style array: C<$issues> is a
-reference-to-hash whose keys are integers in the range 0..I<n>-1,
-where I<n> is the number of books the patron currently has on loan.
-
-The values of C<$issues> are references-to-hash whose keys are
-selected fields from the issues, items, biblio, and biblioitems tables
-of the Koha database.
-
-=cut
-
-#'
-sub getissues {
-
- # New subroutine for Circ2.pm
- my ($borrower) = @_;
- my $dbh = C4::Context->dbh;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my %currentissues;
- my $select = "
- SELECT items.*,
- issues.timestamp AS timestamp,
- issues.date_due AS date_due,
- items.barcode AS barcode,
- biblio.title AS title,
- biblio.author AS author,
- biblioitems.dewey AS dewey,
- itemtypes.description AS itemtype,
- biblioitems.subclass AS subclass,
- biblioitems.ccode AS ccode,
- biblioitems.isbn AS isbn,
- biblioitems.classification AS classification
- FROM items
- LEFT JOIN issues ON issues.itemnumber = items.itemnumber
- LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
- LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
- LEFT JOIN itemtypes ON itemtypes.itemtype = biblioitems.itemtype
- WHERE issues.borrowernumber = ?
- AND issues.returndate IS NULL
- ORDER BY issues.date_due DESC
- ";
- my $sth = $dbh->prepare($select);
- $sth->execute($borrowernumber);
- my $counter = 0;
-
- while ( my $data = $sth->fetchrow_hashref ) {
- $data->{'dewey'} =~ s/0*$//;
- ( $data->{'dewey'} == 0 ) && ( $data->{'dewey'} = '' );
-
- # FIXME - The Dewey code is a string, not a number.
- # FIXME - Use POSIX::strftime to get a text version of today's
- # date. That's what it's for.
- # FIXME - Move the date calculation outside of the loop.
- my @datearr = localtime( time() );
- my $todaysdate =
- ( 1900 + $datearr[5] )
- . sprintf( "%0.2d", ( $datearr[4] + 1 ) )
- . sprintf( "%0.2d", $datearr[3] );
-
- # FIXME - Instead of converting the due date to YYYYMMDD, just
- # use
- # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
- # ...
- # if ($date->{date_due} lt $todaysdate)
- my $datedue = $data->{'date_due'};
- $datedue =~ s/-//g;
- if ( $datedue < $todaysdate ) {
- $data->{'overdue'} = 1;
- }
- $currentissues{$counter} = $data;
- $counter++;
-
- # FIXME - This is ludicrous. If you want to return an
- # array of values, just use an array. That's what
- # they're there for.
- }
- $sth->finish;
- return ( \%currentissues );
-}
-
-=head2 GetIssuesFromBiblio
-
-$issues = GetIssuesFromBiblio($biblionumber);
-
-this function get all issues from a biblionumber.
-
-Return:
-C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
-tables issues and the firstname,surname & cardnumber from borrowers.
-
-=cut
-
-sub GetIssuesFromBiblio {
- my $biblionumber = shift;
- return undef unless $biblionumber;
- my $dbh = C4::Context->dbh;
- my $query = "
- SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
- FROM issues
- LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
- LEFT JOIN items ON issues.itemnumber = items.itemnumber
- LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
- LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
- WHERE biblio.biblionumber = ?
- ORDER BY issues.timestamp
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute($biblionumber);
-
- my @issues;
- while ( my $data = $sth->fetchrow_hashref ) {
- push @issues, $data;
- }
- return \@issues;
-}
-
-=head2 renewstatus
-
-$ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber);
-
-Find out whether a borrowed item may be renewed.
-
-C<$env> is ignored.
-
-C<$dbh> is a DBI handle to the Koha database.
-
-C<$borrowernumber> is the borrower number of the patron who currently
-has the item on loan.
-
-C<$itemnumber> is the number of the item to renew.
-
-C<$renewstatus> returns a true value iff the item may be renewed. The
-item must currently be on loan to the specified borrower; renewals
-must be allowed for the item's type; and the borrower must not have
-already renewed the loan.
-
-=cut
-
-sub renewstatus {
-
- # check renewal status
- my ( $env, $borrowernumber, $itemno ) = @_;
- my $dbh = C4::Context->dbh;
- my $renews = 1;
- my $renewokay = 0;
-
- # Look in the issues table for this item, lent to this borrower,
- # and not yet returned.
-
- # FIXME - I think this function could be redone to use only one SQL call.
- my $sth1 = $dbh->prepare(
- "select * from issues
- where (borrowernumber = ?)
- and (itemnumber = ?)
- and returndate is null"
- );
- $sth1->execute( $borrowernumber, $itemno );
- if ( my $data1 = $sth1->fetchrow_hashref ) {
-
- # Found a matching item
-
- # See if this item may be renewed. This query is convoluted
- # because it's a bit messy: given the item number, we need to find
- # the biblioitem, which gives us the itemtype, which tells us
- # whether it may be renewed.
- my $sth2 = $dbh->prepare(
- "SELECT renewalsallowed from items,biblioitems,itemtypes
- where (items.itemnumber = ?)
- and (items.biblioitemnumber = biblioitems.biblioitemnumber)
- and (biblioitems.itemtype = itemtypes.itemtype)"
- );
- $sth2->execute($itemno);
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- $renews = $data2->{'renewalsallowed'};
- }
- if ( $renews && $renews > $data1->{'renewals'} ) {
- $renewokay = 1;
- }
- $sth2->finish;
- my ( $resfound, $resrec ) = CheckReserves($itemno);
- if ($resfound) {
- $renewokay = 0;
- }
- ( $resfound, $resrec ) = CheckReserves($itemno);
- if ($resfound) {
- $renewokay = 0;
- }
-
- }
- $sth1->finish;
- return ($renewokay);
-}
-
-=head2 renewbook
-
-&renewbook($env, $borrowernumber, $itemnumber, $datedue);
-
-Renews a loan.
-
-C<$env-E<gt>{branchcode}> is the code of the branch where the
-renewal is taking place.
-
-C<$env-E<gt>{usercode}> is the value to log in C<statistics.usercode>
-in the Koha database.
-
-C<$borrowernumber> is the borrower number of the patron who currently
-has the item.
-
-C<$itemnumber> is the number of the item to renew.
-
-C<$datedue> can be used to set the due date. If C<$datedue> is the
-empty string, C<&renewbook> will calculate the due date automatically
-from the book's item type. If you wish to set the due date manually,
-C<$datedue> should be in the form YYYY-MM-DD.
-
-=cut
-
-sub renewbook {
-
- # mark book as renewed
- my ( $env, $borrowernumber, $itemno, $datedue ) = @_;
- my $dbh = C4::Context->dbh;
-
- # If the due date wasn't specified, calculate it by adding the
- # book's loan length to today's date.
- if ( $datedue eq "" ) {
-
- #debug_msg($env, "getting date");
- my $iteminformation = getiteminformation( $itemno, 0 );
- my $borrower = getpatroninformation( $env, $borrowernumber, 0 );
- my $loanlength = getLoanLength(
- $borrower->{'categorycode'},
- $iteminformation->{'itemtype'},
- $borrower->{'branchcode'}
- );
- my ( $due_year, $due_month, $due_day ) =
- Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
- $datedue = "$due_year-$due_month-$due_day";
-
- #$datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d");
- }
-
- # Find the issues record for this book
- my $sth =
- $dbh->prepare(
-"select * from issues where borrowernumber=? and itemnumber=? and returndate is null"
- );
- $sth->execute( $borrowernumber, $itemno );
- my $issuedata = $sth->fetchrow_hashref;
- $sth->finish;
-
- # Update the issues record to have the new due date, and a new count
- # of how many times it has been renewed.
- my $renews = $issuedata->{'renewals'} + 1;
- $sth = $dbh->prepare(
- "update issues set date_due = ?, renewals = ?
- where borrowernumber=? and itemnumber=? and returndate is null"
- );
- $sth->execute( $datedue, $renews, $borrowernumber, $itemno );
- $sth->finish;
-
- # Log the renewal
- UpdateStats( $env, $env->{'branchcode'}, 'renew', '', '', $itemno );
-
- # Charge a new rental fee, if applicable?
- my ( $charge, $type ) = calc_charges( $env, $itemno, $borrowernumber );
- if ( $charge > 0 ) {
- my $accountno = getnextacctno( $env, $borrowernumber, $dbh );
- my $item = getiteminformation($itemno);
- $sth = $dbh->prepare(
-"Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
- values (?,?,now(),?,?,?,?,?)"
- );
- $sth->execute( $borrowernumber, $accountno, $charge,
- "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
- 'Rent', $charge, $itemno );
- $sth->finish;
- }
-
- # return();
-}
-
-=head2 calc_charges
-
-($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
-
-Calculate how much it would cost for a given patron to borrow a given
-item, including any applicable discounts.
-
-C<$env> is ignored.
-
-C<$itemnumber> is the item number of item the patron wishes to borrow.
-
-C<$borrowernumber> is the patron's borrower number.
-
-C<&calc_charges> returns two values: C<$charge> is the rental charge,
-and C<$item_type> is the code for the item's item type (e.g., C<VID>
-if it's a video).
-
-=cut
-
-sub calc_charges {
-
- # calculate charges due
- my ( $env, $itemno, $borrowernumber ) = @_;
- my $charge = 0;
- my $dbh = C4::Context->dbh;
- my $item_type;
-
- # Get the book's item type and rental charge (via its biblioitem).
- my $sth1 = $dbh->prepare(
- "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
- where (items.itemnumber =?)
- and (biblioitems.biblioitemnumber = items.biblioitemnumber)
- and (biblioitems.itemtype = itemtypes.itemtype)"
- );
- $sth1->execute($itemno);
- if ( my $data1 = $sth1->fetchrow_hashref ) {
- $item_type = $data1->{'itemtype'};
- $charge = $data1->{'rentalcharge'};
- my $q2 = "select rentaldiscount from issuingrules,borrowers
- where (borrowers.borrowernumber = ?)
- and (borrowers.categorycode = issuingrules.categorycode)
- and (issuingrules.itemtype = ?)";
- my $sth2 = $dbh->prepare($q2);
- $sth2->execute( $borrowernumber, $item_type );
- if ( my $data2 = $sth2->fetchrow_hashref ) {
- my $discount = $data2->{'rentaldiscount'};
- if ( $discount eq 'NULL' ) {
- $discount = 0;
- }
- $charge = ( $charge * ( 100 - $discount ) ) / 100;
- }
- $sth2->finish;
- }
-
- $sth1->finish;
- return ( $charge, $item_type );
-}
-
-=head2 createcharge
-
-&createcharge( $env, $dbh, $itemno, $borrowernumber, $charge )
-
-=cut
-
-# FIXME - A virtually identical function appears in
-# C4::Circulation::Issues. Pick one and stick with it.
-sub createcharge {
-
- #Stolen from Issues.pm
- my ( $env, $dbh, $itemno, $borrowernumber, $charge ) = @_;
- my $nextaccntno = getnextacctno( $env, $borrowernumber, $dbh );
- my $query ="
- INSERT INTO accountlines
- (borrowernumber, itemnumber, accountno,
- date, amount, description, accounttype,
- amountoutstanding)
- VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute( $borrowernumber, $itemno, $nextaccntno, $charge, $charge );
- $sth->finish;
-}
-
-=head2 find_reserves
-
-($status, $record) = &find_reserves($itemnumber);
-
-Looks up an item in the reserves.
-
-C<$itemnumber> is the itemnumber to look up.
-
-C<$status> is true iff the search was successful.
-
-C<$record> is a reference-to-hash describing the reserve. Its keys are
-the fields from the reserves table of the Koha database.
-
-=cut
-
-#'
-# FIXME - This API is bogus: just return the record, or undef if none
-# was found.
-# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
-# that one looks rather different.
-sub find_reserves {
-
- # Stolen from Returns.pm
- warn "!!!!! SHOULD NOT BE HERE : Circ2::find_reserves is deprecated !!!";
- my ($itemno) = @_;
- my %env;
- my $dbh = C4::Context->dbh;
- my ($itemdata) = getiteminformation( $itemno, 0 );
- my $bibno = $dbh->quote( $itemdata->{'biblionumber'} );
- my $bibitm = $dbh->quote( $itemdata->{'biblioitemnumber'} );
- my $sth =
- $dbh->prepare(
-"select * from reserves where ((found = 'W') or (found is null)) and biblionumber = ? and cancellationdate is NULL order by priority, reservedate"
- );
- $sth->execute($bibno);
- my $resfound = 0;
- my $resrec;
- my $lastrec;
-
- # print $query;
-
- # FIXME - I'm not really sure what's going on here, but since we
- # only want one result, wouldn't it be possible (and far more
- # efficient) to do something clever in SQL that only returns one
- # set of values?
- while ( ( $resrec = $sth->fetchrow_hashref ) && ( not $resfound ) ) {
-
- # FIXME - Unlike Pascal, Perl allows you to exit loops
- # early. Take out the "&& (not $resfound)" and just
- # use "last" at the appropriate point in the loop.
- # (Oh, and just in passing: if you'd used "!" instead
- # of "not", you wouldn't have needed the parentheses.)
- $lastrec = $resrec;
- my $brn = $dbh->quote( $resrec->{'borrowernumber'} );
- my $rdate = $dbh->quote( $resrec->{'reservedate'} );
- my $bibno = $dbh->quote( $resrec->{'biblionumber'} );
- if ( $resrec->{'found'} eq "W" ) {
- if ( $resrec->{'itemnumber'} eq $itemno ) {
- $resfound = 1;
- }
- }
- else {
- # FIXME - Use 'elsif' to avoid unnecessary indentation.
- if ( $resrec->{'constrainttype'} eq "a" ) {
- $resfound = 1;
- }
- else {
- my $consth =
- $dbh->prepare(
- "SELECT * FROM reserveconstraints
- WHERE borrowernumber = ?
- AND reservedate = ?
- AND biblionumber = ?
- AND biblioitemnumber = ?"
- );
- $consth->execute( $brn, $rdate, $bibno, $bibitm );
- if ( my $conrec = $consth->fetchrow_hashref ) {
- if ( $resrec->{'constrainttype'} eq "o" ) {
- $resfound = 1;
- }
- }
- $consth->finish;
- }
- }
- if ($resfound) {
- my $updsth =
- $dbh->prepare(
- "UPDATE reserves
- SET found = 'W',
- itemnumber = ?
- WHERE borrowernumber = ?
- AND reservedate = ?
- AND biblionumber = ?"
- );
- $updsth->execute( $itemno, $brn, $rdate, $bibno );
- $updsth->finish;
-
- # FIXME - "last;" here to break out of the loop early.
- }
- }
- $sth->finish;
- return ( $resfound, $lastrec );
-}
-
-=head2 fixdate
-
-( $date, $invalidduedate ) = fixdate( $year, $month, $day );
-
-=cut
-
-sub fixdate {
- my ( $year, $month, $day ) = @_;
- my $invalidduedate;
- my $date;
- if ( $year && $month && $day ) {
- if ( ( $year eq 0 ) && ( $month eq 0 ) && ( $year eq 0 ) ) {
-
- # $env{'datedue'}='';
- }
- else {
- if ( ( $year eq 0 ) || ( $month eq 0 ) || ( $year eq 0 ) ) {
- $invalidduedate = 1;
- }
- else {
- if (
- ( $day > 30 )
- && ( ( $month == 4 )
- || ( $month == 6 )
- || ( $month == 9 )
- || ( $month == 11 ) )
- )
- {
- $invalidduedate = 1;
- }
- elsif ( ( $day > 29 ) && ( $month == 2 ) ) {
- $invalidduedate = 1;
- }
- elsif (
- ( $month == 2 )
- && ( $day > 28 )
- && ( ( $year % 4 )
- && ( ( !( $year % 100 ) || ( $year % 400 ) ) ) )
- )
- {
- $invalidduedate = 1;
- }
- else {
- $date = "$year-$month-$day";
- }
- }
- }
- }
- return ( $date, $invalidduedate );
-}
-
-=head2 get_current_return_date_of
-
-&get_current_return_date_of(@itemnumber);
-
-=cut
-
-sub get_current_return_date_of {
- my (@itemnumbers) = @_;
- my $query = '
- SELECT
- date_due,
- itemnumber
- FROM issues
- WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
- AND returndate IS NULL
- ';
- return get_infos_of( $query, 'itemnumber', 'date_due' );
-}
-
-=head2 get_transfert_infos
-
-get_transfert_infos($itemnumber);
-
-=cut
-
-sub get_transfert_infos {
- my ($itemnumber) = @_;
-
- my $dbh = C4::Context->dbh;
-
- my $query = '
- SELECT datesent,
- frombranch,
- tobranch
- FROM branchtransfers
- WHERE itemnumber = ?
- AND datearrived IS NULL
- ';
- my $sth = $dbh->prepare($query);
- $sth->execute($itemnumber);
- my @row = $sth->fetchrow_array();
- $sth->finish;
- return @row;
-}
-
-=head2 DeleteTransfer
-
-&DeleteTransfer($itemnumber);
-
-=cut
-
-sub DeleteTransfer {
- my ($itemnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "DELETE FROM branchtransfers
- WHERE itemnumber=?
- AND datearrived IS NULL "
- );
- $sth->execute($itemnumber);
- $sth->finish;
-}
-
-=head2 GetTransfersFromBib
-
-@results = GetTransfersFromBib($frombranch,$tobranch);
-
-=cut
-
-sub GetTransfersFromBib {
- my ( $frombranch, $tobranch ) = @_;
- return unless ( $frombranch && $tobranch );
- my $dbh = C4::Context->dbh;
- my $query = "
- SELECT itemnumber,datesent,frombranch
- FROM branchtransfers
- WHERE frombranch=?
- AND tobranch=?
- AND datearrived IS NULL
- ";
- my $sth = $dbh->prepare($query);
- $sth->execute( $frombranch, $tobranch );
- my @gettransfers;
- my $i = 0;
-
- while ( my $data = $sth->fetchrow_hashref ) {
- $gettransfers[$i] = $data;
- $i++;
- }
- $sth->finish;
- return (@gettransfers);
-}
-
-=head2 GetReservesToBranch
-
-@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);
-}
-
-=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 waitingdate" );
- $sth->execute($frombranch);
- my @transreserv;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $transreserv[$i] = $data;
- $i++;
- }
- $sth->finish;
- return (@transreserv);
-}
-
-=head2 checktransferts
-
-@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 COUNT(*) FROM notifys
- WHERE notify_id = ?
- AND notify_level = ?
- AND itemnumber = ? ");
- $sth->execute($notify_id,$notify_level,$itemnumber);
- my $notified = $sth->fetchrow;
-$sth->finish;
-return ($notified);
-}
-
-=head2 GetOverduesForBranch
-
-Sql request for display all information for branchoverdues.pl
-2 possibilities : with or without department .
-display is filtered by branch
-
-=cut
-
-sub GetOverduesForBranch {
- my ( $branch, $department) = @_;
- if ( not $department ) {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("
- SELECT
- borrowers.surname,
- borrowers.firstname,
- biblio.title,
- itemtypes.description,
- issues.date_due,
- issues.returndate,
- branches.branchname,
- items.barcode,
- borrowers.phone,
- borrowers.email,
- items.itemcallnumber,
- borrowers.borrowernumber,
- items.itemnumber,
- biblio.biblionumber,
- issues.branchcode,
- accountlines.notify_id,
- accountlines.notify_level,
- items.location,
- accountlines.amountoutstanding
- FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
- WHERE ( issues.returndate is null)
- AND ( accountlines.amountoutstanding != '0.000000')
- AND ( accountlines.accounttype = 'FU')
- AND ( issues.borrowernumber = accountlines.borrowernumber )
- AND ( issues.itemnumber = accountlines.itemnumber )
- AND ( borrowers.borrowernumber = issues.borrowernumber )
- AND ( biblio.biblionumber = biblioitems.biblionumber )
- AND ( biblioitems.biblionumber = items.biblionumber )
- AND ( itemtypes.itemtype = biblioitems.itemtype )
- AND ( items.itemnumber = issues.itemnumber )
- AND ( branches.branchcode = issues.branchcode )
- AND (issues.branchcode = ?)
- AND (issues.date_due <= NOW())
- ORDER BY borrowers.surname
- ");
- $sth->execute($branch);
- my @getoverdues;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- #check if the document has already been notified
- my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
- if ($countnotify eq '0'){
- $getoverdues[$i] = $data;
- $i++;
- }
- }
- return (@getoverdues);
- $sth->finish;
- }
- else {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare( "
- SELECT borrowers.surname,
- borrowers.firstname,
- biblio.title,
- itemtypes.description,
- issues.date_due,
- issues.returndate,
- branches.branchname,
- items.barcode,
- borrowers.phone,
- borrowers.email,
- items.itemcallnumber,
- borrowers.borrowernumber,
- items.itemnumber,
- biblio.biblionumber,
- issues.branchcode,
- accountlines.notify_id,
- accountlines.notify_level,
- items.location,
- accountlines.amountoutstanding
- FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
- WHERE ( issues.returndate is null )
- AND ( accountlines.amountoutstanding != '0.000000')
- AND ( accountlines.accounttype = 'FU')
- AND ( issues.borrowernumber = accountlines.borrowernumber )
- AND ( issues.itemnumber = accountlines.itemnumber )
- AND ( borrowers.borrowernumber = issues.borrowernumber )
- AND ( biblio.biblionumber = biblioitems.biblionumber )
- AND ( biblioitems.biblionumber = items.biblionumber )
- AND ( itemtypes.itemtype = biblioitems.itemtype )
- AND ( items.itemnumber = issues.itemnumber )
- AND ( branches.branchcode = issues.branchcode )
- AND (issues.branchcode = ? AND items.location = ?)
- AND (issues.date_due <= NOW())
- ORDER BY borrowers.surname
- " );
- $sth->execute( $branch, $department);
- my @getoverdues;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- #check if the document has already been notified
- my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
- if ($countnotify eq '0'){
- $getoverdues[$i] = $data;
- $i++;
- }
- }
- $sth->finish;
- return (@getoverdues);
- }
-}
-
-
-=head2 AddNotifyLine
-
-&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
-
-Creat a line into notify, if the method is phone, the notification_send_date is implemented to
-
-=cut
-
-sub AddNotifyLine {
- my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
- if ( $method eq "phone" ) {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
- VALUES (?,?,now(),now(),?,?,?)"
- );
- $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
- $notifyId );
- $sth->finish;
- }
- else {
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
- VALUES (?,?,now(),?,?,?)"
- );
- $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
- $notifyId );
- $sth->finish;
- }
- return 1;
-}
-
-=head2 RemoveNotifyLine
-
-&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
-
-Cancel a notification
-
-=cut
-
-sub RemoveNotifyLine {
- my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "DELETE FROM notifys
- WHERE
- borrowernumber=?
- AND itemnumber=?
- AND notify_date=?"
- );
- $sth->execute( $borrowernumber, $itemnumber, $notify_date );
- $sth->finish;
- return 1;
-}
-
-=head2 AnonymiseIssueHistory
-
-$rows = AnonymiseIssueHistory($borrowernumber,$date)
-
-This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
-if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
-
-return the number of affected rows.
-
-=cut
-
-sub AnonymiseIssueHistory {
- my $date = shift;
- my $borrowernumber = shift;
- my $dbh = C4::Context->dbh;
- my $query = "
- UPDATE issues
- SET borrowernumber = NULL
- WHERE returndate < '".$date."'
- AND borrowernumber IS NOT NULL
- ";
- $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
- my $rows_affected = $dbh->do($query);
- return $rows_affected;
-}
-
-=head2 GetItemsLost
-
-$items = GetItemsLost($where,$orderby);
-
-This function get the items lost into C<$items>.
-
-=over 2
-
-=item input:
-C<$where> is a hashref. it containts a field of the items table as key
-and the value to match as value.
-C<$orderby> is a field of the items table.
-
-=item return:
-C<$items> is a reference to an array full of hasref which keys are items' table column.
-
-=item usage in the perl script:
-
-my %where;
-$where{barcode} = 0001548;
-my $items = GetLostItems( \%where, "homebranch" );
-$template->param(itemsloop => $items);
-
-=back
-
-=cut
-
-sub GetLostItems {
- # Getting input args.
- my $where = shift;
- my $orderby = shift;
- my $dbh = C4::Context->dbh;
-
- my $query = "
- SELECT *
- FROM items
- WHERE itemlost IS NOT NULL
- AND itemlost <> 0
- ";
- foreach my $key (keys %$where) {
- $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
- }
- $query .= " ORDER BY ".$orderby if defined $orderby;
-
- my $sth = $dbh->prepare($query);
- $sth->execute;
- my @items;
- while ( my $row = $sth->fetchrow_hashref ){
- push @items, $row;
- }
- return \@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 <info@koha.org>
-
-=cut
-