Browse Source

Added support for showing patron flags in the issues module.

Moved popup message windows to a Toplevel widget instead of a message
widget.  Toplevel widgets come up much faster than message widgets.
3.0.x
tonnesen 21 years ago
parent
commit
e6d86cdd17
  1. 166
      C4/Circulation/Circ2.pm
  2. 87
      tkperl/tkcirc

166
C4/Circulation/Circ2.pm

@ -59,10 +59,40 @@ my $priv_func = sub {
# make all your functions, whether exported or not;
sub getbranches {
my ($env) = @_;
my %branches;
my $dbh=&C4Connect;
my $sth=$dbh->prepare("select * from branches");
$sth->execute;
while (my $branch=$sth->fetchrow_hashref) {
$branches{$branch->{'branchcode'}}=$branch;
}
return (\%branches);
}
sub getprinters {
my ($env) = @_;
my %printers;
my $dbh=&C4Connect;
my $sth=$dbh->prepare("select * from printers");
$sth->execute;
while (my $printer=$sth->fetchrow_hashref) {
$printers{$printer->{'printername'}}=$printer;
}
return (\%printers);
}
sub getpatroninformation {
my ($env, $borrowernumber,$cardnumber) = @_;
my $dbh=&C4Connect;
my $sth;
open O, ">>/root/tkcirc.out";
print O "Looking up patron $borrowernumber / $cardnumber\n";
if ($borrowernumber) {
$sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber");
} elsif ($cardnumber) {
@ -78,6 +108,8 @@ sub getpatroninformation {
my $flags=patronflags($env, $borrower, $dbh);
$sth->finish;
$dbh->disconnect;
print O "$borrower->{'surname'} <---\n";
close O;
return($borrower, $flags);
}
@ -144,9 +176,6 @@ sub currentissues {
my $datedue=$data->{'date_due'};
my $itemnumber=$data->{'itemnumber'};
my ($iteminformation) = getiteminformation($env, $itemnumber,0);
open O, ">>/root/tkcirc.out";
print O "Getting item info for $itemnumber $iteminformation->{'barcode'}.\n";
close O;
$iteminformation->{'datedue'}=$datedue;
$currentissues{$counter}=$iteminformation;
$counter++;
@ -265,6 +294,14 @@ sub issuebook {
my ($datedue);
my ($rejected,$question,$defaultanswer,$questionnumber, $noissue);
SWITCH: {
if ($patroninformation->{'gonenoaddress'}) {
$rejected="Patron is gone, with no known address.";
last SWITCH;
}
if ($patroninformation->{'lost'}) {
$rejected="Patron's card has been reported lost.";
last SWITCH;
}
if ($iteminformation->{'notforloan'} == 1) {
$rejected="Item not for loan.";
last SWITCH;
@ -325,10 +362,10 @@ sub issuebook {
$rsth->execute;
$rsth->finish;
} elsif ($resbor ne "") {
my $resborrower=getpatroninformation($env, $resbor,0);
my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
if ($responses->{2} eq '') {
$questionnumber=2;
$question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}\nAllow issue?";
$question="Reserved for $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}) [$resbor]\nAllow issue?";
$defaultanswer='N';
last SWITCH;
} elsif ($responses->{2} eq 'N') {
@ -394,73 +431,74 @@ sub returnbook {
my $sth=$dbh->prepare("select * from issues where (itemnumber='$iteminformation->{'itemnumber'}') and (returndate is null)");
$sth->execute;
my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
($borrower)=getpatroninformation($env,$currentborrower,0);
my @datearr = localtime(time);
my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = $borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (returndate is null)";
my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
updatelastseen($env,$dbh,$iteminformation->{'itemnumber'});
if ($currentborrower) {
($borrower)=getpatroninformation($env,$currentborrower,0);
my @datearr = localtime(time);
my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
my $query = "update issues set returndate = now(), branchcode ='$env->{'branchcode'}' where (borrowernumber = $borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (returndate is null)";
my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
# check for overdue fine
# check for overdue fine
$overduecharge;
$sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')");
$sth->execute;
# alter fine to show that the book has been returned
if (my $data = $sth->fetchrow_hashref) {
my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) and (acccountno='$data->{'accountno'}')");
$usth->execute();
$usth->finish();
$overduecharge=$data->{'amountoutstanding'};
}
$sth->finish;
# check for charge made for lost book
$sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='L')");
$sth->execute;
if (my $data = $sth->fetchrow_hashref) {
# writeoff this amount
my $offset;
my $amount = $data->{'amount'};
my $acctno = $data->{'accountno'};
my $amountleft;
if ($data->{'amountoutstanding'} == $amount) {
$offset = $data->{'amount'};
$amountleft = 0;
} else {
$offset = $amount - $data->{'amountoutstanding'};
$amountleft = $data->{'amountoutstanding'} - $amount;
$overduecharge;
$sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')");
$sth->execute;
# alter fine to show that the book has been returned
if (my $data = $sth->fetchrow_hashref) {
my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) and (acccountno='$data->{'accountno'}')");
$usth->execute();
$usth->finish();
$overduecharge=$data->{'amountoutstanding'};
}
my $uquery = "update accountlines
set accounttype = 'LR',amountoutstanding='0'
where (borrowernumber = $borrower->{'borrowernumber'})
and (itemnumber = $iteminformation->{'itemnumber'})
and (accountno = '$acctno') ";
my $usth = $dbh->prepare($uquery);
$usth->execute();
$usth->finish;
my $nextaccntno = C4::Accounts::getnextacctno($env,$borrower->{'borrowernumber'},$dbh);
$uquery = "insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
values ($borrower->{'borrowernumber'},$nextaccntno,now(),0-$amount,'Book Returned',
'CR',$amountleft)";
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
$uquery = "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
$sth->finish;
# check for charge made for lost book
$sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='L')");
$sth->execute;
if (my $data = $sth->fetchrow_hashref) {
# writeoff this amount
my $offset;
my $amount = $data->{'amount'};
my $acctno = $data->{'accountno'};
my $amountleft;
if ($data->{'amountoutstanding'} == $amount) {
$offset = $data->{'amount'};
$amountleft = 0;
} else {
$offset = $amount - $data->{'amountoutstanding'};
$amountleft = $data->{'amountoutstanding'} - $amount;
}
my $uquery = "update accountlines
set accounttype = 'LR',amountoutstanding='0'
where (borrowernumber = $borrower->{'borrowernumber'})
and (itemnumber = $iteminformation->{'itemnumber'})
and (accountno = '$acctno') ";
my $usth = $dbh->prepare($uquery);
$usth->execute();
$usth->finish;
my $nextaccntno = C4::Accounts::getnextacctno($env,$borrower->{'borrowernumber'},$dbh);
$uquery = "insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
values ($borrower->{'borrowernumber'},$nextaccntno,now(),0-$amount,'Book Returned',
'CR',$amountleft)";
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
$uquery = "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
$usth = $dbh->prepare($uquery);
$usth->execute;
$usth->finish;
}
$sth->finish;
}
$sth->finish;
UpdateStats($env,'branch','return','0','',$iteminformation->{'itemnumber'});
}
$dbh->disconnect;
UpdateStats($env,'branch','return','0','',$iteminformation->{'itemnumber'});
return ($iteminformation, $borrower, $messages, $overduecharge);
}

87
tkperl/tkcirc

@ -13,6 +13,13 @@ my $issuebut, $returnbut, $mainholder;
my $borrnumber, $borrower, $borrowerlist;
my @items2, $currentissues;
my $returnedframe;
my (@flagbold, @flagnormal, @flagnoissues, @flagtag, @textnoissues);
@flagbold=(-background=>undef, -foreground=>'blue', -underline=>1, -relief=>'sunken', -borderwidth=>1);
@flagnormal=(-background=>undef, -foreground=>'blue', -underline=>1, -relief=>'flat');
@flagtag=(-background=>undef, -foreground=>'blue', -underline=>1, -relief=>'flat');
@flagnoissues=(-background=>undef, -foreground=>'red', -underline=>1, -relief=>'flat');
@textnoissues=(-background=>undef, -foreground=>'red', -relief=>'flat');
@flagnoissuesbold=(-background=>undef, -foreground=>'red', -underline=>1, -relief=>'sunken', -borderwidth=>1);
my $MW=MainWindow->new(-height => 500, -width => 600);
$MW->fontCreate('C_normal',-family => 'courier', -size => -12);
@ -147,10 +154,37 @@ sub issues {
$line .= "$borrower->{'surname'}, ";
$line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
$line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
$line .= "$borrower->{'categorycode'}";
$line .= "$borrower->{'categorycode'} ";
$borrowerinfo->insert('0.0',$line);
open O, ">>/root/tkcirc.out";
my $flag='';
my $nossisues=0;
foreach $flag (sort keys %$flags) {
print O "Configuring flag $flag\n";
$borrowerinfo->insert('end', $flag, "$flag", " ");
if ($flags->{$flag}->{'noissues'}) {
$noissues=1;
$borrowerinfo->tag('configure', "$flag", @flagnoissues);
$borrowerinfo->tag('bind', "$flag", "<Any-Leave>" => sub {shift->tag('configure', "$flag", @flagnoissues)});
$borrowerinfo->tag('bind', "$flag", "<Any-Enter>" => sub {shift->tag('configure', "$flag", @flagnoissuesbold)});
} else {
$borrowerinfo->tag('configure', "$flag", @flagtag);
$borrowerinfo->tag('bind', "$flag", "<Any-Leave>" => sub {shift->tag('configure', "$flag", @flagtag)});
$borrowerinfo->tag('bind', "$flag", "<Any-Enter>" => sub {shift->tag('configure', "$flag", @flagbold)});
}
$borrowerinfo->tag('bind', "$flag", "<1>" => sub {&patronnote($borrower,$flags, $flag)});
}
close O;
if ($noissues) {
$borrowerinfo->insert('end', "\n", "");
$borrowerinfo->insert('end', "No issues allowed for this borrower!", "noissuestag");
$borrowerinfo->tag('configure', 'noissuestag', @textnoissues);
}
$borrowerinfo->insert('0.0',$line);
#$borrowerinfo->insert('0.0',$line);
$borrowerinfo->configure(-state => 'disabled');
$borrowerinfo->pack;
my $ciframe=$mainholder->LabFrame(-label=>'Current Issues', -labelside=>acrosstop);
@ -208,15 +242,33 @@ sub issues {
}
}
sub patronnote {
my ($borrower, $flags, $flag) = @_;
my $flaginfo=$flags->{$flag};
info_msg($env, "$borrower->{'surname'} $flag\n$flags->{$flag}->{'message'}");
}
sub error_msg {
my ($env, $message) = @_;
$MW->bell();
$MW->bell();
$MW->bell();
my $button = $MW->messageBox(-type => 'OK', -title => 'Error Message', -message => "$message");
}
sub info_msg {
my ($env, $message) = @_;
my $window=$MW->Toplevel();
$window->title('Informational Message');
my $text=$window->Scrolled('Text', -height=>4, -width=>40, -wrap=>'word', -scrollbars=>'oe');
$text->pack(-expand=>1, -fill=>'both');
$text->insert('0.0', "$message");
#$text->configure(-state => 'disabled');
my $button=$window->Button(-text=>'OK', -command => sub { $window->destroy()});
$button->pack();
$window->bind('<Return>' => sub {$window->destroy()});
}
sub info_msg_old {
$MW->bell();
my ($env, $message) = @_;
my $button = $MW->messageBox(-type => 'OK', -title => 'Informational Message', -message => "$message");
@ -228,7 +280,7 @@ sub msg_yn {
my $message = $message1;
($message2) && ($message.="\n$message2");
($message3) && ($message.="\n$message3");
my $button = $MW ->messageBox(-type => 'YesNo', -default => 'Yes', -title => 'Message', -message => "$message");
my $button = $MW->messageBox(-type => 'YesNo', -default => 'Yes', -title => 'Message', -message => "$message");
$button=substr($button,0,1);
return ($button);
}
@ -698,15 +750,22 @@ sub returnbk {
my $item = $barcodeentry->get();
$barcodeentry->delete('0.0', 'end');
my ($iteminformation,$borrower,$messages,$overduecharge) = returnbook($env, $item);
my $line = "$borrower->{'cardnumber'} ";
$line .= "$borrower->{'surname'}, ";
$line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
$line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
$line .= "$borrower->{'categorycode'}";
$borrowerinfo->configure(-state => 'normal');
$borrowerinfo->delete('0.0', 'end');
$borrowerinfo->insert('0.0',$line);
$borrowerinfo->configure(-state => 'disabled');
if ($borrower) {
my $line = "$borrower->{'cardnumber'} ";
$line .= "$borrower->{'surname'}, ";
$line .= "$borrower->{'title'} $borrower->{'firstname'}\n";
$line .= "$borrower->{'streetaddress'}, $borrower->{'city'}\n";
$line .= "$borrower->{'categorycode'}";
$borrowerinfo->configure(-state => 'normal');
$borrowerinfo->delete('0.0', 'end');
$borrowerinfo->insert('0.0',$line);
$borrowerinfo->configure(-state => 'disabled');
} else {
$borrowerinfo->configure(-state => 'normal');
$borrowerinfo->delete('0.0', 'end');
$borrowerinfo->insert('0.0','Not Loaned Out');
$borrowerinfo->configure(-state => 'disabled');
}
#if ($bornum ne "") {
# ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
# } else {

Loading…
Cancel
Save