[Koha-cvs] CVS: koha/C4/Circulation Issues.pm,1.1.1.1.2.1,1.1.1.1.2.2
Chris Cormack
rangi at users.sourceforge.net
Thu Jul 3 00:17:44 CEST 2003
Update of /cvsroot/koha/koha/C4/Circulation
In directory sc8-pr-cvs1:/tmp/cvs-serv19271/C4/Circulation
Modified Files:
Tag: rel-1-2
Issues.pm
Log Message:
Fix for the duplicate member problem.
Thanks to mhansen
Index: Issues.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Circulation/Issues.pm,v
retrieving revision 1.1.1.1.2.1
retrieving revision 1.1.1.1.2.2
diff -C2 -r1.1.1.1.2.1 -r1.1.1.1.2.2
*** Issues.pm 14 Aug 2002 18:30:50 -0000 1.1.1.1.2.1
--- Issues.pm 2 Jul 2003 22:17:42 -0000 1.1.1.1.2.2
***************
*** 1,8 ****
! package C4::Circulation::Issues; #asummes C4/Circulation/Issues
#package to deal with Issues
#written 3/11/99 by chris at katipo.co.nz
-
# Copyright 2000-2002 Katipo Communications
#
--- 1,9 ----
! package C4::Circulation::Issues;
!
! # $Id$
#package to deal with Issues
#written 3/11/99 by chris at katipo.co.nz
# Copyright 2000-2002 Katipo Communications
#
***************
*** 22,33 ****
# Suite 330, Boston, MA 02111-1307 USA
use strict;
require Exporter;
use DBI;
! use C4::Database;
use C4::Accounts;
use C4::InterfaceCDK;
use C4::Circulation::Main;
use C4::Circulation::Borrower;
use C4::Scan;
use C4::Stats;
--- 23,41 ----
# Suite 330, Boston, MA 02111-1307 USA
+ # FIXME - AFAICT the only function here that's still being used is
+ # &formatitem, and I'm not convinced that it's really being used.
+
use strict;
require Exporter;
use DBI;
! use C4::Context;
use C4::Accounts;
use C4::InterfaceCDK;
use C4::Circulation::Main;
+ # FIXME - C4::Circulation::Main and C4::Circulation::Issues
+ # use each other, so functions get redefined.
use C4::Circulation::Borrower;
+ # FIXME - C4::Circulation::Issues and C4::Circulation::Borrower
+ # use each other, so functions get redefined.
use C4::Scan;
use C4::Stats;
***************
*** 35,84 ****
use C4::Format;
use C4::Input;
! use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
!
# set the version for version checking
$VERSION = 0.01;
!
@ISA = qw(Exporter);
@EXPORT = qw(&Issue &formatitem);
- %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
-
- # your exported package globals go here,
- # as well as any optionally exported functions
-
- @EXPORT_OK = qw($Var1 %Hashit);
-
-
- # non-exported package globals go here
- use vars qw(@more $stuff);
-
- # initalize package globals, first exported ones
-
- my $Var1 = '';
- my %Hashit = ();
-
- # then the others (which are still accessible as $Some::Module::stuff)
- my $stuff = '';
- my @more = ();
-
- # all file-scoped lexicals must be created before
- # the functions below that use them.
-
- # file-private lexicals go here
- my $priv_var = '';
- my %secret_hash = ();
-
- # here's a file-private function as a closure,
- # callable as &$priv_func; it cannot be prototyped.
- my $priv_func = sub {
- # stuff goes here.
- };
-
- # make all your functions, whether exported or not;
-
sub Issue {
my ($env) = @_;
! my $dbh=&C4Connect;
#clear help
helptext('');
--- 43,80 ----
use C4::Format;
use C4::Input;
! use vars qw($VERSION @ISA @EXPORT);
!
# set the version for version checking
$VERSION = 0.01;
!
! =head1 NAME
!
! C4::Circulation::Issues - Miscellaneous functions related to Koha issues
!
! =head1 SYNOPSIS
!
! use C4::Circulation::Issues;
!
! =head1 DESCRIPTION
!
! This module provides a function for pretty-printing an item being
! issued.
!
! =head1 FUNCTIONS
!
! =over 2
!
! =cut
! #'
!
@ISA = qw(Exporter);
@EXPORT = qw(&Issue &formatitem);
+ # FIXME - This is only used in C4::Circmain and C4::Circulation, both
+ # of which look obsolete. Is this function obsolete as well?
+ # If not, this needs a POD.
sub Issue {
my ($env) = @_;
! my $dbh = C4::Context->dbh;
#clear help
helptext('');
***************
*** 90,94 ****
$done = "Issues";
while ($done eq "Issues") {
! my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
#C4::Circulation::Borrowers
$env->{'loanlength'}="";
--- 86,90 ----
$done = "Issues";
while ($done eq "Issues") {
! my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
#C4::Circulation::Borrowers
$env->{'loanlength'}="";
***************
*** 101,105 ****
$env->{'bcard'} = $borrower->{'cardnumber'};
#deal with alternative loans
! #now check items
($items,$items2)=
C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
--- 97,101 ----
$env->{'bcard'} = $borrower->{'cardnumber'};
#deal with alternative loans
! #now check items
($items,$items2)=
C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
***************
*** 113,129 ****
#&endint($env);
}
! }
! $dbh->disconnect;
! Cdk::refreshCdkScreen();
return ($done);
! }
!
sub processitems {
#process a users items
my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
! my $dbh=&C4Connect;
$env->{'newborrower'} = "";
! my ($itemnum,$reason) =
issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
if ($itemnum eq ""){
--- 109,125 ----
#&endint($env);
}
! }
! Cdk::refreshCdkScreen();
return ($done);
! }
+ # FIXME - Not exported, but called by "telnet/borrwraper.pl".
+ # Presumably this function is obsolete.
sub processitems {
#process a users items
my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
! my $dbh = C4::Context->dbh;
$env->{'newborrower'} = "";
! my ($itemnum,$reason) =
issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
if ($itemnum eq ""){
***************
*** 141,149 ****
$amountdue += $charge;
}
! }
! $dbh->disconnect;
#check to see if more books to process for this user
my @done;
! if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
if ($reason eq 'Finished user'){
if (@$items2[0] ne "") {
--- 137,144 ----
$amountdue += $charge;
}
! }
#check to see if more books to process for this user
my @done;
! if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
if ($reason eq 'Finished user'){
if (@$items2[0] ne "") {
***************
*** 152,156 ****
&reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
}
! }
@done = ("Issues");
} elsif ($reason eq "Print"){
--- 147,151 ----
&reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
}
! }
@done = ("Issues");
} elsif ($reason eq "Print"){
***************
*** 159,163 ****
} else {
if ($reason ne 'Finished issues'){
! #return No to let them know that we wish to
# process more Items for borrower
@done = ("No",$items2,$it2p,$amountdue,$itemsdet);
--- 154,158 ----
} else {
if ($reason ne 'Finished issues'){
! #return No to let them know that we wish to
# process more Items for borrower
@done = ("No",$items2,$it2p,$amountdue,$itemsdet);
***************
*** 166,191 ****
}
}
! #debug_msg($env, "return from issues $done[0]");
! $dbh->disconnect;
return @done;
}
sub formatitem {
my ($env,$item,$datedue,$charge) = @_;
my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
my $iclass = $item->{'itemtype'};
if ($item->{'dewey'} > 0) {
my $dewey = $item->{'dewey'};
$dewey =~ s/0*$//;
$dewey =~ s/\.$//;
! $iclass = $iclass.$dewey.$item->{'subclass'};
};
my $llen = 65 - length($iclass);
my $line = fmtstr($env,$line,"L".$llen);
! my $line = $line." $iclass ";
! my $line = $line.fmtdec($env,$charge,"22");
return $line;
! }
!
sub issueitem{
my ($env,$dbh,$itemnum,$bornum,$items)=@_;
--- 161,215 ----
}
}
! #debug_msg($env, "return from issues $done[0]");
return @done;
}
+ =item formatitem
+
+ $line = &formatitem($env, $item, $datedue, $charge);
+
+ Pretty-prints a description of an item being issued, and returns the
+ pretty-printed string.
+
+ C<$env> is effectively ignored.
+
+ C<$item> is a reference-to-hash whose keys are fields from the items
+ table in the Koha database.
+
+ C<$datedue> is a string that will be prepended to the output.
+
+ C<$charge> is a number that will be appended to the output.
+
+ The return value C<$line> is a string of the form
+
+ I<$datedue $barcode $title: $author $type$dewey$subclass $charge>
+
+ where those values that are not passed in as arguments are obtained
+ from C<$item>.
+
+ =cut
+ #'
sub formatitem {
my ($env,$item,$datedue,$charge) = @_;
my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
+ # FIXME - Use string interpolation or sprintf()
my $iclass = $item->{'itemtype'};
+ # FIXME - The Dewey code is a string, not a number.
if ($item->{'dewey'} > 0) {
my $dewey = $item->{'dewey'};
$dewey =~ s/0*$//;
$dewey =~ s/\.$//;
! $iclass .= $dewey.$item->{'subclass'};
};
my $llen = 65 - length($iclass);
my $line = fmtstr($env,$line,"L".$llen);
! # FIXME - Use sprintf() instead of &fmtstr.
! my $line .= " $iclass ";
! my $line .= fmtdec($env,$charge,"22");
return $line;
! }
!
! # Only used internally
! # FIXME - Only used by &processitems, which appears to be obsolete.
sub issueitem{
my ($env,$dbh,$itemnum,$bornum,$items)=@_;
***************
*** 199,203 ****
my $charge;
my $datedue = $env->{'loanlength'};
! my $sth=$dbh->prepare($query);
$sth->execute;
if ($item=$sth->fetchrow_hashref) {
--- 223,227 ----
my $charge;
my $datedue = $env->{'loanlength'};
! my $sth=$dbh->prepare($query);
$sth->execute;
if ($item=$sth->fetchrow_hashref) {
***************
*** 211,215 ****
$canissue = 0;
# } elsif ($item->{'itemlost'} == 1) {
! # error_msg($env,"Item Lost");
# $canissue = 0;
} elsif ($item->{'restricted'} == 1 ){
--- 235,239 ----
$canissue = 0;
# } elsif ($item->{'itemlost'} == 1) {
! # error_msg($env,"Item Lost");
# $canissue = 0;
} elsif ($item->{'restricted'} == 1 ){
***************
*** 227,233 ****
#check if item is on issue already
if ($canissue == 1) {
! my ($currbor,$issuestat,$newdate) =
&C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
! if ($issuestat eq "N") {
$canissue = 0;
} elsif ($issuestat eq "R") {
--- 251,257 ----
#check if item is on issue already
if ($canissue == 1) {
! my ($currbor,$issuestat,$newdate) =
&C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
! if ($issuestat eq "N") {
$canissue = 0;
} elsif ($issuestat eq "R") {
***************
*** 239,250 ****
}
&UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
! }
! }
if ($canissue == 1) {
#check reserve
! my ($resbor,$resrec) = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
#debug_msg($env,$resbor);
! if ($resbor eq $bornum) {
! my $rquery = "update reserves
set found = 'F'
where reservedate = '$resrec->{'reservedate'}'
--- 263,274 ----
}
&UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
! }
! }
if ($canissue == 1) {
#check reserve
! my ($resbor,$resrec) = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
#debug_msg($env,$resbor);
! if ($resbor eq $bornum) {
! my $rquery = "update reserves
set found = 'F'
where reservedate = '$resrec->{'reservedate'}'
***************
*** 255,259 ****
$rsth->finish;
} elsif ($resbor ne "") {
! my $bquery = "select * from borrowers
where borrowernumber = '$resbor'";
my $btsh = $dbh->prepare($bquery);
--- 279,283 ----
$rsth->finish;
} elsif ($resbor ne "") {
! my $bquery = "select * from borrowers
where borrowernumber = '$resbor'";
my $btsh = $dbh->prepare($bquery);
***************
*** 261,265 ****
my $resborrower = $btsh->fetchrow_hashref;
my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
! $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
my $ans = msg_ny($env,$msgtxt,"Allow issue?");
if ($ans eq "N") {
--- 285,289 ----
my $resborrower = $btsh->fetchrow_hashref;
my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
! $msgtxt .= " $resborrower->{'initials'} $resborrower->{'surname'}";
my $ans = msg_ny($env,$msgtxt,"Allow issue?");
if ($ans eq "N") {
***************
*** 270,274 ****
my $ans = msg_ny($env,"Cancel reserve?");
if ($ans eq "Y") {
! my $rquery = "update reserves
set found = 'F'
where reservedate = '$resrec->{'reservedate'}'
--- 294,298 ----
my $ans = msg_ny($env,"Cancel reserve?");
if ($ans eq "Y") {
! my $rquery = "update reserves
set found = 'F'
where reservedate = '$resrec->{'reservedate'}'
***************
*** 284,288 ****
}
#if charge deal with it
!
if ($canissue == 1) {
$charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
--- 308,312 ----
}
#if charge deal with it
!
if ($canissue == 1) {
$charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
***************
*** 295,314 ****
if ($charge > 0) {
createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
! }
} elsif ($canissue == 0) {
info_msg($env,"Can't issue $item->{'cardnumber'}");
! }
} else {
! my $valid = checkdigit($env,$itemnum);
if ($valid ==1) {
if (substr($itemnum,0,1) = "V") {
#this is a borrower
$env->{'newborrower'} = $itemnum;
! } else {
error_msg($env,"$itemnum not found - rescan");
}
} else {
error_msg($env,"Invalid Number");
! }
}
$sth->finish;
--- 319,338 ----
if ($charge > 0) {
createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
! }
} elsif ($canissue == 0) {
info_msg($env,"Can't issue $item->{'cardnumber'}");
! }
} else {
! my $valid = checkdigit($env,$itemnum, 1);
if ($valid ==1) {
if (substr($itemnum,0,1) = "V") {
#this is a borrower
$env->{'newborrower'} = $itemnum;
! } else {
error_msg($env,"$itemnum not found - rescan");
}
} else {
error_msg($env,"Invalid Number");
! }
}
$sth->finish;
***************
*** 317,320 ****
--- 341,346 ----
}
+ # FIXME - A virtually identical function appears in
+ # C4::Circulation::Circ2. Pick one and stick with it.
sub createcharge {
my ($env,$dbh,$itemno,$bornum,$charge) = @_;
***************
*** 330,334 ****
!
sub updateissues{
# issue the book
--- 356,360 ----
! # Only used internally
sub updateissues{
# issue the book
***************
*** 336,340 ****
my $loanlength=21;
my $query="Select * from biblioitems,itemtypes
! where (biblioitems.biblioitemnumber='$bitno')
and (biblioitems.itemtype = itemtypes.itemtype)";
my $sth=$dbh->prepare($query);
--- 362,366 ----
my $loanlength=21;
my $query="Select * from biblioitems,itemtypes
! where (biblioitems.biblioitemnumber='$bitno')
and (biblioitems.itemtype = itemtypes.itemtype)";
my $sth=$dbh->prepare($query);
***************
*** 343,347 ****
$loanlength = $data->{'loanlength'}
}
! $sth->finish;
my $dateduef;
if ($env->{'loanlength'} eq "") {
--- 369,373 ----
$loanlength = $data->{'loanlength'}
}
! $sth->finish;
my $dateduef;
if ($env->{'loanlength'} eq "") {
***************
*** 352,356 ****
} else {
$dateduef = $env->{'loanlength'};
! }
$query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
--- 378,382 ----
} else {
$dateduef = $env->{'loanlength'};
! }
$query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
***************
*** 375,378 ****
--- 401,410 ----
}
+ # FIXME - This is very similar to
+ # &C4::Circulation::Renewals2::calc_charges and
+ # &C4::Circulation::Circ2::calc_charges.
+ # Pick one and stick with it.
+
+ # Only used internally
sub calc_charges {
# calculate charges due
***************
*** 389,394 ****
$item_type = $data1->{'itemtype'};
$charge = $data1->{'rentalcharge'};
! my $q2 = "select rentaldiscount from borrowers,categoryitem
! where (borrowers.borrowernumber = '$bornum')
and (borrowers.categorycode = categoryitem.categorycode)
and (categoryitem.itemtype = '$item_type')";
--- 421,426 ----
$item_type = $data1->{'itemtype'};
$charge = $data1->{'rentalcharge'};
! my $q2 = "select rentaldiscount from borrowers,categoryitem
! where (borrowers.borrowernumber = '$bornum')
and (borrowers.categorycode = categoryitem.categorycode)
and (categoryitem.itemtype = '$item_type')";
***************
*** 399,407 ****
$charge = ($charge *(100 - $discount)) / 100;
}
! $sth2->{'finish'};
! }
$sth1->finish;
return ($charge);
}
! END { } # module clean-up code here (global destructor)
--- 431,448 ----
$charge = ($charge *(100 - $discount)) / 100;
}
! $sth2->{'finish'}; # FIXME - Was this supposed to be $sth2->finish ?
! }
$sth1->finish;
return ($charge);
}
! 1;
! __END__
!
! =back
!
! =head1 AUTHOR
!
! Koha Developement team <info at koha.org>
!
! =cut
More information about the Koha-cvs
mailing list