[Koha-devel] CVS: koha/C4/Circulation Circ2.pm,1.21,1.22

[Finlay Thompson]

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 &currentissues 
&getiteminformation &findborrower &issuebook &returnbook
! &find_reserves &transferbook);
  %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
                  
--- 25,29 ----
      
  @ISA = qw(Exporter);
! @EXPORT = qw(&getbranches &getprinters &getpatroninformation &currentissues 
&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, address@hidden, 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, address@hidden, 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, address@hidden, $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);
  }