C4/Reserves.pm

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