C4/Circulation/Circ2.pm

   1 package C4::Circulation::Circ2; #assumes C4/Circulation/Returns
   2
   3 #package to deal with Returns
   4 #written 3/11/99 by olwen@katipo.co.nz
   5
   6 use strict;
   7 require Exporter;
   8 use DBI;
   9 use C4::Database;
  10 use C4::Accounts;
  11 use C4::InterfaceCDK;
  12 use C4::Circulation::Main;
  13 use C4::Format;
  14 use C4::Circulation::Renewals;
  15 use C4::Scan;
  16 use C4::Stats;
  17 use C4::Search;
  18 use C4::Print;
  19
  20 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  21
  22 # set the version for version checking
  23 $VERSION = 0.01;
  24
  25 @ISA = qw(Exporter);
  26 @EXPORT = qw(&getpatroninformation &currentissues &getiteminformation &findborrower &issuebook &returnbook);
  27 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  28
  29 # your exported package globals go here,
  30 # as well as any optionally exported functions
  31
  32 @EXPORT_OK   = qw($Var1 %Hashit);
  33
  34
  35 # non-exported package globals go here
  36 #use vars qw(@more $stuff);
  37
  38 # initalize package globals, first exported ones
  39
  40 my $Var1   = '';
  41 my %Hashit = ();
  42
  43 # then the others (which are still accessible as $Some::Module::stuff)
  44 my $stuff  = '';
  45 my @more   = ();
  46
  47 # all file-scoped lexicals must be created before
  48 # the functions below that use them.
  49
  50 # file-private lexicals go here
  51 my $priv_var    = '';
  52 my %secret_hash = ();
  53
  54 # here's a file-private function as a closure,
  55 # callable as &$priv_func;  it cannot be prototyped.
  56 my $priv_func = sub {
  57   # stuff goes here.
  58 };
  59
  60 # make all your functions, whether exported or not;
  61
  62 sub getpatroninformation {
  63     my ($env, $borrowernumber,$cardnumber) = @_;
  64     my $dbh=&C4Connect;
  65     my $sth;
  66     if ($borrowernumber) {
  67         $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber");
  68     } elsif ($cardnumber) {
  69         $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber");
  70     } else {
  71          # error condition.  This subroutine must be called with either a
  72          # borrowernumber or a card number.
  73         $env->{'apierror'}="invalid borrower information passed to getpatroninformation subroutine";
  74          return();
  75     }
  76     $sth->execute;
  77     my $borrower=$sth->fetchrow_hashref;
  78     my $flags=patronflags($env, $borrower, $dbh);
  79     $sth->finish;
  80     $dbh->disconnect;
  81     return($borrower, $flags);
  82 }
  83
  84 sub patronflags {
  85     my %flags;
  86     my ($env,$patroninformation,$dbh) = @_;
  87     my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh);
  88     if ($amount>0) {
  89         my %flaginfo;
  90         $flaginfo{'message'}='Patron owes $amount';
  91         if ($amount>5) {
  92             $flaginfo{'noissues'}=1;
  93         }
  94         $flags{'CHARGES'}=\%flaginfo;
  95     }
  96     if ($patroninformation->{'gonenoaddress'} == 1) {
  97         my %flaginfo;
  98         $flaginfo{'message'}='Borrower has no valid address.';
  99         $flaginfo{'noissues'}=1;
 100         $flags{'GNA'}=\%flaginfo;
 101     }
 102     if ($patroninformation->{'lost'} == 1) {
 103         my %flaginfo;
 104         $flaginfo{'message'}='Borrower\'s card reported lost.';
 105         $flaginfo{'noissues'}=1;
 106         $flags{'LOST'}=\%flaginfo;
 107     }
 108     if ($patroninformation->{'borrowernotes'}) {
 109         my %flaginfo;
 110         $flaginfo{'message'}="Note: $patroninformation->{'borrowernotes'}";
 111         $flags{'NOTES'}=\%flaginfo;
 112     }
 113     my ($odues) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh);
 114     if ($odues > 0) {
 115         my %flaginfo;
 116         $flaginfo{'message'}="Overdue Items";
 117         $flags{'ODUES'}=\%flaginfo;
 118     }
 119     my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'});
 120     if ($nowaiting>0) {
 121         my %flaginfo;
 122         $flaginfo{'message'}="Reserved items available";
 123         $flaginfo{'itemlist'}=$itemswaiting;
 124         $flaginfo{'itemfields'}=['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
 125         $flags{'WAITING'}=\%flaginfo;
 126     }
 127
 128     my $flag;
 129     my $key;
 130     return(\%flags);
 131 }
 132
 133
 134
 135 sub currentissues {
 136     my ($env, $borrower) = @_;
 137     my $dbh=&C4Connect;
 138     my %currentissues;
 139     my $counter=1;
 140     my $borrowernumber=$borrower->{'borrowernumber'};
 141     my $sth=$dbh->prepare("select * from issues,items,biblio where borrowernumber=$borrowernumber and issues.itemnumber=items.itemnumber and items.biblionumber=biblio.biblionumber and returndate is null order by date_due");
 142     $sth->execute;
 143     while (my $data = $sth->fetchrow_hashref) {
 144         my $datedue=$data->{'date_due'};
 145         my $itemnumber=$data->{'itemnumber'};
 146         my ($iteminformation) = getiteminformation($env, $itemnumber,0);
 147         open O, ">>/root/tkcirc.out";
 148         print O "Getting item info for $itemnumber $iteminformation->{'barcode'}.\n";
 149         close O;
 150         $iteminformation->{'datedue'}=$datedue;
 151         $currentissues{$counter}=$iteminformation;
 152         $counter++;
 153     }
 154     $sth->finish;
 155     $dbh->disconnect;
 156     return(\%currentissues);
 157 }
 158
 159 sub getiteminformation {
 160     my ($env, $itemnumber, $barcode) = @_;
 161     my $dbh=&C4Connect;
 162     my $sth;
 163     if ($itemnumber) {
 164         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=$itemnumber and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 165     } elsif ($barcode) {
 166         my $q_barcode=$dbh->quote($barcode);
 167         $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=$q_barcode and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
 168     } else {
 169         $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
 170         # Error condition.
 171         return();
 172     }
 173     $sth->execute;
 174     my $iteminformation=$sth->fetchrow_hashref;
 175     $sth->finish;
 176     $dbh->disconnect;
 177     $iteminformation->{'dewey'}=~s/0*$//;
 178     return($iteminformation);
 179 }
 180
 181 sub findborrower {
 182     my ($env, $key) = @_;
 183     my $dbh=&C4Connect;
 184     my @borrowers;
 185     my $q_key=$dbh->quote($key);
 186     my $sth=$dbh->prepare("select * from borrowers where cardnumber=$q_key");
 187     $sth->execute;
 188     if ($sth->rows) {
 189         my ($borrower)=$sth->fetchrow_hashref;
 190         push (@borrowers, $borrower);
 191     } else {
 192         $q_key=$dbh->quote("$key%");
 193         $sth->finish;
 194         $sth=$dbh->prepare("select * from borrowers where surname like $q_key");
 195         $sth->execute;
 196         while (my $borrower = $sth->fetchrow_hashref) {
 197             push (@borrowers, $borrower);
 198         }
 199     }
 200     $sth->finish;
 201     $dbh->disconnect;
 202     return(\@borrowers);
 203 }
 204
 205 sub currentborrower {
 206     my ($env, $itemnumber, $dbh) = @_;
 207     my $q_itemnumber=$dbh->quote($itemnumber);
 208     my $sth=$dbh->prepare("select borrowers.borrowernumber from
 209     issues,borrowers where issues.itemnumber=$q_itemnumber and
 210     issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
 211     NULL");
 212     $sth->execute;
 213     my ($previousborrower)=$sth->fetchrow;
 214     return($previousborrower);
 215 }
 216
 217
 218 sub checkreserve {
 219   # Check for reserves for biblio
 220   my ($env,$dbh,$itemnum)=@_;
 221   my $resbor = "";
 222   my $query = "select * from reserves,items
 223     where (items.itemnumber = '$itemnum')
 224     and (reserves.cancellationdate is NULL)
 225     and (items.biblionumber = reserves.biblionumber)
 226     and ((reserves.found = 'W')
 227     or (reserves.found is null))
 228     order by priority";
 229   my $sth = $dbh->prepare($query);
 230   $sth->execute();
 231   my $resrec;
 232   if (my $data=$sth->fetchrow_hashref) {
 233     $resrec=$data;
 234     my $const = $data->{'constrainttype'};
 235     if ($const eq "a") {
 236       $resbor = $data->{'borrowernumber'};
 237     } else {
 238       my $found = 0;
 239       my $cquery = "select * from reserveconstraints,items
 240          where (borrowernumber='$data->{'borrowernumber'}')
 241          and reservedate='$data->{'reservedate'}'
 242          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 243          and (items.itemnumber=$itemnum and
 244          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 245       my $csth = $dbh->prepare($cquery);
 246       $csth->execute;
 247       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 248       if ($const eq 'o') {
 249         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 250       } else {
 251         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 252       }
 253       $csth->finish();
 254     }
 255   }
 256   $sth->finish;
 257   return ($resbor,$resrec);
 258 }
 259
 260
 261 sub issuebook {
 262     my ($env, $patroninformation, $barcode, $responses) = @_;
 263     my $dbh=&C4Connect;
 264     my $iteminformation=getiteminformation($env, 0, $barcode);
 265     my ($datedue);
 266     my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
 267     SWITCH: {
 268         if ($iteminformation->{'notforloan'} == 1) {
 269             $rejected="Item not for loan.";
 270             last SWITCH;
 271         }
 272         if ($iteminformation->{'wthdrawn'} == 1) {
 273             $rejected="Item withdrawn.";
 274             last SWITCH;
 275         }
 276         if ($iteminformation->{'restricted'} == 1) {
 277             $rejected="Restricted item.";
 278             last SWITCH;
 279         }
 280         if ($iteminformation->{'itemtype'} eq 'REF') {
 281             $rejected="Reference item:  Not for loan.";
 282             last SWITCH;
 283         }
 284         my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
 285         if ($currentborrower eq $patroninformation->{'borrowernumber'}) {
 286 # Already issued to current borrower
 287             my ($renewstatus) = renewstatus($env,$dbh,$patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 288             if ($renewstatus == 0) {
 289                 $rejected="No more renewals allowed for this item.";
 290                 last SWITCH;
 291             } else {
 292                 if ($responses->{4} eq '') {
 293                     $questionnumber=4;
 294                     $question="Book is issued to this borrower.\nRenew?";
 295                     $defaultanswer='Y';
 296                     last SWITCH;
 297                 } elsif ($responses->{4} eq 'Y') {
 298                     renewbook($env,$dbh, $patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'});
 299                     $noissue=1;
 300                 } else {
 301                     $rejected=-1;
 302                     last SWITCH;
 303                 }
 304             }
 305         } elsif ($currentborrower ne '') {
 306             my ($currborrower, $cbflags)=getpatroninformation($env,$currentborrower,0);
 307             if ($responses->{1} eq '') {
 308                 $questionnumber=1;
 309                 $question="Issued to $currborrower->{'firstname'} $currborrower->{'surname'} ($currborrower->{'cardnumber'}).\nMark as returned?";
 310                 $defaultanswer='Y';
 311                 last SWITCH;
 312             } elsif ($responses->{1} eq 'Y') {
 313                 returnbook($env,$iteminformation->{'barcode'});
 314             } else {
 315                 $rejected=-1;
 316                 last SWITCH;
 317             }
 318         }
 319
 320         my ($resbor, $resrec) = checkreserve($env, $dbh, $iteminformation->{'itemnumber'});
 321
 322         if ($resbor eq $patroninformation->{'borrowernumber'}) {
 323              my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
 324              my $rsth = $dbh->prepare($rquery);
 325              $rsth->execute;
 326              $rsth->finish;
 327         } elsif ($resbor ne "") {
 328             my $resborrower=getpatroninformation($env, $resbor,0);
 329             if ($responses->{2} eq '') {
 330                 $questionnumber=2;
 331                 $question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}\nAllow issue?";
 332                 $defaultanswer='N';
 333                 last SWITCH;
 334             } elsif ($responses->{2} eq 'N') {
 335                 printreserve($env, $resrec, $resborrower, $iteminformation);
 336                 $rejected=-1;
 337                 last SWITCH;
 338             } else {
 339                 if ($responses->{3} eq '') {
 340                     $questionnumber=3;
 341                     $question="Cancel reserve for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}?";
 342                     $defaultanswer='N';
 343                     last SWITCH;
 344                 } elsif ($responses->{3} eq 'Y') {
 345                     my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
 346                     my $rsth = $dbh->prepare($rquery);
 347                     $rsth->execute;
 348                     $rsth->finish;
 349                 }
 350             }
 351         }
 352     }
 353     my $dateduef;
 354     unless (($question) || ($rejected) || ($noissue)) {
 355         my $loanlength=21;
 356         if ($iteminformation->{'loanlength'}) {
 357             $loanlength=$iteminformation->{'loanlength'};
 358         }
 359         my $ti=time;
 360         my $datedue=time+($loanlength)*86400;
 361         my @datearr = localtime($datedue);
 362         $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 363         my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values ($patroninformation->{'borrowernumber'}, $iteminformation->{'itemnumber'}, '$dateduef', '$env->{'branchcode'}')");
 364         $sth->execute;
 365         $sth->finish;
 366         $iteminformation->{'issues'}++;
 367         $sth=$dbh->prepare("update items set issues=$iteminformation->{'issues'} where itemnumber=$iteminformation->{'itemnumber'}");
 368         $sth->execute;
 369         $sth->finish;
 370     }
 371     $dbh->disconnect;
 372     return ($iteminformation, $dateduef, $rejected, $question, $questionnumber, $defaultanswer);
 373 }
 374
 375
 376 sub updatelastseen {
 377     my ($env,$dbh,$itemnumber)= @_;
 378     my $br = $env->{'branchcode'};
 379     my $query = "update items
 380     set datelastseen = now(), holdingbranch = '$br'
 381     where (itemnumber = '$itemnumber')";
 382     my $sth = $dbh->prepare($query);
 383     $sth->execute;
 384     $sth->finish;
 385 }
 386
 387 sub returnbook {
 388     my ($env, $barcode) = @_;
 389     my ($messages, $overduecharge);
 390     my $dbh=&C4Connect;
 391     my ($iteminformation) = getiteminformation($env, 0, $barcode);
 392     my $borrower;
 393     if ($iteminformation) {
 394         my $sth=$dbh->prepare("select * from issues where (itemnumber='$iteminformation->{'itemnumber'}') and (returndate is null)");
 395         $sth->execute;
 396         my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
 397         ($borrower)=getpatroninformation($env,$currentborrower,0);
 398
 399         my @datearr = localtime(time);
 400         my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
 401         my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = $borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (returndate is null)";
 402         my $sth = $dbh->prepare($query);
 403         $sth->execute;
 404         $sth->finish;
 405         updatelastseen($env,$dbh,$iteminformation->{'itemnumber'});
 406
 407
 408         # check for overdue fine
 409
 410         $overduecharge;
 411         $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')");
 412         $sth->execute;
 413         # alter fine to show that the book has been returned
 414         if (my $data = $sth->fetchrow_hashref) {
 415             my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) and (acccountno='$data->{'accountno'}')");
 416             $usth->execute();
 417             $usth->finish();
 418             $overduecharge=$data->{'amountoutstanding'};
 419         }
 420         $sth->finish;
 421         # check for charge made for lost book
 422         $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='L')");
 423         $sth->execute;
 424         if (my $data = $sth->fetchrow_hashref) {
 425             # writeoff this amount
 426             my $offset;
 427             my $amount = $data->{'amount'};
 428             my $acctno = $data->{'accountno'};
 429             my $amountleft;
 430             if ($data->{'amountoutstanding'} == $amount) {
 431                 $offset = $data->{'amount'};
 432                 $amountleft = 0;
 433             } else {
 434                 $offset = $amount - $data->{'amountoutstanding'};
 435                 $amountleft = $data->{'amountoutstanding'} - $amount;
 436             }
 437             my $uquery = "update accountlines
 438               set accounttype = 'LR',amountoutstanding='0'
 439               where (borrowernumber = $borrower->{'borrowernumber'})
 440               and (itemnumber = $iteminformation->{'itemnumber'})
 441               and (accountno = '$acctno') ";
 442             my $usth = $dbh->prepare($uquery);
 443             $usth->execute();
 444             $usth->finish;
 445             my $nextaccntno = C4::Accounts::getnextacctno($env,$borrower->{'borrowernumber'},$dbh);
 446             $uquery = "insert into accountlines
 447               (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 448               values ($borrower->{'borrowernumber'},$nextaccntno,now(),0-$amount,'Book Returned',
 449               'CR',$amountleft)";
 450             $usth = $dbh->prepare($uquery);
 451             $usth->execute;
 452             $usth->finish;
 453             $uquery = "insert into accountoffsets
 454               (borrowernumber, accountno, offsetaccount,  offsetamount)
 455               values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
 456             $usth = $dbh->prepare($uquery);
 457             $usth->execute;
 458             $usth->finish;
 459         }
 460         $sth->finish;
 461     }
 462     $dbh->disconnect;
 463     UpdateStats($env,'branch','return','0','',$iteminformation->{'itemnumber'});
 464     return ($iteminformation, $borrower, $messages, $overduecharge);
 465 }
 466
 467 END { }       # module clean-up code here (global destructor)