C4/Circulation/Main.pm

   1 package C4::Circulation::Main; #asummes C4/Circulation/Main
   2
   3 #package to deal with circulation
   4
   5
   6 # Copyright 2000-2002 Katipo Communications
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along with
  20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  21 # Suite 330, Boston, MA  02111-1307 USA
  22
  23 use strict;
  24 require Exporter;
  25 use DBI;
  26 use C4::Database;
  27 use C4::Circulation::Issues;
  28 use C4::Circulation::Returns;
  29 use C4::Circulation::Renewals;
  30 use C4::Circulation::Borrower;
  31 use C4::Reserves;
  32 use C4::Search;
  33 use C4::InterfaceCDK;
  34 use C4::Security;
  35 use C4::Format;
  36
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  38
  39 # set the version for version checking
  40 $VERSION = 0.01;
  41
  42 @ISA = qw(Exporter);
  43 @EXPORT = qw(&pastitems &checkoverdues &previousissue
  44 &checkreserve &checkwaiting &scanbook &scanborrower &getbranch &getprinter);
  45 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  46
  47 # your exported package globals go here,
  48 # as well as any optionally exported functions
  49
  50 @EXPORT_OK   = qw($Var1 %Hashit);
  51
  52
  53 # non-exported package globals go here
  54 use vars qw(@more $stuff);
  55
  56 # initalize package globals, first exported ones
  57
  58 my $Var1   = '';
  59 my %Hashit = ();
  60
  61 # then the others (which are still accessible as $Some::Module::stuff)
  62 my $stuff  = '';
  63 my @more   = ();
  64
  65 # all file-scoped lexicals must be created before
  66 # the functions below that use them.
  67
  68 # file-private lexicals go here
  69 my $priv_var    = '';
  70 my %secret_hash = ();
  71
  72 # here's a file-private function as a closure,
  73 # callable as &$priv_func;  it cannot be prototyped.
  74 my $priv_func = sub {
  75   # stuff goes here.
  76 };
  77
  78 # make all your functions, whether exported or not;
  79
  80 sub getbranch {
  81   my ($env) = @_;
  82   my $dbh = C4Connect;
  83   my $query = "select * from branches order by branchcode";
  84   my $sth = $dbh->prepare($query);
  85   $sth->execute;
  86   if ($sth->rows>1) {
  87       my @branches;
  88       while (my $data = $sth->fetchrow_hashref) {
  89         push @branches,$data;
  90       }
  91       brmenu ($env,\@branches);
  92   } else {
  93       my $data = $sth->fetchrow_hashref;
  94       $env->{'branchcode'}=$data->{'branchcode'};
  95   }
  96   my $query = "select * from branches
  97     where branchcode = '$env->{'branchcode'}'";
  98   $sth = $dbh->prepare($query);
  99   $sth->execute;
 100   my $data = $sth->fetchrow_hashref;
 101   $env->{'brdata'} = $data;
 102   $env->{'branchname'} = $data->{'branchname'};
 103   $sth->finish;
 104   $dbh->disconnect;
 105 }
 106
 107 sub getprinter {
 108   my ($env) = @_;
 109   my $dbh = C4Connect;
 110   my $query = "select * from printers order by printername";
 111   my $sth = $dbh->prepare($query);
 112   $sth->execute;
 113   if ($sth->rows>1) {
 114       my @printers;
 115       while (my $data = $sth->fetchrow_hashref) {
 116         push @printers,$data;
 117       }
 118       prmenu ($env,\@printers);
 119   } else {
 120       my $data=$sth->fetchrow_hashref;
 121       $env->{'queue'}=$data->{'printqueue'};
 122       $env->{'printtype'}=$data->{'printtype'};
 123   }
 124   $sth->finish;
 125   $dbh->disconnect;
 126   }
 127
 128 # FIXME - This is not the same as &C4::Circulation::pastitems, though
 129 # the two appear to share some code.
 130 sub pastitems{
 131   #Get list of all items borrower has currently on issue
 132   my ($env,$bornum,$dbh)=@_;
 133   my $query1 = "select * from issues  where (borrowernumber=$bornum)
 134     and (returndate is null) order by date_due";
 135   my $sth=$dbh->prepare($query1);
 136   $sth->execute;
 137   my $i=0;
 138   my @items;
 139   my @items2;
 140   while (my $data1=$sth->fetchrow_hashref) {
 141     my $data = itemnodata($env,$dbh,$data1->{'itemnumber'}); #C4::Search
 142     my @date = split("-",$data1->{'date_due'});
 143     my $odate = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
 144     my $line = C4::Circulation::Issues::formatitem($env,$data,$odate,"");
 145     $items[$i]=$line;
 146     $i++;
 147   }
 148   $sth->finish();
 149   return(\@items,\@items2);
 150 }
 151
 152 sub checkoverdues{
 153   #checks whether a borrower has overdue items
 154   my ($env,$bornum,$dbh)=@_;
 155   my @datearr = localtime;
 156   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
 157   my $query = "Select count(*) from issues where borrowernumber=$bornum and
 158         returndate is NULL and date_due < '$today'";
 159   my $sth=$dbh->prepare($query);
 160   $sth->execute;
 161   my $data = $sth->fetchrow_hashref;
 162   $sth->finish;
 163   return $data->{'count(*)'};
 164 }
 165
 166 # FIXME - This is quite similar to &C4::Circulation::previousissue
 167 sub previousissue {
 168   my ($env,$itemnum,$dbh,$bornum)=@_;
 169   my $sth=$dbh->prepare("Select
 170      firstname,surname,issues.borrowernumber,cardnumber,returndate
 171      from issues,borrowers where
 172      issues.itemnumber='$itemnum' and
 173      issues.borrowernumber=borrowers.borrowernumber
 174      and issues.returndate is NULL");
 175   $sth->execute;
 176   my $borrower=$sth->fetchrow_hashref;
 177   my $canissue = "Y";
 178   $sth->finish;
 179   my $newdate;
 180   if ($borrower->{'borrowernumber'} ne ''){
 181     if ($bornum eq $borrower->{'borrowernumber'}){
 182       # no need to issue
 183       my ($renewstatus) = C4::Circulation::Renewals::renewstatus($env,$dbh,$bornum,$itemnum);
 184       my ($resbor,$resrec) = checkreserve($env,$dbh,$itemnum);
 185       if ($renewstatus == "0") {
 186         info_msg($env,"</S>Issued to this borrower - No renewals<!S>");
 187         $canissue = "N";
 188       } elsif ($resbor ne "") {
 189         my $resp = C4::InterfaceCDK::msg_ny($env,"Book is issued to this borrower",
 190           "and is reserved - Renew?");
 191         if ($resp eq "Y") {
 192           $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
 193           $canissue = "R";
 194         } else {
 195           $canissue = "N";
 196         }
 197       } else {
 198         my $resp = C4::InterfaceCDK::msg_yn($env,"Book is issued to this borrower", "Renew?");
 199         if ($resp eq "Y") {
 200           $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
 201           $canissue = "R";
 202         } else {
 203           $canissue = "N";
 204         }
 205       }
 206     } else {
 207       my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
 208       my $resp = C4::InterfaceCDK::msg_yn($env,$text,"Mark as returned?");
 209       if ( $resp eq "Y") {
 210         &returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
 211       } else {
 212         $canissue = "N";
 213       }
 214     }
 215   }
 216   return($borrower->{'borrowernumber'},$canissue,$newdate);
 217 }
 218
 219
 220 sub checkreserve{
 221   # Check for reserves for biblio
 222   my ($env,$dbh,$itemnum)=@_;
 223   my $resbor = "";
 224   my $query = "select * from reserves,items
 225     where (items.itemnumber = '$itemnum')
 226     and (reserves.cancellationdate is NULL)
 227     and (items.biblionumber = reserves.biblionumber)
 228     and ((reserves.found = 'W')
 229     or (reserves.found is null))
 230     order by priority";
 231   my $sth = $dbh->prepare($query);
 232   $sth->execute();
 233   my $resrec;
 234   if (my $data=$sth->fetchrow_hashref) {
 235     $resrec=$data;
 236     my $const = $data->{'constrainttype'};
 237     if ($const eq "a") {
 238       $resbor = $data->{'borrowernumber'};
 239     } else {
 240       my $found = 0;
 241       my $cquery = "select * from reserveconstraints,items
 242          where (borrowernumber='$data->{'borrowernumber'}')
 243          and reservedate='$data->{'reservedate'}'
 244          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 245          and (items.itemnumber=$itemnum and
 246          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 247       my $csth = $dbh->prepare($cquery);
 248       $csth->execute;
 249       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 250       if ($const eq 'o') {
 251         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 252       } else {
 253         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 254       }
 255       $csth->finish();
 256     }
 257   }
 258   $sth->finish;
 259   return ($resbor,$resrec);
 260 }
 261
 262 sub checkwaiting{
 263   # check for reserves waiting
 264   my ($env,$dbh,$bornum)=@_;
 265   my @itemswaiting;
 266   my $query = "select * from reserves
 267     where (borrowernumber = '$bornum')
 268     and (reserves.found='W') and cancellationdate is NULL";
 269   my $sth = $dbh->prepare($query);
 270   $sth->execute();
 271   my $cnt=0;
 272   if (my $data=$sth->fetchrow_hashref) {
 273     @itemswaiting[$cnt] =$data;
 274     $cnt ++
 275   }
 276   $sth->finish;
 277   return ($cnt,\@itemswaiting);
 278 }
 279
 280 # FIXME - This is identical to &C4::Circulation::scanbook
 281 sub scanbook {
 282   my ($env,$interface)=@_;
 283   #scan barcode
 284   my ($number,$reason)=dialog("Book Barcode:");
 285   $number=uc $number;
 286   return ($number,$reason);
 287 }
 288
 289 # FIXME - This is very similar to &C4::Circulation::scanborrower
 290 sub scanborrower {
 291   my ($env,$interface)=@_;
 292   #scan barcode
 293   my ($number,$reason,$book)=C4::InterfaceCDK::borrower_dialog($env); #C4::InterfaceCDK
 294   $number= $number;
 295   $book=uc $book;
 296   return ($number,$reason,$book);
 297 }
 298
 299
 300 END { }       # module clean-up code here (global destructor)