olwen
25 years ago
13 changed files with 857 additions and 136 deletions
@ -0,0 +1,84 @@ |
|||
package C4::Interface::AccountsCDK; #asummes C4/Interface/AccountsCDK |
|||
|
|||
#uses Newt |
|||
use C4::Format; |
|||
use C4::InterfaceCDK; |
|||
use strict; |
|||
|
|||
require Exporter; |
|||
use DBI; |
|||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
|||
|
|||
# set the version for version checking |
|||
$VERSION = 0.01; |
|||
|
|||
@ISA = qw(Exporter); |
|||
@EXPORT = qw(&accountsdialog); |
|||
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], |
|||
|
|||
# your exported package globals go here, |
|||
# as well as any optionally exported functions |
|||
|
|||
@EXPORT_OK = qw($Var1 %Hashit); |
|||
# non-exported package globals go here |
|||
use vars qw(@more $stuff); |
|||
|
|||
# initalize package globals, first exported ones |
|||
|
|||
my $Var1 = ''; |
|||
my %Hashit = (); |
|||
|
|||
# then the others (which are still accessible as $Some::Module::stuff) |
|||
my $stuff = ''; |
|||
my @more = (); |
|||
|
|||
# all file-scoped lexicals must be created before |
|||
# the functions below that use them. |
|||
|
|||
# file-private lexicals go here |
|||
my $priv_var = ''; |
|||
my %secret_hash = (); |
|||
|
|||
# here's a file-private function as a closure, |
|||
# callable as &$priv_func; it cannot be prototyped. |
|||
my $priv_func = sub { |
|||
# stuff goes here. |
|||
}; |
|||
|
|||
# make all your functions, whether exported or not; |
|||
|
|||
|
|||
|
|||
sub accountsdialog { |
|||
my ($env,$title,$borrower,$accountlines,$amountowing)=@_; |
|||
my $titlepanel = titlepanel($env,$env->{'sysarea'},"Money Owing"); |
|||
my @borinfo; |
|||
my $reason; |
|||
$borinfo[0] = "$borrower->{'cardnumber'}"; |
|||
$borinfo[1] = "$borrower->{'surname'}, $borrower->{'title'} $borrower->{'firstname'} "; |
|||
$borinfo[2] = "$borrower->{'streetaddress'}, $borrower->{'city'}"; |
|||
$borinfo[3] = "<R>Total Due: </B>".fmtdec($env,$amountowing,"52"); |
|||
my $borpanel = |
|||
new Cdk::Label ('Message' =>\@borinfo, 'Ypos'=>4, 'Xpos'=>"RIGHT"); |
|||
$borpanel->draw(); |
|||
my $acctlist = new Cdk::Scroll ('Title'=>"Outstanding Items", |
|||
'List'=>\@$accountlines,'Height'=>12,'Width'=>30, |
|||
'Xpos'=>1,'Ypos'=>10); |
|||
$acctlist->draw(); |
|||
my $amountentry = new Cdk::Entry('Label'=>"Amount: ", |
|||
'Max'=>"10",'Width'=>"10", |
|||
'Xpos'=>"1",'Ypos'=>"4", |
|||
'Type'=>"INT"); |
|||
$amountentry->set('Value'=>$amountowing); |
|||
my $amount =$amountentry->activate(); |
|||
|
|||
debug_msg($env,"accounts $amount"); |
|||
|
|||
if (!defined $amount) { |
|||
$reason="Finished user"; |
|||
} |
|||
return($amount,$reason); |
|||
} |
|||
|
|||
|
|||
END { } # module clean-up code here (global destructor) |
|||
@ -0,0 +1,239 @@ |
|||
package C4::Interface::ReserveentCDK; #asummes C4/Interface/ReserveCDK |
|||
|
|||
#uses Newt |
|||
use C4::Format; |
|||
use C4::InterfaceCDK; |
|||
use strict; |
|||
use Cdk; |
|||
|
|||
require Exporter; |
|||
use DBI; |
|||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
|||
|
|||
# set the version for version checking |
|||
$VERSION = 0.01; |
|||
|
|||
@ISA = qw(Exporter); |
|||
@EXPORT = qw(&FindBiblioScreen &SelectBiblio &MakeReserveScreen); |
|||
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], |
|||
|
|||
# your exported package globals go here, |
|||
# as well as any optionally exported functions |
|||
|
|||
@EXPORT_OK = qw($Var1 %Hashit); |
|||
# non-exported package globals go here |
|||
use vars qw(@more $stuff); |
|||
|
|||
# initalize package globals, first exported ones |
|||
|
|||
my $Var1 = ''; |
|||
my %Hashit = (); |
|||
|
|||
# then the others (which are still accessible as $Some::Module::stuff) |
|||
my $stuff = ''; |
|||
my @more = (); |
|||
|
|||
# all file-scoped lexicals must be created before |
|||
# the functions below that use them. |
|||
|
|||
# file-private lexicals go here |
|||
my $priv_var = ''; |
|||
my %secret_hash = (); |
|||
|
|||
# here's a file-private function as a closure, |
|||
# callable as &$priv_func; it cannot be prototyped. |
|||
my $priv_func = sub { |
|||
# stuff goes here. |
|||
}; |
|||
|
|||
# make all your functions, whether exported or not; |
|||
|
|||
sub FindBiblioScreen { |
|||
my ($env,$title,$numflds,$flds,$fldlns)=@_; |
|||
my $titlepanel = titlepanel($env,"Reserves","Find a title"); |
|||
#my @coltitles=("a","b"); |
|||
my @rowtitles; |
|||
my $nflds =@$flds; |
|||
my $ow = 0; |
|||
while ($ow < $nflds) { |
|||
@rowtitles[$ow]=@$flds[$ow]; |
|||
$ow++; |
|||
} |
|||
my @coltitles = (""); |
|||
my @coltypes = ("UMIXED"); |
|||
my @colwidths = (40); |
|||
my $entrymatrix = new Cdk::Matrix ( |
|||
'ColTitles'=> \@coltitles, |
|||
'RowTitles'=> \@rowtitles, |
|||
'ColWidths'=> \@colwidths, |
|||
'ColTypes'=> \@coltypes, |
|||
'Vrows'=> 7, |
|||
'Vcols'=> 1, |
|||
'RowSpace'=> 0); |
|||
#$entrymatrix->set('BoxCell'=>"FALSE"); |
|||
#$entrymatrix->draw(); |
|||
$entrymatrix->inject('Input'=>"KEY_DOWN"); |
|||
my $reason; |
|||
my ($rows,$cols,$info) = $entrymatrix->activate(); |
|||
my @responses; |
|||
if (!defined $rows) { |
|||
$reason = "Circ"; |
|||
} else { |
|||
my $i = 0; |
|||
while ($i < $numflds) { |
|||
$responses[$i] =$info->[$i][0]; |
|||
$i++; |
|||
} |
|||
} |
|||
return($reason,@responses); |
|||
} |
|||
|
|||
sub SelectBiblio { |
|||
my ($env,$count,$entries) = @_; |
|||
my $titlepanel = titlepanel($env,"Reserves","Select title"); |
|||
my $biblist = new Cdk::Alphalist('Title'=>"Select a Title", |
|||
'List'=>\@$entries,'Height' => 22,'Width' => 76, |
|||
'Ypos'=>1); |
|||
my $selection = $biblist->activate(); |
|||
my $reason; |
|||
my $result; |
|||
if (!defined $selection) { |
|||
$reason="Circ"; |
|||
} else { |
|||
$result=$selection; |
|||
} |
|||
return($reason,$result); |
|||
} |
|||
|
|||
sub MakeReserveScreen { |
|||
my ($env,$bibliorec,$bitems,$branches) = @_; |
|||
my $titlepanel = titlepanel($env,"Reserves","Create Reservation"); |
|||
my $line = fmtstr($env,$bibliorec->{'title'},"L72"); |
|||
my $authlen = length($bibliorec->{'author'}); |
|||
my $testlen = length($bibliorec->{'title'}) + $authlen; |
|||
if ($testlen < 72) { |
|||
$line = substr($line,0,71-$authlen)." ".$bibliorec->{'author'}; |
|||
$line = fmtstr($env,$line,"L72"); |
|||
} else { |
|||
my $split = int(($testlen-72)*0.7); |
|||
$line = substr($line,0,72+$split-$authlen)." ".$bibliorec->{'author'}; |
|||
$line = fmtstr($env,$line,"L72"); |
|||
} |
|||
my @book = ($line); |
|||
my $bookpanel = new Cdk::Label ('Message' =>\@book, |
|||
'Ypos'=>"2"); |
|||
$bookpanel->draw(); |
|||
my $branchlist = new Cdk::Radio('Title'=>"Collection Branch", |
|||
'List'=>\@$branches, |
|||
'Xpos'=>"2",'Ypos'=>"7",'Width'=>"23",'Height'=>"17"); |
|||
$branchlist->draw(); |
|||
my $i = 0; |
|||
while ($i < 4) { |
|||
$branchlist->inject('Input'=>"KEY_DOWN"); |
|||
$i++; |
|||
} |
|||
$branchlist->inject('Input'=>" "); |
|||
my @constraintlist = ("Any item","Only Selected","Except Selected"); |
|||
my $constrainttype = new Cdk::Radio('Title'=>"Reserve Constraints", |
|||
'List'=>\@constraintlist, |
|||
'Xpos'=>"54",'Ypos'=>"4",'Width'=>"17",'Height'=>"6"); |
|||
$constrainttype->draw(); |
|||
my $numbit = @$bitems; |
|||
my @itemarr; |
|||
my $i; |
|||
while ($i < $numbit) { |
|||
my $bitline = @$bitems[$i]; |
|||
my @blarr = split("\t",$bitline); |
|||
my $line = @blarr[1]." ".@blarr[2]; |
|||
if (@blarr[3] > 0) { |
|||
my $line = $line.@blarr[3]; |
|||
} |
|||
my $line = $line.@blarr[4]." ".@blarr[5]; |
|||
$line = fmtstr($env,$line,"L40"); |
|||
#$bitx{$line} = @blarr[0]; |
|||
$itemarr[$i]=$line; |
|||
$i++; |
|||
} |
|||
my @sel = ("Y ","N "); |
|||
my $itemlist = new Cdk::Selection('Title'=>"Items Held", |
|||
'List'=>\@itemarr,'Choices'=>\@sel, |
|||
'Xpos'=>"36",'Ypos'=>"9",'Width'=>"40",'Height'=>"15"); |
|||
$itemlist->draw(); |
|||
my $borrowerentry = new Cdk::Entry('Label'=>"Borrower: ", |
|||
'Max'=>"11",'Width'=>"11", |
|||
'Xpos'=>"2",'Ypos'=>"5", |
|||
'Type'=>"UMIXED"); |
|||
borrbind($env,$borrowerentry); |
|||
# $borrowentry->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);}); |
|||
my $complete = 0; |
|||
my $reason = ""; |
|||
my @answers; |
|||
while ($complete == 0) { |
|||
my $borrowercode = $borrowerentry->activate(); |
|||
if (!defined $borrowercode) { |
|||
$reason="Circ"; |
|||
$complete = 1; |
|||
@answers[0] = "" |
|||
} else { |
|||
@answers[0] = $borrowercode; |
|||
if ($borrowercode ne "") { $complete = 1; }; |
|||
while ($complete == 1) { |
|||
my $x = $branchlist->activate(); |
|||
if (!defined $x) { |
|||
$complete = 0; |
|||
@answers[1] = ""; |
|||
} else { |
|||
my @brline = split(" ",@$branches[$x]); |
|||
@answers[1] = @brline[0]; |
|||
$complete = 2; |
|||
$answers[2] = "a"; |
|||
$answers[3] = ""; |
|||
while ($complete == 2) { |
|||
if ($numbit > 1) { |
|||
my @constarr = ("a", "o", "e"); |
|||
my $constans = $constrainttype->activate(); |
|||
if (!defined $constans) { |
|||
$complete = 1; # go back a step |
|||
} else { |
|||
@answers[2] = $constarr[$constans]; |
|||
$complete = 3; |
|||
if ($answers[2] ne "a") { |
|||
while ($complete == 3) { |
|||
my @itemans = $itemlist->activate(); |
|||
if (!defined @itemans) { |
|||
$complete = 2; # go back a step |
|||
} else { |
|||
$complete = 4; |
|||
my $no_ans = @itemans; |
|||
#debug_msg ($env,"itemres 0- @itemans[0]"); |
|||
#debug_msg ($env,"itemres 1- @itemans[1]"); |
|||
my @items; |
|||
my $cnt = @itemans; |
|||
my $i = 0; |
|||
my $j = 0; |
|||
while ($i < $cnt) { |
|||
if ($itemans[$i] == 0) { |
|||
my $bitline = @$bitems[$i]; |
|||
my @blarr = split("\t",$bitline); |
|||
@items[$j] = @blarr[0]; |
|||
$j++; |
|||
} |
|||
$i++; |
|||
} |
|||
@answers[3] = \@items; |
|||
#debug_msg($env,"$answers[0] $answers[1] $answers[2] $answers[3]"); |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} else { |
|||
$complete = 3; |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
} |
|||
return ($reason,@answers); |
|||
} |
|||
END { } # module clean-up code here (global destructor) |
|||
@ -0,0 +1,328 @@ |
|||
package C4::InterfaceCDK; #asummes C4/InterfaceCDK |
|||
|
|||
#uses Newt |
|||
use C4::Format; |
|||
use C4::Interface::Funkeys; |
|||
use strict; |
|||
use Cdk; |
|||
#use C4::Circulation; |
|||
|
|||
require Exporter; |
|||
use DBI; |
|||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
|||
|
|||
# set the version for version checking |
|||
$VERSION = 0.01; |
|||
|
|||
@ISA = qw(Exporter); |
|||
@EXPORT = qw(&dialog &startint &endint &output &clearscreen &pause &helptext |
|||
&textbox &menu &issuewindow &msg_yn &borrower_dialog &debug_msg &error_msg |
|||
&selborrower &returnwindow &logondialog &borrowerwindow &titlepanel |
|||
&borrbind &borrfill); |
|||
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], |
|||
|
|||
# your exported package globals go here, |
|||
# as well as any optionally exported functions |
|||
|
|||
@EXPORT_OK = qw($Var1 %Hashit); |
|||
# non-exported package globals go here |
|||
use vars qw(@more $stuff); |
|||
|
|||
# initalize package globals, first exported ones |
|||
|
|||
my $Var1 = ''; |
|||
my %Hashit = (); |
|||
|
|||
# then the others (which are still accessible as $Some::Module::stuff) |
|||
my $stuff = ''; |
|||
my @more = (); |
|||
|
|||
# all file-scoped lexicals must be created before |
|||
# the functions below that use them. |
|||
|
|||
# file-private lexicals go here |
|||
my $priv_var = ''; |
|||
my %secret_hash = (); |
|||
my $lastval = chr(18); |
|||
|
|||
# here's a file-private function as a closure, |
|||
# callable as &$priv_func; it cannot be prototyped. |
|||
my $priv_func = sub { |
|||
# stuff goes here. |
|||
}; |
|||
|
|||
# make all your functions, whether exported or not; |
|||
sub suspend_cb { |
|||
|
|||
} |
|||
|
|||
sub startint { |
|||
my ($env,$msg)=@_; |
|||
Cdk::init(); |
|||
} |
|||
|
|||
sub menu { |
|||
my ($env,$type,$title,@items)=@_; |
|||
$env->{'sysarea'}="Menu"; |
|||
my $titlebar=titlepanel($env,"Library System","Main Menu"); |
|||
my $reason; |
|||
my $data; |
|||
my @mitems; |
|||
my $x = 0; |
|||
while ($items[$x] ne "") { |
|||
$mitems[$x]="<C>".$items[$x]; |
|||
$x++; |
|||
} |
|||
if ($type eq 'console'){ |
|||
my $menucnt = @items; |
|||
my $menu = new Cdk::Scroll ('Title'=>" ", |
|||
'List'=>\@mitems, |
|||
'Height'=> $menucnt+4, |
|||
'Width'=> 26); |
|||
# Activate the object. |
|||
my ($menuItem) = $menu->activate(); |
|||
# Check the results. |
|||
if (!defined $menuItem) { |
|||
$data = "Quit"; |
|||
} |
|||
else { |
|||
$data = $items[$menuItem]; |
|||
} |
|||
} |
|||
return($reason,$data); |
|||
# end of menu |
|||
|
|||
} |
|||
|
|||
|
|||
sub clearscreen { |
|||
} |
|||
|
|||
sub pause { |
|||
|
|||
} |
|||
|
|||
sub output { |
|||
my($left,$top,$msg)=@_; |
|||
my @outm; |
|||
$outm[0]=$msg; |
|||
my $output = new Cdk::Label ('Message' =>\@outm, |
|||
'Ypos'=>$top, 'Xpos'=>$left, 'Box'=>0); |
|||
$output->draw(); |
|||
return $output; |
|||
} |
|||
|
|||
sub helptext { |
|||
my ($text)=@_; |
|||
my $helptext = output(1,24,$text); |
|||
return $helptext; |
|||
} |
|||
|
|||
|
|||
sub titlepanel{ |
|||
my ($env,$title,$title2)=@_; |
|||
my @header; |
|||
#debug_msg($env,$title); |
|||
@header[0] = fmtstr($env,$title,"L36").fmtstr($env,$title2,"R36"); |
|||
my $label = new Cdk::Label ('Message' =>\@header, |
|||
'Ypos'=>0); |
|||
$label->draw(); |
|||
#debug_msg($env,$title2); |
|||
return $label; |
|||
} |
|||
|
|||
sub msg_yn { |
|||
my ($text1,$text2)=@_; |
|||
# Cdk::init(); |
|||
# Create the dialog buttons. |
|||
my @buttons = ("Yes", "No"); |
|||
my @mesg = ("<C>$text1", "<C>$text2"); |
|||
# Create the dialog object. |
|||
my $dialog = new Cdk::Dialog ('Message' => \@mesg, 'Buttons' => \@buttons); |
|||
my $resp = $dialog->activate(); |
|||
my $response = "Y"; |
|||
if ($resp = "1") { |
|||
$response = "N"; |
|||
} |
|||
return $response; |
|||
} |
|||
|
|||
sub debug_msg { |
|||
my ($env,$text)=@_; |
|||
popupLabel (["Debug </R>$text"]); |
|||
return(); |
|||
} |
|||
|
|||
sub error_msg { |
|||
my ($env,$text)=@_; |
|||
popupLabel (["<C>Error </R>$text"]); |
|||
return(); |
|||
} |
|||
|
|||
sub endint { |
|||
Cdk::end(); |
|||
} |
|||
|
|||
sub borrower_dialog { |
|||
my ($env)=@_; |
|||
my $result; |
|||
my $borrower; |
|||
my $book; |
|||
my @coltitles = ("Borrower","Book"); |
|||
my @rowtitles = (" "); |
|||
my @coltypes = ("UMIXED","UMIXED"); |
|||
my @colwidths = (10,10); |
|||
#Cdk::refreshCdkScreen(); |
|||
my $matrix = new Cdk::Matrix ( |
|||
'ColTitles'=> \@coltitles, |
|||
'RowTitles'=> \@rowtitles, |
|||
'ColWidths'=> \@colwidths, |
|||
'ColTypes'=> \@coltypes, |
|||
'Vrows'=> 1, |
|||
'Vcols'=> 2); |
|||
borrbind($env,$matrix); |
|||
$matrix->draw(); |
|||
my ($rows,$cols,$info) = $matrix->activate(); |
|||
debug_msg($env,$info->[0][0]); |
|||
debug_msg($env,$info->[0][1]); |
|||
|
|||
if (!defined $rows) { |
|||
$result = "Circ"; |
|||
} else { |
|||
$borrower = $info->[0][0]; |
|||
$book = $info->[0][1]; |
|||
} |
|||
$matrix->erase(); |
|||
return ($borrower,$result,$book); |
|||
} |
|||
|
|||
sub selborrower { |
|||
my ($env,$dbh,$borrows,$bornums)=@_; |
|||
my $result; |
|||
my $label = "Select a borrower"; |
|||
my $scroll = new Cdk::Scroll ('Title'=>$label, |
|||
'List'=>\@$borrows,'Height'=>15,'Width'=>60); |
|||
my $returnValue = $scroll->activate (); |
|||
if (!defined $returnValue) { |
|||
#$result = "Circ"; |
|||
} else { |
|||
$result = substr(@$borrows[$returnValue],0,9); |
|||
} |
|||
return $result; |
|||
} |
|||
|
|||
sub issuewindow { |
|||
my ($env,$title,$items1,$items2,$borrower,$amountowing)=@_; |
|||
my $titlepanel = titlepanel($env,"Issues","Issue a book"); |
|||
my $scroll2 = new Cdk::Scroll ('Title'=>"Previous Issues", |
|||
'List'=>\@$items1,'Height'=> 8,'Width'=>78,'Ypos'=>18); |
|||
$scroll2->draw(); |
|||
my $scroll1 = new Cdk::Scroll ('Title'=>"Current Issues", |
|||
'List'=>\@$items2,'Height'=> 8,'Width'=>78,'Ypos'=>9); |
|||
$scroll1->draw(); |
|||
my $borrbox = borrowerbox($env,$borrower,$amountowing); |
|||
my @borrinfo; |
|||
$borrbox->draw(); |
|||
my $entryBox = new Cdk::Entry('Label'=>"Book Barcode: ", |
|||
'Max'=>"11",'Width'=>"11", |
|||
'Xpos'=>"0",'Ypos'=>"4", |
|||
'Type'=>"UMIXED"); |
|||
my $x; |
|||
my $barcode; |
|||
$entryBox->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll1);}); |
|||
$scroll1->bind('Key'=>"KEY_TAB",'Function'=>sub {$x = act($scroll2);}); |
|||
$scroll2->bind('Key'=>"KEY_TAB",'Function'=>sub { |
|||
$x = act($entryBox); |
|||
return $x;}); |
|||
$entryBox->bind('Key'=>"KEY_BTAB",'Function'=>sub {$x = act($scroll2);}); |
|||
$scroll1->bind('Key'=>"KEY_BTAB",'Function'=>sub { |
|||
$x = act($entryBox); |
|||
return $x;}); |
|||
$scroll2->bind('Key'=>"KEY_BTAB",'Function'=>sub {$x = act($scroll1);}); |
|||
$barcode = $entryBox->activate(); |
|||
my $reason; |
|||
if (!defined $barcode) { |
|||
$reason="Finished user" |
|||
} |
|||
$borrbox->erase(); |
|||
$entryBox->erase(); |
|||
$scroll2->erase(); |
|||
$scroll1->erase(); |
|||
|
|||
debug_msg($env,"exiting"); |
|||
|
|||
return $barcode,$reason; |
|||
} |
|||
|
|||
sub borrowerbox { |
|||
my ($env,$borrower,$amountowing) = @_; |
|||
my @borrinfo; |
|||
$borrinfo[0]="$borrower->{'cardnumber'} ". |
|||
"$borrower->{'surname'}, $borrower->{'title'} $borrower->{'firstname'}"; |
|||
$borrinfo[1]="$borrower->{'streetaddress'}, $borrower->{'city'}"; |
|||
$borrinfo[2]="<R>Amount Owing</B> $amountowing"; |
|||
my $borrbox = new Cdk::Label ('Message' =>\@borrinfo, |
|||
'Ypos'=>4, 'Xpos'=>"RIGHT"); |
|||
return $borrbox; |
|||
} |
|||
|
|||
sub returnwindow { |
|||
my ($env,$title,$item,$items,$borrower,$amountowing)=@_; |
|||
#debug_msg($env,$borrower); |
|||
my $titlepanel = titlepanel($env,"Returns","Scan book"); |
|||
my $returnlist = new Cdk::Scroll ('Title'=>"Items Returned", |
|||
'List'=>\@$items,'Height'=> 12,'Width'=>60,'Ypos'=>10,'Xpos'=>1); |
|||
$returnlist->draw(); |
|||
my $borrbox; |
|||
if ($borrower-{'cardnumber'} ne "") { |
|||
$borrbox = borrowerbox($env,$borrower,$amountowing); |
|||
$borrbox->draw(); |
|||
} |
|||
my $bookentry = new Cdk::Entry('Label'=>"Book Barcode: ", |
|||
'Max'=>"11",'Width'=>"11", |
|||
'Xpos'=>"1",'Ypos'=>"4", |
|||
'Type'=>"UMIXED"); |
|||
my $barcode = $bookentry->activate(); |
|||
my $reason; |
|||
if (!defined $barcode) { |
|||
$barcode=""; |
|||
$reason="Circ"; |
|||
} else { |
|||
$reason=""; |
|||
} |
|||
return($reason,$barcode); |
|||
} |
|||
|
|||
sub act { |
|||
my ($obj) = @_; |
|||
my $ans = $obj->activate(); |
|||
return $ans; |
|||
} |
|||
|
|||
sub borrbind { |
|||
my ($env,$entry) = @_; |
|||
my $lastborr = $env->{"bcard"}; |
|||
if ($lastborr ne "" ) { |
|||
#debug_msg($env,"Binding $lastborr"); |
|||
$entry->bind('Key'=>$lastval,'Function'=>sub {borfill($env,$entry);}); |
|||
} else { |
|||
#debug_msg($env,"not Binding "); |
|||
} |
|||
} |
|||
|
|||
sub borfill { |
|||
my ($env,$entry) = @_; |
|||
#debug_msg("","hi there"); |
|||
my $lastborr = $env->{"bcard"}; |
|||
my $i = 0; |
|||
while ($i < 9) { |
|||
$entry->inject('Input'=>substr($lastborr,$i,1)); |
|||
$i++; |
|||
} |
|||
$entry->inject('Input'=>chr(13)); |
|||
|
|||
} |
|||
|
|||
END { } # module clean-up code here (global destructor) |
|||
|
|||
|
|||
Loading…
Reference in new issue