Koha-community
/
Koha
13
5
Fork 0
Code Issues Releases Wiki Activity
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 24 years ago
parent
e6fb400c7d
commit
e6d86cdd17
2 changed files with 175 additions and 78 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 166
      C4/Circulation/Circ2.pm
  2. 87
      tkperl/tkcirc

166
C4/Circulation/Circ2.pm
View File

@ -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
View File

@ -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 {

Write Preview
Loading…
Cancel
Save