-# -*- 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 circulation
-#written 3/11/99 by olwen@katipo.co.nz
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
# 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 C4::Context;
use C4::Stats;
use C4::Reserves2;
use C4::Koha;
-use C4::Accounts2;
use C4::Biblio;
-use C4::Calendar::Calendar;
-use C4::Search;
-use C4::Members;
-use C4::Date;
+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
=head1 SYNOPSIS
- use C4::Circulation::Circ2;
+use C4::Circulation::Circ2;
=head1 DESCRIPTION
=head1 FUNCTIONS
-=over 2
-
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- ¤tissues
- &getissues
- &getiteminformation
- &renewstatus
- &renewbook
- &canbookbeissued
- &issuebook
- &returnbook
- &find_reserves
- &transferbook
- &decode
- &calc_charges
- &listitemsforinventory
- &itemseen
- &itemseenbarcode
- &fixdate
- &itemissues
- &patronflags
- &get_current_return_date_of
- &get_transfert_infos
- &checktransferts
- &GetReservesForBranch
- &GetReservesToBranch
- &GetTransfersFromBib
- &getBranchIp);
-
-# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
-=item itemissues
-
- @issues = &itemissues($biblionumber, $biblio);
+ &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
+);
-Looks up information about who has borrowed the bookZ<>(s) with the
-given biblionumber.
+=head2 itemseen
-C<$biblio> is ignored.
+&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
-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:
+=cut
-=over 4
+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;
+}
-=item C<date_due>
+=head2 itemborrowed
-If the item is currently on loan, this gives the due date.
+&itemseen($itemnum)
+Mark item as borrowed. Is called when an item is issued.
+C<$itemnum> is the item number
-If the item is not on loan, then this is either "Available" or
-"Cancelled", if the item has been withdrawn.
+=cut
-=item C<card>
+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;
+}
-If the item is currently on loan, this gives the card number of the
-patron who currently has the item.
+=head2 GetItemsForInventory
-=item C<timestamp0>, C<timestamp1>, C<timestamp2>
+$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
-These give the timestamp for the last three times the item was
-borrowed.
+Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
-=item C<card0>, C<card1>, C<card2>
+The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
+It is ordered by callnumber,title.
-The card number of the last three patrons who borrowed this item.
+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)
-=item C<borrower0>, C<borrower1>, C<borrower2>
+=cut
-The borrower number of the last three patrons who borrowed this item.
+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
-=cut
-#'
-sub itemissues {
- my ($dbh,$data, $itemnumber)=@_;
-
-
- my $i = 0;
- my @results;
+=head3 GNA
+=over 4
- # 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");
+=item (Gone, no address.) Set if the patron has left without giving a
+forwarding address.
- $sth2->execute($itemnumber);
- if (my $data2 = $sth2->fetchrow_hashref) {
+=back
- $data->{'date_due'}=$data2->{'date_due'};
- $data->{'datelastborrowed'} = $data2->{'issue_date'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- $data->{issues}++;
- }
+=head3 LOST
- $sth2->finish;
- my $sth2 = $dbh->prepare("select * from reserveissue,borrowers
-where itemnumber = ?
-and rettime is NULL
-and reserveissue.borrowernumber = borrowers.borrowernumber");
+=over 4
- $sth2->execute($itemnumber);
- if (my $data2 = $sth2->fetchrow_hashref) {
+=item Set if the patron's card has been reported as lost.
- $data->{'date_due'}=$data2->{'duetime'};
- $data->{'datelastborrowed'} = $data2->{'restime'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- $data->{issues}++;
- }
+=back
- $sth2->finish;
- # Find the last 2 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 limit 2") ;
- $sth2->execute($itemnumber) ;
-my $i2=0;
- while (my $data2 = $sth2->fetchrow_hashref) {
- $data->{"timestamp$i2"} = $data2->{'timestamp'};
- $data->{"card$i2"} = $data2->{'cardnumber'};
- $data->{"borrower$i2"} = $data2->{'borrowernumber'};
-$data->{'datelastborrowed'} = $data2->{'issue_date'} unless $data->{'datelastborrowed'};
- $i2++;
- } # while
+=head3 DBARRED
- $sth2->finish;
- return($data);
-}
+=over 4
+=item Set if the patron has been debarred.
+=back
-=head2 itemseen
+=head3 NOTES
-&itemseen($dbh,$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
+=over 4
-=cut
+=item Any additional notes about the patron.
-sub itemseen {
- my ($dbh,$itemnumber) = @_;
-my $sth=$dbh->prepare("select biblionumber from items where itemnumber=?");
- $sth->execute($itemnumber);
-my ($biblionumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1);
-# find today's date
-my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp);
-}
-sub itemseenbarcode {
- my ($dbh,$barcode) = @_;
-my $sth=$dbh->prepare("select biblionumber,itemnumber from items where barcode=$barcode");
- $sth->execute();
-my ($biblionumber,$itemnumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1);
-my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
-my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",$year,$mon,$mday,$hour,$min,$sec);
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp);
-}
+=back
-sub listitemsforinventory {
- my ($minlocation,$datelastseen,$offset,$size) = @_;
- my $count=0;
- my @results;
- my @kohafields;
- my @values;
- my @relations;
- my $sort;
- my @and_or;
- my $facets;
- if ($datelastseen){
- push @kohafields, "classification","datelastseen";
- push @values,$minlocation,$datelastseen;
- push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ","\@attr 2=1 ";
- push @and_or,"\@and";
- $sort="lcsort";
- ($count,$facets,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
- }else{
- push @kohafields, "classification";
- push @values,$minlocation;
- push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ";
- push @and_or,"";
- $sort="lcsort";
- ($count,$facets,@results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
- }
-
- return @results;
-}
+=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.
-=head2 decode
+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
-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:
=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
=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 together with biblio given either the itemnumber or the barcode
- my ($env, $itemnumber, $barcode) = @_;
- my $dbh=C4::Context->dbh;
- my ($itemrecord)=XMLgetitem($dbh,$itemnumber,$barcode);
- return undef unless $itemrecord; ## This is to prevent a system crash if barcode does not exist
- my $itemhash=XML_xml2hash_onerecord($itemrecord);
- my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemhash,"holdings");
-##Now get full biblio details from MARC
- if ($iteminformation) {
-my ($record)=XMLgetbiblio($dbh,$iteminformation->{'biblionumber'});
- my $recordhash=XML_xml2hash_onerecord($record);
-my $biblio=XMLmarc2koha_onerecord($dbh,$recordhash,"biblios");
- foreach my $field (keys %$biblio){
- $iteminformation->{$field}=$biblio->{$field};
- }
- $iteminformation->{'date_due'}="" if $iteminformation->{'date_due'} eq "0000-00-00";
- ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
- }
- 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.
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<BadBarcode>
+=item C<BadBarcode>
There is no item in the catalog with the given barcode. The value is C<$barcode>.
-C<IsPermanent>
+=item C<IsPermanent>
The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
-C<DestinationEqualsHolding>
+=item C<DestinationEqualsHolding>
The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
-C<WasReturned>
+=item C<WasReturned>
The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
-C<ResFound>
+=item C<ResFound>
The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
-C<WasTransferred>
+=item C<WasTransferred>
The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
=back
-=back
-
-=back
-
=cut
-##This routine is reverted to origional state
-##This routine is used when a book physically arrives at a branch due to user returning it there
-## so record the fact that holdingbranch is changed.
+#'
+# 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 {
-# transfer book code....
- my ($tbr, $barcode, $ignoreRs,$user) = @_;
- my $messages;
- my %env;
- my $dbh=C4::Context->dbh;
- 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 = 0;
- }
- #actually do the transfer....
- if ($dotransfer) {
- dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user);
- $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 {
-## The book has arrived at this branch because it has been returned there
-## So we update the fact the book is in that branch not that we want to send the book to that branch
-
- my ($itm, $fbr, $tbr,$user) = @_;
- my $dbh = C4::Context->dbh;
-
- #new entry in branchtransfers....
- my $sth=$dbh->prepare("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch,comments) VALUES (?, ?, now(), ?,?)");
- $sth->execute($itm, $fbr, $tbr,$user);
- #update holdingbranch in items .....
- &domarctransfer($dbh,$itm,$tbr);
-## Item seen taken out of this loop to optimize ZEBRA updates
-# &itemseen($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;
}
-sub domarctransfer{
-my ($dbh,$itemnumber,$holdingbranch) = @_;
-$itemnumber=~s /\'//g;
-my $sth=$dbh->prepare("select biblionumber from items where itemnumber=$itemnumber");
- $sth->execute();
-my ($biblionumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'holdingbranch',$holdingbranch,1);
- $sth->finish;
+##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( $biblionumber, $itemnumber,
+ 'items.holdingbranch', $holdingbranch, 0 );
+ }
+ return;
}
=head2 canbookbeissued
=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
=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
borrower gone with no address
=head3 CARD_LOST
-
+
borrower declared it's card lost
=head3 DEBARRED
item is restricted (set by ??)
-=back
-
C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :
# 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);
-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 biblio 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, items it, biblio b where i.borrowernumber = ? and i.returndate is null and i.itemnumber = it.itemnumber and b.biblionumber=it.biblionumber and b.itemtype like ?");
- my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null');
- my $alreadyissued;
-
- # check the 3 parameters
- #print "content-type: text/plain \n\n";
- #print "$cat_borrower, $type, $branch_borrower";
- $sth->execute($cat_borrower, $type, $branch_borrower);
- my $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- # print "content-type: text/plain \n\n";
- #print "$cat_borrower, $type, $branch_borrower";
- $sth2->execute($borrower->{'borrowernumber'}, $type);
- my $alreadyissued = $sth2->fetchrow;
- # print "***" . $alreadyissued;
- #print "----". $result->{'maxissueqty'};
- if ($result->{'maxissueqty'} <= $alreadyissued) {
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- }else {
- return;
- }
- }
+Looks up information about who has borrowed the bookZ<>(s) with the
+given biblioitemnumber.
- # 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 ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+C<$biblio> is ignored.
- # 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 ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+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:
- #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 ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+=over 4
- #check for borrowertype=*;itemtype=*
- $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 ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+=item C<date_due>
- $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 ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+If the item is currently on loan, this gives the due date.
- $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 ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
+If the item is not on loan, then this is either "Available" or
+"Cancelled", if the item has been withdrawn.
- $sth->execute("*", "*", "");
- $result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
- my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
- return;
- }
- }
- return;
-}
+=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.
-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);
+=item C<card0>, C<card1>, C<card2>
-#
-# BORROWER STATUS
-#
- if ($borrower->{flags}->{GNA}) {
- $issuingimpossible{GNA} = 1;
- }
- if ($borrower->{flags}->{'LOST'}) {
- $issuingimpossible{CARD_LOST} = 1;
- }
- if ($borrower->{flags}->{'DBARRED'}) {
- $issuingimpossible{DEBARRED} = 1;
- }
- my $today=get_today();
- if (DATE_diff($borrower->{expiry},$today)<0) {
- $issuingimpossible{EXPIRED} = 1;
- }
-#
-# BORROWER STATUS
-#
+The card number of the last three patrons who borrowed this item.
-# 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<borrower0>, C<borrower1>, C<borrower2>
+The borrower number of the last three patrons who borrowed this item.
-#
-# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
-#
- my $toomany = TooMany($borrower, $iteminformation);
- $needsconfirmation{TOO_MANY} = $toomany if $toomany;
- $issuingimpossible{TOO_MANY} = $toomany if $toomany;
-#
-# ITEM CHECKING
-#
- unless ($iteminformation->{barcode}) {
- $issuingimpossible{UNKNOWN_BARCODE} = 1;
- }
- if ($iteminformation->{'notforloan'} > 0) {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ($iteminformation->{'itemtype'} eq 'REF') {
- $issuingimpossible{NOT_FOR_LOAN} = 1;
- }
- if ($iteminformation->{'wthdrawn'} == 1) {
- $issuingimpossible{WTHDRAWN} = 1;
- }
- if ($iteminformation->{'restricted'} == 1) {
- $issuingimpossible{RESTRICTED} = 1;
- }
- if ($iteminformation->{'shelf'} eq 'Res') {
- $issuingimpossible{IN_RESERVE} = 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} ) ;
- }
- }
+=back
-#
-# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
-#
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- if ($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 {
- if (C4::Context->preference("strictrenewals")){
- ###if this is set do not allow automatic renewals
- ##the new renew script will do same strict checks as issues and return error codes
- $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'});
- } 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);
- }
- }
-
- return(\%issuingimpossible,\%needsconfirmation);
+=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
=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<$date> contains the max date of return. calculated if empty.
+=item C<$date> contains the max date of return. calculated if empty.
+
+=back
=cut
-#
-# issuing book. We already have checked it can be issued, so, just issue it !
-#
sub issuebook {
-### fix me STOP using koha hashes, change so that XML hash is used
- my ($env,$borrower,$barcode,$date,$cancelreserve) = @_;
- my $dbh = C4::Context->dbh;
- my $itemrecord=XMLgetitemhash($dbh,"",$barcode);
- my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
- $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber});
- my $error;
+ 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'});
- if (C4::Context->preference("strictrenewals")){
- $error=renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
- renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}) if ($error>1);
- }else{
- 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'});
-#warn "return : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'};
-
- }
- # See if the item is on reserve.
- my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
-#warn "$restype,$res";
- 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($iteminformation->{'biblionumber'},0,$res->{'borrowernumber'});
-# warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
- } else {
- my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
- transferbook($tobrcd,$barcode, 1);
-# warn "transferbook";
- }
- }
- }
-
- my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())");
- my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
-
- my $dateduef;
- my @datearr = localtime();
- $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-". $datearr[3];
-
- my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
- my ($yeardue, $monthdue, $daydue) = split /-/, $dateduef;
- ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
- $dateduef = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
+ 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'});
-#warn $dateduef;
- 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'}++;
-##Record in MARC the new data ,date_due as due date,issue count and the borrowernumber
- $itemrecord=XML_writeline($itemrecord, "issues", $iteminformation->{'issues'},"holdings");
- $itemrecord=XML_writeline($itemrecord, "date_due", $dateduef,"holdings");
- $itemrecord=XML_writeline($itemrecord, "borrowernumber", $borrower->{'borrowernumber'},"holdings");
- $itemrecord=XML_writeline($itemrecord, "itemlost", "0","holdings");
- $itemrecord=XML_writeline($itemrecord, "onloan", "1","holdings");
- # find today's date as timestamp
- my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
- $itemrecord=XML_writeline($itemrecord, "datelastseen", $timestamp,"holdings");
- ##Now update the zebradb
- NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$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 in SQL
- &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ 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;
}
-return($error);
+
+# 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
=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);
-
- $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;
+ 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);
+($doreturn, $messages, $iteminformation, $borrower) =
+ &returnbook($barcode, $branch);
Returns a 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 $itemrecord=XMLgetitemhash($dbh,"",$barcode);
- if (not $itemrecord) {
- $messages->{'BadBarcode'} = $barcode;
- $doreturn = 0;
- return ($doreturn, $messages, undef, undef);
- }
- my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings");
- $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber});
-
- # 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 ($branches->{$hbr}->{'PE'}) {
- $messages->{'IsPermanent'} = $hbr;
- }
- # check that the book has been cancelled
- if ($iteminformation->{'wthdrawn'}) {
- $messages->{'wthdrawn'} = 1;
- # $doreturn = 0;
- }
- # update issues, thereby returning book (should push this out into another subroutine
- my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
- if ($doreturn) {
- my $sth = $dbh->prepare("update issues set returndate = now() where (itemnumber = ?) and (returndate is null)");
- $sth->execute( $iteminformation->{'itemnumber'});
- $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
-
- $sth->finish;
- }
- $itemrecord=XML_writeline($itemrecord, "date_due", "","holdings");
- $itemrecord=XML_writeline($itemrecord, "onloan", "0","holdings");
- $itemrecord=XML_writeline($itemrecord, "borrowernumber", "","holdings");
-
- my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
- my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
- $year += 1900;
- $mon += 1;
- my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
- $year,$mon,$mday,$hour,$min,$sec);
- $itemrecord=XML_writeline($itemrecord, "datelastseen", $timestamp,"holdings");
-
-
- ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
- # transfer book to the current branch
-
- 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?
- $itemrecord=XML_writeline($itemrecord, "itemlost", "","holdings");
- }
-####WARNING-- FIXME#########
-### The following new script is commented out
-## I did not understand what it is supposed to do.
-## If a book is returned at one branch it is automatically recorded being in that branch by
-## transferbook script. This scrip tries to find out whether it was sent thre
-## Well whether sent or not it is physically there and transferbook records this fact in MARCrecord as well
-## If this script is trying to do something else it should be uncommented and also add support for updating MARC record --TG
-# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
-# 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'});
- $itemrecord=XML_writeline($itemrecord, "itemoverdue", "","holdings");
- # find reserves.....
- my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
- if ($resfound) {
- # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
- $resrec->{'ResFound'} = $resfound;
- $messages->{'ResFound'} = $resrec;
- }
- ##Now update the zebradb
- NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'});
- # 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)
=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
=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;
+ 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
-#
-# 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
sub patronflags {
-# Original subroutine for Circ2.pm
- my %flags;
- my ($env, $patroninformation, $dbh) = @_;
- my $amount = C4::Accounts2::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'} == 1) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower has no valid address.';
- $flaginfo{'noissues'} = 1;
- $flags{'GNA'} = \%flaginfo;
- }
- if ($patroninformation->{'lost'} == 1) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower\'s card reported lost.';
- $flaginfo{'noissues'} = 1;
- $flags{'LOST'} = \%flaginfo;
- }
- if ($patroninformation->{'debarred'} == 1) {
- my %flaginfo;
- $flaginfo{'message'} = 'Borrower is Debarred.';
- $flaginfo{'noissues'} = 1;
- $flags{'DBARRED'} = \%flaginfo;
- }
- if ($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 $today=get_today();
- my @overdueitems;
- my $count = 0;
- my $sth = $dbh->prepare("SELECT issues.* , i.biblionumber as biblionumber,b.* FROM issues, items i,biblio b
- WHERE i.itemnumber=issues.itemnumber
- AND i.biblionumber=b.biblionumber
- 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 $sth=$dbh->prepare("select borrowers.borrowernumber from
- issues,borrowers where issues.itemnumber=? and
- issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
- NULL");
- $sth->execute($itemnumber);
- 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 {
-# 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=? )");
- $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.
#'
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.
- my $today=get_today();
- if ($env->{'todaysissues'}) {
-
- $crit=" and issues.timestamp like '$today%' ";
- }
- if ($env->{'nottodaysissues'}) {
-
- $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 where
- borrowernumber=? and issues.itemnumber=items.itemnumber and
- returndate is null
- $crit order by issues.date_due");
- $sth->execute($borrowernumber);
- while (my $data = $sth->fetchrow_hashref) {
-
-
- if ($data->{'date_due'} lt $today) {
- $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.
of the Koha database.
=cut
+
#'
sub getissues {
- my ($borrower) = @_;
- my $dbh = C4::Context->dbh;
- my $borrowernumber = $borrower->{'borrowernumber'};
- my %currentissues;
- my $bibliodata;
- my @results;
- my $todaysdate=get_today();
- my $counter = 0;
- my $select = "SELECT *
- FROM issues,items,biblio
- WHERE issues.borrowernumber = ?
- AND issues.itemnumber = items.itemnumber
- AND items.biblionumber = biblio.biblionumber
- AND issues.returndate IS NULL
- ORDER BY issues.date_due";
- # print $select;
- my $sth=$dbh->prepare($select);
- $sth->execute($borrowernumber);
- while (my $data = $sth->fetchrow_hashref) {
- if ($data->{'date_due'} lt $todaysdate) {
- $data->{'overdue'} = 1;
- }
- $currentissues{$counter} = $data;
- $counter++;
- }
- $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 {
-# 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.
=cut
sub renewstatus {
- # check renewal status
- ##If system preference "strictrenewals" is used This script will try to return $renewok=2 or $renewok=3 as error messages
- ##
- my ($env,$bornum,$itemnumber)=@_;
- my $dbh=C4::Context->dbh;
- my $renews = 1;
- my $resfound;
- my $resrec;
- my $renewokay=0; ##
- # Look in the issues table for this item, lent to this borrower,
- # and not yet returned.
-my $borrower=C4::Members::getpatroninformation($dbh,$bornum,undef);
-
- # FIXME - I think this function could be redone to use only one SQL call.
- my $sth1 = $dbh->prepare("select * from issues,items,biblio
- where (borrowernumber = ?)
- and (issues.itemnumber = ?)
- and items.biblionumber=biblio.biblionumber
- and returndate is null
- and items.itemnumber=issues.itemnumber");
- $sth1->execute($bornum,$itemnumber);
-my $data1 = $sth1->fetchrow_hashref;
- if ($data1 ) {
- # Found a matching item
- if (C4::Context->preference("LibraryName") eq "NEU Grand Library"){
- ##privileged get renewal whatever the case may be
- if ($borrower->{'categorycode'} eq 'P'){
- $renewokay = 1;
- return $renewokay;
- }
- }
- # See if this item may be renewed.
- my $sth2 = $dbh->prepare("select renewalsallowed from itemtypes where itemtypes.itemtype=?");
- $sth2->execute($data1->{itemtype});
- if (my $data2=$sth2->fetchrow_hashref) {
- $renews = $data2->{'renewalsallowed'};
- }
- if ($renews > $data1->{'renewals'}) {
- $renewokay= 1;
- }else{
- if (C4::Context->preference("strictrenewals")){
- $renewokay=3 ;
- }
- }
- $sth2->finish;
- ($resfound, $resrec) = CheckReserves($itemnumber);
- if ($resfound) {
- if (C4::Context->preference("strictrenewals")){
- $renewokay=4;
- }else{
- $renewokay = 0;
- }
- }
- ($resfound, $resrec) = CheckReserves($itemnumber);
- if ($resfound) {
- if (C4::Context->preference("strictrenewals")){
- $renewokay=4;
- }else{
- $renewokay = 0;
- }
- }
- if (C4::Context->preference("strictrenewals")){
- ### A new system pref "allowRenewalsBefore" prevents the renewal before a set amount of days left before expiry
- ## Try to find whether book can be renewed at this date
- my $loanlength;
-
- my $allowRenewalsBefore = C4::Context->preference("allowRenewalsBefore");
- my $today=get_today();
-
- # Find the issues record for this book###
- my $sth=$dbh->prepare("select SUBDATE(date_due, $allowRenewalsBefore) from issues where itemnumber=? and returndate is null");
- $sth->execute($itemnumber);
- my $startdate=$sth->fetchrow;
- $sth->finish;
-
- my $difference = DATE_diff($today,$startdate);
- if ($difference < 0) {
- $renewokay=2 ;
- }
- }##strictrenewals
- }##item found
- $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.
=cut
sub renewbook {
- my ($env,$bornum,$itemnumber,$datedue)=@_;
- # mark book as renewed
- my $loanlength;
-my $dbh=C4::Context->dbh;
-my $sth;
-my $iteminformation = getiteminformation($env, $itemnumber,0);
-
+ # 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");
+ }
-if ($datedue eq "" ) {
+ # 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;
- my $borrower = C4::Members::getpatroninformation($env,$bornum,0);
- $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
-
- my $datedue=get_today();
- my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
- my ($yeardue, $monthdue, $daydue) = split /-/, $datedue;
- ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
- $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
-
- # Update the issues record to have the new due date, and a new count
- # of how many times it has been renewed.
-
- $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1
- where borrowernumber=? and itemnumber=? and returndate is null");
- $sth->execute($datedue,$bornum,$itemnumber);
- $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;
- ## Update items and marc record with new date -T.G
- &XMLmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'date_due',$datedue);
-
- # Log the renewal
- UpdateStats($env,$env->{'branchcode'},'renew','','',$itemnumber,$iteminformation->{'itemtype'},$bornum);
-
- # Charge a new rental fee, if applicable?
- my ($charge,$type)=calc_charges($env, $itemnumber, $bornum);
- if ($charge > 0){
- my $accountno=getnextacctno($env,$bornum,$dbh);
- $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 $iteminformation->{'title'} $iteminformation->{'barcode'}",'Rent',$charge,$itemnumber);
- $sth->finish;
- # print $account;
- }# end of rental charge
-
- return format_date($datedue);
- }
+ # 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
-
-=item calc_charges
-
- ($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
+($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.
=cut
sub calc_charges {
- # calculate charges due
- my ($env, $itemnumber, $bornum)=@_;
- my $charge=0;
- my $dbh = C4::Context->dbh;
- my $item_type;
- my $sth= $dbh->prepare("select itemtype from biblio,items where items.biblionumber=biblio.biblionumber and itemnumber=?");
- $sth->execute($itemnumber);
- my $itemtype=$sth->fetchrow;
- $sth->finish;
-
- my $sth1= $dbh->prepare("select rentalcharge from itemtypes where itemtypes.itemtype=?");
- $sth1->execute($itemtype);
-
- $charge = $sth1->fetchrow;
- 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,$itemtype);
- 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";
- }
+
+ # 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,$itemtype);
+ }
+
+ $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 {
- my ($env,$dbh,$itemnumber,$bornum,$charge) = @_;
- my $nextaccntno = getnextacctno($env,$bornum,$dbh);
- my $sth = $dbh->prepare(<<EOT);
- INSERT INTO accountlines
- (borrowernumber, itemnumber, accountno,
- date, amount, description, accounttype,
- amountoutstanding)
- VALUES (?, ?, ?,
- now(), ?, 'Rental', 'Rent',
- ?)
-EOT
- $sth->execute($bornum, $itemnumber, $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.
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 {
- my ($itemnumber) = @_;
+
+ # 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("", $itemnumber,0);
- 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($itemdata->{'biblionumber'});
+ 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) {
- $lastrec = $resrec;
- if ($resrec->{'found'} eq "W") {
- if ($resrec->{'itemnumber'} eq $itemnumber) {
- $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 = ? ");
- $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
- 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($itemnumber,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
- $updsth->finish;
- last;
- }
+ 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 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);
+}
+
+=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);
}
-sub checktransferts{
- my($itemnumber) = @_;
+=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
- return (@tranferts);
+=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
-1;
-__END__
+&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
+
projects / koha.git / blobdiff