C4/Reserves.pm

   1 package C4::Reserves; #asummes C4/Reserves
   2
   3 #requires DBI.pm to be installed
   4 #uses DBD:Pg
   5
   6
   7 # Copyright 2000-2002 Katipo Communications
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it under the
  12 # terms of the GNU General Public License as published by the Free Software
  13 # Foundation; either version 2 of the License, or (at your option) any later
  14 # version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  17 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  18 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License along with
  21 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  22 # Suite 330, Boston, MA  02111-1307 USA
  23
  24 use strict;
  25 require Exporter;
  26 use DBI;
  27 use C4::Context;
  28 use C4::Format;
  29 use C4::Accounts;
  30 use C4::Stats;
  31 use C4::InterfaceCDK;
  32 use C4::Interface::ReserveentCDK;
  33 use C4::Circulation::Main;
  34 use C4::Circulation::Borrower;
  35 use C4::Search;
  36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  37
  38 # set the version for version checking
  39 $VERSION = 0.01;
  40
  41 @ISA = qw(Exporter);
  42 @EXPORT = qw(&EnterReserves CalcReserveFee CreateReserve );
  43 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  44
  45 # your exported package globals go here,
  46 # as well as any optionally exported functions
  47
  48 @EXPORT_OK   = qw($Var1 %Hashit);
  49
  50
  51 # non-exported package globals go here
  52 use vars qw(@more $stuff);
  53
  54 # initalize package globals, first exported ones
  55
  56 my $Var1   = '';
  57 my %Hashit = ();
  58
  59 # then the others (which are still accessible as $Some::Module::stuff)
  60 my $stuff  = '';
  61 my @more   = ();
  62
  63 # all file-scoped lexicals must be created before
  64 # the functions below that use them.
  65
  66 # file-private lexicals go here
  67 my $priv_var    = '';
  68 my %secret_hash = ();
  69
  70 # here's a file-private function as a closure,
  71 # callable as &$priv_func;  it cannot be prototyped.
  72 my $priv_func = sub {
  73   # stuff goes here.
  74 };
  75
  76 # make all your functions, whether exported or not;
  77
  78 sub EnterReserves{
  79   my ($env)=@_;
  80   my $titlepanel = titlepanel($env,"Reserves","Enter Selection");
  81   my @flds = ("No of entries","Barcode","ISBN","Title","Keywords","Author","Subject");
  82   my @fldlens = ("5","15","15","50","50","50","50");
  83   my ($reason,$num,$itemnumber,$isbn,$title,$keyword,$author,$subject) =
  84      FindBiblioScreen($env,"Reserves",7,\@flds,\@fldlens);
  85   my $donext ="Circ";
  86   if ($reason ne "") {
  87     $donext = $reason;
  88   } else {
  89     my %search;
  90     $search{'title'}= $title;
  91     $search{'keyword'}=$keyword;
  92     $search{'author'}=$author;
  93     $search{'subject'}=$subject;
  94     $search{'item'}=$itemnumber;
  95     $search{'isbn'}=$isbn;
  96     my @results;
  97     my $count;
  98     if ($num < 1 ) {
  99       $num = 30;
 100     }
 101     my $offset = 0;
 102     my $title = titlepanel($env,"Reserves","Searching");
 103     if ($itemnumber ne '' || $isbn ne ''){
 104       ($count,@results)=&CatSearch($env,'precise',\%search,$num,$offset);
 105     } else {
 106       if ($subject ne ''){
 107         ($count,@results)=&CatSearch($env,'subject',\%search,$num,$offset);
 108       } else {
 109         if ($keyword ne ''){
 110           ($count,@results)=&KeywordSearch($env,'intra',\%search,$num,$offset);
 111         } else {
 112           ($count,@results)=&CatSearch($env,'loose',\%search,$num,$offset);
 113         }
 114       }
 115     }
 116     my $no_ents = @results;
 117     my $biblionumber;
 118     if ($no_ents > 0) {
 119       if ($no_ents == 1) {
 120         my @ents = split("\t",@results[0]);
 121         $biblionumber  = @ents[2];
 122       } else {
 123         my %biblio_xref;
 124         my @bibtitles;
 125         my $i = 0;
 126         my $line;
 127         while ($i < $no_ents) {
 128           my @ents = split("\t",@results[$i]);
 129           $line = fmtstr($env,@ents[1],"L70");
 130           my $auth = substr(@ents[0],0,30);
 131           substr($line,(70-length($auth)-2),length($auth)+2) = "  ".$auth;
 132           @bibtitles[$i]=$line;
 133           $biblio_xref{$line}=@ents[2];
 134           $i++;
 135         }
 136         my $title = titlepanel($env,"Reserves","Select Title");
 137         my ($results,$bibres) = SelectBiblio($env,$count,\@bibtitles);
 138         if ($results eq "") {
 139           $biblionumber = $biblio_xref{$bibres};
 140         } else {
 141           $donext = $results;
 142         }
 143       }
 144
 145       if ($biblionumber eq "") {
 146         error_msg($env,"No items found");
 147       } else {
 148         my @items = GetItems($env,$biblionumber);
 149         my $cnt_it = @items;
 150         my $dbh = C4::Context->dbh;
 151         my $query = "Select * from biblio where biblionumber = $biblionumber";
 152         my $sth = $dbh->prepare($query);
 153         $sth->execute;
 154         my $data=$sth->fetchrow_hashref;
 155         $sth->finish;
 156         my @branches;
 157         my $query = "select * from branches where issuing=1 order by branchname";
 158         my $sth=$dbh->prepare($query);
 159         $sth->execute;
 160         while (my $branchrec=$sth->fetchrow_hashref) {
 161           my $branchdet =
 162             fmtstr($env,$branchrec->{'branchcode'},"L2")." ".$branchrec->{'branchname'};
 163           push @branches,$branchdet;
 164         }
 165         $sth->finish;
 166         $donext = "";
 167         while ($donext eq "") {
 168           my $title = titlepanel($env,"Reserves","Create Reserve");
 169           my ($reason,$borcode,$branch,$constraint,$bibitems) =
 170             MakeReserveScreen($env, $data, \@items, \@branches);
 171           if ($borcode ne "") {
 172             my ($borrnum,$borrower) = findoneborrower($env,$dbh,$borcode);
 173             if ($reason eq "") {
 174               if ($borrnum ne "") {
 175                 my $fee =
 176                   CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems);
 177                   CreateReserve($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$fee);
 178                 $donext = "Circ"
 179               }
 180
 181             } else {
 182               $donext = $reason;
 183             }
 184           } else { $donext = "Circ" }
 185         }
 186       }
 187     }
 188   }
 189   return ($donext);
 190 }
 191
 192 sub CalcReserveFee {
 193   my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_;
 194   #check for issues;
 195   my $dbh = C4::Context->dbh;
 196   my $const = lc substr($constraint,0,1);
 197   my $query = "select * from borrowers,categories
 198     where (borrowernumber = '$borrnum')
 199     and (borrowers.categorycode = categories.categorycode)";
 200   my $sth = $dbh->prepare($query);
 201   $sth->execute;
 202   my $data = $sth->fetchrow_hashref;
 203   $sth->finish();
 204   my $fee = $data->{'reservefee'};
 205   my $cntitems = @->$bibitems;
 206   if ($fee > 0) {
 207     # check for items on issue
 208     # first find biblioitem records
 209     my @biblioitems;
 210     my $query1 = "select * from biblio,biblioitems
 211        where (biblio.biblionumber = '$biblionumber')
 212        and (biblio.biblionumber = biblioitems.biblionumber)";
 213     my $sth1 = $dbh->prepare($query1);
 214     $sth1->execute();
 215     while (my $data1=$sth1->fetchrow_hashref) {
 216       if ($const eq "a") {
 217         push @biblioitems,$data1;
 218      } else {
 219         my $found = 0;
 220         my $x = 0;
 221         while ($x < $cntitems) {
 222           if (@$bibitems->{'biblioitemnumber'} == $data->{'biblioitemnumber'}) {
 223             $found = 1;
 224           }
 225           $x++;
 226         }
 227         if ($const eq 'o') {if ($found == 1) {push @biblioitems,$data;}
 228         } else {if ($found == 0) {push @biblioitems,$data;} }
 229       }
 230     }
 231     $sth1->finish;
 232     my $cntitemsfound = @biblioitems;
 233     my $issues = 0;
 234     my $x = 0;
 235     my $allissued = 1;
 236     while ($x < $cntitemsfound) {
 237       my $bitdata = @biblioitems[$x];
 238       my $query2 = "select * from items
 239         where biblioitemnumber = '$bitdata->{'biblioitemnumber'}'";
 240       my $sth2 = $dbh->prepare($query2);
 241       $sth2->execute;
 242       while (my $itdata=$sth2->fetchrow_hashref) {
 243         my $query3 = "select * from issues
 244            where itemnumber = '$itdata->{'itemnumber'}' and returndate is null";
 245         my $sth3 = $dbh->prepare($query3);
 246         $sth3->execute();
 247         if (my $isdata=$sth3->fetchrow_hashref) { } else {$allissued = 0; }
 248       }
 249       $x++;
 250     }
 251     if ($allissued == 0) {
 252       my $rquery = "select * from reserves
 253         where biblionumber = '$biblionumber'";
 254       my $rsth = $dbh->prepare($rquery);
 255       $rsth->execute();
 256       if (my $rdata = $rsth->fetchrow_hashref) { } else {
 257         $fee = 0;
 258       }
 259     }
 260   }
 261   return $fee;
 262 } # end CalcReserveFee
 263
 264 sub CreateReserve {
 265   my ($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$fee) = @_;
 266   my $dbh = C4::Context->dbh;
 267   #$dbh->{RaiseError} = 1;
 268   #$dbh->{AutoCommit} = 0;
 269   my $const = lc substr($constraint,0,1);
 270   my @datearr = localtime(time);
 271   my $resdate = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 272   #eval {
 273     # updates take place here
 274     if ($fee > 0) {
 275       my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
 276       my $updquery = "insert into accountlines
 277          (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 278           values ($borrnum,$nextacctno,now(),$fee,'Reserve Charge','Res',$fee)";
 279       my $usth = $dbh->prepare($updquery);
 280       $usth->execute;
 281       $usth->finish;
 282     }
 283     my $query="insert into reserves (borrowernumber,biblionumber,reservedate,branchcode,constrainttype) values ('$borrnum','$biblionumber','$resdate','$branch','$const')";
 284     my $sth = $dbh->prepare($query);
 285     $sth->execute();
 286     if (($const eq "o") || ($const eq "e")) {
 287       my $numitems = @$bibitems;
 288       my $i = 0;
 289       while ($i < $numitems) {
 290         my $biblioitem = @$bibitems[$i];
 291         my $query = "insert into reserveconstraints
 292            (borrowernumber,biblionumber,reservedate,biblioitemnumber)
 293            values ('$borrnum','$biblionumber','$resdate','$biblioitem')";
 294         my $sth = $dbh->prepare($query);
 295         $sth->execute();
 296         $i++;
 297       }
 298     }
 299   UpdateStats($env,'branch','reserve',$fee);
 300   #$dbh->commit();
 301   #};
 302   #if (@_) {
 303   #  # update failed
 304   #  my $temp = @_;
 305   #  #  error_msg($env,"Update failed");
 306   #  $dbh->rollback();
 307   #}
 308   return();
 309 } # end CreateReserve
 310
 311
 312
 313
 314 END { }       # module clean-up code here (global destructor)