tkperl/tkcirc

   1 #!/usr/bin/perl
   2 use Tk;
   3 require Tk::Dialog;
   4 use C4::Circulation::Circ2;
   5
   6 require Exporter;
   7 use DBI;
   8
   9
  10 my %env;
  11
  12 my $issuebut, $returnbut, $mainholder;
  13 my $borrnumber, $borrower, $borrowerlist;
  14 my @items2, $currentissues;
  15 my $returnedframe;
  16
  17 my $MW=MainWindow->new(-height => 500, -width => 600);
  18 $MW->fontCreate('C_normal',-family => 'courier', -size => -12);
  19 my $titlebar=$MW->Frame(-height => 100, -width => 600, -relief => 'ridge', -borderwidth => '4');
  20 my $frametop=$MW->Frame(-height => 100, -width => 600, -relief => 'ridge', -borderwidth => '2');
  21 my $framebot=$MW->Frame(-height => 430, -width => 600, -relief => 'ridge', -borderwidth => '2');
  22 my $kohalabel=$titlebar->Label(-text => 'Koha');
  23 my $menulabel=$titlebar->Label(-text => 'Main Menu');
  24 my $branchlabel=$titlebar->Label(-text => 'Stewart Elementary-lp');
  25 $kohalabel->pack(qw/-side left -padx 10/);
  26 $branchlabel->pack(qw/-side left -padx 10 -fill x -expand 1/);
  27 $menulabel->pack(qw/-side left -padx 10/);
  28 my $issuesbut=$frametop->Button(-text => 'Issues', -underline => 0, -command => sub { $data='Issues'; getborrnumber(); });
  29 $issuesbut->pack(qw/-side left -padx 2 -pady 2 -expand 1 -fill x/);
  30 my $returnsbut=$frametop->Button(-text => 'Returns', -underline => 0, -command => sub { $data='Returns'; returns(); });
  31 $returnsbut->pack(qw/-side right -padx 2 -pady 2 -expand 1 -fill x/);
  32 Tk::grid($titlebar, -col => 0, -row => 0, -sticky => 'nsew');
  33 Tk::grid($frametop, -col => 0, -row => 1, -sticky => 'nsew');
  34 Tk::grid($framebot, -col => 0, -row => 2, -sticky => 'nsew');
  35
  36 MainLoop;
  37
  38
  39
  40 sub getborrnumber {
  41     @items2=();
  42     ($mainholder) && ($mainholder->destroy);
  43     $mainholder=$framebot->Frame(-height => 500, -width => 600);
  44     Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'nsew');
  45     $mainholder->gridPropagate(0);
  46     my $borrentryframe=$mainholder->Frame(-height => 40, -width => 200, -relief=>'ridge', -borderwidth=>4);
  47     $borrentryframe->pack(-ipadx => 10, -ipady => 10);
  48     $label=$borrentryframe->Label(-text => "Borrower CardNumber\nor Last Name:", -anchor => 'w');
  49     Tk::grid($label, -col => 0, -row => 0, -sticky => 'nw');
  50     $borrentry=$borrentryframe->Entry(-width => 15);
  51     $borrentry->bind('<Return>' => \&checkborrower);
  52     Tk::grid($borrentry, -col => 1, -row => 0, -sticky => 'nw');
  53     $borrentry->focus;
  54 #Check for surname entry instead of borrower card number
  55 }
  56
  57
  58 sub checkborrower {
  59     $key=$borrentry->get();
  60     my ($borrowers, $flags) = findborrower($env, $key);
  61     my @borrowers=@$borrowers;
  62     if ($#borrowers==0) {
  63         $borrnumber=$borrowers[0]->{'borrowernumber'};
  64         issues();
  65     } elsif ($#borrowers>0) {
  66         ($mainholder) && ($mainholder->destroy);
  67         $mainholder=$framebot->Frame(-height => 500, -width => 500);
  68         Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'nsew');
  69         my $frame=$mainholder->Frame(-height => 500, -width => 500, -relief => 'ridge', -borderwidth => '5');
  70         Tk::grid($frame, -col=>0, -row=>0, -sticky => 'nsew');
  71         $frame->pack(-ipadx=>10, -ipady=>10);
  72         my $label=$frame->Label(-text => 'Pick a Patron', -justify => 'center', -relief => 'ridge', -borderwidth => 3);
  73         Tk::grid($label, -col => 0, -row => 0, -sticky => 'nsew');
  74         $borrowerlist=$frame->Scrolled(Listbox, -width => '50', -height => '10', -setgrid => '1', -scrollbars => 'se', -font => 'C_normal');
  75         $borrowerlist->bind('<Double-1>' => \&pickborrower);
  76         $borrowerlist->bind('<Return>' => \&pickborrower);
  77         Tk::grid($borrowerlist, -col => 0, -row => 1, -sticky => 'n', -pady => 10);
  78         my $buttonframe=$frame->Frame(-height=>40, -width =>500);
  79         Tk::grid($buttonframe, -col => 0, -row => 2);
  80         my $okbutton=$buttonframe->Button(-text => 'OK', -command => \&pickborrower);
  81         $okbutton->pack(-side => 'left', -padx => 10, -pady => 10);
  82         my $cancelbutton=$buttonframe->Button(-text => 'Cancel', -command => \&getborrnumber);
  83         $cancelbutton->pack(-side => 'left', -padx => 10, -pady => 10);
  84         my @borrowerlist;
  85         my $borrower;
  86         foreach $borrower (@borrowers) {
  87             my $cardnumber=$borrower->{'cardnumber'};
  88             my $categorycode=$borrower->{'categorycode'};
  89             my $name=$borrower->{'surname'}.", ".$borrower->{'firstname'};
  90             my $line = sprintf "%10s %4s %-25s", $cardnumber, $categorycode, $name;
  91             push (@borrowerlist, $line);
  92         }
  93         $borrowerlist->insert(0,@borrowerlist);
  94         $borrowerlist->activate(0);
  95         $borrowerlist->focus();
  96     }
  97 }
  98
  99 sub pickborrower {
 100     my $line=$borrowerlist->get('active');
 101     $line=~s/^\s*//;
 102     my $borcardnumber=(split(/\s+/, $line))[0];
 103     my ($borrower,$flags)=getpatroninformation($env, 0, $borcardnumber);
 104     $borrnumber = $borrower->{'borrowernumber'};
 105     issues();
 106 }
 107
 108 sub issues {
 109     my ($borrower, $flags) = getpatroninformation($env,$borrnumber,0);
 110     my ($items) = currentissues($env, $borrower);
 111     #my $previssues='';
 112     #open O, ">>/root/tkcirc.out";
 113     #foreach (sort {$items->{$a} cmp $items->{$b}} keys %$items) {
 114 #       $previssues.="$_->{'title'} $_->{'author'} $_->{'barcode'}\n";
 115 #    }
 116 #    print O "PREVISSUES\n$previssues\n";
 117 #    close O;
 118     $mainholder->destroy;
 119     $mainholder=$framebot->Frame();
 120     Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'n');
 121     $mainholder->gridPropagate(0);
 122     $topline=$mainholder->Frame();
 123     $topline->pack(-side => top, -fill => 'x', -expand => '1');
 124
 125
 126     $barcodeduedate=$topline->LabFrame(-label=>'Item Information', -height=>80, -width=>100, -labelside=>acrosstop);
 127     Tk::grid($barcodeduedate, -col => 0, -row => 0, -sticky => 'nsew');
 128     $barcodelabel=$barcodeduedate->Label(-text => 'Item Barcode:', -justify => right, -anchor => e);
 129     Tk::grid($barcodelabel, -col => 0, -row => 0, -sticky => 'e');
 130     $barcodeentry=$barcodeduedate->Entry(-width => 15);
 131     $barcodeentry->bind('<Return>' => \&issuebk);
 132     $barcodeentry->bind('<Escape>' => \&getborrnumber);
 133     $barcodeentry->grid(-col => 1, -row => 0);
 134     $barcodeentry->focus;
 135     $duedatelabel=$barcodeduedate->Label(-text => 'Due Date:', -justify => right, -anchor => e);
 136     Tk::grid($duedatelabel, -col => 0, -row => 1, -sticky => 'e');
 137     $duedateentry=$barcodeduedate->Entry(-width => 15);
 138     $duedateentry->bind('<Return>' => \&issuebk);
 139     $duedateentry->grid(-col => 1, -row => 1);
 140     $middle=$topline->Frame(-width => 40);
 141     Tk::grid($middle, -col => 1, -sticky => 'ew');
 142
 143     $biframe=$topline->LabFrame(-label=>'Patron Information', -labelside=>acrosstop);
 144     Tk::grid($biframe, -col=>2, -row=>0, -sticky=>'nsew');
 145     $borrowerinfo=$biframe->Text(-height => 4, -width => 40, -wrap => none, -relief=>flat);
 146     my $line = "$borrower->{'cardnumber'} ";
 147     $line .= "$borrower->{'surname'}, ";
 148     $line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
 149     $line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
 150     $line .= "$borrower->{'categorycode'}";
 151
 152
 153     $borrowerinfo->insert('0.0',$line);
 154     $borrowerinfo->configure(-state => 'disabled');
 155     $borrowerinfo->pack;
 156     my $ciframe=$mainholder->LabFrame(-label=>'Current Issues', -labelside=>acrosstop);
 157     $ciframe->pack;
 158
 159
 160
 161
 162     $currentissues=$ciframe->Table(-rows=>10, -columns=>5, -scrollbars=>'e', -fixedrows=>1, -takefocus=>1);
 163     $currentissues->pack();
 164     $currentissues->put(0,0,$currentissues->Label(-text=>"Due Date", -relief => 'groove', borderwidth=>'3'));
 165     $currentissues->put(0,1,$currentissues->Label(-text=>"Bar Code", -relief => 'groove', borderwidth=>'3'));
 166     $currentissues->put(0,2,$currentissues->Label(-text=>"Title", -relief => 'groove', borderwidth=>'3', -width=>35));
 167     $currentissues->put(0,3,$currentissues->Label(-text=>"Author", -relief => 'groove', borderwidth=>'3', -width=>20));
 168     $currentissues->put(0,4,$currentissues->Label(-text=>"Class", -relief => 'groove', borderwidth=>'3'));
 169     $currentissues->see(0,0);
 170     $currentissues->see(0,1);
 171     $currentissues->see(0,2);
 172     $currentissues->see(0,3);
 173     $currentissues->see(0,4);
 174     $currentissues->see(0,5);
 175
 176     my $piframe=$mainholder->LabFrame(-label=>'Previous Issues', -labelside=>acrosstop);
 177     $piframe->pack;
 178     $previousissues=$piframe->Table(-rows=>10, -columns=>5, -scrollbars=>'e', -fixedrows=>1, -takefocus=>1);
 179     $previousissues->pack();
 180     $previousissues->put(0,0,$previousissues->Label(-text=>"Due Date", -relief => 'groove', borderwidth=>'3'));
 181     $previousissues->put(0,1,$previousissues->Label(-text=>"Bar Code", -relief => 'groove', borderwidth=>'3'));
 182     $previousissues->put(0,2,$previousissues->Label(-text=>"Title", -relief => 'groove', borderwidth=>'3', -width=>35));
 183     $previousissues->put(0,3,$previousissues->Label(-text=>"Author", -relief => 'groove', borderwidth=>'3', -width=>20));
 184     $previousissues->put(0,4,$previousissues->Label(-text=>"Class", -relief => 'groove', borderwidth=>'3'));
 185     $previousissues->see(0,0);
 186     $previousissues->see(0,1);
 187     $previousissues->see(0,2);
 188     $previousissues->see(0,3);
 189     $previousissues->see(0,4);
 190
 191     my ($borrowerissues) = currentissues($env, $borrower);
 192     my $counter=1;
 193     #foreach (sort {$items->{$a} cmp $items->{$b}} keys %$items) {
 194     foreach (sort keys %$borrowerissues) {
 195         my $bookissue=$borrowerissues->{$_};
 196         $previousissues->put($counter,0,$previousissues->Label(-text=>$bookissue->{'duedate'}, -relief=>'groove', -borderwidth=>'2'));
 197         $previousissues->put($counter,1,$previousissues->Label(-text=>$bookissue->{'barcode'}, -relief=>'groove', -borderwidth=>'2'));
 198         $previousissues->put($counter,2,$previousissues->Label(-text=>$bookissue->{'title'}, -relief=>'groove', -borderwidth=>'2'));
 199         $previousissues->put($counter,3,$previousissues->Label(-text=>$bookissue->{'author'}, -relief=>'groove', -borderwidth=>'2'));
 200         $previousissues->put($counter,4,$previousissues->Label(-text=>$bookissue->{'dewey'}.$bookissue->{'subclass'}, -relief=>'groove', -borderwidth=>'2'));
 201         $previousissues->see($counter,0);
 202         $previousissues->see($counter,1);
 203         $previousissues->see($counter,2);
 204         $previousissues->see($counter,3);
 205         $previousissues->see($counter,4);
 206         $counter++;
 207
 208     }
 209 }
 210
 211 sub error_msg {
 212     my ($env, $message) = @_;
 213     $MW->bell();
 214     $MW->bell();
 215     $MW->bell();
 216     my $button = $MW->messageBox(-type => 'OK', -title => 'Error Message', -message => "$message");
 217 }
 218
 219 sub info_msg {
 220     $MW->bell();
 221     my ($env, $message) = @_;
 222     my $button = $MW->messageBox(-type => 'OK', -title => 'Informational Message', -message => "$message");
 223 }
 224
 225 sub msg_yn {
 226     $MW->bell();
 227     my ($env, $message1, $message2, $message3) =@_;
 228     my $message = $message1;
 229     ($message2) && ($message.="\n$message2");
 230     ($message3) && ($message.="\n$message3");
 231     my $button = $MW ->messageBox(-type => 'YesNo', -default => 'Yes', -title => 'Message', -message => "$message");
 232     $button=substr($button,0,1);
 233     return ($button);
 234 }
 235
 236
 237 sub msg_ny {
 238     $MW->bell();
 239     my ($env, $message1, $message2, $message3) =@_;
 240     my $message = $message1;
 241     ($message2) && ($message.="\n$message2");
 242     ($message3) && ($message.="\n$message3");
 243     my $button = $MW ->messageBox(-type => 'YesNo', -default => 'No', -title => 'Message', -message => "$message");
 244     $button=substr($button,0,1);
 245     return ($button);
 246 }
 247
 248
 249 sub updateissues {
 250   # issue the book
 251   my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
 252   my $loanlength=21;
 253   my $query="Select *  from biblioitems,itemtypes
 254   where (biblioitems.biblioitemnumber='$bitno')
 255   and (biblioitems.itemtype = itemtypes.itemtype)";
 256   my $sth=$dbh->prepare($query);
 257   $sth->execute;
 258   if (my $data=$sth->fetchrow_hashref) {
 259     $loanlength = $data->{'loanlength'}
 260   }
 261   $sth->finish;
 262   my $dateduef;
 263   if ($env->{'loanlength'} eq "") {
 264     my $ti = time;
 265     my $datedue = time + ($loanlength * 86400);
 266     my @datearr = localtime($datedue);
 267     $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 268   } else {
 269     my $ti = time;
 270     my $datedue = time + ($env->{'loanlength'} * 86400);
 271     my @datearr = localtime($datedue);
 272     $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
 273   }
 274   $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
 275   values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
 276   my $sth=$dbh->prepare($query);
 277   $sth->execute;
 278   $sth->finish;
 279   $query = "Select * from items where itemnumber=$itemno";
 280   $sth=$dbh->prepare($query);
 281   $sth->execute;
 282   my $item=$sth->fetchrow_hashref;
 283   $sth->finish;
 284   $item->{'issues'}++;
 285   $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
 286   $sth=$dbh->prepare($query);
 287   $sth->execute;
 288   $sth->finish;
 289   my @datearr = split('-',$dateduef);
 290   my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
 291   return($dateret);
 292 }
 293
 294 sub returnrecord {
 295   # mark items as returned
 296   my ($env,$dbh,$bornum,$itemno)=@_;
 297   #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
 298   my @datearr = localtime(time);
 299   my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
 300   my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = '$bornum') and (itemnumber = '$itemno') and (returndate is null)";
 301   my $sth = $dbh->prepare($query);
 302   $sth->execute;
 303   $sth->finish;
 304   updatelastseen($env,$dbh,$itemno);
 305   # check for overdue fine
 306   my $oduecharge;
 307   my $query = "select * from accountlines where (borrowernumber = '$bornum') and (itemnumber = '$itemno') and (accounttype = 'FU' or accounttype='O')";
 308   my $sth = $dbh->prepare($query);
 309     $sth->execute;
 310     if (my $data = $sth->fetchrow_hashref) {
 311        # alter fine to show that the book has been returned.
 312        my $uquery = "update accountlines set accounttype = 'F' where (borrowernumber = '$bornum') and (itemnumber = '$itemno') and (accountno = '$data->{'accountno'}') ";
 313        my $usth = $dbh->prepare($uquery);
 314        $usth->execute();
 315        $usth->finish();
 316        $oduecharge = $data->{'amountoutstanding'};
 317     }
 318     $sth->finish;
 319   # check for charge made for lost book
 320   my $query = "select * from accountlines
 321     where (borrowernumber = '$bornum')
 322     and (itemnumber = '$itemno')
 323     and (accounttype = 'L')";
 324   my $sth = $dbh->prepare($query);
 325   $sth->execute;
 326   if (my $data = $sth->fetchrow_hashref) {
 327     # writeoff this amount
 328     my $offset;
 329     my $amount = $data->{'amount'};
 330     my $acctno = $data->{'accountno'};
 331     my $amountleft;
 332     if ($data->{'amountoutstanding'} == $amount) {
 333        $offset = $data->{'amount'};
 334        $amountleft = 0;
 335     } else {
 336        $offset = $amount - $data->{'amountoutstanding'};
 337        $amountleft = $data->{'amountoutstanding'} - $amount;
 338     }
 339     my $uquery = "update accountlines
 340       set accounttype = 'LR',amountoutstanding='0'
 341       where (borrowernumber = '$bornum')
 342       and (itemnumber = '$itemno')
 343       and (accountno = '$acctno') ";
 344     my $usth = $dbh->prepare($uquery);
 345     $usth->execute();
 346     $usth->finish;
 347     my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
 348     $uquery = "insert into accountlines
 349       (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
 350       values ($bornum,$nextaccntno,now(),0-$amount,'Book Returned',
 351       'CR',$amountleft)";
 352     $usth = $dbh->prepare($uquery);
 353     $usth->execute;
 354     $usth->finish;
 355     $uquery = "insert into accountoffsets
 356       (borrowernumber, accountno, offsetaccount,  offsetamount)
 357       values ($bornum,$data->{'accountno'},$nextaccntno,$offset)";
 358     $usth = $dbh->prepare($uquery);
 359     $usth->execute;
 360     $usth->finish;
 361   }
 362   $sth->finish;
 363   UpdateStats($env,'branch','return','0','',$itemno);
 364   return($oduecharge);
 365 }
 366
 367
 368
 369 sub calc_charges {
 370   # calculate charges due
 371   my ($env, $dbh, $itemno, $bornum)=@_;
 372   my $charge=0;
 373   my $item_type;
 374   my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
 375     where (items.itemnumber ='$itemno')
 376     and (biblioitems.biblioitemnumber = items.biblioitemnumber)
 377     and (biblioitems.itemtype = itemtypes.itemtype)";
 378   my $sth1= $dbh->prepare($q1);
 379   $sth1->execute;
 380   if (my $data1=$sth1->fetchrow_hashref) {
 381      $item_type = $data1->{'itemtype'};
 382      $charge = $data1->{'rentalcharge'};
 383      my $q2 = "select rentaldiscount from borrowers,categoryitem
 384         where (borrowers.borrowernumber = '$bornum')
 385         and (borrowers.categorycode = categoryitem.categorycode)
 386         and (categoryitem.itemtype = '$item_type')";
 387      my $sth2=$dbh->prepare($q2);
 388      $sth2->execute;
 389      if (my $data2=$sth2->fetchrow_hashref) {
 390         my $discount = $data2->{'rentaldiscount'};
 391         $charge = ($charge *(100 - $discount)) / 100;
 392      }
 393      $sth2->{'finish'};
 394   }
 395   $sth1->finish;
 396   return ($charge);
 397 }
 398
 399
 400
 401 sub previousissue {
 402   my ($env,$itemnum,$dbh,$bornum)=@_;
 403   my $sth=$dbh->prepare("Select
 404      firstname,surname,issues.borrowernumber,cardnumber,returndate
 405      from issues,borrowers where
 406      issues.itemnumber='$itemnum' and
 407      issues.borrowernumber=borrowers.borrowernumber
 408      and issues.returndate is NULL");
 409   $sth->execute;
 410   my $borrower=$sth->fetchrow_hashref;
 411   my $canissue = "Y";
 412   $sth->finish;
 413   my $newdate;
 414   if ($borrower->{'borrowernumber'} ne ''){
 415     if ($bornum eq $borrower->{'borrowernumber'}){
 416       # no need to issue
 417       my ($renewstatus) = C4::Circulation::Renewals::renewstatus($env,$dbh,$bornum,$itemnum);
 418       my ($resbor,$resrec) = checkreserve($env,$dbh,$itemnum);
 419       if ($renewstatus == "0") {
 420         info_msg($env,"</S>Issued to this borrower - No renewals<!S>");
 421         $canissue = "N";
 422       } elsif ($resbor ne "") {
 423         my $resp = msg_ny($env,"Book is issued to this borrower",
 424           "and is reserved - Renew?");
 425         if ($resp eq "Y") {
 426           $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
 427           $canissue = "R";
 428         } else {
 429           $canissue = "N";
 430         }
 431       } else {
 432         my $resp = msg_yn($env,"Book is issued to this borrower", "Renew?");
 433         if ($resp eq "Y") {
 434           $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
 435           $canissue = "R";
 436         } else {
 437           $canissue = "N";
 438         }
 439       }
 440     } else {
 441       my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
 442       my $resp = msg_yn($env,$text,"Mark as returned?");
 443       if ( $resp eq "Y") {
 444         &returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
 445       } else {
 446         $canissue = "N";
 447       }
 448     }
 449   }
 450   return($borrower->{'borrowernumber'},$canissue,$newdate);
 451 }
 452 sub checkreserve{
 453   # Check for reserves for biblio
 454   my ($env,$dbh,$itemnum)=@_;
 455   my $resbor = "";
 456   my $query = "select * from reserves,items
 457     where (items.itemnumber = '$itemnum')
 458     and (reserves.cancellationdate is NULL)
 459     and (items.biblionumber = reserves.biblionumber)
 460     and ((reserves.found = 'W')
 461     or (reserves.found is null))
 462     order by priority";
 463   my $sth = $dbh->prepare($query);
 464   $sth->execute();
 465   my $resrec;
 466   if (my $data=$sth->fetchrow_hashref) {
 467     $resrec=$data;
 468     my $const = $data->{'constrainttype'};
 469     if ($const eq "a") {
 470       $resbor = $data->{'borrowernumber'};
 471     } else {
 472       my $found = 0;
 473       my $cquery = "select * from reserveconstraints,items
 474          where (borrowernumber='$data->{'borrowernumber'}')
 475          and reservedate='$data->{'reservedate'}'
 476          and reserveconstraints.biblionumber='$data->{'biblionumber'}'
 477          and (items.itemnumber=$itemnum and
 478          items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
 479       my $csth = $dbh->prepare($cquery);
 480       $csth->execute;
 481       if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
 482       if ($const eq 'o') {
 483         if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
 484       } else {
 485         if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
 486       }
 487       $csth->finish();
 488     }
 489   }
 490   $sth->finish;
 491   return ($resbor,$resrec);
 492 }
 493
 494
 495 sub scanbook {
 496   my ($env,$interface)=@_;
 497   #scan barcode
 498   my ($number,$reason)=dialog("Book Barcode:");
 499   $number=uc $number;
 500   return ($number,$reason);
 501 }
 502
 503
 504 sub issuebk {
 505     my %responses,@issueditems;
 506     $env->{'loanlength'}=14;
 507     $env->{'branchcode'}='STWE';
 508     $barcode=$barcodeentry->get();
 509     $barcodeentry->delete('0.0','end');
 510     my ($patroninformation, $flags) = getpatroninformation($env,$borrnumber,0);
 511     my $continue=1;
 512     my ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer);
 513     while ($continue) {
 514         ($iteminformation, $duedate, $rejected, $question, $questionnumber,
 515             $defaultanswer) = issuebook($env, $patroninformation, $barcode,
 516             \%responses);
 517         if ($rejected) {
 518             if ($rejected == -1) {
 519                 last;
 520             } else {
 521                 error_msg($env, $rejected);
 522                 last;
 523             }
 524         }
 525         if ($question) {
 526             my $response = msg_yn($env, "$question");
 527             $responses{$questionnumber}=$response;
 528         } else {
 529             $continue=0;
 530         }
 531     }
 532     unless ($rejected) {
 533         $iteminformation->{'duedate'}=$duedate;
 534         push (@issueditems, $iteminformation);
 535         my $counter=$#issueditems+1;
 536         $currentissues->put($counter,0,$currentissues->Label(-text=>$iteminformation->{'duedate'}, -relief=>'groove', -borderwidth=>'2'));
 537         $currentissues->put($counter,1,$currentissues->Label(-text=>$iteminformation->{'barcode'}, -relief=>'groove', -borderwidth=>'2'));
 538         $currentissues->put($counter,2,$currentissues->Label(-text=>$iteminformation->{'title'}, -relief=>'groove', -borderwidth=>'2'));
 539         $currentissues->put($counter,3,$currentissues->Label(-text=>$iteminformation->{'author'}, -relief=>'groove', -borderwidth=>'2'));
 540         $currentissues->put($counter,4,$currentissues->Label(-text=>$iteminformation->{'dewey'}.$iteminformation->{'subclass'}, -relief=>'groove', -borderwidth=>'2'));
 541         $currentissues->see($counter,0);
 542         $currentissues->see($counter,1);
 543         $currentissues->see($counter,2);
 544         $currentissues->see($counter,3);
 545         $currentissues->see($counter,4);
 546     }
 547 }
 548
 549
 550 sub issuebook2 {
 551     my $bornum=$borrnumber;
 552     $barcode=$barcodeentry->get();
 553     $barcodeentry->delete('0.0', 'end');
 554     my $itemnum=$barcode;
 555     #my ($env,$dbh,$itemnum,$bornum,$items)=@_;
 556     $itemnum=uc $itemnum;
 557     my $canissue = 1;
 558 ##  my ($itemnum,$reason)=&scanbook();
 559     my $query="Select * from items,biblio,biblioitems where (barcode='$itemnum') and
 560       (items.biblionumber=biblio.biblionumber) and
 561       (items.biblioitemnumber=biblioitems.biblioitemnumber) ";
 562     my $item;
 563     my $charge;
 564     my $datedue = $env->{'loanlength'};
 565     my $sth=$dbh->prepare($query);
 566     $sth->execute;
 567     if ($item=$sth->fetchrow_hashref) {
 568     $sth->finish;
 569      #check if item is restricted
 570     if ($item->{'notforloan'} == 1) {
 571         error_msg($env,"Item Not for Loan");
 572         $canissue = 0;
 573     } elsif ($item->{'wthdrawn'} == 1) {
 574         error_msg($env,"Item Withdrawn");
 575         $canissue = 0;
 576     } elsif ($item->{'restricted'} == 1 ){
 577         error_msg($env,"Restricted Item");
 578         $canissue = 0;
 579     } elsif ($item->{'itemtype'} eq 'REF'){
 580         error_msg($env,"Item Not for Loan");
 581         $canissue=0;
 582     }
 583      #check if item is on issue already
 584     if ($canissue == 1) {
 585         my ($currbor,$issuestat,$newdate) =
 586             &previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
 587         if ($issuestat eq "N") {
 588             $canissue = 0;
 589         } elsif ($issuestat eq "R") {
 590             $canissue = -1;
 591             $datedue = $newdate;
 592             $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 593             if ($charge > 0) {
 594                 createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 595             }
 596             &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 597         }
 598     }
 599     if ($canissue == 1) {
 600        #check reserve
 601        my ($resbor,$resrec) =  &checkreserve($env,$dbh,$item->{'itemnumber'});
 602        #debug_msg($env,$resbor);
 603        if ($resbor eq $bornum) {
 604             my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
 605             my $rsth = $dbh->prepare($rquery);
 606             $rsth->execute;
 607             $rsth->finish;
 608        } elsif ($resbor ne "") {
 609             my $bquery = "select * from borrowers
 610             where borrowernumber = '$resbor'";
 611             my $btsh = $dbh->prepare($bquery);
 612             $btsh->execute;
 613             my $resborrower = $btsh->fetchrow_hashref;
 614             my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
 615             $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
 616             my $ans = msg_ny($env,$msgtxt,"Allow issue?");
 617             if ($ans eq "N") {
 618 # print a docket;
 619                 printreserve($env,$resrec,$resborrower,$item);
 620                 $canissue = 0;
 621             } else {
 622                 my $ans = msg_ny($env,"Cancel reserve?");
 623                 if ($ans eq "Y") {
 624                     my $rquery = "update reserves set found = 'F' where reservedate = '$resrec->{'reservedate'}' and borrowernumber = '$resrec->{'borrowernumber'}' and biblionumber = '$resrec->{'biblionumber'}'";
 625                     my $rsth = $dbh->prepare($rquery);
 626                     $rsth->execute;
 627                     $rsth->finish;
 628                 }
 629             }
 630             $btsh->finish();
 631         }
 632     }
 633     #if charge deal with it
 634
 635     if ($canissue == 1) {
 636         $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
 637     }
 638     if ($canissue == 1) {
 639          #now mark as issued
 640         $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
 641          #debug_msg("","date $datedue");
 642         &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
 643         if ($charge > 0) {
 644             createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
 645         }
 646     } elsif ($canissue == 0) {
 647         #info_msg($env,"Can't issue $item->{'cardnumber'}");
 648     }
 649 } else {
 650     #my $valid = checkdigit($env,$itemnum);
 651     my $valid=1;
 652         if ($valid ==1) {
 653             if (substr($itemnum,0,1) = "V") {
 654                 #this is a borrower
 655                 $env->{'newborrower'} = $itemnum;
 656             } else {
 657                 error_msg($env,"$itemnum not found - rescan");
 658             }
 659         } else {
 660             error_msg($env,"Invalid Number");
 661         }
 662     }
 663     $sth->finish;
 664 #debug_msg($env,"date $datedue");
 665     if (($datedue ne "") && ($canissue)) {
 666         my $line=formatitem($env, $item, $datedue, $charge);
 667         unshift @items2, $line;
 668     }
 669     my $currentissuestext='';
 670     foreach (@items2) {
 671         $currentissuestext.="$_\n";
 672     }
 673     $currentissues->configure(-state => 'normal');
 674     $currentissues->delete('0.0','end');
 675     $currentissues->insert('0.0',$currentissuestext);
 676     $currentissues->configure(-state => 'disabled');
 677     return($item,$charge,$datedue);
 678 }
 679
 680 sub formatitem {
 681    my ($env,$item,$datedue,$charge) = @_;
 682    my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
 683    my $iclass =  $item->{'itemtype'};
 684    if ($item->{'dewey'} > 0) {
 685      my $dewey = $item->{'dewey'};
 686      $dewey =~ s/0*$//;
 687      $dewey =~ s/\.$//;
 688      $iclass = $iclass.$dewey.$item->{'subclass'};
 689    };
 690    my $llen = 65 - length($iclass);
 691    my $line = fmtstr($env,$line,"L".$llen);
 692    my $line = $line." $iclass ";
 693    my $line = $line.fmtdec($env,$charge,"22");
 694    return $line;
 695 }
 696
 697 sub returnbk {
 698     my $item = $barcodeentry->get();
 699     $barcodeentry->delete('0.0', 'end');
 700     my ($iteminformation,$borrower,$messages,$overduecharge) = returnbook($env, $item);
 701     my $line = "$borrower->{'cardnumber'} ";
 702     $line .= "$borrower->{'surname'}, ";
 703     $line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
 704     $line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
 705     $line .= "$borrower->{'categorycode'}";
 706     $borrowerinfo->configure(-state => 'normal');
 707     $borrowerinfo->delete('0.0', 'end');
 708     $borrowerinfo->insert('0.0',$line);
 709     $borrowerinfo->configure(-state => 'disabled');
 710     #if ($bornum ne "") {
 711 #       ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
 712 #    } else {
 713 #       $issues = "";
 714 #       $odues = "";
 715 #       $amt_owing = "";
 716 #    }
 717     if ($iteminformation->{'itemnumber'} ne "" ) {
 718         $iteminformation->{'borrower'}=$borrower->{'cardnumber'};
 719         unshift @items,$iteminformation;
 720         $iteminformation->{'dewey'}=~s/0*$//;
 721         if ($items[20] > "") {
 722             #pop @items;
 723         }
 724     }
 725     displayitemsreturned();
 726 }
 727
 728 sub displayitemsreturned {
 729     my $counter=0;
 730     $itemsreturned->put($counter,0,$itemsreturned->Label(-text=>"Bar Code", -relief => 'groove', borderwidth=>'3'));
 731     $itemsreturned->put($counter,1,$itemsreturned->Label(-text=>"Title", -relief => 'groove', borderwidth=>'3', -width=>35));
 732     $itemsreturned->put($counter,2,$itemsreturned->Label(-text=>"Author", -relief => 'groove', borderwidth=>'3', -width=>20));
 733     $itemsreturned->put($counter,3,$itemsreturned->Label(-text=>"Class", -relief => 'groove', borderwidth=>'3'));
 734     $itemsreturned->put($counter,4,$itemsreturned->Label(-text=>"Borrower", -relief => 'groove', borderwidth=>'3'));
 735     $itemsreturned->see($counter,0);
 736     $itemsreturned->see($counter,1);
 737     $itemsreturned->see($counter,2);
 738     $itemsreturned->see($counter,3);
 739     $itemsreturned->see($counter,4);
 740     $counter++;
 741     my $itemno;
 742     foreach $itemno (@items) {
 743         $itemno->{'dewey'}=~s/0*$//;
 744         $itemsreturned->put($counter,0,$itemsreturned->Label(-text=>$itemno->{'barcode'}, -relief => 'groove', borderwidth=>'2'));
 745         $itemsreturned->put($counter,1,$itemsreturned->Label(-text=>$itemno->{'title'}, -relief => 'groove', borderwidth=>'2'));
 746         $itemsreturned->put($counter,2,$itemsreturned->Label(-text=>$itemno->{'author'}, -relief => 'groove', borderwidth=>'2'));
 747         $itemsreturned->put($counter,3,$itemsreturned->Label(-text=>$itemno->{'dewey'}.$itemno->{'subclass'}, -relief => 'groove', borderwidth=>'2'));
 748         $itemsreturned->put($counter,4,$itemsreturned->Label(-text=>$itemno->{'borrower'}, -relief => 'groove', borderwidth=>'2'));
 749         $itemsreturned->see($counter,0);
 750         $itemsreturned->see($counter,1);
 751         $itemsreturned->see($counter,2);
 752         $itemsreturned->see($counter,3);
 753         $itemsreturned->see($counter,4);
 754         $itemsreturned->see(1,0);
 755         $counter++;
 756     }
 757 }
 758
 759 sub returns {
 760     #@items=();
 761     ($mainholder) && ($mainholder->destroy);
 762     $mainholder=$framebot->Frame(-height => 500, -width => 600);
 763     Tk::grid($mainholder, -col => 0, -row => 0, -sticky => 'nsew');
 764     #$mainholder->gridPropagate(0);
 765     $topline=$mainholder->Frame();
 766     $topline->pack(-side => top, -fill => 'x', -expand => '1');
 767
 768
 769     my $barcodeframe=$topline->LabFrame(-label=>'Item Barcode', -height=>80, -width=>100, -labelside=>acrosstop);
 770     Tk::grid($barcodeframe, -col => 0, -row => 0, -sticky => 'n');
 771     $barcodeentry=$barcodeframe->Entry(-width => 15);
 772     $barcodeentry->bind('<Return>' => \&returnbk);
 773     $barcodeentry->grid(-col => 1, -row => 0, -sticky=>'e', -padx=>10, -pady=>10);
 774     $barcodeentry->focus;
 775
 776     $biframe=$topline->LabFrame(-label=>'Patron Information', -labelside=>acrosstop);
 777     Tk::grid($biframe, -col=>2, -row=>0, -sticky=>'nsew');
 778     $borrowerinfo=$biframe->Text(-height => 4, -width => 40, -wrap => none, -relief=>flat);
 779     $borrowerinfo->configure(-state => 'disabled');
 780     $borrowerinfo->grid(-col=>1, -row=>0, -sticky=>'w');
 781
 782
 783     $returnedframe=$mainholder->LabFrame(-label=>'Items Returned', -labelside=>acrosstop);
 784     $returnedframe->pack;
 785     $itemsreturned=$returnedframe->Table(-rows=>10, -columns => 5, -scrollbars=>e, -fixedrows => 1, -takefocus => 1);
 786     $itemsreturned->pack(-side => top);
 787     displayitemsreturned();
 788     #$itemsreturned=$returnedframe->Scrolled(Text, -height=>20, -width=>80, -relief => 'flat', -scrollbars => 'e');
 789     #$itemsreturned->insert('0.0','');
 790     #$itemsreturned->configure(-state => 'disabled');
 791     #$itemsreturned->pack(-side => top);
 792 }
 793
 794
 795 sub updatelastseen {
 796   my ($env,$dbh,$itemnumber)= @_;
 797   my $br = $env->{'branchcode'};
 798   my $query = "update items
 799     set datelastseen = now(), holdingbranch = '$br'
 800     where (itemnumber = '$itemnumber')";
 801   my $sth = $dbh->prepare($query);
 802   $sth->execute;
 803   $sth->finish;
 804
 805 }
 806
 807
 808
 809 sub checkissue {
 810     my ($env,$dbh, $item) = @_;
 811     my $reason='Circ';
 812     my $bornum;
 813     my $borrower;
 814     my $itemno;
 815     my $itemrec;
 816     my $amt_owing;
 817     $item = uc $item;
 818     my $query = "select * from items,biblio
 819         where barcode = '$item'
 820         and (biblio.biblionumber=items.biblionumber)";
 821     my $sth=$dbh->prepare($query);
 822     $sth->execute;
 823     if ($itemrec=$sth->fetchrow_hashref) {
 824         $sth->finish;
 825         $itemno = $itemrec->{'itemnumber'};
 826         $query = "select * from issues
 827         where (itemnumber='$itemrec->{'itemnumber'}')
 828         and (returndate is null)";
 829         my $sth=$dbh->prepare($query);
 830         $sth->execute;
 831         if (my $issuerec=$sth->fetchrow_hashref) {
 832             $sth->finish;
 833             $query = "select * from borrowers where
 834             (borrowernumber = '$issuerec->{'borrowernumber'}')";
 835             my $sth= $dbh->prepare($query);
 836             $sth->execute;
 837             $env->{'bornum'}=$issuerec->{'borrowernumber'};
 838             $borrower = $sth->fetchrow_hashref;
 839             $bornum = $issuerec->{'borrowernumber'};
 840             $itemno = $issuerec->{'itemnumber'};
 841             $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
 842             $reason = "Returned";
 843         } else {
 844             $sth->finish;
 845             updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
 846             $reason = "Item not issued";
 847         }
 848         my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
 849         if ($resfound eq "y") {
 850             my $bquery = "select * from borrowers
 851             where borrowernumber = '$resrec->{'borrowernumber'}'";
 852             my $btsh = $dbh->prepare($bquery);
 853             $btsh->execute;
 854             my $resborrower = $btsh->fetchrow_hashref;
 855 #printreserve($env,$resrec,$resborrower,$itemrec);
 856             my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
 857             error_msg($env,$mess);
 858             $btsh->finish;
 859         }
 860     } else {
 861         $sth->finish;
 862         $reason = "Item not found";
 863     }
 864     return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
 865 }
 866
 867 sub find_reserves {
 868     my ($env,$dbh,$itemno) = @_;
 869     my $itemdata = itemnodata($env,$dbh,$itemno);
 870     my $query = "select * from reserves where found is null
 871     and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
 872     order by priority,reservedate ";
 873     my $sth = $dbh->prepare($query);
 874     $sth->execute;
 875     my $resfound = "n";
 876     my $resrec;
 877     while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
 878         if ($resrec->{'found'} eq "W") {
 879             if ($resrec->{'itemnumber'} eq $itemno) {
 880                 $resfound = "y";
 881             }
 882         } elsif ($resrec->{'constrainttype'} eq "a") {
 883             $resfound = "y";
 884         } else {
 885             my $conquery = "select * from reserveconstraints where borrowernumber
 886                 = $resrec->{'borrowernumber'} and reservedate = '$resrec->{'reservedate'}' and biblionumber = $resrec->{'biblionumber'} and biblioitemnumber = $itemdata->{'biblioitemnumber'}";
 887             my $consth = $dbh->prepare($conquery);
 888             $consth->execute;
 889             if (my $conrec=$consth->fetchrow_hashref) {
 890                 if ($resrec->{'constrainttype'} eq "o") {
 891                     $resfound = "y";
 892                 }
 893             } else {
 894                 if ($resrec->{'constrainttype'} eq "e") {
 895                     $resfound = "y";
 896                 }
 897             }
 898             $consth->finish;
 899         }
 900         if ($resfound eq "y") {
 901             my $updquery = "update reserves
 902                 set found = 'W',itemnumber='$itemno'
 903                 where borrowernumber = $resrec->{'borrowernumber'}
 904                 and reservedate = '$resrec->{'reservedate'}'
 905                 and biblionumber = $resrec->{'biblionumber'}";
 906             my $updsth = $dbh->prepare($updquery);
 907             $updsth->execute;
 908             $updsth->finish;
 909             my $itbr = $resrec->{'branchcode'};
 910             if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
 911                 my $updquery = "update items
 912                 set holdingbranch = 'TR'
 913                 where itemnumber = $itemno";
 914                 my $updsth = $dbh->prepare($updquery);
 915                 $updsth->execute;
 916                 $updsth->finish;
 917             }
 918         }
 919     }
 920     $sth->finish;
 921     return ($resfound,$resrec);
 922 }