[Koha-cvs] koha bookshelves/addbookbybiblionumber.pl books...
paul poulain
paul at koha-fr.org
Fri Mar 9 15:32:26 CET 2007
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/09 14:32:26
Modified files:
bookshelves : addbookbybiblionumber.pl shelves.pl
C4/Circulation : Circ2.pm Fines.pm
Log message:
rel_3_0 moved to HEAD
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/bookshelves/addbookbybiblionumber.pl?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/bookshelves/shelves.pl?cvsroot=koha&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&r1=1.123&r2=1.124
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Fines.pm?cvsroot=koha&r1=1.20&r2=1.21
Patches:
Index: bookshelves/addbookbybiblionumber.pl
===================================================================
RCS file: /sources/koha/koha/bookshelves/addbookbybiblionumber.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- bookshelves/addbookbybiblionumber.pl 27 Sep 2006 21:19:21 -0000 1.5
+++ bookshelves/addbookbybiblionumber.pl 9 Mar 2007 14:32:26 -0000 1.6
@@ -1,8 +1,7 @@
#!/usr/bin/perl
+
#script to provide bookshelf management
-# WARNING: This file uses 4-character tabs!
#
-# $Header: /sources/koha/koha/bookshelves/addbookbybiblionumber.pl,v 1.5 2006/09/27 21:19:21 tgarip1957 Exp $
#
# Copyright 2000-2002 Katipo Communications
#
@@ -21,17 +20,55 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id: addbookbybiblionumber.pl,v 1.6 2007/03/09 14:32:26 tipaul Exp $
+
+=head1 NAME
+
+ addbookbybiblionumber.pl
+
+=head1 DESCRIPTION
+
+ This script allow to add a book in a virtual shelf from a biblionumber.
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item biblionumber
+
+ The biblionumber
+
+=item shelfnumber
+
+ the shelfnumber where to add the book.
+
+=item newbookshelf
+
+ if this parameter exists, then it must be equals to the name of the shelf
+ to add.
+
+=item category
+
+ if this script has to add a shelf, it add one with this category.
+
+=back
+
+=cut
+
use strict;
-use C4::Search;
use C4::Biblio;
use CGI;
+use C4::Output;
use C4::BookShelves;
use C4::Circulation::Circ2;
use C4::Auth;
use C4::Interface::CGI::Output;
-my $env;
+#use it only to debug !
+use CGI::Carp qw/fatalsToBrowser/;
+use warnings;
+
my $query = new CGI;
my $biblionumber = $query->param('biblionumber');
my $shelfnumber = $query->param('shelfnumber');
@@ -46,18 +83,16 @@
flagsrequired => {catalogue => 1},
});
-my $x; # for trash
-($x,$x,$shelfnumber) = AddShelf('',$newbookshelf,$loggedinuser,$category) if $newbookshelf;
+$shelfnumber = AddShelf($newbookshelf,$loggedinuser,$category) if $newbookshelf;
-if ($shelfnumber) {
- &AddToShelfFromBiblio($env, $biblionumber, $shelfnumber);
+if ($shelfnumber || ($shelfnumber == -1)) { # the shelf already exist.
+ &AddToShelfFromBiblio($biblionumber, $shelfnumber);
print "Content-Type: text/html\n\n<html><body onload=\"window.close()\"></body></html>";
exit;
-} else {
-
- my ( $bibliocount, @biblios ) = getbiblio($biblionumber);
+} else { # this shelf doesn't already exist.
+ my ( $bibliocount, @biblios ) = GetBiblio($biblionumber);
- my ($shelflist) = GetShelfList($loggedinuser,3);
+ my ($shelflist) = GetShelves($loggedinuser,3);
my @shelvesloop;
my %shelvesloop;
foreach my $element (sort keys %$shelflist) {
@@ -65,14 +100,16 @@
$shelvesloop{$element} = $shelflist->{$element}->{'shelfname'};
}
- my $CGIbookshelves=CGI::scrolling_list( -name => 'shelfnumber',
+ my $CGIbookshelves=CGI::scrolling_list(
+ -name => 'shelfnumber',
-values => \@shelvesloop,
-labels => \%shelvesloop,
-size => 1,
-tabindex=>'',
-multiple => 0 );
- $template->param(biblionumber => $biblionumber,
+ $template->param(
+ biblionumber => $biblionumber,
title => $biblios[0]->{'title'},
author => $biblios[0]->{'author'},
CGIbookshelves => $CGIbookshelves,
@@ -83,9 +120,30 @@
output_html_with_http_headers $query, $cookie, $template->output;
}
+
# $Log: addbookbybiblionumber.pl,v $
-# Revision 1.5 2006/09/27 21:19:21 tgarip1957
-# Finalized XML version for intranet
+# Revision 1.6 2007/03/09 14:32:26 tipaul
+# rel_3_0 moved to HEAD
+#
+# Revision 1.4.2.6 2006/12/18 16:35:17 toins
+# removing use HTML::Template from *.pl.
+#
+# Revision 1.4.2.5 2006/12/05 11:35:29 toins
+# Biblio.pm cleaned.
+# additionalauthors, bibliosubject, bibliosubtitle tables are now unused.
+# Some functions renamed according to the coding guidelines.
+#
+# Revision 1.4.2.4 2006/11/30 18:23:51 toins
+# theses scripts don't need to use C4::Search.
+#
+# Revision 1.4.2.3 2006/10/30 09:48:19 tipaul
+# samll bugfix to create a bookshelf correctly
+#
+# Revision 1.4.2.2 2006/08/30 16:13:54 toins
+# correct an error in the "if condition".
+#
+# Revision 1.4.2.1 2006/08/30 15:59:14 toins
+# Code cleaned according to coding guide lines.
#
# Revision 1.4 2006/07/04 14:36:51 toins
# Head & rel_2_2 merged
@@ -100,23 +158,6 @@
# Revision 1.3.2.2 2006/02/05 21:45:25 kados
# Adds support for intranetstylesheet system pref in Koha scripts
#
-# Revision 1.3.2.1 2006/02/04 21:26:47 kados
-# Adds support for intranetcolorstylesheet
-#
-# Revision 1.3 2004/12/15 17:28:22 tipaul
-# adding bookshelf features :
-# * create bookshelf on the fly
-# * modify a bookshelf (this being not finished, will commit the rest soon)
-#
-# Revision 1.2 2004/11/19 16:31:30 tipaul
-# bugfix for bookshelves not in official CVS
-#
-# Revision 1.1.2.2 2004/03/10 15:08:18 tipaul
-# modifying shelves : introducing category of shelf : private, public, free for all
-#
-# Revision 1.1.2.1 2004/02/19 10:14:36 tipaul
-# new feature : adding book to bookshelf from biblio detail screen.
-#
# Local Variables:
# tab-width: 4
Index: bookshelves/shelves.pl
===================================================================
RCS file: /sources/koha/koha/bookshelves/shelves.pl,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- bookshelves/shelves.pl 27 Sep 2006 21:19:21 -0000 1.10
+++ bookshelves/shelves.pl 9 Mar 2007 14:32:26 -0000 1.11
@@ -1,8 +1,5 @@
#!/usr/bin/perl
-#script to provide bookshelf management
-# WARNING: This file uses 4-character tabs!
-#
-# $Header: /sources/koha/koha/bookshelves/shelves.pl,v 1.10 2006/09/27 21:19:21 tgarip1957 Exp $
+
#
# Copyright 2000-2002 Katipo Communications
#
@@ -21,275 +18,295 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+=head1 NAME
+
+ shelves.pl
+
+=head1 DESCRIPTION
+
+ this script is used to script to provide bookshelf management
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item C<modifyshelfcontents>
+
+ if this script has to modify the shelve content.
+
+=item C<shelfnumber>
+
+ to know on which shelve this script has to work.
+
+=item C<addbarcode>
+
+=item C<op>
+
+ op can be equals to:
+ * modifsave to save change on the shelves
+ * modif to change the template to allow to modify the shelves.
+
+=item C<viewshelf>
+
+ to load the template with 'viewshelves param' which allow to read the shelves information.
+
+=item C<shelves>
+
+ if equals to 1. then call the function shelves which add
+ or delete a shelf.
+
+=item C<addshelf>
+
+ if the param shelves = 1 then addshelf must be equals to the name of the shelf to add.
+
+=back
+
+=cut
+
use strict;
-use C4::Search;
use CGI;
+use C4::Output;
use C4::BookShelves;
use C4::Circulation::Circ2;
use C4::Auth;
use C4::Interface::CGI::Output;
-
-my $env;
my $query = new CGI;
-my $headerbackgroundcolor='#663266';
-my $circbackgroundcolor='#555555';
-my $circbackgroundcolor='#550000';
-my $linecolor1='#bbbbbb';
-my $linecolor2='#dddddd';
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "bookshelves/shelves.tmpl",
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "bookshelves/shelves.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {catalogue => 1},
- });
+ flagsrequired => { catalogue => 1 },
+ }
+);
-if ($query->param('modifyshelfcontents')) {
- my $shelfnumber=$query->param('shelfnumber');
- my $barcode=$query->param('addbarcode');
- my ($item) = getiteminformation($env, 0, $barcode);
- if (ShelfPossibleAction($loggedinuser,$shelfnumber,'manage')) {
- AddToShelf($env, $item->{'itemnumber'}, $shelfnumber);
- foreach ($query->param) {
+if ( $query->param('modifyshelfcontents') ) {
+ my $shelfnumber = $query->param('viewshelf');
+ my $barcode = $query->param('addbarcode');
+ my ($item) = getiteminformation( 0, $barcode );
+ if ( ShelfPossibleAction( $loggedinuser, $shelfnumber, 'manage' ) ) {
+ AddToShelf( $item->{'itemnumber'}, $shelfnumber );
+ foreach ( $query->param ) {
if (/REM-(\d*)/) {
- my $itemnumber=$1;
- RemoveFromShelf($env, $itemnumber, $shelfnumber);
+ my $itemnumber = $1;
+ DelFromShelf( $itemnumber, $shelfnumber );
}
}
}
}
-my ($shelflist) = GetShelfList($loggedinuser,2);
-$template->param({ loggedinuser => $loggedinuser,
- headerbackgroundcolor => $headerbackgroundcolor,
- circbackgroundcolor => $circbackgroundcolor });
+# getting the Shelves list
+my $shelflist = GetShelves( $loggedinuser, 2 );
+$template->param( { loggedinuser => $loggedinuser } );
+my $op = $query->param('op');
+
SWITCH: {
- if ($query->param('op') eq 'modifsave') {
- ModifShelf($query->param('shelfnumber'),$query->param('shelfname'),$loggedinuser,$query->param('category'));
+ if ( $op && ( $op eq 'modifsave' ) ) {
+ ModShelf(
+ $query->param('shelfnumber'), $query->param('shelfname'),
+ $loggedinuser, $query->param('category')
+ );
last SWITCH;
}
- if ($query->param('op') eq 'modif') {
- my ($shelfnumber,$shelfname,$owner,$category) = GetShelf($query->param('shelf'));
- $template->param(edit => 1,
+ if ( $op && ( $op eq 'modif' ) ) {
+ my ( $shelfnumber, $shelfname, $owner, $category ) =
+ GetShelf( $query->param('shelf') );
+ $template->param(
+ edit => 1,
shelfnumber => $shelfnumber,
shelfname => $shelfname,
- "category$category" => 1);
-# editshelf($query->param('shelf'));
+ "category$category" => 1
+ );
+
+ # editshelf($query->param('shelf'));
last SWITCH;
}
- if ($query->param('viewshelf')) {
- viewshelf($query->param('viewshelf'));
+ if ( $query->param('viewshelf') ) {
+ #check that the user can view the shelf
+ my $shelfnumber = $query->param('viewshelf');
+ if ( ShelfPossibleAction( $loggedinuser, $shelfnumber, 'view' ) ) {
+ my $items = GetShelfContents($shelfnumber);
+ $template->param(
+ shelfname => $shelflist->{$shelfnumber}->{'shelfname'},
+ shelfnumber => $shelfnumber,
+ viewshelf => $query->param('viewshelf'),
+ manageshelf => &ShelfPossibleAction( $loggedinuser, $shelfnumber, 'manage' ),
+ itemsloop => $items,
+ );
+ }
last SWITCH;
}
- if ($query->param('shelves')) {
- shelves();
+ if ( $query->param('shelves') ) {
+ if ( my $newshelf = $query->param('addshelf') ) {
+ my $shelfnumber = AddShelf(
+ $newshelf,
+ $query->param('owner'),
+ $query->param('category')
+ );
+
+ if ( $shelfnumber == -1 ) { #shelf already exists.
+ $template->param(
+ {
+ shelfnumber => $shelfnumber,
+ already => 1
+ }
+ );
+ }
+ }
+ my @paramsloop;
+ foreach ( $query->param() ) {
+ my %line;
+ if (/DEL-(\d+)/) {
+ my $delshelf = $1;
+ my ( $status, $count ) = DelShelf($delshelf);
+ if ($status) {
+ $line{'status'} = $status;
+ $line{'count'} = $count;
+ }
+ }
+
+ #if the shelf is not deleted, %line points on null
+ push( @paramsloop, \%line );
+ }
+ $template->param( paramsloop => \@paramsloop );
+ my ($shelflist) = GetShelves( $loggedinuser, 2 );
+ my $color = '';
+ my @shelvesloop;
+ foreach my $element ( sort keys %$shelflist ) {
+ my %line;
+ ( $color eq 1 ) ? ( $color = 0 ) : ( $color = 1 );
+ $line{'toggle'} = $color;
+ $line{'shelf'} = $element;
+ $line{'shelfname'} = $shelflist->{$element}->{'shelfname'};
+ $line{'shelfbookcount'} = $shelflist->{$element}->{'count'};
+ push( @shelvesloop, \%line );
+ }
+ $template->param(
+ shelvesloop => \@shelvesloop,
+ shelves => 1,
+ );
last SWITCH;
}
}
-($shelflist) = GetShelfList($loggedinuser,2); # rebuild shelflist in case a shelf has been added
+($shelflist) =
+ GetShelves( $loggedinuser, 2 )
+ ; # rebuild shelflist in case a shelf has been added
-my $color='';
+my $color = '';
my @shelvesloop;
-foreach my $element (sort keys %$shelflist) {
+my $numberCanManage = 0;
+
+foreach my $element ( sort keys %$shelflist ) {
my %line;
- ($color eq 1) ? ($color=0) : ($color=1);
- $line{'toggle'}=$color;
- $line{'shelf'}=$element;
- $line{'shelfname'}=$shelflist->{$element}->{'shelfname'};
- $line{"category".$shelflist->{$element}->{'category'}} = 1;
+ ( $color eq 1 ) ? ( $color = 0 ) : ( $color = 1 );
+ $line{'toggle'} = $color;
+ $line{'shelf'} = $element;
+ $line{'shelfname'} = $shelflist->{$element}->{'shelfname'};
+ $line{ "category" . $shelflist->{$element}->{'category'} } = 1;
$line{'mine'} = 1 if $shelflist->{$element}->{'owner'} eq $loggedinuser;
- $line{'shelfbookcount'}=$shelflist->{$element}->{'count'};
- $line{'canmanage'} = ShelfPossibleAction($loggedinuser,$element,'manage');
- $line{'firstname'}=$shelflist->{$element}->{'firstname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
- $line{'surname'}=$shelflist->{$element}->{'surname'} unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
-;
- push (@shelvesloop, \%line);
- }
-$template->param(shelvesloop => \@shelvesloop,
- intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
- intranetstylesheet => C4::Context->preference("intranetstylesheet"),
- IntranetNav => C4::Context->preference("IntranetNav"),
- );
+ $line{'shelfbookcount'} = $shelflist->{$element}->{'count'};
+ $line{'canmanage'} = ShelfPossibleAction( $loggedinuser, $element, 'manage' );
+ $line{'firstname'} = $shelflist->{$element}->{'firstname'}
+ unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
+ $line{'surname'} = $shelflist->{$element}->{'surname'}
+ unless $shelflist->{$element}->{'owner'} eq $loggedinuser;
+
+ $numberCanManage++ if $line{'canmanage'};
+
+ push( @shelvesloop, \%line );
+}
+
+$template->param(
+ shelvesloop => \@shelvesloop,
+ numberCanManage => $numberCanManage,
+);
output_html_with_http_headers $query, $cookie, $template->output;
-# sub editshelf {
-# my ($shelfnumber) = @_;
-# my ($shelfnumber,$shelfname,$owner,$category) = GetShelf($shelfnumber);
-# $template->param(edit => 1,
-# shelfnumber => $shelfnumber,
-# shelfname => $shelfname,
-# "category$category" => 1);
-# }
sub shelves {
- if (my $newshelf=$query->param('addshelf')) {
- my ($status, $string) = AddShelf($env,$newshelf,$query->param('owner'),$query->param('category'));
- if ($status) {
- $template->param(status1 => $status, string1 => $string);
+ my $innertemplate = shift;
+ if ( my $newshelf = $query->param('addshelf') ) {
+ my $shelfnumber = AddShelf(
+ $newshelf,
+ $query->param('owner'),
+ $query->param('category')
+ );
+
+ if ( $shelfnumber == -1 ) { #shelf already exists.
+ $template->param(
+ {
+ shelfnumber => $shelfnumber,
+ already => 1
+ }
+ );
}
}
my @paramsloop;
- foreach ($query->param()) {
+ foreach ( $query->param() ) {
my %line;
if (/DEL-(\d+)/) {
- my $delshelf=$1;
- my ($status, $string) = RemoveShelf($env,$delshelf);
+ my $delshelf = $1;
+ my ( $status, $count ) = DelShelf($delshelf);
if ($status) {
- $line{'status'}=$status;
- $line{'string'} = $string;
+ $line{'status'} = $status;
+ $line{'count'} = $count;
}
}
+
#if the shelf is not deleted, %line points on null
- push(@paramsloop,\%line);
+ push( @paramsloop, \%line );
}
- $template->param(paramsloop => \@paramsloop);
- my ($shelflist) = GetShelfList($loggedinuser,2);
- my $color='';
+ $innertemplate->param( paramsloop => \@paramsloop );
+ my ($shelflist) = GetShelves( $loggedinuser, 2 );
+ my $color = '';
my @shelvesloop;
- foreach my $element (sort keys %$shelflist) {
+ foreach my $element ( sort keys %$shelflist ) {
my %line;
- ($color eq 1) ? ($color=0) : ($color=1);
- $line{'toggle'}=$color;
- $line{'shelf'}=$element;
- $line{'shelfname'}=$shelflist->{$element}->{'shelfname'} ;
- $line{'shelfbookcount'}=$shelflist->{$element}->{'count'} ;
- push(@shelvesloop, \%line);
+ ( $color eq 1 ) ? ( $color = 0 ) : ( $color = 1 );
+ $line{'toggle'} = $color;
+ $line{'shelf'} = $element;
+ $line{'shelfname'} = $shelflist->{$element}->{'shelfname'};
+ $line{'shelfbookcount'} = $shelflist->{$element}->{'count'};
+ push( @shelvesloop, \%line );
}
- $template->param(shelvesloop=>\@shelvesloop,
+ $innertemplate->param(
+ shelvesloop => \@shelvesloop,
shelves => 1,
);
}
-sub viewshelf {
- my $shelfnumber=shift;
- #check that the user can view the shelf
- return unless (ShelfPossibleAction($loggedinuser,$shelfnumber,'view'));
- my ($itemlist) = GetShelfContents($env, $shelfnumber);
- my $item='';
- my $color='';
- my @itemsloop;
- foreach $item (sort {$a->{'barcode'} cmp $b->{'barcode'}} @$itemlist) {
- my %line;
- ($color eq 1) ? ($color=0) : ($color=1);
- $line{'toggle'}=$color;
- $line{'itemnumber'}=$item->{'itemnumber'};
- $line{'barcode'}=$item->{'barcode'};
- $line{'title'}=$item->{'title'};
- $line{'author'}=$item->{'author'};
- $line{'publicationyear'}=$item->{'publicationyear'};
- $line{'itemtype'}=$item->{'itemtype'};
- $line{biblionumber} = $item->{biblionumber};
- push(@itemsloop, \%line);
- }
- $template->param( itemsloop => \@itemsloop,
- shelfname => $shelflist->{$shelfnumber}->{'shelfname'},
- shelfnumber => $shelfnumber,
- viewshelf => $query->param('viewshelf'),
- manageshelf => &ShelfPossibleAction($loggedinuser,$shelfnumber,'manage'),
- );
-}
-
#
# $Log: shelves.pl,v $
-# Revision 1.10 2006/09/27 21:19:21 tgarip1957
-# Finalized XML version for intranet
-#
-# Revision 1.9 2006/07/04 14:36:51 toins
-# Head & rel_2_2 merged
-#
-# Revision 1.5.2.5 2006/02/05 21:59:21 kados
-# Adds script support for IntranetNav ... see mail to koha-devel for
-# details
-#
-# Revision 1.5.2.4 2006/02/05 21:45:25 kados
-# Adds support for intranetstylesheet system pref in Koha scripts
-#
-# Revision 1.5.2.3 2006/02/04 21:26:47 kados
-# Adds support for intranetcolorstylesheet
-#
-# Revision 1.5.2.2 2005/04/27 18:15:27 oleonard
-# Left out some instances in the previous update
-#
-# Revision 1.5.2.1 2005/04/27 16:55:38 oleonard
-# Moving alternating row colors to the template, adding publicationyear and itemtype variables
-#
-# Revision 1.5 2004/12/16 11:30:57 tipaul
-# adding bookshelf features :
-# * create bookshelf on the fly
-# * modify a bookshelf name & status
-#
-# Revision 1.4 2004/12/15 17:28:23 tipaul
-# adding bookshelf features :
-# * create bookshelf on the fly
-# * modify a bookshelf (this being not finished, will commit the rest soon)
-#
-# Revision 1.3 2004/12/02 16:38:50 tipaul
-# improvement in book shelves
-#
-# Revision 1.2 2004/11/19 16:31:30 tipaul
-# bugfix for bookshelves not in official CVS
-#
-# Revision 1.1.2.1 2004/03/10 15:08:18 tipaul
-# modifying shelves : introducing category of shelf : private, public, free for all
-#
-# Revision 1.13 2004/02/11 08:35:31 tipaul
-# synch'ing 2.0.0 branch and head
+# Revision 1.11 2007/03/09 14:32:26 tipaul
+# rel_3_0 moved to HEAD
#
-# Revision 1.12.2.1 2004/02/06 14:22:19 tipaul
-# fixing bugs in bookshelves management.
+# Revision 1.9.2.9 2007/02/05 15:54:30 toins
+# don't display "remove selected shelves" if the user logged has no shelf.
#
-# Revision 1.12 2003/02/05 10:04:14 acli
-# Worked around weirdness with HTML::Template; without the {}, it complains
-# of being passed an odd number of arguments even though we are not
+# Revision 1.9.2.8 2006/12/15 17:36:57 toins
+# - some change on the html param.
+# - Writing directly the code of a sub called only once.
+# - adding syspref: BiblioDefaultView.
#
-# Revision 1.11 2003/02/05 09:23:03 acli
-# Fixed a few minor errors to make it run
-# Noted correct tab size
+# Revision 1.9.2.7 2006/12/14 17:22:55 toins
+# bookshelves work perfectly with mod_perl and are cleaned.
#
-# Revision 1.10 2003/02/02 07:18:37 acli
-# Moved C4/Charset.pm to C4/Interface/CGI/Output.pm
+# Revision 1.9.2.6 2006/12/13 10:06:05 toins
+# fix a mod_perl specific bug.
#
-# Create output_html_with_http_headers function to contain the "print $query
-# ->header(-type => guesstype...),..." call. This is in preparation for
-# non-HTML output (e.g., text/xml) and charset conversion before output in
-# the future.
+# Revision 1.9.2.5 2006/12/11 17:10:06 toins
+# fixing some bugs on bookshelves.
#
-# Created C4/Interface/CGI/Template.pm to hold convenience functions specific
-# to the CGI interface using HTML::Template
+# Revision 1.9.2.4 2006/11/30 18:23:51 toins
+# theses scripts don't need to use C4::Search.
#
-# Modified moremembers.pl to make the "sex" field localizable for languages
-# where M and F doesn't make sense
+# Revision 1.9.2.3 2006/10/30 09:50:45 tipaul
+# better perl writting
#
-# Revision 1.9 2002/12/19 18:55:40 hdl
-# Templating reservereport et shelves.
+# Revision 1.9.2.2 2006/10/17 07:59:35 toins
+# ccode added.
#
-# Revision 1.9 2002/08/14 18:12:51 hdl
-# Templating files
-#
-# Revision 1.8 2002/08/14 18:12:51 tonnesen
-# Added copyright statement to all .pl and .pm files
-#
-# Revision 1.7 2002/07/05 05:03:37 tonnesen
-# Minor changes to authentication routines.
-#
-# Revision 1.5 2002/07/04 19:42:48 tonnesen
-# Minor changes
-#
-# Revision 1.4 2002/07/04 19:21:29 tonnesen
-# Beginning of authentication api. Applied to shelves.pl for now as a test case.
-#
-# Revision 1.2.2.1 2002/06/26 20:28:15 tonnesen
-# Some udpates that I made here locally a while ago. Still won't be useful, but
-# should be functional
-#
-#
-#
-
-
-
-
-# Local Variables:
-# tab-width: 4
-# End:
Index: C4/Circulation/Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.123
retrieving revision 1.124
diff -u -b -r1.123 -r1.124
--- C4/Circulation/Circ2.pm 15 Nov 2006 01:36:00 -0000 1.123
+++ C4/Circulation/Circ2.pm 9 Mar 2007 14:32:26 -0000 1.124
@@ -1,14 +1,5 @@
-# -*- tab-width: 8 -*-
-# Please use 8-character tabs for this file (indents are every 4 characters)
-
package C4::Circulation::Circ2;
-# $Id: Circ2.pm,v 1.123 2006/11/15 01:36:00 tgarip1957 Exp $
-
-#package to deal with circulation
-#written 3/11/99 by olwen at katipo.co.nz
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
@@ -26,24 +17,31 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id: Circ2.pm,v 1.124 2007/03/09 14:32:26 tipaul Exp $
+
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: 1.124 $' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -51,7 +49,7 @@
=head1 SYNOPSIS
- use C4::Circulation::Circ2;
+use C4::Circulation::Circ2;
=head1 DESCRIPTION
@@ -61,12 +59,11 @@
=head1 FUNCTIONS
-=over 2
-
=cut
@ISA = qw(Exporter);
@EXPORT = qw(
+ &getpatroninformation
¤tissues
&getissues
&getiteminformation
@@ -79,214 +76,270 @@
&transferbook
&decode
&calc_charges
- &listitemsforinventory
+ &GetItemsForInventory
&itemseen
- &itemseenbarcode
&fixdate
- &itemissues
- &patronflags
&get_current_return_date_of
&get_transfert_infos
&checktransferts
&GetReservesForBranch
&GetReservesToBranch
&GetTransfersFromBib
- &getBranchIp);
+ &getBranchIp
+ &dotransfer
+ &GetOverduesForBranch
+ &AddNotifyLine
+ &RemoveNotifyLine
+ &GetIssuesFromBiblio
+ &AnonymiseIssueHistory
+ &GetLostItems
+ &itemissues
+ &updateWrongTransfer
+);
-# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
-=item itemissues
+=head2 itemseen
- @issues = &itemissues($biblionumber, $biblio);
+&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
-Looks up information about who has borrowed the bookZ<>(s) with the
-given biblionumber.
+=cut
-C<$biblio> is ignored.
+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;
+}
-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:
+=head2 itemborrowed
-=over 4
+&itemseen($itemnum)
+Mark item as borrowed. Is called when an item is issued.
+C<$itemnum> is the item number
-=item C<date_due>
+=cut
-If the item is currently on loan, this gives the due date.
+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 not on loan, then this is either "Available" or
-"Cancelled", if the item has been withdrawn.
+=head2 GetItemsForInventory
-=item C<card>
+$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
-If the item is currently on loan, this gives the card number of the
-patron who currently has the item.
+Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
-=item C<timestamp0>, C<timestamp1>, C<timestamp2>
+The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
+It is ordered by callnumber,title.
-These give the timestamp for the last three times the item was
-borrowed.
+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<card0>, C<card1>, C<card2>
+=cut
-The card 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;
+}
-=item C<borrower0>, C<borrower1>, C<borrower2>
+=head2 getpatroninformation
-The borrower number of the last three patrons who borrowed this item.
+($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
-=back
+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.
-=cut
-#'
-sub itemissues {
- my ($dbh,$data, $itemnumber)=@_;
+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 :
- my $i = 0;
- my @results;
+ 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.
- # 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");
+The possible flags are:
- $sth2->execute($itemnumber);
- if (my $data2 = $sth2->fetchrow_hashref) {
+=head3 CHARGES
- $data->{'date_due'}=$data2->{'date_due'};
- $data->{'datelastborrowed'} = $data2->{'issue_date'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- $data->{issues}++;
- }
+=over 4
- $sth2->finish;
- my $sth2 = $dbh->prepare("select * from reserveissue,borrowers
-where itemnumber = ?
-and rettime is NULL
-and reserveissue.borrowernumber = borrowers.borrowernumber");
+=item Shows the patron's credit or debt, if any.
- $sth2->execute($itemnumber);
- if (my $data2 = $sth2->fetchrow_hashref) {
+=back
- $data->{'date_due'}=$data2->{'duetime'};
- $data->{'datelastborrowed'} = $data2->{'restime'};
- $data->{'card'} = $data2->{'cardnumber'};
- $data->{'borrower'} = $data2->{'borrowernumber'};
- $data->{issues}++;
- }
+=head3 GNA
- $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
+=over 4
- $sth2->finish;
- return($data);
-}
+=item (Gone, no address.) Set if the patron has left without giving a
+forwarding address.
+=back
+=head3 LOST
-=head2 itemseen
+=over 4
-&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
+=item Set if the patron's card has been reported as lost.
-=cut
+=back
-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);
-}
+=head3 DBARRED
-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, at 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, at results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
- }
+=over 4
- return @results;
-}
+=item Set if the patron has been debarred.
+=back
+
+=head3 NOTES
+=over 4
+=item Any additional notes about the patron.
-=head2 decode
+=back
+
+=head3 ODUES
=over 4
-=head3 $str = &decode($chunk);
+=item Set if the patron has overdue items. This flag has several keys:
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
+overdue items. Its elements are references-to-hash, each describing an
+overdue item. The keys are selected fields from the issues, biblio,
+biblioitems, and items tables of the Koha database.
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
+the overdue items, one per line.
+
+=back
+
+=head3 WAITING
=over 4
-Decodes a segment of a string emitted by a CueCat barcode scanner and
-returns it.
+=item Set if any items that the patron has reserved are available.
+
+C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
+available items. Each element is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database.
=back
+=cut
+
+sub getpatroninformation {
+ my ( $env, $borrowernumber, $cardnumber ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query;
+ my $sth;
+ if ($borrowernumber) {
+ $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
+ $sth->execute($borrowernumber);
+ }
+ elsif ($cardnumber) {
+ $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
+ $sth->execute($cardnumber);
+ }
+ else {
+ return undef;
+ }
+ my $borrower = $sth->fetchrow_hashref;
+ my $amount = checkaccount( $env, $borrowernumber, $dbh );
+ $borrower->{'amountoutstanding'} = $amount;
+ my $flags = patronflags( $env, $borrower, $dbh );
+ my $accessflagshash;
+
+ $sth = $dbh->prepare("select bit,flag from userflags");
+ $sth->execute;
+ while ( my ( $bit, $flag ) = $sth->fetchrow ) {
+ if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
+ $accessflagshash->{$flag} = 1;
+ }
+ }
+ $sth->finish;
+ $borrower->{'flags'} = $flags;
+ $borrower->{'authflags'} = $accessflagshash;
+
+ # find out how long the membership lasts
+ $sth =
+ $dbh->prepare(
+ "select enrolmentperiod from categories where categorycode = ?");
+ $sth->execute( $borrower->{'categorycode'} );
+ my $enrolment = $sth->fetchrow;
+ $borrower->{'enrolmentperiod'} = $enrolment;
+ return ($borrower); #, $flags, $accessflagshash);
+}
+
+=head2 decode
+
+=head3 $str = &decode($chunk);
+
+=over 4
+
+=item Decodes a segment of a string emitted by a CueCat barcode scanner and
+returns it.
+
=back
=cut
@@ -294,44 +347,39 @@
# 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!";
+ my $seq =
+ 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
+ my @s = map { index( $seq, $_ ); } split( //, $encoded );
+ my $l = ( $#s + 1 ) % 4;
+ if ($l) {
+ if ( $l == 1 ) {
+ warn "Error!";
return;
}
- $l = 4-$l;
+ $l = 4 - $l;
$#s += $l;
}
my $r = '';
- while ($#s >= 0)
- {
- my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
- $r .=chr(($n >> 16) ^ 67) .
- chr(($n >> 8 & 255) ^ 67) .
- chr(($n & 255) ^ 67);
- @s = @s[4..$#s];
+ while ( $#s >= 0 ) {
+ my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
+ $r .=
+ chr( ( $n >> 16 ) ^ 67 )
+ .chr( ( $n >> 8 & 255 ) ^ 67 )
+ .chr( ( $n & 255 ) ^ 67 );
+ @s = @s[ 4 .. $#s ];
}
- $r = substr($r,0,length($r)-$l);
+ $r = substr( $r, 0, length($r) - $l );
return $r;
}
=head2 getiteminformation
-=over 4
-
-$item = &getiteminformation($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:
@@ -340,7 +388,7 @@
=over 4
-The due date on this item, if it has been borrowed and not returned
+=item The due date on this item, if it has been borrowed and not returned
yet. The date is in YYYY-MM-DD format.
=back
@@ -349,41 +397,63 @@
=over 4
-True if the item may not be borrowed.
-
-=back
+=item True if the item may not be borrowed.
=back
=cut
-
sub getiteminformation {
-# returns a hash of item information 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};
+
+ # 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;
}
- $iteminformation->{'date_due'}="" if $iteminformation->{'date_due'} eq "0000-00-00";
- ($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
+ 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);
+ 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.
@@ -407,119 +477,147 @@
=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 ( $tbr, $barcode, $ignoreRs ) = @_;
my $messages;
my %env;
- my $dbh=C4::Context->dbh;
my $dotransfer = 1;
my $branches = GetBranches();
+ my $iteminformation = getiteminformation( 0, $barcode );
- my $iteminformation = getiteminformation(\%env, 0, $barcode);
# bad barcode..
- if (not $iteminformation) {
+ if ( not $iteminformation ) {
$messages->{'BadBarcode'} = $barcode;
$dotransfer = 0;
}
+
# get branches of book...
my $hbr = $iteminformation->{'homebranch'};
my $fbr = $iteminformation->{'holdingbranch'};
+
# if is permanent...
- if ($hbr && $branches->{$hbr}->{'PE'}) {
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
$messages->{'IsPermanent'} = $hbr;
}
+
# can't transfer book if is already there....
# FIXME - Why not? Shouldn't it trivially succeed?
- if ($fbr eq $tbr) {
+ if ( $fbr eq $tbr ) {
$messages->{'DestinationEqualsHolding'} = 1;
$dotransfer = 0;
}
+
# check if it is still issued to someone, return it...
- my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
+ my ($currentborrower) = currentborrower( $iteminformation->{'itemnumber'} );
if ($currentborrower) {
- returnbook($barcode, $fbr);
+ returnbook( $barcode, $fbr );
$messages->{'WasReturned'} = $currentborrower;
}
+
# find reserves.....
# FIXME - Don't call &CheckReserves unless $ignoreRs is true.
# That'll save a database query.
- my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
- if ($resfound and not $ignoreRs) {
+ my ( $resfound, $resrec ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
+ if ( $resfound and not $ignoreRs ) {
$resrec->{'ResFound'} = $resfound;
- $messages->{'ResFound'} = $resrec;
- $dotransfer = 0;
+
+ # $messages->{'ResFound'} = $resrec;
+ $dotransfer = 1;
}
+
#actually do the transfer....
if ($dotransfer) {
- dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user);
+ dotransfer( $iteminformation->{'itemnumber'}, $fbr, $tbr );
+
+ # don't need to update MARC anymore, we do it in batch now
$messages->{'WasTransfered'} = 1;
}
- return ($dotransfer, $messages, $iteminformation);
+ return ( $dotransfer, $messages, $iteminformation );
}
# Not exported
-
+# FIXME - This is only used in &transferbook. Why bother making it a
+# separate function?
sub dotransfer {
-## 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 ) = @_;
- my ($itm, $fbr, $tbr,$user) = @_;
my $dbh = C4::Context->dbh;
+ $itm = $dbh->quote($itm);
+ $fbr = $dbh->quote($fbr);
+ $tbr = $dbh->quote($tbr);
#new entry in branchtransfers....
- my $sth=$dbh->prepare("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch,comments) VALUES (?, ?, now(), ?,?)");
- $sth->execute($itm, $fbr, $tbr,$user);
+ $dbh->do(
+"INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
+ VALUES ($itm, $fbr, now(), $tbr)"
+ );
+
#update holdingbranch in items .....
- &domarctransfer($dbh,$itm,$tbr);
-## Item seen taken out of this loop to optimize ZEBRA updates
-# &itemseen($dbh,$itm);
+ $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");
+##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();
-my ($biblionumber)=$sth->fetchrow;
-XMLmoditemonefield($dbh,$biblionumber,$itemnumber,'holdingbranch',$holdingbranch,1);
- $sth->finish;
+ while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
+ &MARCmoditemonefield( $biblionumber, $itemnumber,
+ 'items.holdingbranch', $holdingbranch, 0 );
+ }
+ return;
}
=head2 canbookbeissued
@@ -530,13 +628,13 @@
=over 4
-C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
+=item C<$env> Environment variable. Should be empty usually, but used by other subs. Next code cleaning could drop it.
-C<$borrower> hash with borrower informations (from getpatroninformation)
+=item C<$borrower> hash with borrower informations (from getpatroninformation)
-C<$barcode> is the bar code of the book being issued.
+=item C<$barcode> is the bar code of the book being issued.
-C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
+=item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
=back
@@ -544,9 +642,11 @@
=over 4
-C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
+=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :
+=back
+
=head3 INVALID_DATE
sticky due date is invalid
@@ -579,8 +679,6 @@
item is restricted (set by ??)
-=back
-
C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
Possible values are :
@@ -613,277 +711,464 @@
# check if a book can be issued.
# returns an array with errors if any
-
-
-
-
-
-
-
-
-
-
-sub TooMany ($$){
+sub TooMany ($$) {
my $borrower = shift;
my $iteminformation = shift;
my $cat_borrower = $borrower->{'categorycode'};
my $branch_borrower = $borrower->{'branchcode'};
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare('select itemtype from biblio where biblionumber = ?');
- $sth->execute($iteminformation->{'biblionumber'});
+
+ my $sth =
+ $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
+ $sth->execute( $iteminformation->{'biblionumber'} );
my $type = $sth->fetchrow;
- $sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?');
- 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');
+ $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
- #print "content-type: text/plain \n\n";
- #print "$cat_borrower, $type, $branch_borrower";
- $sth->execute($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);
+
+ # 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;
- # print "***" . $alreadyissued;
- #print "----". $result->{'maxissueqty'};
- if ($result->{'maxissueqty'} <= $alreadyissued) {
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- }else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
# check for branch=*
- $sth->execute($cat_borrower, $type, "");
+ $sth->execute( $cat_borrower, $type, "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, $type);
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
# check for itemtype=*
- $sth->execute($cat_borrower, "*", $branch_borrower);
+ $sth->execute( $cat_borrower, "*", $branch_borrower );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
my ($alreadyissued) = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+
# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- #check for borrowertype=*
- $sth->execute("*", $type, $branch_borrower);
+ # check for borrowertype=*
+ $sth->execute( "*", $type, $branch_borrower );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- #check for borrowertype=*;itemtype=*
- $sth->execute("*", "*", $branch_borrower);
+ $sth->execute( "*", "*", $branch_borrower );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute("*", $type, "");
+ $sth->execute( "*", $type, "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty}) && $result->{maxissueqty}>=0) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute($cat_borrower, "*", "");
+ $sth->execute( $cat_borrower, "*", "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
- $sth->execute("*", "*", "");
+ $sth->execute( "*", "*", "" );
$result = $sth->fetchrow_hashref;
- if (defined($result->{maxissueqty})) {
- $sth3->execute($borrower->{'borrowernumber'});
+ if ( defined( $result->{maxissueqty} ) ) {
+ $sth3->execute( $borrower->{'borrowernumber'} );
my $alreadyissued = $sth3->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0));
- } else {
+ if ( $result->{'maxissueqty'} <= $alreadyissued ) {
+ return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
+ }
+ else {
return;
}
}
return;
}
+=head2 itemissues
+ @issues = &itemissues($biblioitemnumber, $biblio);
+Looks up information about who has borrowed the bookZ<>(s) with the
+given biblioitemnumber.
-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);
+C<$biblio> is ignored.
-#
-# 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
-#
+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:
-# 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;
- }
- }
+=over 4
+=item C<date_due>
-#
-# 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 the item is currently on loan, this gives the due date.
+
+If the item is not on loan, then this is either "Available" or
+"Cancelled", if the item has been withdrawn.
+
+=item C<card>
+
+If the item is currently on loan, this gives the card number of the
+patron who currently has the item.
+
+=item C<timestamp0>, C<timestamp1>, C<timestamp2>
+
+These give the timestamp for the last three times the item was
+borrowed.
+
+=item C<card0>, C<card1>, C<card2>
+
+The card number of the last three patrons who borrowed this item.
+
+=item C<borrower0>, C<borrower1>, C<borrower2>
+
+The borrower number of the last three patrons who borrowed this item.
+
+=back
+
+=cut
+
+#'
+sub itemissues {
+ my ( $bibitem, $biblio ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # FIXME - If this function die()s, the script will abort, and the
+ # user won't get anything; depending on how far the script has
+ # gotten, the user might get a blank page. It would be much better
+ # to at least print an error message. The easiest way to do this
+ # is to set $SIG{__DIE__}.
+ my $sth =
+ $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
+ || die $dbh->errstr;
+ my $i = 0;
+ my @results;
+
+ $sth->execute($bibitem) || die $sth->errstr;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ # Find out who currently has this item.
+ # FIXME - Wouldn't it be better to do this as a left join of
+ # some sort? Currently, this code assumes that if
+ # fetchrow_hashref() fails, then the book is on the shelf.
+ # fetchrow_hashref() can fail for any number of reasons (e.g.,
+ # database server crash), not just because no items match the
+ # search criteria.
+ my $sth2 = $dbh->prepare(
+ "select * from issues,borrowers
+where itemnumber = ?
+and returndate is NULL
+and issues.borrowernumber = borrowers.borrowernumber"
+ );
+
+ $sth2->execute( $data->{'itemnumber'} );
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
+ $data->{'date_due'} = $data2->{'date_due'};
+ $data->{'card'} = $data2->{'cardnumber'};
+ $data->{'borrower'} = $data2->{'borrowernumber'};
}
-if (C4::Context->preference("IndependantBranches")){
+ 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} ) ;
+ 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 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
+ #
+ # 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 {
- 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;
}
+ else {
+ # $needsconfirmation{RENEW_ISSUE} = 1;
+ }
}
- } elsif ($currentborrower) {
-# issued to someone else
- my $currborinfo = getpatroninformation(0,$currentborrower);
+ elsif ($currentborrower) {
+
+ # issued to someone else
+ my $currborinfo = getpatroninformation( 0, $currentborrower );
+
# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
- $needsconfirmation{ISSUED_TO_ANOTHER} = "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
+ $needsconfirmation{ISSUED_TO_ANOTHER} =
+"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
}
-# See if the item is on RESERVE
- my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
+
+ # See if the item is on reserve.
+ my ( $restype, $res ) = CheckReserves( $iteminformation->{'itemnumber'} );
if ($restype) {
my $resbor = $res->{'borrowernumber'};
- if ($resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting") {
+ if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
+ {
+
# The item is on reserve and waiting, but has been
# reserved by some other patron.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
- # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- } elsif ($restype eq "Reserved") {
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ $needsconfirmation{RESERVE_WAITING} =
+"$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
+
+# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
+ }
+ elsif ( $restype eq "Reserved" ) {
+
# The item is on reserve for someone else.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- $needsconfirmation{RESERVED} = "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ $needsconfirmation{RESERVED} =
+"$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
}
}
- if(C4::Context->preference("LibraryName") eq "Horowhenua Library Trust"){
- if ($borrower->{'categorycode'} eq 'W'){
+ if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
+ {
+ if ( $borrower->{'categorycode'} eq 'W' ) {
my %issuingimpossible;
- return(\%issuingimpossible,\%needsconfirmation);
+ return ( \%issuingimpossible, \%needsconfirmation );
}
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
+ }
+ }
+ else {
+ return ( \%issuingimpossible, \%needsconfirmation );
}
-
- return(\%issuingimpossible,\%needsconfirmation);
}
=head2 issuebook
@@ -894,148 +1179,229 @@
=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 ( $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 ($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);
+ 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'});
+ &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'}
+ );
}
- } 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";
+ my ( $restype, $res ) =
+ CheckReserves( $iteminformation->{'itemnumber'} );
if ($restype) {
my $resbor = $res->{'borrowernumber'};
- if ($resbor eq $borrower->{'borrowernumber'}) {
+ if ( $resbor eq $borrower->{'borrowernumber'} ) {
+
# The item is on reserve to the current patron
FillReserve($res);
-# warn "FillReserve";
- } elsif ($restype eq "Waiting") {
-# warn "Waiting";
+ }
+ elsif ( $restype eq "Waiting" ) {
+
+ # warn "Waiting";
# The item is on reserve and waiting, but has been
# reserved by some other patron.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
- if ($cancelreserve){
- CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- } else {
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
+ if ($cancelreserve) {
+ CancelReserve( 0, $res->{'itemnumber'},
+ $res->{'borrowernumber'} );
+ }
+ else {
+
# set waiting reserve to first in reserve queue as book isn't waiting now
- UpdateReserve(1, $res->{'biblionumber'}, $res->{'borrowernumber'}, $res->{'branchcode'});
+ UpdateReserve(
+ 1,
+ $res->{'biblionumber'},
+ $res->{'borrowernumber'},
+ $res->{'branchcode'}
+ );
}
- } elsif ($restype eq "Reserved") {
-#warn "Reserved";
+ }
+ elsif ( $restype eq "Reserved" ) {
+
+ # warn "Reserved";
# The item is on reserve for someone else.
- my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
+ my ( $resborrower, $flags ) =
+ getpatroninformation( $env, $resbor, 0 );
my $branches = GetBranches();
- my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
+ my $branchname =
+ $branches->{ $res->{'branchcode'} }->{'branchname'};
if ($cancelreserve) {
+
# cancel reserves on this item
- CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
- # also cancel reserve on biblio related to this item
- # my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?");
- # $st_Fbiblio->execute($res->{'itemnumber'});
- # my $biblionumber = $st_Fbiblio->fetchrow;
-# CancelReserve($iteminformation->{'biblionumber'},0,$res->{'borrowernumber'});
-# warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
- } else {
- my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
- transferbook($tobrcd,$barcode, 1);
+ 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 $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 ($datesent) = get_transfert_infos($iteminformation->{'itemnumber'});
- 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);
+ 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;
+ }
-#warn $dateduef;
+# 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;
+ $dateduef = $date;
}
+
# if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
- if (C4::Context->preference('ReturnBeforeExpiry') && $dateduef gt $borrower->{expiry}) {
- $dateduef=$borrower->{expiry};
+ if ( C4::Context->preference('ReturnBeforeExpiry')
+ && $dateduef gt $borrower->{dateexpiry} )
+ {
+ $dateduef = $borrower->{dateexpiry};
}
- $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'});
+ $sth->execute(
+ $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'},
+ strftime( "%Y-%m-%d", localtime ),$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'});
+ $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;
+ 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'});
+
+ # Record the fact that this book was issued.
+ &UpdateStats(
+ $env, $env->{'branchcode'},
+ 'issue', $charge,
+ '', $iteminformation->{'itemnumber'},
+ $iteminformation->{'itemtype'}, $borrower->{'borrowernumber'}
+ );
}
-return($error);
+
+ &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$iteminformation->{'biblionumber'})
+ if C4::Context->preference("IssueLog");
+
}
=head2 getLoanLength
@@ -1047,49 +1413,62 @@
=cut
sub getLoanLength {
- my ($borrowertype,$itemtype,$branchcode) = @_;
+ my ( $borrowertype, $itemtype, $branchcode ) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?");
- # try to find issuelength & return the 1st available.
- # check with borrowertype, itemtype and branchcode, then without one of those parameters
- $sth->execute($borrowertype,$itemtype,$branchcode);
+ my $sth =
+ $dbh->prepare(
+"select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
+ );
+
+# try to find issuelength & return the 1st available.
+# check with borrowertype, itemtype and branchcode, then without one of those parameters
+ $sth->execute( $borrowertype, $itemtype, $branchcode );
my $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength);
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute($borrowertype,$itemtype,"");
+ $sth->execute( $borrowertype, $itemtype, "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute($borrowertype,"*",$branchcode);
+ $sth->execute( $borrowertype, "*", $branchcode );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*",$itemtype,$branchcode);
+ $sth->execute( "*", $itemtype, $branchcode );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute($borrowertype,"*","");
+ $sth->execute( $borrowertype, "*", "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*","*",$branchcode);
+ $sth->execute( "*", "*", $branchcode );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*",$itemtype,"");
+ $sth->execute( "*", $itemtype, "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
- $sth->execute("*","*","");
+ $sth->execute( "*", "*", "" );
$loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength}
+ if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
# if no rule is set => 21 days (hardcoded)
return 21;
}
+
=head2 returnbook
- ($doreturn, $messages, $iteminformation, $borrower) =
+($doreturn, $messages, $iteminformation, $borrower) =
&returnbook($barcode, $branch);
Returns a book.
@@ -1151,116 +1530,142 @@
# is more C-ish than Perl-ish).
sub returnbook {
- my ($barcode, $branch) = @_;
+ my ( $barcode, $branch ) = @_;
my %env;
my $messages;
my $dbh = C4::Context->dbh;
my $doreturn = 1;
+ my $validTransfert = 0;
+ my $reserveDone = 0;
+
die '$branch not defined' unless defined $branch; # just in case (bug 170)
# get information on item
- my $itemrecord=XMLgetitemhash($dbh,"",$barcode);
- if (not $itemrecord) {
+ my ($iteminformation) = getiteminformation( 0, $barcode );
+
+ if ( not $iteminformation ) {
$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) {
+ 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'}) {
+ if ( $hbr && $branches->{$hbr}->{'PE'} ) {
$messages->{'IsPermanent'} = $hbr;
}
+
# check that the book has been cancelled
- if ($iteminformation->{'wthdrawn'}) {
- $messages->{'wthdrawn'} = 1;
- # $doreturn = 0;
+ if ( $iteminformation->{'wthdrawn'} ) {
+ $messages->{'wthdrawn'} = 1;itemnumber
+ $doreturn = 0;
}
- # update issues, thereby returning book (should push this out into another subroutine
- my ($borrower) = getpatroninformation(\%env, $currentborrower, 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 (itemnumber = ?) and (returndate is null)");
- $sth->execute( $iteminformation->{'itemnumber'});
+ my $sth =
+ $dbh->prepare(
+"update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"
+ );
+ $sth->execute( $borrower->{'borrowernumber'},
+ $iteminformation->{'itemnumber'} );
$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
+# continue to deal with returns cases, but not only if we have an issue
- if ($transfered) {
- $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
+# 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);
+ 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;
+
+ # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
+ # 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'
-# 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'});
+ 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'});
+
+# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
$resrec->{'ResFound'} = $resfound;
$messages->{'ResFound'} = $resrec;
+ $reserveDone = 1;
}
- ##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);
+ 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
@@ -1276,83 +1681,117 @@
=cut
sub fixaccountforlostandreturned {
- my ($iteminfo, $borrower) = @_;
+ my ( $iteminfo, $borrower ) = @_;
my %env;
my $dbh = C4::Context->dbh;
my $itm = $iteminfo->{'itemnumber'};
+
# check for charge made for lost book
- my $sth = $dbh->prepare("select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc");
+ my $sth =
+ $dbh->prepare(
+"select * from accountlines where (itemnumber = ?) and (accounttype='L' or accounttype='Rep') order by date desc"
+ );
$sth->execute($itm);
- if (my $data = $sth->fetchrow_hashref) {
+ if ( my $data = $sth->fetchrow_hashref ) {
+
# writeoff this amount
my $offset;
my $amount = $data->{'amount'};
my $acctno = $data->{'accountno'};
my $amountleft;
- if ($data->{'amountoutstanding'} == $amount) {
+ if ( $data->{'amountoutstanding'} == $amount ) {
$offset = $data->{'amount'};
$amountleft = 0;
- } else {
+ }
+ else {
$offset = $amount - $data->{'amountoutstanding'};
$amountleft = $data->{'amountoutstanding'} - $amount;
}
- my $usth = $dbh->prepare("update accountlines set accounttype = 'LR',amountoutstanding='0'
+ my $usth = $dbh->prepare(
+ "update accountlines set accounttype = 'LR',amountoutstanding='0'
where (borrowernumber = ?)
- and (itemnumber = ?) and (accountno = ?) ");
- $usth->execute($data->{'borrowernumber'},$itm,$acctno);
+ and (itemnumber = ?) and (accountno = ?) "
+ );
+ $usth->execute( $data->{'borrowernumber'}, $itm, $acctno );
$usth->finish;
+
#check if any credit is left if so writeoff other accounts
- my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
- if ($amountleft < 0){
- $amountleft*=-1;
- }
- if ($amountleft > 0){
- my $msth = $dbh->prepare("select * from accountlines where (borrowernumber = ?)
- and (amountoutstanding >0) order by date");
- $msth->execute($data->{'borrowernumber'});
+ my $nextaccntno =
+ getnextacctno( \%env, $data->{'borrowernumber'}, $dbh );
+ if ( $amountleft < 0 ) {
+ $amountleft *= -1;
+ }
+ if ( $amountleft > 0 ) {
+ my $msth = $dbh->prepare(
+ "select * from accountlines where (borrowernumber = ?)
+ and (amountoutstanding >0) order by date"
+ );
+ $msth->execute( $data->{'borrowernumber'} );
+
# offset transactions
my $newamtos;
my $accdata;
- while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
- if ($accdata->{'amountoutstanding'} < $amountleft) {
+ while ( ( $accdata = $msth->fetchrow_hashref )
+ and ( $amountleft > 0 ) )
+ {
+ if ( $accdata->{'amountoutstanding'} < $amountleft ) {
$newamtos = 0;
$amountleft -= $accdata->{'amountoutstanding'};
- } else {
+ }
+ else {
$newamtos = $accdata->{'amountoutstanding'} - $amountleft;
$amountleft = 0;
}
my $thisacct = $accdata->{'accountno'};
- my $usth = $dbh->prepare("update accountlines set amountoutstanding= ?
+ my $usth = $dbh->prepare(
+ "update accountlines set amountoutstanding= ?
where (borrowernumber = ?)
- and (accountno=?)");
- $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
+ and (accountno=?)"
+ );
+ $usth->execute( $newamtos, $data->{'borrowernumber'},
+ '$thisacct' );
$usth->finish;
- $usth = $dbh->prepare("insert into accountoffsets
+ $usth = $dbh->prepare(
+ "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
values
- (?,?,?,?)");
- $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
+ (?,?,?,?)"
+ );
+ $usth->execute(
+ $data->{'borrowernumber'},
+ $accdata->{'accountno'},
+ $nextaccntno, $newamtos
+ );
$usth->finish;
}
$msth->finish;
}
- if ($amountleft > 0){
- $amountleft*=-1;
+ if ( $amountleft > 0 ) {
+ $amountleft *= -1;
}
- my $desc="Book Returned ".$iteminfo->{'barcode'};
- $usth = $dbh->prepare("insert into accountlines
+ my $desc = "Book Returned " . $iteminfo->{'barcode'};
+ $usth = $dbh->prepare(
+ "insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values (?,?,now(),?,?,'CR',?)");
- $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
+ values (?,?,now(),?,?,'CR',?)"
+ );
+ $usth->execute(
+ $data->{'borrowernumber'},
+ $nextaccntno, 0 - $amount,
+ $desc, $amountleft
+ );
$usth->finish;
- $usth = $dbh->prepare("insert into accountoffsets
+ $usth = $dbh->prepare(
+ "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
- values (?,?,?,?)");
- $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
+ values (?,?,?,?)"
+ );
+ $usth->execute( $borrower->{'borrowernumber'},
+ $data->{'accountno'}, $nextaccntno, $offset );
+ $usth->finish;
+ $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
+ $usth->execute($itm);
$usth->finish;
-# $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
-# $usth->execute($itm);
-# $usth->finish;
}
$sth->finish;
return;
@@ -1362,8 +1801,6 @@
&fixoverdueonreturn($brn,$itm);
-??
-
C<$brn> borrowernumber
C<$itm> itemnumber
@@ -1371,198 +1808,263 @@
=cut
sub fixoverduesonreturn {
- my ($brn, $itm) = @_;
+ my ( $brn, $itm ) = @_;
my $dbh = C4::Context->dbh;
+
# check for overdue fine
- my $sth = $dbh->prepare("select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')");
- $sth->execute($brn,$itm);
+ my $sth =
+ $dbh->prepare(
+"select * from accountlines where (borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or accounttype='O')"
+ );
+ $sth->execute( $brn, $itm );
+
# alter fine to show that the book has been returned
- if (my $data = $sth->fetchrow_hashref) {
- my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)");
- $usth->execute($brn,$itm,$data->{'accountno'});
+ if ( my $data = $sth->fetchrow_hashref ) {
+ my $usth =
+ $dbh->prepare(
+"update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (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
+
+ # Original subroutine for Circ2.pm
my %flags;
- my ($env, $patroninformation, $dbh) = @_;
- my $amount = C4::Accounts2::checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
- if ($amount > 0) {
+ my ( $env, $patroninformation, $dbh ) = @_;
+ my $amount =
+ checkaccount( $env, $patroninformation->{'borrowernumber'}, $dbh );
+ if ( $amount > 0 ) {
my %flaginfo;
my $noissuescharge = C4::Context->preference("noissuescharge");
- $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
- if ($amount > $noissuescharge) {
+ $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
+ if ( $amount > $noissuescharge ) {
$flaginfo{'noissues'} = 1;
}
$flags{'CHARGES'} = \%flaginfo;
- } elsif ($amount < 0){
+ }
+ elsif ( $amount < 0 ) {
my %flaginfo;
$flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
$flags{'CHARGES'} = \%flaginfo;
}
- if ($patroninformation->{'gonenoaddress'} == 1) {
+ if ( $patroninformation->{'gonenoaddress'}
+ && $patroninformation->{'gonenoaddress'} == 1 )
+ {
my %flaginfo;
$flaginfo{'message'} = 'Borrower has no valid address.';
$flaginfo{'noissues'} = 1;
$flags{'GNA'} = \%flaginfo;
}
- if ($patroninformation->{'lost'} == 1) {
+ if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
my %flaginfo;
$flaginfo{'message'} = 'Borrower\'s card reported lost.';
$flaginfo{'noissues'} = 1;
$flags{'LOST'} = \%flaginfo;
}
- if ($patroninformation->{'debarred'} == 1) {
+ if ( $patroninformation->{'debarred'}
+ && $patroninformation->{'debarred'} == 1 )
+ {
my %flaginfo;
$flaginfo{'message'} = 'Borrower is Debarred.';
$flaginfo{'noissues'} = 1;
$flags{'DBARRED'} = \%flaginfo;
}
- if ($patroninformation->{'borrowernotes'}) {
+ if ( $patroninformation->{'borrowernotes'}
+ && $patroninformation->{'borrowernotes'} )
+ {
my %flaginfo;
$flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
$flags{'NOTES'} = \%flaginfo;
}
- my ($odues, $itemsoverdue)
- = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
- if ($odues > 0) {
+ my ( $odues, $itemsoverdue ) =
+ checkoverdues( $env, $patroninformation->{'borrowernumber'}, $dbh );
+ if ( $odues > 0 ) {
my %flaginfo;
$flaginfo{'message'} = "Yes";
$flaginfo{'itemlist'} = $itemsoverdue;
- foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
- $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
+ foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
+ @$itemsoverdue )
+ {
+ $flaginfo{'itemlisttext'} .=
+ "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
}
$flags{'ODUES'} = \%flaginfo;
}
- my ($nowaiting, $itemswaiting)
- = CheckWaiting($patroninformation->{'borrowernumber'});
- if ($nowaiting > 0) {
+ 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);
+ 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();
+#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 issues.* , i.biblionumber as biblionumber,b.* FROM issues, items i,biblio b
- WHERE i.itemnumber=issues.itemnumber
- AND i.biblionumber=b.biblionumber
+ my $sth = $dbh->prepare(
+ "SELECT * FROM issues,biblio,biblioitems,items
+ WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND issues.itemnumber = items.itemnumber
AND issues.borrowernumber = ?
AND issues.returndate is NULL
- AND issues.date_due < ?");
- $sth->execute($bornum,$today);
- while (my $data = $sth->fetchrow_hashref) {
-
- push (@overdueitems, $data);
+ AND issues.date_due < ?"
+ );
+ $sth->execute( $borrowernumber, $today );
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @overdueitems, $data );
$count++;
}
$sth->finish;
- return ($count, \@overdueitems);
+ return ( $count, \@overdueitems );
}
-# Not exported
+=head2 currentborrower
+
+$borrower=currentborrower($itemnumber)
+
+Not exported
+
+=cut
+
sub currentborrower {
-# Original subroutine for Circ2.pm
+
+ # Original subroutine for Circ2.pm
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
-
- my $sth=$dbh->prepare("select borrowers.borrowernumber from
- issues,borrowers where issues.itemnumber=? and
+ 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($itemnumber);
+ NULL"
+ );
+ $sth->execute;
my ($borrower) = $sth->fetchrow;
- return($borrower);
+ return ($borrower);
}
-# FIXME - Not exported, but used in 'updateitem.pl' anyway.
+=head2 checkreserve_to_delete
+
+( $resbor, $resrec ) = &checkreserve_to_delete($env,$dbh,$itemnum);
+
+=cut
+
sub checkreserve_to_delete {
-# Check for reserves for biblio
- my ($env,$dbh,$itemnum)=@_;
+
+ # Stolen from Main.pm
+ # Check for reserves for biblio
+ my ( $env, $dbh, $itemnum ) = @_;
my $resbor = "";
- my $sth = $dbh->prepare("select * from reserves,items
+ my $sth = $dbh->prepare(
+ "select * from reserves,items
where (items.itemnumber = ?)
and (reserves.cancellationdate is NULL)
and (items.biblionumber = reserves.biblionumber)
and ((reserves.found = 'W')
or (reserves.found is null))
- order by priority");
+ order by priority"
+ );
$sth->execute($itemnum);
my $resrec;
- my $data=$sth->fetchrow_hashref;
- while ($data && $resbor eq '') {
- $resrec=$data;
+ my $data = $sth->fetchrow_hashref;
+ while ( $data && $resbor eq '' ) {
+ $resrec = $data;
my $const = $data->{'constrainttype'};
- if ($const eq "a") {
+ if ( $const eq "a" ) {
$resbor = $data->{'borrowernumber'};
- } else {
+ }
+ else {
my $found = 0;
- my $csth = $dbh->prepare("select * from reserveconstraints,items
+ my $csth = $dbh->prepare(
+ "select * from reserveconstraints,items
where (borrowernumber=?)
and reservedate=?
and reserveconstraints.biblionumber=?
- and (items.itemnumber=? )");
- $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'};}
+ 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;
+ $data = $sth->fetchrow_hashref;
}
$sth->finish;
- return ($resbor,$resrec);
+ return ( $resbor, $resrec );
}
=head2 currentissues
- $issues = ¤tissues($env, $borrower);
+$issues = ¤tissues($env, $borrower);
Returns a list of books currently on loan to a patron.
@@ -1587,13 +2089,14 @@
#'
sub currentissues {
-# New subroutine for Circ2.pm
- my ($env, $borrower) = @_;
+
+ # New subroutine for Circ2.pm
+ my ( $env, $borrower ) = @_;
my $dbh = C4::Context->dbh;
my %currentissues;
- my $counter=1;
+ my $counter = 1;
my $borrowernumber = $borrower->{'borrowernumber'};
- my $crit='';
+ my $crit = '';
# Figure out whether to get the books issued today, or earlier.
# FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
@@ -1601,42 +2104,85 @@
# 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'}) {
+ if ( $env->{'todaysissues'} ) {
- $crit=" and !(issues.timestamp like '$today%') ";
+ # 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 where
+ my $sth = $dbh->prepare(
+ "select * from issues,items,biblioitems,biblio where
borrowernumber=? and issues.itemnumber=items.itemnumber and
- returndate is null
- $crit order by issues.date_due");
+ 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) {
-
+ while ( my $data = $sth->fetchrow_hashref ) {
- if ($data->{'date_due'} lt $today) {
- $data->{'overdue'}=1;
+ # 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'};
+ my $itemnumber = $data->{'itemnumber'};
+
# FIXME - Consecutive integers as hash keys? You have GOT to
# be kidding me! Use an array, fercrissakes!
- $currentissues{$counter}=$data;
+ $currentissues{$counter} = $data;
$counter++;
}
$sth->finish;
- return(\%currentissues);
+ return ( \%currentissues );
}
=head2 getissues
- $issues = &getissues($borrowernumber);
+$issues = &getissues($borrowernumber);
Returns the set of books currently on loan to a patron.
@@ -1651,57 +2197,115 @@
of the Koha database.
=cut
+
#'
sub getissues {
+
+ # New subroutine for Circ2.pm
my ($borrower) = @_;
my $dbh = C4::Context->dbh;
my $borrowernumber = $borrower->{'borrowernumber'};
my %currentissues;
- my $bibliodata;
- my @results;
- my $todaysdate=get_today();
- my $counter = 0;
- my $select = "SELECT *
- FROM issues,items,biblio
+ 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.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);
+ ORDER BY issues.date_due DESC
+ ";
+ my $sth = $dbh->prepare($select);
$sth->execute($borrowernumber);
- while (my $data = $sth->fetchrow_hashref) {
- if ($data->{'date_due'} lt $todaysdate) {
+ 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);
+ 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 ++
+=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;
}
- $sth->finish;
- return ($cnt,\@itemswaiting);
+ 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.
@@ -1722,95 +2326,63 @@
=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 ( $env, $borrowernumber, $itemno ) = @_;
+ my $dbh = C4::Context->dbh;
my $renews = 1;
- my $resfound;
- my $resrec;
- my $renewokay=0; ##
+ 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
+ my $sth1 = $dbh->prepare(
+ "select * from issues
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 ) {
+ and (itemnumber = ?)
+ and returndate is null"
+ );
+ $sth1->execute( $borrowernumber, $itemno );
+ if ( my $data1 = $sth1->fetchrow_hashref ) {
+
# 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) {
+
+ # 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 > $data1->{'renewals'}) {
- $renewokay= 1;
- }else{
- if (C4::Context->preference("strictrenewals")){
- $renewokay=3 ;
- }
+ if ( $renews && $renews > $data1->{'renewals'} ) {
+ $renewokay = 1;
}
$sth2->finish;
- ($resfound, $resrec) = CheckReserves($itemnumber);
+ my ( $resfound, $resrec ) = CheckReserves($itemno);
if ($resfound) {
- if (C4::Context->preference("strictrenewals")){
- $renewokay=4;
- }else{
$renewokay = 0;
}
- }
- ($resfound, $resrec) = CheckReserves($itemnumber);
+ ( $resfound, $resrec ) = CheckReserves($itemno);
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);
+ return ($renewokay);
}
=head2 renewbook
- &renewbook($env, $borrowernumber, $itemnumber, $datedue);
+&renewbook($env, $borrowernumber, $itemnumber, $datedue);
Renews a loan.
@@ -1833,64 +2405,73 @@
=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);
-
-
-if ($datedue eq "" ) {
-
- my $borrower = C4::Members::getpatroninformation($env,$bornum,0);
- $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
+ # mark book as renewed
+ my ( $env, $borrowernumber, $itemno, $datedue ) = @_;
+ my $dbh = C4::Context->dbh;
- 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);
+ # If the due date wasn't specified, calculate it by adding the
+ # book's loan length to today's date.
+ if ( $datedue eq "" ) {
+
+ #debug_msg($env, "getting date");
+ my $iteminformation = getiteminformation( $itemno, 0 );
+ my $borrower = getpatroninformation( $env, $borrowernumber, 0 );
+ my $loanlength = getLoanLength(
+ $borrower->{'categorycode'},
+ $iteminformation->{'itemtype'},
+ $borrower->{'branchcode'}
+ );
+ my ( $due_year, $due_month, $due_day ) =
+ Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
+ $datedue = "$due_year-$due_month-$due_day";
+
+ #$datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d");
+ }
+
+ # Find the issues record for this book
+ my $sth =
+ $dbh->prepare(
+"select * from issues where borrowernumber=? and itemnumber=? and returndate is null"
+ );
+ $sth->execute( $borrowernumber, $itemno );
+ my $issuedata = $sth->fetchrow_hashref;
+ $sth->finish;
# Update the issues record to have the new due date, and a new count
# of how many times it has been renewed.
-
- $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1
- where borrowernumber=? and itemnumber=? and returndate is null");
- $sth->execute($datedue,$bornum,$itemnumber);
+ 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);
+ UpdateStats( $env, $env->{'branchcode'}, 'renew', '', '', $itemno );
# 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);
+ my ( $charge, $type ) = calc_charges( $env, $itemno, $borrowernumber );
+ if ( $charge > 0 ) {
+ my $accountno = getnextacctno( $env, $borrowernumber, $dbh );
+ my $item = getiteminformation($itemno);
+ $sth = $dbh->prepare(
+"Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
+ values (?,?,now(),?,?,?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $accountno, $charge,
+ "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
+ 'Rent', $charge, $itemno );
$sth->finish;
- # print $account;
- }# end of rental charge
-
- return format_date($datedue);
}
-
-
+ # 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.
@@ -1908,65 +2489,72 @@
=cut
sub calc_charges {
+
# calculate charges due
- my ($env, $itemnumber, $bornum)=@_;
- my $charge=0;
+ my ( $env, $itemno, $borrowernumber ) = @_;
+ 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;
+ # Get the book's item type and rental charge (via its biblioitem).
+ my $sth1 = $dbh->prepare(
+ "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
+ where (items.itemnumber =?)
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)"
+ );
+ $sth1->execute($itemno);
+ if ( my $data1 = $sth1->fetchrow_hashref ) {
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
my $q2 = "select rentaldiscount from issuingrules,borrowers
where (borrowers.borrowernumber = ?)
and (borrowers.categorycode = issuingrules.categorycode)
and (issuingrules.itemtype = ?)";
- my $sth2=$dbh->prepare($q2);
- $sth2->execute($bornum,$itemtype);
- if (my $data2=$sth2->fetchrow_hashref) {
+ my $sth2 = $dbh->prepare($q2);
+ $sth2->execute( $borrowernumber, $item_type );
+ if ( my $data2 = $sth2->fetchrow_hashref ) {
my $discount = $data2->{'rentaldiscount'};
- if ($discount eq 'NULL') {
- $discount=0;
+ if ( $discount eq 'NULL' ) {
+ $discount = 0;
}
- $charge = ($charge *(100 - $discount)) / 100;
- # warn "discount is $discount";
+ $charge = ( $charge * ( 100 - $discount ) ) / 100;
}
$sth2->finish;
+ }
$sth1->finish;
- return ($charge,$itemtype);
+ 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);
+ #Stolen from Issues.pm
+ my ( $env, $dbh, $itemno, $borrowernumber, $charge ) = @_;
+ my $nextaccntno = getnextacctno( $env, $borrowernumber, $dbh );
+ my $query ="
INSERT INTO accountlines
(borrowernumber, itemnumber, accountno,
date, amount, description, accounttype,
amountoutstanding)
- VALUES (?, ?, ?,
- now(), ?, 'Rental', 'Rent',
- ?)
-EOT
- $sth->execute($bornum, $itemnumber, $nextaccntno, $charge, $charge);
+ 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.
@@ -1978,190 +2566,309 @@
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) {
+ 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;
- if ($resrec->{'found'} eq "W") {
- if ($resrec->{'itemnumber'} eq $itemnumber) {
+ my $brn = $dbh->quote( $resrec->{'borrowernumber'} );
+ my $rdate = $dbh->quote( $resrec->{'reservedate'} );
+ my $bibno = $dbh->quote( $resrec->{'biblionumber'} );
+ if ( $resrec->{'found'} eq "W" ) {
+ if ( $resrec->{'itemnumber'} eq $itemno ) {
$resfound = 1;
}
- } else {
+ }
+ else {
# FIXME - Use 'elsif' to avoid unnecessary indentation.
- if ($resrec->{'constrainttype'} eq "a") {
+ if ( $resrec->{'constrainttype'} eq "a" ) {
$resfound = 1;
- } else {
- my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? ");
- $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
- if (my $conrec = $consth->fetchrow_hashref) {
- if ($resrec->{'constrainttype'} eq "o") {
+ }
+ else {
+ my $consth =
+ $dbh->prepare(
+ "SELECT * FROM reserveconstraints
+ WHERE borrowernumber = ?
+ AND reservedate = ?
+ AND biblionumber = ?
+ AND biblioitemnumber = ?"
+ );
+ $consth->execute( $brn, $rdate, $bibno, $bibitm );
+ if ( my $conrec = $consth->fetchrow_hashref ) {
+ if ( $resrec->{'constrainttype'} eq "o" ) {
$resfound = 1;
-
}
}
$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'});
+ my $updsth =
+ $dbh->prepare(
+ "UPDATE reserves
+ SET found = 'W',
+ itemnumber = ?
+ WHERE borrowernumber = ?
+ AND reservedate = ?
+ AND biblionumber = ?"
+ );
+ $updsth->execute( $itemno, $brn, $rdate, $bibno );
$updsth->finish;
- last;
+
+ # 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))) {
+ 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";
}
+ elsif ( ( $day > 29 ) && ( $month == 2 ) ) {
+ $invalidduedate = 1;
}
+ elsif (
+ ( $month == 2 )
+ && ( $day > 28 )
+ && ( ( $year % 4 )
+ && ( ( !( $year % 100 ) || ( $year % 400 ) ) ) )
+ )
+ {
+ $invalidduedate = 1;
}
- return ($date, $invalidduedate);
+ else {
+ $date = "$year-$month-$day";
+ }
+ }
+ }
+ }
+ return ( $date, $invalidduedate );
}
+=head2 get_current_return_date_of
+
+&get_current_return_date_of(@itemnumber);
+
+=cut
+
sub get_current_return_date_of {
my (@itemnumbers) = @_;
-
my $query = '
-SELECT date_due,
+ SELECT
+ date_due,
itemnumber
FROM issues
- WHERE itemnumber IN ('.join(',', @itemnumbers).') AND returndate IS NULL
-';
- return get_infos_of($query, 'itemnumber', 'date_due');
+ WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
+ AND returndate IS NULL
+ ';
+ return get_infos_of( $query, 'itemnumber', 'date_due' );
}
+=head2 get_transfert_infos
+
+get_transfert_infos($itemnumber);
+
+=cut
+
sub get_transfert_infos {
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $query = '
-SELECT datesent,
+ SELECT datesent,
frombranch,
tobranch
FROM branchtransfers
WHERE itemnumber = ?
AND datearrived IS NULL
-';
+ ';
my $sth = $dbh->prepare($query);
$sth->execute($itemnumber);
-
my @row = $sth->fetchrow_array();
-
$sth->finish;
-
return @row;
}
+=head2 DeleteTransfer
+
+&DeleteTransfer($itemnumber);
+
+=cut
sub DeleteTransfer {
- my($itemnumber) = @_;
+ my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("DELETE FROM branchtransfers
- where itemnumber=?
- AND datearrived is null ");
+ my $sth = $dbh->prepare(
+ "DELETE FROM branchtransfers
+ WHERE itemnumber=?
+ AND datearrived IS NULL "
+ );
$sth->execute($itemnumber);
$sth->finish;
}
+=head2 GetTransfersFromBib
+
+ at results = GetTransfersFromBib($frombranch,$tobranch);
+
+=cut
+
sub GetTransfersFromBib {
- my($frombranch,$tobranch) = @_;
+ my ( $frombranch, $tobranch ) = @_;
+ return unless ( $frombranch && $tobranch );
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT itemnumber,datesent,frombranch FROM
- branchtransfers
- where frombranch=?
+ my $query = "
+ SELECT itemnumber,datesent,frombranch
+ FROM branchtransfers
+ WHERE frombranch=?
AND tobranch=?
- AND datearrived is null ");
- $sth->execute($frombranch,$tobranch);
+ AND datearrived IS NULL
+ ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $frombranch, $tobranch );
my @gettransfers;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $gettransfers[$i]=$data;
+ my $i = 0;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $gettransfers[$i] = $data;
$i++;
}
$sth->finish;
- return(@gettransfers);
+ return (@gettransfers);
}
+=head2 GetReservesToBranch
+
+ at transreserv = GetReservesToBranch( $frombranch, $default );
+
+=cut
+
sub GetReservesToBranch {
- my($frombranch,$default) = @_;
+ my ( $frombranch, $default ) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT borrowernumber,reservedate,itemnumber,timestamp FROM
- reserves
- where priority='0' AND cancellationdate is null
+ my $sth = $dbh->prepare(
+ "SELECT borrowernumber,reservedate,itemnumber,timestamp
+ FROM reserves
+ WHERE priority='0' AND cancellationdate is null
AND branchcode=?
AND branchcode!=?
- AND found is null ");
- $sth->execute($frombranch,$default);
+ AND found IS NULL "
+ );
+ $sth->execute( $frombranch, $default );
my @transreserv;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $transreserv[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
$i++;
}
$sth->finish;
- return(@transreserv);
+ return (@transreserv);
}
+=head2 GetReservesForBranch
+
+ at transreserv = GetReservesForBranch($frombranch);
+
+=cut
+
sub GetReservesForBranch {
- my($frombranch) = @_;
+ my ($frombranch) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT borrowernumber,reservedate,itemnumber,waitingdate FROM
- reserves
- where priority='0' AND cancellationdate is null
+ 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");
+ AND branchcode=?
+ ORDER BY waitingdate" );
$sth->execute($frombranch);
my @transreserv;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $transreserv[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $transreserv[$i] = $data;
$i++;
}
$sth->finish;
- return(@transreserv);
+ return (@transreserv);
}
-sub checktransferts{
- my($itemnumber) = @_;
+=head2 checktransferts
+
+ at tranferts = checktransferts($itemnumber);
+
+=cut
+
+sub checktransferts {
+ my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT datesent,frombranch,tobranch FROM branchtransfers
- WHERE itemnumber = ? AND datearrived IS NULL");
+ my $sth = $dbh->prepare(
+ "SELECT datesent,frombranch,tobranch FROM branchtransfers
+ WHERE itemnumber = ? AND datearrived IS NULL"
+ );
$sth->execute($itemnumber);
my @tranferts = $sth->fetchrow_array;
$sth->finish;
@@ -2169,14 +2876,333 @@
return (@tranferts);
}
+=head2 CheckItemNotify
-1;
-__END__
+Sql request to check if the document has alreday been notified
+this function is not exported, only used with GetOverduesForBranch
+
+=cut
+
+sub CheckItemNotify {
+ my ($notify_id,$notify_level,$itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("
+ SELECT COUNT(*) FROM notifys
+ WHERE notify_id = ?
+ AND notify_level = ?
+ AND itemnumber = ? ");
+ $sth->execute($notify_id,$notify_level,$itemnumber);
+ my $notified = $sth->fetchrow;
+$sth->finish;
+return ($notified);
+}
+
+=head2 GetOverduesForBranch
+
+Sql request for display all information for branchoverdues.pl
+2 possibilities : with or without departement .
+display is filtered by branch
+
+=cut
+
+sub GetOverduesForBranch {
+ my ( $branch, $departement) = @_;
+ if ( not $departement ) {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("
+ SELECT
+ borrowers.surname,
+ borrowers.firstname,
+ biblio.title,
+ itemtypes.description,
+ issues.date_due,
+ issues.returndate,
+ branches.branchname,
+ items.barcode,
+ borrowers.phone,
+ borrowers.email,
+ items.itemcallnumber,
+ borrowers.borrowernumber,
+ items.itemnumber,
+ biblio.biblionumber,
+ issues.branchcode,
+ accountlines.notify_id,
+ accountlines.notify_level,
+ items.location,
+ accountlines.amountoutstanding
+ FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
+ WHERE ( issues.returndate is null)
+ AND ( accountlines.amountoutstanding != '0.000000')
+ AND ( accountlines.accounttype = 'FU')
+ AND ( issues.borrowernumber = accountlines.borrowernumber )
+ AND ( issues.itemnumber = accountlines.itemnumber )
+ AND ( borrowers.borrowernumber = issues.borrowernumber )
+ AND ( biblio.biblionumber = biblioitems.biblionumber )
+ AND ( biblioitems.biblionumber = items.biblionumber )
+ AND ( itemtypes.itemtype = biblioitems.itemtype )
+ AND ( items.itemnumber = issues.itemnumber )
+ AND ( branches.branchcode = issues.branchcode )
+ AND (issues.branchcode = ?)
+ AND (issues.date_due <= NOW())
+ ORDER BY borrowers.surname
+ ");
+ $sth->execute($branch);
+ my @getoverdues;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ #check if the document has already been notified
+ my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
+ if ($countnotify eq '0'){
+ $getoverdues[$i] = $data;
+ $i++;
+ }
+ }
+ return (@getoverdues);
+ $sth->finish;
+ }
+ else {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "
+ SELECT borrowers.surname,
+ borrowers.firstname,
+ biblio.title,
+ itemtypes.description,
+ issues.date_due,
+ issues.returndate,
+ branches.branchname,
+ items.barcode,
+ borrowers.phone,
+ borrowers.email,
+ items.itemcallnumber,
+ borrowers.borrowernumber,
+ items.itemnumber,
+ biblio.biblionumber,
+ issues.branchcode,
+ accountlines.notify_id,
+ accountlines.notify_level,
+ items.location,
+ accountlines.amountoutstanding
+ FROM issues,borrowers,biblio,biblioitems,itemtypes,items,branches,accountlines
+ WHERE ( issues.returndate is null )
+ AND ( accountlines.amountoutstanding != '0.000000')
+ AND ( accountlines.accounttype = 'FU')
+ AND ( issues.borrowernumber = accountlines.borrowernumber )
+ AND ( issues.itemnumber = accountlines.itemnumber )
+ AND ( borrowers.borrowernumber = issues.borrowernumber )
+ AND ( biblio.biblionumber = biblioitems.biblionumber )
+ AND ( biblioitems.biblionumber = items.biblionumber )
+ AND ( itemtypes.itemtype = biblioitems.itemtype )
+ AND ( items.itemnumber = issues.itemnumber )
+ AND ( branches.branchcode = issues.branchcode )
+ AND (issues.branchcode = ? AND items.location = ?)
+ AND (issues.date_due <= NOW())
+ ORDER BY borrowers.surname
+ " );
+ $sth->execute( $branch, $departement);
+ my @getoverdues;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ #check if the document has already been notified
+ my $countnotify = CheckItemNotify($data->{'notify_id'},$data->{'notify_level'},$data->{'itemnumber'});
+ if ($countnotify eq '0'){
+ $getoverdues[$i] = $data;
+ $i++;
+ }
+ }
+ $sth->finish;
+ return (@getoverdues);
+ }
+}
+
+
+=head2 AddNotifyLine
+
+&AddNotifyLine($borrowernumber, $itemnumber, $overduelevel, $method, $notifyId)
+
+Creat a line into notify, if the method is phone, the notification_send_date is implemented to
+
+=cut
+
+sub AddNotifyLine {
+ my ( $borrowernumber, $itemnumber, $overduelevel, $method, $notifyId ) = @_;
+ if ( $method eq "phone" ) {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_send_date,notify_level,method,notify_id)
+ VALUES (?,?,now(),now(),?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+ $sth->finish;
+ }
+ else {
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "INSERT INTO notifys (borrowernumber,itemnumber,notify_date,notify_level,method,notify_id)
+ VALUES (?,?,now(),?,?,?)"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $overduelevel, $method,
+ $notifyId );
+ $sth->finish;
+ }
+ return 1;
+}
+
+=head2 RemoveNotifyLine
+
+&RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
+
+Cancel a notification
+
+=cut
+
+sub RemoveNotifyLine {
+ my ( $borrowernumber, $itemnumber, $notify_date ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare(
+ "DELETE FROM notifys
+ WHERE
+ borrowernumber=?
+ AND itemnumber=?
+ AND notify_date=?"
+ );
+ $sth->execute( $borrowernumber, $itemnumber, $notify_date );
+ $sth->finish;
+ return 1;
+}
+
+=head2 AnonymiseIssueHistory
+
+$rows = AnonymiseIssueHistory($borrowernumber,$date)
+
+This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
+if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
+
+return the number of affected rows.
+
+=cut
+
+sub AnonymiseIssueHistory {
+ my $date = shift;
+ my $borrowernumber = shift;
+ my $dbh = C4::Context->dbh;
+ my $query = "
+ UPDATE issues
+ SET borrowernumber = NULL
+ WHERE returndate < '".$date."'
+ AND borrowernumber IS NOT NULL
+ ";
+ $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
+ my $rows_affected = $dbh->do($query);
+ return $rows_affected;
+}
+
+=head2 GetItemsLost
+
+$items = GetItemsLost($where,$orderby);
+
+This function get the items lost into C<$items>.
+
+=over 2
+
+=item input:
+C<$where> is a hashref. it containts a field of the items table as key
+and the value to match as value.
+C<$orderby> is a field of the items table.
+
+=item return:
+C<$items> is a reference to an array full of hasref which keys are items' table column.
+
+=item usage in the perl script:
+
+my %where;
+$where{barcode} = 0001548;
+my $items = GetLostItems( \%where, "homebranch" );
+$template->param(itemsloop => $items);
=back
+=cut
+
+sub GetLostItems {
+ # Getting input args.
+ my $where = shift;
+ my $orderby = shift;
+ my $dbh = C4::Context->dbh;
+
+ my $query = "
+ SELECT *
+ FROM items
+ WHERE itemlost IS NOT NULL
+ AND itemlost <> 0
+ ";
+ foreach my $key (keys %$where) {
+ $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
+ }
+ $query .= " ORDER BY ".$orderby if defined $orderby;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @items;
+ while ( my $row = $sth->fetchrow_hashref ){
+ push @items, $row;
+ }
+ return \@items;
+}
+
+=head2 updateWrongTransfer
+
+$items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
+
+This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation
+
+=cut
+
+sub updateWrongTransfer {
+ my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
+ my $dbh = C4::Context->dbh;
+# first step validate the actual line of transfert .
+ my $sth =
+ $dbh->prepare(
+ "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
+ );
+ $sth->execute($FromLibrary,$itemNumber);
+ $sth->finish;
+
+# second step create a new line of branchtransfer to the right location .
+ dotransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
+
+#third step changing holdingbranch of item
+ UpdateHoldingbranch($FromLibrary,$itemNumber);
+}
+
+=head2 UpdateHoldingbranch
+
+$items = UpdateHoldingbranch($branch,$itmenumber);
+Simple methode for updating hodlingbranch in items BDD line
+=cut
+
+sub UpdateHoldingbranch {
+ my ( $branch,$itmenumber ) = @_;
+ my $dbh = C4::Context->dbh;
+# first step validate the actual line of transfert .
+ my $sth =
+ $dbh->prepare(
+ "update items set holdingbranch = ? where itemnumber= ?"
+ );
+ $sth->execute($branch,$itmenumber);
+ $sth->finish;
+
+
+}
+
+1;
+
+__END__
+
=head1 AUTHOR
Koha Developement team <info at koha.org>
=cut
+
Index: C4/Circulation/Fines.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Fines.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- C4/Circulation/Fines.pm 15 Nov 2006 01:36:00 -0000 1.20
+++ C4/Circulation/Fines.pm 9 Mar 2007 14:32:26 -0000 1.21
@@ -1,6 +1,6 @@
package C4::Circulation::Fines;
-# $Id: Fines.pm,v 1.20 2006/11/15 01:36:00 tgarip1957 Exp $
+# $Id: Fines.pm,v 1.21 2007/03/09 14:32:26 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -21,13 +21,16 @@
use strict;
require Exporter;
-
use C4::Context;
-use C4::Biblio;
+use Date::Calc qw/Today/;
use vars qw($VERSION @ISA @EXPORT);
+use C4::Accounts2;
+use Date::Manip qw/UnixDate/;
+use C4::Log; # logaction
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision: 1.21 $' =~ /\d+/g;
+shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -49,7 +52,30 @@
=cut
@ISA = qw(Exporter);
- at EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine &ReplacementCost);
+ at EXPORT = qw( &BorType
+ &CalcFine
+ &Getoverdues
+ &GetIssuingRules
+ &CheckAccountLineLevelInfo
+ &CheckAccountLineItemInfo
+ &CheckExistantNotifyid
+ &CheckBorrowerDebarred
+ &GetIssuesIteminfo
+ &GetNextIdNotify
+ &GetOverdueDelays
+ &GetOverduerules
+ &GetFine
+ &GetItems
+ &GetNotifyId
+ &GetNextIdNotify
+ &NumberNotifyId
+ &AmountNotify
+ &UpdateAccountLines
+ &UpdateFine
+ &UpdateBorrowerDebarred
+ &CreateItemAccountLine
+ &ReplacementCost
+ &ReplacementCost2);
=item Getoverdues
@@ -64,20 +90,28 @@
Koha database.
=cut
+
#'
-sub Getoverdues{
+sub Getoverdues {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from issues where date_due < now() and returndate is NULL order by borrowernumber");
+ my $sth = $dbh->prepare(
+ "Select * from issues where date_due < now() and returndate is
+ NULL order by borrowernumber "
+ );
$sth->execute;
+
# FIXME - Use push @results
- my $i=0;
+ my $i = 0;
my @results;
- while (my $data=$sth->fetchrow_hashref){
- push @results,$data;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$i] = $data;
$i++;
}
$sth->finish;
- return($i,\@results);
+
+ # print @results;
+ # FIXME - Bogus API.
+ return ( $i, \@results );
}
=item CalcFine
@@ -93,7 +127,20 @@
members might get a longer grace period between the first and second
reminders that a book is overdue).
-
+The fine is calculated as follows: if it is time for the first
+reminder, the fine is the value listed for the given (branch, item type,
+borrower code) combination. If it is time for the second reminder, the
+fine is doubled. Finally, if it is time to send the account to a
+collection agency, the fine is set to 5 local monetary units (a really
+good deal for the patron if the library is in Italy). Otherwise, the
+fine is 0.
+
+Note that the way this function is currently implemented, it only
+returns a nonzero value on the notable days listed above. That is, if
+the categoryitems entry says to send a first reminder 7 days after the
+book is due, then if you call C<&CalcFine> 7 days after the book is
+due, it will give a nonzero fine. If you call C<&CalcFine> the next
+day, however, it will say that the fine is 0.
C<$itemnumber> is the book's item number.
@@ -108,60 +155,178 @@
C<$amount> is the fine owed by the patron (see above).
C<$chargename> is the chargename field from the applicable record in
-the issuingrules table, whatever that is.
+the categoryitem table, whatever that is.
C<$message> is a text message, either "First Notice", "Second Notice",
or "Final Notice".
=cut
+
#'
sub CalcFine {
- my ($itemnumber,$bortype,$difference)=@_;
+ my ( $itemnumber, $bortype, $difference , $dues ) = @_;
my $dbh = C4::Context->dbh;
- # Look up the issuingrules record for this book's item type and the
- # given borrwer type.
+ my $data = GetIssuingRules($itemnumber,$bortype);
+ my $amount = 0;
+ my $printout;
+ my $countspecialday=&GetSpecialHolidays($dues,$itemnumber);
+ my $countrepeatableday=&GetRepeatableHolidays($dues,$itemnumber,$difference);
+ my $countalldayclosed = $countspecialday + $countrepeatableday;
+ my $daycount = $difference - $countalldayclosed;
+ my $daycounttotal = $daycount - $data->{'firstremind'};
+ if ($data->{'firstremind'} < $daycount)
+ {
+ $amount = $daycounttotal*$data->{'fine'};
+ }
+ return ( $amount, $data->{'chargename'}, $printout ,$daycounttotal ,$daycount );
+}
- my $sth=$dbh->prepare("Select * from items,biblio,itemtypes,issuingrules where items.itemnumber=?
- and items.biblionumber=biblio.biblionumber and
- biblio.itemtype=itemtypes.itemtype and
- issuingrules.itemtype=itemtypes.itemtype and
- issuingrules.categorycode=? ");
-# print $query;
- $sth->execute($itemnumber,$bortype);
- my $data=$sth->fetchrow_hashref;
- # FIXME - Error-checking: the item might be lost, or there
- # might not be an entry in 'issuingrules' for this item type
- # or borrower type.
- $sth->finish;
- my $amount=0;
- my $printout;
+=item GetSpecialHolidays
+
+&GetSpecialHolidays($date_dues,$itemnumber);
+
+return number of special days between date of the day and date due
+
+C<$date_dues> is the envisaged date of book return.
+
+C<$itemnumber> is the book's item number.
+
+=cut
+
+sub GetSpecialHolidays {
+my ($date_dues,$itemnumber) = @_;
+# calcul the today date
+my $today = join "-", &Today();
+
+# return the holdingbranch
+my $iteminfo=GetIssuesIteminfo($itemnumber);
+# use sql request to find all date between date_due and today
+my $dbh = C4::Context->dbh;
+my $query=qq|SELECT DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d')as date
+FROM `special_holidays`
+WHERE DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') >= ?
+AND DATE_FORMAT(concat(year,'-',month,'-',day),'%Y-%m-%d') <= ?
+AND branchcode=?
+|;
+my @result=GetWdayFromItemnumber($itemnumber);
+my @result_date;
+my $wday;
+my $dateinsec;
+my $sth = $dbh->prepare($query);
+$sth->execute($date_dues,$today,$iteminfo->{'branchcode'});
- if ($difference > $data->{'firstremind'}){
- # Yes. Set the fine as listed.
-$amount=$data->{'fine'}* $difference;
+while ( my $special_date=$sth->fetchrow_hashref){
+ push (@result_date,$special_date);
+}
+
+my $specialdaycount=scalar(@result_date);
- $printout="First Notice";
+ for (my $i=0;$i<scalar(@result_date);$i++){
+ $dateinsec=UnixDate($result_date[$i]->{'date'},"%o");
+ (undef,undef,undef,undef,undef,undef,$wday,undef,undef) =localtime($dateinsec);
+ for (my $j=0;$j<scalar(@result);$j++){
+ if ($wday == ($result[$j]->{'weekday'})){
+ $specialdaycount --;
+ }
}
+ }
+
+return $specialdaycount;
+}
+
+=item GetRepeatableHolidays
+
+&GetRepeatableHolidays($date_dues, $itemnumber, $difference,);
+
+return number of day closed between date of the day and date due
+
+C<$date_dues> is the envisaged date of book return.
- # Is it time to send out a second reminder?
- my $second=$data->{'firstremind'}+$data->{chargeperiod};
- if ($difference == $second){
-$amount=$data->{'fine'}* $difference;
+C<$itemnumber> is item number.
- $printout="Second Notice";
+C<$difference> numbers of between day date of the day and date due
+
+=cut
+
+sub GetRepeatableHolidays{
+my ($date_dues,$itemnumber,$difference) = @_;
+my $dateinsec=UnixDate($date_dues,"%o");
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime($dateinsec);
+my @result=GetWdayFromItemnumber($itemnumber);
+my @dayclosedcount;
+my $j;
+
+for (my $i=0;$i<scalar(@result);$i++){
+ my $k=$wday;
+
+ for ( $j=0;$j<$difference;$j++){
+ if ($result[$i]->{'weekday'} == $k)
+ {
+ push ( @dayclosedcount ,$k);
+ }
+ $k++;
+ ($k=0) if($k eq 7);
+ }
}
+return scalar(@dayclosedcount);
+}
+
+
+=item GetWayFromItemnumber
+
+&Getwdayfromitemnumber($itemnumber);
- # Is it time to send the account to a collection agency?
- # FIXME -This $data->{'accountsent'} is not seemed to be set in the DB
- if ($difference == $data->{'accountsent'}){
- $amount=$data->{'fine'}* $difference;
+return the different week day from repeatable_holidays table
- $printout="Final Notice";
+C<$itemnumber> is item number.
+
+=cut
+
+sub GetWdayFromItemnumber{
+my($itemnumber)=@_;
+my $iteminfo=GetIssuesIteminfo($itemnumber);
+my @result;
+my $dbh = C4::Context->dbh;
+my $query = qq|SELECT weekday
+ FROM repeatable_holidays
+ WHERE branchcode=?
+|;
+my $sth = $dbh->prepare($query);
+ # print $query;
+
+$sth->execute($iteminfo->{'branchcode'});
+while ( my $weekday=$sth->fetchrow_hashref){
+ push (@result,$weekday);
}
- return($amount,$data->{'chargename'},$printout);
+return @result;
}
+
+=item GetIssuesIteminfo
+
+&GetIssuesIteminfo($itemnumber);
+
+return all data from issues about item
+
+C<$itemnumber> is item number.
+
+=cut
+
+sub GetIssuesIteminfo{
+my($itemnumber)=@_;
+my $dbh = C4::Context->dbh;
+my $query = qq|SELECT *
+ FROM issues
+ WHERE itemnumber=?
+|;
+my $sth = $dbh->prepare($query);
+$sth->execute($itemnumber);
+my ($issuesinfo)=$sth->fetchrow_hashref;
+return $issuesinfo;
+}
+
+
=item UpdateFine
&UpdateFine($itemnumber, $borrowernumber, $amount, $type, $description);
@@ -187,13 +352,14 @@
accountlines table of the Koha database.
=cut
+
#'
# FIXME - This API doesn't look right: why should the caller have to
# specify both the item number and the borrower number? A book can't
# be on loan to two different people, so the item number should be
# sufficient.
sub UpdateFine {
- my ($itemnum,$bornum,$amount,$type,$due)=@_;
+ my ( $itemnum, $borrowernumber, $amount, $type, $due ) = @_;
my $dbh = C4::Context->dbh;
# FIXME - What exactly is this query supposed to do? It looks up an
# entry in accountlines that matches the given item and borrower
@@ -201,56 +367,83 @@
# account type has one of several values, but what does this _mean_?
# Does it look up existing fines for this item?
# FIXME - What are these various account types? ("FU", "O", "F", "M")
-
- my $sth=$dbh->prepare("Select * from accountlines where itemnumber=? and
+ my $sth = $dbh->prepare(
+ "Select * from accountlines where itemnumber=? and
borrowernumber=? and (accounttype='FU' or accounttype='O' or
- accounttype='F' or accounttype='M') ");
- $sth->execute($itemnum,$bornum);
+ accounttype='F' or accounttype='M') and description like ?"
+ );
+ $sth->execute( $itemnum, $borrowernumber, "%$due%" );
+
+ if ( my $data = $sth->fetchrow_hashref ) {
- if (my $data=$sth->fetchrow_hashref){
# I think this if-clause deals with the case where we're updating
# an existing fine.
-# print "in accounts ...";
- if ($data->{'amount'} != $amount){
+ # print "in accounts ...";
+ if ( $data->{'amount'} != $amount ) {
-# print "updating";
- my $diff=$amount - $data->{'amount'};
- my $out=$data->{'amountoutstanding'}+$diff;
- my $sth2=$dbh->prepare("update accountlines set date=now(), amount=?,
+ # print "updating";
+ my $diff = $amount - $data->{'amount'};
+ my $out = $data->{'amountoutstanding'} + $diff;
+ my $sth2 = $dbh->prepare(
+ "update accountlines set date=now(), amount=?,
amountoutstanding=?,accounttype='FU' where
- accountid=?");
- $sth2->execute($amount,$out,$data->{'accountid'});
+ borrowernumber=? and itemnumber=?
+ and (accounttype='FU' or accounttype='O') and description like ?"
+ );
+ $sth2->execute( $amount, $out, $data->{'borrowernumber'},
+ $data->{'itemnumber'}, "%$due%" );
$sth2->finish;
- } else {
- print "no update needed $data->{'amount'} \n";
}
- } else {
+ else {
+
+ # print "no update needed $data->{'amount'}"
+ }
+ }
+ else {
+
# I think this else-clause deals with the case where we're adding
# a new fine.
- my $sth4=$dbh->prepare("select title from biblio ,items where items.itemnumber=?
- and biblio.biblionumber=items.biblionumber");
+ my $sth4 = $dbh->prepare(
+ "select title from biblio,items where items.itemnumber=?
+ and biblio.biblionumber=items.biblionumber"
+ );
$sth4->execute($itemnum);
- my $title=$sth4->fetchrow;
+ my $title = $sth4->fetchrow_hashref;
$sth4->finish;
- # print "not in account";
- my $sth3=$dbh->prepare("Select max(accountno) from accountlines");
- $sth3->execute;
- # FIXME - Make $accountno a scalar.
- my $accountno=$sth3->fetchrow;
- $sth3->finish;
- $accountno++;
- my $sth2=$dbh->prepare("Insert into accountlines
+
+# # print "not in account";
+# my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
+# $sth3->execute;
+#
+# # FIXME - Make $accountno a scalar.
+# my @accountno = $sth3->fetchrow_array;
+# $sth3->finish;
+# $accountno[0]++;
+# begin transaction
+ my $nextaccntno = getnextacctno(undef,$borrowernumber,$dbh);
+ my $sth2 = $dbh->prepare(
+ "Insert into accountlines
(borrowernumber,itemnumber,date,amount,
description,accounttype,amountoutstanding,accountno) values
- (?,?,now(),?,?,'FU',?,?)");
- $sth2->execute($bornum,$itemnum,$amount,"$type $title $due",$amount,$accountno);
+ (?,?,now(),?,?,'FU',?,?)"
+ );
+ $sth2->execute( $borrowernumber, $itemnum, $amount,
+ "$type $title->{'title'} $due",
+ $amount, $nextaccntno);
$sth2->finish;
}
+ # logging action
+ &logaction(
+ C4::Context->userenv->{'number'},
+ "FINES",
+ $type,
+ $borrowernumber,
+ "due=".$due." amount=".$amount." itemnumber=".$itemnum
+ ) if C4::Context->preference("FinesLog");
+
$sth->finish;
}
-
-
=item BorType
$borrower = &BorType($borrowernumber);
@@ -263,17 +456,20 @@
category he or she belongs to.
=cut
+
#'
sub BorType {
- my ($borrowernumber)=@_;
+ my ($borrowernumber) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select * from borrowers,categories where
+ my $sth = $dbh->prepare(
+ "Select * from borrowers,categories where
borrowernumber=? and
-borrowers.categorycode=categories.categorycode");
+borrowers.categorycode=categories.categorycode"
+ );
$sth->execute($borrowernumber);
- my $data=$sth->fetchrow_hashref;
+ my $data = $sth->fetchrow_hashref;
$sth->finish;
- return($data);
+ return ($data);
}
=item ReplacementCost
@@ -283,16 +479,574 @@
Returns the replacement cost of the item with the given item number.
=cut
+
#'
-sub ReplacementCost{
- my ($itemnumber)=@_;
+sub ReplacementCost {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("Select replacementprice from items where itemnumber=?");
+ $sth->execute($itemnum);
+
+ # FIXME - Use fetchrow_array or something.
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return ( $data->{'replacementprice'} );
+}
+
+=item GetFine
+
+$data->{'sum(amountoutstanding)'} = &GetFine($itemnum,$borrowernumber);
+
+return the total of fine
+
+C<$itemnum> is item number
+
+C<$borrowernumber> is the borrowernumber
+
+=cut
+
+
+sub GetFine {
+ my ( $itemnum, $borrowernumber ) = @_;
+ my $dbh = C4::Context->dbh();
+ my $query = "SELECT sum(amountoutstanding) FROM accountlines
+ where accounttype like 'F%'
+ AND amountoutstanding > 0 AND itemnumber = ? AND borrowernumber=?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $itemnum, $borrowernumber );
+ my $data = $sth->fetchrow_hashref();
+ $sth->finish();
+ $dbh->disconnect();
+ return ( $data->{'sum(amountoutstanding)'} );
+}
+
+
+
+
+=item GetIssuingRules
+
+$data = &GetIssuingRules($itemnumber,$categorycode);
+
+Looks up for all issuingrules an item info
+
+C<$itemnumber> is a reference-to-hash whose keys are all of the fields
+from the borrowers and categories tables of the Koha database. Thus,
+
+C<$categorycode> contains information about borrowers category
+
+C<$data> contains all information about both the borrower and
+category he or she belongs to.
+=cut
+
+sub GetIssuingRules {
+ my ($itemnumber,$categorycode)=@_;
+ my $dbh = C4::Context->dbh();
+ my $query=qq|SELECT *
+ FROM items,biblioitems,itemtypes,issuingrules
+ WHERE items.itemnumber=?
+ AND items.biblioitemnumber=biblioitems.biblioitemnumber
+ AND biblioitems.itemtype=itemtypes.itemtype
+ AND issuingrules.itemtype=itemtypes.itemtype
+ AND issuingrules.categorycode=?
+ AND (items.itemlost <> 1
+ OR items.itemlost is NULL)|;
+ my $sth = $dbh->prepare($query);
+ # print $query;
+ $sth->execute($itemnumber,$categorycode);
+ my ($data) = $sth->fetchrow_hashref;
+ $sth->finish;
+return ($data);
+
+}
+
+
+sub ReplacementCost2 {
+ my ( $itemnum, $borrowernumber ) = @_;
+ my $dbh = C4::Context->dbh();
+ my $query = "SELECT amountoutstanding
+ FROM accountlines
+ WHERE accounttype like 'L'
+ AND amountoutstanding > 0
+ AND itemnumber = ?
+ AND borrowernumber= ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $itemnum, $borrowernumber );
+ my $data = $sth->fetchrow_hashref();
+ $sth->finish();
+ $dbh->disconnect();
+ return ( $data->{'amountoutstanding'} );
+}
+
+
+=item GetNextIdNotify
+
+($result) = &GetNextIdNotify($reference);
+
+Returns the new file number
+
+C<$result> contains the next file number
+
+C<$reference> contains the beggining of file number
+
+=cut
+
+
+
+sub GetNextIdNotify {
+my ($reference)=@_;
+my $query=qq|SELECT max(notify_id)
+ FROM accountlines
+ WHERE notify_id like \"$reference%\"
+ |;
+# AND borrowernumber=?|;
+my $dbh = C4::Context->dbh;
+my $sth=$dbh->prepare($query);
+$sth->execute();
+my $result=$sth->fetchrow;
+$sth->finish;
+my $count;
+ if ($result eq '')
+ {
+ ($result=$reference."01") ;
+ }else
+ {
+ $count=substr($result,6)+1;
+
+ if($count<10){
+ ($count = "0".$count);
+ }
+ $result=$reference.$count;
+ }
+return $result;
+}
+
+
+=item AmountNotify
+
+(@notify) = &AmountNotify($borrowernumber);
+
+Returns amount for all file per borrowers
+C<@notify> array contains all file per borrowers
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+sub NumberNotifyId{
+ my ($borrowernumber)=@_;
my $dbh = C4::Context->dbh;
- my ($itemrecord)=XMLgetitem($dbh,$itemnumber);
-$itemrecord=XML_xml2hash_onerecord($itemrecord);
- my $replacementprice=XML_readline_onerecord($itemrecord,"replacementprice","holdings");
- return($replacementprice);
+ my $env;
+ my $query=qq| SELECT distinct(notify_id)
+ FROM accountlines
+ WHERE borrowernumber=?|;
+ my @notify;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ while ( my $numberofotify=$sth->fetchrow_array){
+ push (@notify,$numberofotify);
+ }
+ $sth->finish;
+
+ return (@notify);
+
}
+=item AmountNotify
+
+($totalnotify) = &AmountNotify($notifyid);
+
+Returns amount for all file per borrowers
+C<$notifyid> is the file number
+
+C<$totalnotify> contains amount of a file
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+sub AmountNotify{
+ my ($notifyid)=@_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq| SELECT sum(amountoutstanding)
+ FROM accountlines
+ WHERE notify_id=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($notifyid);
+ my $totalnotify=$sth->fetchrow;
+ $sth->finish;
+ return ($totalnotify);
+}
+
+
+=item GetNotifyId
+
+($notify_id) = &GetNotifyId($borrowernumber,$itemnumber);
+
+Returns the file number per borrower and itemnumber
+
+C<$borrowernumber> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the borrower categorycode
+
+C<$notify_id> contains the file number for the borrower number nad item number
+
+=cut
+
+ sub GetNotifyId {
+ my ($borrowernumber,$itemnumber)=@_;
+ my $query=qq|SELECT notify_id
+ FROM accountlines
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber);
+ my ($notify_id)=$sth->fetchrow;
+ $sth->finish;
+ return ($notify_id);
+
+ }
+
+=item CreateItemAccountLine
+
+() = &CreateItemAccountLine($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level);
+
+update the account lines with file number or with file level
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the item number
+
+C<$borrowernumber> contains the borrower number
+
+C<$date> contains the date of the day
+
+C<$amount> contains item price
+
+C<$description> contains the descritpion of accounttype
+
+C<$accounttype> contains the account type
+
+C<$amountoutstanding> contains the $amountoutstanding
+
+C<$timestamp> contains the timestamp with time and the date of the day
+
+C<$notify_id> contains the file number
+
+C<$level> contains the file level
+
+
+=cut
+
+ sub CreateItemAccountLine {
+ my ($borrowernumber,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level)=@_;
+ my $dbh = C4::Context->dbh;
+ my $nextaccntno = getnextacctno(undef,$borrowernumber,$dbh);
+ my $query= qq|INSERT into accountlines
+ (borrowernumber,accountno,itemnumber,date,amount,description,accounttype,amountoutstanding,timestamp,notify_id,notify_level)
+ VALUES
+ (?,?,?,?,?,?,?,?,?,?,?)|;
+
+
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$nextaccntno,$itemnumber,$date,$amount,$description,$accounttype,$amountoutstanding,$timestamp,$notify_id,$level);
+ $sth->finish;
+ }
+
+=item UpdateAccountLines
+
+() = &UpdateAccountLines($notify_id,$notify_level,$borrowernumber,$itemnumber);
+
+update the account lines with file number or with file level
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the item number
+
+C<$notify_id> contains the file number
+
+C<$notify_level> contains the file level
+
+C<$borrowernumber> contains the borrowernumber
+
+=cut
+
+sub UpdateAccountLines {
+my ($notify_id,$notify_level,$borrowernumber,$itemnumber)=@_;
+my $query;
+if ($notify_id eq '')
+{
+
+ $query=qq|UPDATE accountlines
+ SET notify_level=?
+ WHERE borrowernumber=? AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+}else
+{
+ $query=qq|UPDATE accountlines
+ SET notify_id=?, notify_level=?
+ WHERE borrowernumber=?
+ AND itemnumber=?
+ AND (accounttype='FU' or accounttype='O')|;
+}
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+
+if ($notify_id eq '')
+{
+ $sth->execute($notify_level,$borrowernumber,$itemnumber);
+}else
+{
+ $sth->execute($notify_id,$notify_level,$borrowernumber,$itemnumber);
+}
+ $sth->finish;
+
+}
+
+
+=item GetItems
+
+($items) = &GetItems($itemnumber);
+
+Returns the list of all delays from overduerules.
+
+C<$items> is a reference-to-hash whose keys are all of the fields
+from the items tables of the Koha database. Thus,
+
+C<$itemnumber> contains the borrower categorycode
+
+=cut
+
+sub GetItems {
+ my($itemnumber) = @_;
+ my $query=qq|SELECT *
+ FROM items
+ WHERE itemnumber=?|;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($itemnumber);
+ my ($items)=$sth->fetchrow_hashref;
+ $sth->finish;
+ return($items);
+}
+
+=item GetOverdueDelays
+
+(@delays) = &GetOverdueDelays($categorycode);
+
+Returns the list of all delays from overduerules.
+
+C<@delays> it's an array contains the three delays from overduerules table
+
+C<$categorycode> contains the borrower categorycode
+
+=cut
+
+sub GetOverdueDelays {
+ my($category) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT delay1,delay2,delay3
+ FROM overduerules
+ WHERE categorycode=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($category);
+ my (@delays)=$sth->fetchrow_array;
+ $sth->finish;
+ return(@delays);
+}
+
+=item CheckAccountLineLevelInfo
+
+($exist) = &CheckAccountLineLevelInfo($borrowernumber,$itemnumber,$accounttype,notify_level);
+
+Check and Returns the list of all overdue books.
+
+C<$exist> contains number of line in accounlines
+with the same .biblionumber,itemnumber,accounttype,and notify_level
+
+C<$borrowernumber> contains the borrower number
+
+C<$itemnumber> contains item number
+
+C<$accounttype> contains account type
+
+C<$notify_level> contains the accountline level
+
+
+=cut
+
+sub CheckAccountLineLevelInfo {
+ my($borrowernumber,$itemnumber,$level) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query= qq|SELECT count(*)
+ FROM accountlines
+ WHERE borrowernumber =?
+ AND itemnumber = ?
+ AND notify_level=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber,$level);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ return($exist);
+}
+
+=item GetOverduerules
+
+($overduerules) = &GetOverduerules($categorycode);
+
+Returns the value of borrowers (debarred or not) with notify level
+
+C<$overduerules> return value of debbraed field in overduerules table
+
+C<$category> contains the borrower categorycode
+
+C<$notify_level> contains the notify level
+=cut
+
+
+sub GetOverduerules{
+ my($category,$notify_level) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT debarred$notify_level
+ FROM overduerules
+ WHERE categorycode=?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($category);
+ my ($overduerules)=$sth->fetchrow;
+ $sth->finish;
+ return($overduerules);
+}
+
+
+=item CheckBorrowerDebarred
+
+($debarredstatus) = &CheckBorrowerDebarred($borrowernumber);
+
+Check if the borrowers is already debarred
+
+C<$debarredstatus> return 0 for not debarred and return 1 for debarred
+
+C<$borrowernumber> contains the borrower number
+
+=cut
+
+
+sub CheckBorrowerDebarred{
+ my($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|SELECT debarred
+ FROM borrowers
+ WHERE borrowernumber=?
+ |;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ my ($debarredstatus)=$sth->fetchrow;
+ $sth->finish;
+ if ($debarredstatus eq '1'){
+ return(1);}
+ else{
+ return(0);
+ }
+}
+
+=item UpdateBorrowerDebarred
+
+($borrowerstatut) = &UpdateBorrowerDebarred($borrowernumber);
+
+update status of borrowers in borrowers table (field debarred)
+
+C<$borrowernumber> borrower number
+
+=cut
+
+sub UpdateBorrowerDebarred{
+ my($borrowernumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query=qq|UPDATE borrowers
+ SET debarred='1'
+ WHERE borrowernumber=?
+ |;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber);
+ $sth->finish;
+ return 1;
+}
+
+=item CheckExistantNotifyid
+
+ ($exist) = &CheckExistantNotifyid($borrowernumber,$itemnumber,$accounttype,$notify_id);
+
+Check and Returns the notify id if exist else return 0.
+
+C<$exist> contains a notify_id
+
+C<$borrowernumber> contains the borrower number
+
+C<$date_due> contains the date of item return
+
+
+=cut
+
+sub CheckExistantNotifyid {
+ my($borrowernumber,$date_due) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT notify_id FROM issues,accountlines
+ WHERE accountlines.borrowernumber =?
+ AND issues.itemnumber= accountlines.itemnumber
+ AND date_due = ?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$date_due);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ if ($exist eq '')
+ {
+ return(0);
+ }else
+ {
+ return($exist);
+ }
+}
+
+=item CheckAccountLineItemInfo
+
+ ($exist) = &CheckAccountLineItemInfo($borrowernumber,$itemnumber,$accounttype,$notify_id);
+
+Check and Returns the list of all overdue items from the same file number(notify_id).
+
+C<$exist> contains number of line in accounlines
+with the same .biblionumber,itemnumber,accounttype,notify_id
+
+C<$borrowernumber> contains the borrower number
+
+C<$itemnumber> contains item number
+
+C<$accounttype> contains account type
+
+C<$notify_id> contains the file number
+
+=cut
+
+sub CheckAccountLineItemInfo {
+ my($borrowernumber,$itemnumber,$accounttype,$notify_id) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|SELECT count(*) FROM accountlines
+ WHERE borrowernumber =?
+ AND itemnumber = ?
+ AND accounttype= ?
+ AND notify_id = ?|;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($borrowernumber,$itemnumber,$accounttype,$notify_id);
+ my ($exist)=$sth->fetchrow;
+ $sth->finish;
+ return($exist);
+ }
+
+
1;
__END__
More information about the Koha-cvs
mailing list