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 sub pastitems{
 129   #Get list of all items borrower has currently on issue
 130   my ($env,$bornum,$dbh)=@_;
 131   my $query1 = "select * from issues  where (borrowernumber=$bornum)
 132     and (returndate is null) order by date_due";
 133   my $sth=$dbh->prepare($query1);
 134   $sth->execute;
 135   my $i=0;
 136   my @items;
 137   my @items2;
 138   while (my $data1=$sth->fetchrow_hashref) {
 139     my $data = itemnodata($env,$dbh,$data1->{'itemnumber'}); #C4::Search
 140     my @date = split("-",$data1->{'date_due'});
 141     my $odate = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
 142     my $line = C4::Circulation::Issues::formatitem($env,$data,$odate,"");
 143     $items[$i]=$line;
 144     $i++;
 145   }
 146   $sth->finish();
 147   return(\@items,\@items2);
 148 }
 149
 150 sub checkoverdues{
 151   #checks whether a borrower has overdue items
 152   my ($env,$bornum,$dbh)=@_;
 153   my @datearr = localtime;
 154   my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
 155   my $query = "Select count(*) from issues where borrowernumber=$bornum and
 156         returndate is NULL and date_due < '$today'";
 157   my $sth=$dbh->prepare($query);
 158   $sth->execute;
 159   my $data = $sth->fetchrow_hashref;
 160   $sth->finish;
 161   return $data->{'count(*)'};
 162 }
 163
 164 sub previousissue {
 165   my ($env,$itemnum,$dbh,$bornum)=@_;
 166   my $sth=$dbh->prepare("Select
 167      firstname,surname,issues.borrowernumber,cardnumber,returndate
 168      from issues,borrowers where
 169      issues.itemnumber='$itemnum' and
 170      issues.borrowernumber=borrowers.borrowernumber
 171      and issues.returndate is NULL");
 172   $sth->execute;
 173   my $borrower=$sth->fetchrow_hashref;
 174   my $canissue = "Y";
 175   $sth->finish;
 176   my $newdate;
 177   if ($borrower->{'borrowernumber'} ne ''){
 178     if ($bornum eq $borrower->{'borrowernumber'}){
 179       # no need to issue
 180       my ($renewstatus) = C4::Circulation::Renewals::renewstatus($env,$dbh,$bornum,$itemnum);
 181       my ($resbor,$resrec) = checkreserve($env,$dbh,$itemnum);
 182       if ($renewstatus == "0") {
 183         info_msg($env,"</S>Issued to this borrower - No renewals<!S>");
 184         $canissue = "N";
 185       } elsif ($resbor ne "") {
 186         my $resp = C4::InterfaceCDK::msg_ny($env,"Book is issued to this borrower",
 187           "and is reserved - Renew?");
 188         if ($resp eq "Y") {
 189           $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
 190           $canissue = "R";
 191         } else {
 192           $canissue = "N";
 193         }
 194       } else {
 195         my $resp = C4::InterfaceCDK::msg_yn($env,"Book is issued to this borrower", "Renew?");
 196         if ($resp eq "Y") {
 197           $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
 198           $canissue = "R";
 199         } else {
 200           $canissue = "N";
 201         }
 202       }
 203     } else {
 204       my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
 205       my $resp = C4::InterfaceCDK::msg_yn($env,$text,"Mark as returned?");
 206       if ( $resp eq "Y") {
 207         &returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
 208       } else {
 209         $canissue = "N";
 210       }
 211     }
 212   }
 213   return($borrower->{'borrowernumber'},$canissue,$newdate);
 214 }
 215
 216
 217 sub checkreserve{
 218   # Check for reserves for biblio
 219   my ($env,$dbh,$itemnum)=@_;
 220   my $resbor = "";
 221   my $query = "select * from reserves,items
 222     where (items.itemnumber = '$itemnum')
 223     and (reserves.cancellationdate is NULL)
 224     and (items.biblionumber = reserves.biblionumber)
 225     and ((reserves.found = 'W')
 226     or (reserves.found is null))
 227     order by priority";
 228   my $sth = $dbh->prepare($query);
 229   $sth->execute();
 230   my $resrec;
 231   if (my $data=$sth->fetchrow_hashref) {
 232     $resrec=$data;
 233     my $const = $data->{'constrainttype'};
 234     if ($const eq "a") {
 235       $resbor = $data->{'borrowernumber'};
 236     } else {
 237       my $found = 0;
 238       my $cquery = "select * from reserveconstraints,items
 239          where (borrowernumber='$data->{'borrowernumber'}')
 240          and reservedate='$data->{'reservedate'}'
 241          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 242          and (items.itemnumber=$itemnum and
 243          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 244       my $csth = $dbh->prepare($cquery);
 245       $csth->execute;
 246       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 247       if ($const eq 'o') {
 248         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 249       } else {
 250         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 251       }
 252       $csth->finish();
 253     }
 254   }
 255   $sth->finish;
 256   return ($resbor,$resrec);
 257 }
 258
 259 sub checkwaiting{
 260   # check for reserves waiting
 261   my ($env,$dbh,$bornum)=@_;
 262   my @itemswaiting;
 263   my $query = "select * from reserves
 264     where (borrowernumber = '$bornum')
 265     and (reserves.found='W') and cancellationdate is NULL";
 266   my $sth = $dbh->prepare($query);
 267   $sth->execute();
 268   my $cnt=0;
 269   if (my $data=$sth->fetchrow_hashref) {
 270     @itemswaiting[$cnt] =$data;
 271     $cnt ++
 272   }
 273   $sth->finish;
 274   return ($cnt,\@itemswaiting);
 275 }
 276
 277 sub scanbook {
 278   my ($env,$interface)=@_;
 279   #scan barcode
 280   my ($number,$reason)=dialog("Book Barcode:");
 281   $number=uc $number;
 282   return ($number,$reason);
 283 }
 284
 285 sub scanborrower {
 286   my ($env,$interface)=@_;
 287   #scan barcode
 288   my ($number,$reason,$book)=C4::InterfaceCDK::borrower_dialog($env); #C4::InterfaceCDK
 289   $number= $number;
 290   $book=uc $book;
 291   return ($number,$reason,$book);
 292 }
 293
 294
 295 END { }       # module clean-up code here (global destructor)