tkperl/tkcirc

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