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