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.
This commit is contained in:
tonnesen
parent
e6fb400c7d
commit
e6d86cdd17
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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->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…
Reference in New Issue