C4/Reserves.pm

   1 package C4::Reserves;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 # FIXME - I suspect that this module is obsolete.
  21
  22 use strict;
  23 require Exporter;
  24 use DBI;
  25 use C4::Context;
  26 use C4::Format;
  27 use C4::Accounts;
  28 use C4::Stats;
  29 use C4::InterfaceCDK;
  30 use C4::Interface::ReserveentCDK;
  31 use C4::Circulation::Main;
  32 use C4::Circulation::Borrower;
  33 use C4::Search;
  34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  35
  36 # set the version for version checking
  37 $VERSION = 0.01;
  38
  39 @ISA = qw(Exporter);
  40 @EXPORT = qw(&EnterReserves CalcReserveFee CreateReserve );
  41 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  42
  43 # your exported package globals go here,
  44 # as well as any optionally exported functions
  45
  46 @EXPORT_OK   = qw($Var1 %Hashit);
  47
  48
  49 # non-exported package globals go here
  50 use vars qw(@more $stuff);
  51
  52 # initalize package globals, first exported ones
  53
  54 my $Var1   = '';
  55 my %Hashit = ();
  56
  57 # then the others (which are still accessible as $Some::Module::stuff)
  58 my $stuff  = '';
  59 my @more   = ();
  60
  61 # all file-scoped lexicals must be created before
  62 # the functions below that use them.
  63
  64 # file-private lexicals go here
  65 my $priv_var    = '';
  66 my %secret_hash = ();
  67
  68 # here's a file-private function as a closure,
  69 # callable as &$priv_func;  it cannot be prototyped.
  70 my $priv_func = sub {
  71   # stuff goes here.
  72 };
  73
  74 # make all your functions, whether exported or not;
  75
  76 # FIXME - This doesn't appear to ever be used, except in modules that
  77 # appear to be obsolete.
  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 # FIXME - A functionally identical version of this function appears in
 193 # C4::Reserves2. Pick one and stick with it.
 194 sub CalcReserveFee {
 195   my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_;
 196   #check for issues;
 197   my $dbh = C4::Context->dbh;
 198   my $const = lc substr($constraint,0,1);
 199   my $query = "select * from borrowers,categories
 200     where (borrowernumber = '$borrnum')
 201     and (borrowers.categorycode = categories.categorycode)";
 202   my $sth = $dbh->prepare($query);
 203   $sth->execute;
 204   my $data = $sth->fetchrow_hashref;
 205   $sth->finish();
 206   my $fee = $data->{'reservefee'};
 207   my $cntitems = @->$bibitems;
 208   if ($fee > 0) {
 209     # check for items on issue
 210     # first find biblioitem records
 211     my @biblioitems;
 212     my $query1 = "select * from biblio,biblioitems
 213        where (biblio.biblionumber = '$biblionumber')
 214        and (biblio.biblionumber = biblioitems.biblionumber)";
 215     my $sth1 = $dbh->prepare($query1);
 216     $sth1->execute();
 217     while (my $data1=$sth1->fetchrow_hashref) {
 218       if ($const eq "a") {
 219         push @biblioitems,$data1;
 220      } else {
 221         my $found = 0;
 222         my $x = 0;
 223         while ($x < $cntitems) {
 224           if (@$bibitems->{'biblioitemnumber'} == $data->{'biblioitemnumber'}) {
 225             $found = 1;
 226           }
 227           $x++;
 228         }
 229         if ($const eq 'o') {if ($found == 1) {push @biblioitems,$data;}
 230         } else {if ($found == 0) {push @biblioitems,$data;} }
 231       }
 232     }
 233     $sth1->finish;
 234     my $cntitemsfound = @biblioitems;
 235     my $issues = 0;
 236     my $x = 0;
 237     my $allissued = 1;
 238     while ($x < $cntitemsfound) {
 239       my $bitdata = @biblioitems[$x];
 240       my $query2 = "select * from items
 241         where biblioitemnumber = '$bitdata->{'biblioitemnumber'}'";
 242       my $sth2 = $dbh->prepare($query2);
 243       $sth2->execute;
 244       while (my $itdata=$sth2->fetchrow_hashref) {
 245         my $query3 = "select * from issues
 246            where itemnumber = '$itdata->{'itemnumber'}' and returndate is null";
 247         my $sth3 = $dbh->prepare($query3);
 248         $sth3->execute();
 249         if (my $isdata=$sth3->fetchrow_hashref) { } else {$allissued = 0; }
 250       }
 251       $x++;
 252     }
 253     if ($allissued == 0) {
 254       my $rquery = "select * from reserves
 255         where biblionumber = '$biblionumber'";
 256       my $rsth = $dbh->prepare($rquery);
 257       $rsth->execute();
 258       if (my $rdata = $rsth->fetchrow_hashref) { } else {
 259         $fee = 0;
 260       }
 261     }
 262   }
 263   return $fee;
 264 } # end CalcReserveFee
 265
 266 # FIXME - A somewhat different version of this function appears in
 267 # C4::Reserves2. Pick one and stick with it.
 268 sub CreateReserve {
 269   my ($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$fee) = @_;
 270   my $dbh = C4::Context->dbh;
 271   #$dbh->{RaiseError} = 1;
 272   #$dbh->{AutoCommit} = 0;
 273   my $const = lc substr($constraint,0,1);
 274   my @datearr = localtime(time);
 275   my $resdate = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 276   #eval {
 277     # updates take place here
 278     if ($fee > 0) {
 279       my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
 280       my $updquery = "insert into accountlines
 281          (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 282           values ($borrnum,$nextacctno,now(),$fee,'Reserve Charge','Res',$fee)";
 283       my $usth = $dbh->prepare($updquery);
 284       $usth->execute;
 285       $usth->finish;
 286     }
 287     my $query="insert into reserves (borrowernumber,biblionumber,reservedate,branchcode,constrainttype) values ('$borrnum','$biblionumber','$resdate','$branch','$const')";
 288     my $sth = $dbh->prepare($query);
 289     $sth->execute();
 290     if (($const eq "o") || ($const eq "e")) {
 291       my $numitems = @$bibitems;
 292       my $i = 0;
 293       while ($i < $numitems) {
 294         my $biblioitem = @$bibitems[$i];
 295         my $query = "insert into reserveconstraints
 296            (borrowernumber,biblionumber,reservedate,biblioitemnumber)
 297            values ('$borrnum','$biblionumber','$resdate','$biblioitem')";
 298         my $sth = $dbh->prepare($query);
 299         $sth->execute();
 300         $i++;
 301       }
 302     }
 303   UpdateStats($env,'branch','reserve',$fee);
 304   #$dbh->commit();
 305   #};
 306   #if (@_) {
 307   #  # update failed
 308   #  my $temp = @_;
 309   #  #  error_msg($env,"Update failed");
 310   #  $dbh->rollback();
 311   #}
 312   return();
 313 } # end CreateReserve
 314
 315
 316
 317
 318 END { }       # module clean-up code here (global destructor)