Update of /cvsroot/koha/koha/C4/Circulation In directory usw-pr-cvs1:/tmp/cvs-serv15441/C4/Circulation Modified Files: Circ2.pm Log Message: moredetail.pl presents circulation information taken from the branchtransfers table Circ2.pm has been changed a little admin/branches.pl alows branches to be added, edited and deleted. updatedatabase needs more fixing Index: Circ2.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Circulation/Circ2.pm,v retrieving revision 1.21 retrieving revision 1.22 diff -C2 -r1.21 -r1.22 *** Circ2.pm 13 Mar 2002 21:13:42 -0000 1.21 --- Circ2.pm 2 May 2002 00:08:53 -0000 1.22 *************** *** 5,8 **** --- 5,9 ---- use strict; + # use warnings; require Exporter; use DBI; *************** *** 24,29 **** @ISA = qw(Exporter); ! @EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook ! &find_reserves &transferbook); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], --- 25,29 ---- @ISA = qw(Exporter); ! @EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook &returnbook2 &find_reserves &transferbook &decode); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], *************** *** 63,67 **** sub getbranches { ! my ($env) = @_; my %branches; my $dbh=&C4Connect; --- 63,67 ---- sub getbranches { ! # returns a reference to a hash of references to branches... my %branches; my $dbh=&C4Connect; *************** *** 69,73 **** $sth->execute; while (my $branch=$sth->fetchrow_hashref) { ! # (next) if ($branch->{'branchcode'} eq 'TR'); $branches{$branch->{'branchcode'}}=$branch; } --- 69,80 ---- $sth->execute; while (my $branch=$sth->fetchrow_hashref) { ! my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp); ! my $query = "select categorycode from branchrelations where branchcode = $brc"; ! my $nsth = $dbh->prepare($query); ! $nsth->execute; ! while (my ($cat) = $nsth->fetchrow_array) { ! $branch->{$cat} = 1; ! } ! $nsth->finish; $branches{$branch->{'branchcode'}}=$branch; } *************** *** 96,115 **** my ($env, $borrowernumber,$cardnumber) = @_; my $dbh=&C4Connect; my $sth; open O, ">>/root/tkcirc.out"; print O "Looking up patron $borrowernumber / $cardnumber\n"; if ($borrowernumber) { ! $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber"); } elsif ($cardnumber) { ! $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber"); } else { ! # error condition. This subroutine must be called with either a ! # borrowernumber or a card number. ! $env->{'apierror'}="invalid borrower information passed to getpatroninformation subroutine"; ! return(); } $sth->execute; ! my $borrower=$sth->fetchrow_hashref; ! my $flags=patronflags($env, $borrower, $dbh); $sth->finish; $dbh->disconnect; --- 103,123 ---- my ($env, $borrowernumber,$cardnumber) = @_; my $dbh=&C4Connect; + my $query; my $sth; open O, ">>/root/tkcirc.out"; print O "Looking up patron $borrowernumber / $cardnumber\n"; if ($borrowernumber) { ! $query = "select * from borrowers where borrowernumber=$borrowernumber"; } elsif ($cardnumber) { ! $query = "select * from borrowers where cardnumber=$cardnumber"; } else { ! $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine"; ! return(); } + $env->{'mess'} = $query; + $sth = $dbh->prepare($query); $sth->execute; ! my $borrower = $sth->fetchrow_hashref; ! my $flags = patronflags($env, $borrower, $dbh); $sth->finish; $dbh->disconnect; *************** *** 120,123 **** --- 128,158 ---- } + sub decode { + my ($encoded) = @_; + my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-'; + my @s = map { index($seq,$_); } split(//,$encoded); + my $l = ($#s+1) % 4; + if ($l) + { + if ($l == 1) + { + print "Error!"; + return; + } + $l = 4-$l; + $#s += $l; + } + my $r = ''; + while ($#s >= 0) + { + my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3]; + $r .=chr(($n >> 16) ^ 67) . + chr(($n >> 8 & 255) ^ 67) . + chr(($n & 255) ^ 67); + @s = @s[4..$#s]; + } + $r = substr($r,0,length($r)-$l); + return $r; + } *************** *** 188,205 **** sub transferbook { ! my ($env, $iteminformation, $barcode) = @_; ! my $messages; my $dbh=&C4Connect; #new entry in branchtransfers.... ! my $sth = $dbh->prepare("insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($iteminformation->{'itemnumber'}, '$env->{'frbranchcd'}', now(), '$env->{'tobranchcd'}')"); ! $sth->execute || return (0,"database error: $sth->errstr"); $sth->finish; #update holdingbranch in items ..... ! $sth = $dbh->prepare("update items set holdingbranch='$env->{'tobranchcd'}' where items.itemnumber=$iteminformation->{'itemnumber'}"); ! $sth->execute || return (0,"database error: $sth->errstr"); ! $sth->execute; $sth->finish; $dbh->disconnect; ! return (1, $messages); } --- 223,266 ---- sub transferbook { ! # transfer book code.... ! my ($tbr, $barcode) = @_; ! my $message = ""; ! my %env; ! my $branches = getbranches(); ! my $iteminformation = getiteminformation(\%env,0, $barcode); ! if (not $iteminformation) { ! $message = "<font color='red' size='+2'>There is no book with barcode: $barcode </font>"; ! return (0, $message, 0); ! } ! my $fbr = $iteminformation->{'holdingbranch'}; ! if ($branches->{$fbr}->{'PE'}) { ! $message = "<font color='red' size='+2'>You cannot transfer a book that is in a permanant branch.</font>"; ! return (0, $message, $iteminformation); ! } ! if ($fbr eq $tbr) { ! $message = "<font color='red' size='+2'>You can't transfer the book to the branch it is already at! </font>"; ! return (0, $message, $iteminformation); ! } my $dbh=&C4Connect; + my ($currentborrower) = currentborrower(\%env, $iteminformation->{'itemnumber'}, $dbh); + if ($currentborrower) { + $message = "<font color='red' size='+2'>Book cannot be transfered bracause it is currently on loan to: $currentborrower . Please return book first.</font>"; + return (0, $message, $iteminformation); + } + my $itm = $dbh->quote($iteminformation->{'itemnumber'}); + $fbr = $dbh->quote($fbr); + $tbr = $dbh->quote($tbr); #new entry in branchtransfers.... ! my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($itm, $fbr, now(), $tbr)"; ! my $sth = $dbh->prepare($query); ! $sth->execute; $sth->finish; #update holdingbranch in items ..... ! $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm"; ! $sth = $dbh->prepare($query); ! $sth->execute; $sth->finish; $dbh->disconnect; ! return (1, $message, $iteminformation); } *************** *** 396,400 **** # check for overdue fine - $overduecharge; $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')"); $sth->execute; --- 457,460 ---- *************** *** 407,412 **** } $sth->finish; ! } ! if ($iteminformation->{'itemlost'} eq '1'){ # check for charge made for lost book my $query="select * from accountlines where (itemnumber = --- 467,472 ---- } $sth->finish; ! } ! if ($iteminformation->{'itemlost'} eq '1'){ # check for charge made for lost book my $query="select * from accountlines where (itemnumber = *************** *** 518,582 **** sub patronflags { # Original subroutine for Circ2.pm my %flags; ! my ($env,$patroninformation,$dbh) = @_; ! my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh); if ($amount > 0) { my %flaginfo; ! $flaginfo{'message'}=sprintf "Patron owes \$%.02f", $amount; ! if ($amount>5) { ! $flaginfo{'noissues'}=1; } ! $flags{'CHARGES'}=\%flaginfo; } elsif ($amount < 0){ my %flaginfo; ! $amount=$amount*-1; ! $flaginfo{'message'}=sprintf "Patron has credit of \$%.02f", $amount; ! $flags{'CHARGES'}=\%flaginfo; } if ($patroninformation->{'gonenoaddress'} == 1) { my %flaginfo; ! $flaginfo{'message'}='Borrower has no valid address.'; ! $flaginfo{'noissues'}=1; ! $flags{'GNA'}=\%flaginfo; } if ($patroninformation->{'lost'} == 1) { my %flaginfo; ! $flaginfo{'message'}='Borrower\'s card reported lost.'; ! $flaginfo{'noissues'}=1; ! $flags{'LOST'}=\%flaginfo; } if ($patroninformation->{'debarred'} == 1) { my %flaginfo; ! $flaginfo{'message'}='Borrower is Debarred.'; ! $flaginfo{'noissues'}=1; ! $flags{'DBARRED'}=\%flaginfo; } if ($patroninformation->{'borrowernotes'}) { my %flaginfo; ! $flaginfo{'message'}="$patroninformation->{'borrowernotes'}"; ! $flags{'NOTES'}=\%flaginfo; } ! my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh); if ($odues > 0) { my %flaginfo; ! $flaginfo{'message'}="Yes"; ! $flaginfo{'itemlist'}=$itemsoverdue; foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) { $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; } ! $flags{'ODUES'}=\%flaginfo; } ! my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'}); ! if ($nowaiting>0) { my %flaginfo; ! $flaginfo{'message'}="Reserved items available"; ! $flaginfo{'itemlist'}=$itemswaiting; ! $flaginfo{'itemfields'}=['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch']; ! $flags{'WAITING'}=\%flaginfo; } - my $flag; - my $key; return(\%flags); } --- 578,798 ---- + + sub returnbook2 { + my ($env, $barcode) = @_; + my @messages; + my $dbh=&C4Connect; + # get information on item + my ($iteminformation) = getiteminformation($env, 0, $barcode); + if (not $iteminformation) { + push(@messages, "<font color='red' size='+2'> There is no book with barcode: $barcode </font>"); + return (0, \@messages, 0 ,0); + } + # updatelastseen($env, $dbh, $iteminformation->{'itemnumber'}); + + # find the borrower + my $borrower; + my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh); + if (not $currentborrower) { + push(@messages, "<font color='red' size='+2'>Book: $barcode is not currently issued.</font>"); + return (0, \@messages, 0,0); + } + # update issues, thereby returning book (should push this out into another subroutine + ($borrower) = getpatroninformation($env, $currentborrower, 0); + my $query = "update issues set returndate = now() + where (borrowernumber = '$borrower->{'borrowernumber'}') + and (itemnumber = '$iteminformation->{'itemnumber'}') and (returndate is null)"; + my $sth = $dbh->prepare($query); + $sth->execute; + $sth->finish; + push(@messages, "Book has been returned."); + + my $tbr = $env->{'branchcode'}; + my ($transfered, $message, $item) = transferbook($tbr, $barcode); + if ($transfered) { + push(@messages, "Book: as been transfered."); + } + + if ($iteminformation->{'itemlost'}) { + updateitemlost($dbh, $iteminformation->{'itemnumber'}); + # check for charge made for lost book + my $query = "select * from accountlines where (itemnumber = '$iteminformation->{'itemnumber'}') + and (accounttype='L' or accounttype='Rep') order by date desc"; + my $sth = $dbh->prepare($query); + $sth->execute; + if (my $data = $sth->fetchrow_hashref) { + # writeoff this amount + my $offset; + my $amount = $data->{'amount'}; + my $acctno = $data->{'accountno'}; + my $amountleft; + if ($data->{'amountoutstanding'} == $amount) { + $offset = $data->{'amount'}; + $amountleft = 0; + } else { + $offset = $amount - $data->{'amountoutstanding'}; + $amountleft = $data->{'amountoutstanding'} - $amount; + } + my $uquery = "update accountlines + set accounttype = 'LR',amountoutstanding='0' + where (borrowernumber = '$data->{'borrowernumber'}') + and (itemnumber = '$iteminformation->{'itemnumber'}') + and (accountno = '$acctno') "; + my $usth = $dbh->prepare($uquery); + $usth->execute; + $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 $query = "select * from accountlines + where (borrowernumber = '$data->{'borrowernumber'}') and (amountoutstanding >0) + order by date"; + my $msth = $dbh->prepare($query); + $msth->execute; + # offset transactions + my $newamtos; + my $accdata; + while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){ + if ($accdata->{'amountoutstanding'} < $amountleft) { + $newamtos = 0; + $amountleft = $amountleft - $accdata->{'amountoutstanding'}; + } else { + $newamtos = $accdata->{'amountoutstanding'} - $amountleft; + $amountleft = 0; + } + my $thisacct = $accdata->{accountno}; + my $updquery = "update accountlines set amountoutstanding= '$newamtos' + where (borrowernumber = '$data->{'borrowernumber'}') and (accountno='$thisacct')"; + my $usth = $dbh->prepare($updquery); + $usth->execute; + $usth->finish; + $updquery = "insert into accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + values + ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')"; + my $usth = $dbh->prepare($updquery); + $usth->execute; + $usth->finish; + } + $msth->finish; + } + if ($amountleft > 0){ + $amountleft*=-1; + } + my $desc="Book Returned ".$iteminformation->{'barcode'}; + $uquery = "insert into accountlines + (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) + values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc', + 'CR',$amountleft)"; + $usth = $dbh->prepare($uquery); + + $usth->execute; + $usth->finish; + $uquery = "insert into accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)"; + $usth = $dbh->prepare($uquery); + $usth->execute; + $usth->finish; + $uquery="update items set paidfor='' where itemnumber='$iteminformation->{'itemnumber'}'"; + $usth = $dbh->prepare($uquery); + $usth->execute; + $usth->finish; + } + $sth->finish; + } + + # check for overdue fine + my $query = "select * from accountlines where (borrowernumber='$borrower->{'borrowernumber'}') + and (itemnumber = '$iteminformation->{'itemnumber'}') and (accounttype='FU' or accounttype='O')"; + $sth = $dbh->prepare($query); + $sth->execute; + # alter fine to show that the book has been returned + if (my $data = $sth->fetchrow_hashref) { + my $query = "update accountlines set accounttype='F' + where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) + and (acccountno='$data->{'accountno'}')"; + my $usth=$dbh->prepare($query); + $usth->execute(); + $usth->finish(); + } + $sth->finish; + + my ($resfound, $resrec) = find_reserves($env, $dbh, $iteminformation->{'itemnumber'}); + if ($resfound eq 'y') { + my ($borrower) = getpatroninformation($env,$resrec->{'borrowernumber'},0); + my ($branches) = getbranches(); + my $branchname = $branches->{$resrec->{'branchcode'}}->{'branchname'}; + push(@messages, "<b><font color=red>RESERVED</font></b> for collection by $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'}) at $branchname"); + } + UpdateStats($env,$env->{'branchcode'},'return','0','',$iteminformation->{'itemnumber'}); + $dbh->disconnect; + return (1, \@messages, $iteminformation, $borrower); + } + + + sub patronflags { # Original subroutine for Circ2.pm my %flags; ! my ($env, $patroninformation, $dbh) = @_; ! my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh); if ($amount > 0) { my %flaginfo; ! $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; ! if ($amount > 5) { ! $flaginfo{'noissues'} = 1; } ! $flags{'CHARGES'} = \%flaginfo; } elsif ($amount < 0){ my %flaginfo; ! $amount = $amount*-1; ! $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount; ! $flags{'CHARGES'} = \%flaginfo; } if ($patroninformation->{'gonenoaddress'} == 1) { my %flaginfo; ! $flaginfo{'message'} = 'Borrower has no valid address.'; ! $flaginfo{'noissues'} = 1; ! $flags{'GNA'} = \%flaginfo; } if ($patroninformation->{'lost'} == 1) { my %flaginfo; ! $flaginfo{'message'} = 'Borrower\'s card reported lost.'; ! $flaginfo{'noissues'} = 1; ! $flags{'LOST'} = \%flaginfo; } if ($patroninformation->{'debarred'} == 1) { my %flaginfo; ! $flaginfo{'message'} = 'Borrower is Debarred.'; ! $flaginfo{'noissues'} = 1; ! $flags{'DBARRED'} = \%flaginfo; } if ($patroninformation->{'borrowernotes'}) { my %flaginfo; ! $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; ! $flags{'NOTES'} = \%flaginfo; } ! my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh); if ($odues > 0) { my %flaginfo; ! $flaginfo{'message'} = "Yes"; ! $flaginfo{'itemlist'} = $itemsoverdue; foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) { $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; } ! $flags{'ODUES'} = \%flaginfo; } ! my ($nowaiting, $itemswaiting) = checkwaiting($env, $dbh, $patroninformation->{'borrowernumber'}); ! if ($nowaiting > 0) { my %flaginfo; ! $flaginfo{'message'} = "Reserved items available"; ! $flaginfo{'itemlist'} = $itemswaiting; ! $flaginfo{'itemfields'} = ['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch']; ! $flags{'WAITING'} = \%flaginfo; } return(\%flags); } *************** *** 604,612 **** sub updatelastseen { # Stolen from Returns.pm ! my ($env,$dbh,$itemnumber)= @_; ! my $br = $env->{'branchcode'}; ! my $query = "update items ! set datelastseen = now(), holdingbranch = '$br' ! where (itemnumber = '$itemnumber')"; my $sth = $dbh->prepare($query); $sth->execute; --- 820,828 ---- sub updatelastseen { # Stolen from Returns.pm ! my ($env, $dbh, $itemnumber) = @_; ! my $brc = $env->{'branchcode'}; ! $brc = $dbh->quote($brc); ! my $itm = $dbh->quote($itemnumber); ! my $query = "update items set datelastseen = now(), holdingbranch = $brc where (itemnumber = $itm)"; my $sth = $dbh->prepare($query); $sth->execute; *************** *** 617,621 **** # Original subroutine for Circ2.pm my ($env, $itemnumber, $dbh) = @_; ! my $q_itemnumber=$dbh->quote($itemnumber); my $sth=$dbh->prepare("select borrowers.borrowernumber from issues,borrowers where issues.itemnumber=$q_itemnumber and --- 833,837 ---- # Original subroutine for Circ2.pm my ($env, $itemnumber, $dbh) = @_; ! my $q_itemnumber = $dbh->quote($itemnumber); my $sth=$dbh->prepare("select borrowers.borrowernumber from issues,borrowers where issues.itemnumber=$q_itemnumber and *************** *** 623,627 **** NULL"); $sth->execute; ! my ($previousborrower)=$sth->fetchrow; return($previousborrower); } --- 839,843 ---- NULL"); $sth->execute; ! my ($previousborrower) = $sth->fetchrow; return($previousborrower); }