Browse Source

Committing all the CDK stuff

master
olwen 22 years ago
parent
commit
5b2803d8d8
  1. 4
      C4/Accounts.pm
  2. 28
      C4/Circmain.pm
  3. 24
      C4/Circulation/Borrower.pm
  4. 179
      C4/Circulation/Issues.pm
  5. 17
      C4/Circulation/Main.pm
  6. 2
      C4/Circulation/Renewals.pm
  7. 3
      C4/Circulation/Returns.pm
  8. 84
      C4/Interface/AccountsCDK.pm
  9. 239
      C4/Interface/ReserveentCDK.pm
  10. 328
      C4/InterfaceCDK.pm
  11. 4
      C4/Print.pm
  12. 50
      C4/Reserves.pm
  13. 31
      C4/Search.pm

4
C4/Accounts.pm

@ -7,8 +7,8 @@ use strict;
require Exporter;
use DBI;
use C4::Format;
use C4::Interface;
use C4::Interface::Accounts;
use C4::InterfaceCDK;
use C4::Interface::AccountsCDK;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking

28
C4/Circmain.pm

@ -12,7 +12,7 @@ use C4::Circulation::Returns;
use C4::Circulation::Renewals;
use C4::Circulation::Borrower;
use C4::Reserves;
use C4::Interface;
use C4::InterfaceCDK;
use C4::Security;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ -67,42 +67,42 @@ sub Start_circ{
my $data;
while ($donext ne 'Quit') {
if ($donext eq "Circ") {
#&startint($env,'Circulation');
&startint($env,'Circulation');
clearscreen();
($reason,$data) = menu($env,'console','Circulation',
('Issues','Returns','Borrower Enquiries','Reserves','Log In'));
debug_msg($env,"data = $data");
#debug_msg($env,"data = $data");
#my $response = msg_yn("data",$data);
#debug_msg($env,"Resp $response");
#&endint($env);
} else {
$data = $donext;
}
if ($data eq 'Issues') {
#&startint($env,'Circulation');
$donext=Issue($env); #C4::Circulation::Issues
$donext=Issue($env); #C4::Circulation::Issues
#debug_msg("","do next $donext");
#&endint($env);
} elsif ($data eq 'Returns') {
#&startint($env,'Circulation');
$donext=Returns($env); #C4::Circulation::Returns
$donext=Returns($env); #C4::Circulation::Returns
#&endint($env);
} elsif ($data eq 'Borrower Enquiries'){
#&startint($env,'Circulation');
$donext=Borenq($env); #C4::Circulation::Borrower
# $donext=Borenq($env); #C4::Circulation::Borrower - conversion
#&endint($env);
} elsif ($data eq 'Reserves'){
#&startint($env,'Circulation');
$donext=EnterReserves($env); #C4::Reserves
#&endint($env);
$donext=EnterReserves($env); #C4::Reserves
} elsif ($data eq 'Log In') {
&endint($env);
&Login($env); #C4::Security
&startint($env,'Circulation');
# &endint($env); - conversion
# &Login($env); #C4::Security - conversion
# &startint($env,'Circulation'); - conversion
} elsif ($data eq 'Quit') {
$donext = $data;
}
#debug_msg($env,"donext - $donext");
debug_msg($env,"donext - $donext");
}
&endint($env)
#&endint($env)
}

24
C4/Circulation/Borrower.pm

@ -8,7 +8,7 @@ require Exporter;
use DBI;
use C4::Database;
use C4::Accounts;
use C4::Interface;
use C4::InterfaceCDK;
use C4::Circulation::Main;
use C4::Circulation::Issues;
use C4::Scan;
@ -69,10 +69,9 @@ sub findborrower {
my $book;
while (($bornum eq '') && ($reason eq "")) {
#get borrowerbarcode from scanner
titlepanel($env,$env->{'sysarea'},"Borrower Entry");
($borcode,$reason,$book)=&C4::Circulation::Main::scanborrower();
my $title = titlepanel($env,$env->{'sysarea'},"Borrower Entry");
($borcode,$reason,$book)=&C4::Circulation::Main::scanborrower($env);
#C4::Circulation::Main
# debug_msg($env,"Reaz = $reason");
if ($reason eq "") {
if ($borcode ne '') {
($bornum,$borrower) = findoneborrower($env,$dbh,$borcode);
@ -98,6 +97,8 @@ sub findborrower {
}
my $issuesallowed;
if ($reason eq "") {
$env->{'bornum'} = $bornum;
$env->{'bcard'} = $borrower->{'cardnumber'};
my $borrowers=join(' ',($borrower->{'title'},$borrower->{'firstname'},$borrower->{'surname'}));
# output(1,1,$borrowers);
$issuesallowed = &checktraps($env,$dbh,$bornum,$borrower);
@ -112,6 +113,7 @@ sub findoneborrower {
my $bornum;
my $borrower;
my $ucborcode = uc $borcode;
my $lcborcode = lc $borcode;
my $sth=$dbh->prepare("Select * from borrowers where cardnumber='$ucborcode'");
$sth->execute;
if ($borrower=$sth->fetchrow_hashref) {
@ -119,8 +121,11 @@ sub findoneborrower {
$sth->finish;
} else {
$sth->finish;
# my $borquery = "Select * from borrowers
# where surname ~* '$borcode' order by surname";
my $borquery = "Select * from borrowers
where surname ~* '$borcode' order by surname";
where lower(surname) = '$lcborcode' order by surname,firstname";
my $sthb =$dbh->prepare($borquery);
$sthb->execute;
my $cntbor = 0;
@ -162,15 +167,18 @@ sub checktraps {
my $issuesallowed = "1";
#process borrower traps (could be function)
#check first GNA trap (no address this is the 22nd item in the table)
@traps_set;
if ($borrower->{'gonenoaddress'} == 1){
#got to membership update and update member info
output(20,1,"Borrower has no address");
pause();
push (@traps_set,"GNA");
# output(20,1,"Borrower has no address");
#pause();
}
#check if member has a card reported as lost
if ($borrower->{'lost'} ==1){
push (@traps_set,"LOST");
#update member info
output(20,1,"Borrower has lost card");
#output(20,1,"Borrower has lost card");
}
#check the notes field if notes exist display them
if ($borrower->{'borrowernotes'} ne ''){

179
C4/Circulation/Issues.pm

@ -8,7 +8,7 @@ require Exporter;
use DBI;
use C4::Database;
use C4::Accounts;
use C4::Interface;
use C4::InterfaceCDK;
use C4::Circulation::Main;
use C4::Circulation::Borrower;
use C4::Scan;
@ -22,7 +22,7 @@ use Newt qw();
$VERSION = 0.01;
@ISA = qw(Exporter);
@EXPORT = qw(&Issue);
@EXPORT = qw(&Issue &formatitem);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
# your exported package globals go here,
@ -64,91 +64,109 @@ sub Issue {
my $dbh=&C4Connect;
#clear help
helptext('');
clearscreen();
#clearscreen();
my $done;
my ($items,$items2);
my ($items,$items2,$amountdue);
$env->{'sysarea'} = "Issues";
my ($bornum,$issuesallowed,$borrower,$reason) = &findborrower($env,$dbh);
$done = "Issues";
while ($done eq "Issues") {
my ($bornum,$issuesallowed,$borrower,$reason) = &findborrower($env,$dbh);
#C4::Circulation::Borrowers
if ($reason ne "") {
clearscreen();
$done = $reason;
} else {
#deal with alternative loans
#now check items
clearscreen();
($items,$items2)=C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
$done = "No";
my $row2=5;
my $it2p=0;
while ($done eq 'No'){
($done,$items2,$row2,$it2p) =&processitems($env,$bornum,$borrower,$items,$items2,$row2,$it2p);
}
debug_msg("","after processitems done = $done");
}
if ($reason ne "") {
$done = $reason;
} else {
$env->{'bornum'} = $bornum;
$env->{'bcard'} = $borrower->{'cardnumber'};
#deal with alternative loans
#now check items
($items,$items2)=
C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
$done = "No";
my $it2p=0;
while ($done eq 'No'){
($done,$items2,$it2p) =
&processitems($env,$bornum,$borrower,$items,
$items2,$it2p,$amountdue);
}
#debug_msg("","after processitems done = $done");
}
#debug_msg($env,"after borrd $done");
}
$dbh->disconnect;
# if ($done ne 'Circ'){
# debug_msg("","calling issue again with $done");
# $done=Issue($env);
# }
# if ($done ne 'Quit'){
# debug_msg("","returning $done");
# return($done); #to C4::Circulation
# }
return ($done);
return ($done);
}
sub processitems {
#process a users items
# clearscreen();
# output(1,1,"Processing Items");
helptext("F11 Ends processing for current borrower F10 ends issues");
my ($env,$bornum,$borrower,$items,$items2,$row2,$it2p)=@_;
my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue)=@_;
my $dbh=&C4Connect;
my $row=5;
# my $count=$$items;
my $i=0;
my $amountdue = 0;
# my @date;
my ($itemnum,$reason) = issuewindow($env,'Issues',$items,$items2,$borrower,
fmtdec($env,$amountdue,"32"));
# my $amountdue = 0;
my ($itemnum,$reason) =
issuewindow($env,'Issues',$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
if ($itemnum ne ""){
my ($item,$charge,$datedue) = &issueitem($env,$dbh,$itemnum,$bornum,$items);
if ($item) {
debug_msg("","date $datedue");
# $items2->[$it2p] =
# (fmtstr($env,$item->{'title'},"L23")." ".fmtdec($env,$charge,"22")." ".$datedue);
$items2->[$it2p] = $datedue." ".
fmtstr($env,$item->{'title'},"L55")." ".fmtdec($env,$charge,"22");
$i++;
$amountdue += $charge;
}
if ($datedue ne "") {
my $line = formatline($env,$item,$datedue,$charge);
#$datedue." ".$item->{'title'}.", ".$item->{'author'};
#my $iclass = $item->{'itemtype'};
#if ($item->{'dewey'} > 0) {
# $iclass = $iclass.$item->{'dewey'}.$item->{'subclass'};
#};
#my $llen = 65 - length($iclass);
#my $line = fmtstr($env,$line,"L".$llen);
#my $line = $line." $iclass ";
#my $line = $line.fmtdec($env,$charge,"22");
#$items2->[$it2p] = $datedue." ".
# fmtstr($env,$item->{'title'},"L55")." ".fmtdec($env,$charge,"22");
$items2->[$it2p] = $line;
$it2p++;
$amountdue += $charge;
}
}
$dbh->disconnect;
#check to see if more books to process for this user
my @done;
if ($reason eq 'Finished user'){
return('New borrower');
remoteprint($env,$items2,$borrower);
@done = ("Issues");
} elsif ($reason eq "Print"){
remoteprint($env,$items2,$borrower);
@done = ("No",$items2,$it2p);
} else {
if ($reason ne 'Finished issues'){
#return No to let them know that we wish to process more Items for borrower
return('No',$items2,$row2,$it2p);
@done = ("No",$items2,$it2p);
} else {
return('Circ');
@done = ("Circ");
}
}
#debug_msg($env, "return from issues $done[0]");
return @done;
}
sub formatitem {
my ($env,$item,$datedue,$charge) = @_;
my $line = $datedue." ".$item->{'title'}.", ".$item->{'author'};
my $iclass = $item->{'itemtype'};
if ($item->{'dewey'} > 0) {
$iclass = $iclass.$item->{'dewey'}.$item->{'subclass'};
};
my $llen = 65 - length($iclass);
my $line = fmtstr($env,$line,"L".$llen);
my $line = $line." $iclass ";
my $line = $line.fmtdec($env,$charge,"22");
return $line;
}
sub issueitem{
my ($env,$dbh,$itemnum,$bornum,$items)=@_;
$itemnum=uc $itemnum;
my $canissue = 1;
## my ($itemnum,$reason)=&scanbook();
my $query="Select * from items,biblio where (barcode='$itemnum') and
(items.biblionumber=biblio.biblionumber)";
my $query="Select * from items,biblio,biblioitems where (barcode='$itemnum') and
(items.biblionumber=biblio.biblionumber) and
(items.biblioitemnumber=biblioitems.biblioitemnumber) ";
my $item;
my $charge;
my $datedue;
@ -158,21 +176,27 @@ sub issueitem{
$sth->finish;
#check if item is restricted
if ($item->{'restricted'} == 1 ){
error_msg($env,"Restricted Item");
#output(20,1,"whoop whoop restricted");
#check borrowers status to take out restricted items
# if borrower allowed {
# $canissue = 1
# } else {
# $canissue = 0
# }
} else {
#check if item is on issue already
error_msg($env,"Restricted Item");
#check borrowers status to take out restricted items
# if borrower allowed {
# $canissue = 1
# } else {
# $canissue = 0
# }
}
#check if item is on issue already
if ($canissue == 1) {
my $currbor = &C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
if ($currbor ne "") {$canissue = 0;};
}
if ($canissue == 1) {
#check reserve
my $resbor = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
#if charge deal with it
}
my $resbor;
$resbor = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
if ($resbor ne "") {$canissue = 0;};
}
#if charge deal with it
if ($canissue == 1) {
$charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
}
@ -181,12 +205,14 @@ sub issueitem{
$datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
#debug_msg("","date $datedue");
&UpdateStats($env,$env->{'branchcode'},'issue');
}
} else {
debug_msg($env,"can't issue");
}
} else {
error_msg($env,"$itemnum not found - rescan");
}
$sth->finish;
# debug_msg("","date $datedue");
debug_msg($env,"date $datedue");
return($item,$charge,$datedue);
}
@ -204,9 +230,7 @@ sub updateissues{
}
$sth->finish;
my $ti = time;
my $datedue = time + ($loanlength * 86400) ;
my $datedue = time + ($loanlength * 86400);
my @datearr = localtime($datedue);
my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
$query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
@ -214,9 +238,10 @@ sub updateissues{
my $sth=$dbh->prepare($query);
$sth->execute;
$sth->finish;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
$datedue="$mday-$mon-$year";
return($datedue);
#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
my $dateret=$datearr[3]."-".($datearr[4]+1)."-".(1900+$datearr[5]);
debug_msg($env,"returning $dateret");
return($dateret);
}
sub calc_charges {

17
C4/Circulation/Main.pm

@ -11,7 +11,7 @@ use C4::Circulation::Returns;
use C4::Circulation::Renewals;
use C4::Circulation::Borrower;
use C4::Reserves;
use C4::Interface;
use C4::InterfaceCDK;
use C4::Security;
use C4::Format;
@ -61,9 +61,10 @@ my $priv_func = sub {
sub pastitems{
#Get list of all items borrower has currently on issue
my ($env,$bornum,$dbh)=@_;
my $sth=$dbh->prepare("Select * from issues,items,biblio
my $sth=$dbh->prepare("Select * from issues,items,biblio,biblioitems
where borrowernumber=$bornum and issues.itemnumber=items.itemnumber
and items.biblionumber=biblio.biblionumber
and biblioitems.biblioitemnumber=items.biblioitemnumber
and returndate is null
order by date_due");
$sth->execute;
@ -75,9 +76,11 @@ sub pastitems{
$items[0]=" "x72;
$items2[0]=" "x72;
while (my $data=$sth->fetchrow_hashref) {
my $line = "$data->{'date_due'} $data->{'title'}";
my $line = C4::Issues::formatitem($env,$data,$data->{'date_due'},"");
#my $line = "$data->{'date_due'} $data->{'title'}";
# $items[$i]=fmtstr($env,$line,"L29");
$items[$i]=fmtstr($env,$line,"L72");
#$items[$i]=fmtstr($env,$line,"L72");
$items[$i]=$line;
$i++;
}
return(\@items,\@items2);
@ -105,9 +108,10 @@ sub previousissue {
from issues,borrowers where
issues.itemnumber='$itemnum' and
issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
NULL");
NULL");
$sth->execute;
my $borrower=$sth->fetchrow_hashref;
my $cannissue = 0;
$sth->finish;
if ($borrower->{'borrowernumber'} ne ''){
if ($bornum eq $borrower->{'borrowernumber'}){
@ -123,9 +127,6 @@ NULL");
my $resp = &msg_yn($text,"Mark as returned?");
if ($resp == "y") {
&returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
# can issue
} else {
# can't issue
}
}
}

2
C4/Circulation/Renewals.pm

@ -8,7 +8,7 @@ require Exporter;
use DBI;
use C4::Database;
use C4::Accounts;
use C4::Interface;
use C4::InterfaceCDK;
use C4::Circulation::Renewals;
use C4::Scan;
use C4::Stats;

3
C4/Circulation/Returns.pm

@ -8,7 +8,7 @@ require Exporter;
use DBI;
use C4::Database;
use C4::Accounts;
use C4::Interface;
use C4::InterfaceCDK;
use C4::Circulation::Main;
use C4::Format;
use C4::Scan;
@ -120,6 +120,7 @@ sub checkissue {
(borrowernumber = '$issuerec->{'borrowernumber'}')";
my $sth= $dbh->prepare($query);
$sth->execute;
$env->{'bornum'}=$issuerec->{'borrowernumber'};
$borrower = $sth->fetchrow_hashref;
$bornum = $issuerec->{'borrowernumber'};
$itemno = $issuerec->{'itemnumber'};

84
C4/Interface/AccountsCDK.pm

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

239
C4/Interface/ReserveentCDK.pm

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

328
C4/InterfaceCDK.pm

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

4
C4/Print.pm

@ -2,7 +2,7 @@ package C4::Print; #asummes C4/Print.pm
use strict;
require Exporter;
use C4::Interface;
use C4::InterfaceCDK;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ -49,7 +49,7 @@ my $priv_func = sub {
sub remoteprint {
my ($env,$items,$borrower)=@_;
debug_msg("","In print");
#debug_msg($env,"In print");
my $file=time;
open (FILE,">/tmp/$file");
my $i=0;

50
C4/Reserves.pm

@ -8,8 +8,8 @@ require Exporter;
use DBI;
use C4::Database;
use C4::Format;
use C4::Interface;
use C4::Interface::Reserveentry;
use C4::InterfaceCDK;
use C4::Interface::ReserveentCDK;
use C4::Circulation::Main;
use C4::Circulation::Borrower;
use C4::Search;
@ -57,13 +57,13 @@ my $priv_func = sub {
sub EnterReserves{
my ($env)=@_;
titlepanel($env,"Reserves","Enter Selection");
my $titlepanel = titlepanel($env,"Reserves","Enter Selection");
my @flds = ("No of entries","Barcode","ISBN","Title","Keywords","Author","Subject");
my @fldlens = ("5","15","15","50","50","50","50");
my ($reason,$num,$itemnumber,$isbn,$title,$keyword,$author,$subject) =
FindBiblioScreen($env,"Reserves",7,\@flds,\@fldlens);
my $donext ="Circ";
if ($reason ne "1") {
if ($reason ne "") {
$donext = $reason;
} else {
my %search;
@ -79,7 +79,7 @@ sub EnterReserves{
$num = 30;
}
my $offset = 0;
titlepanel($env,"Reserves","Searching");
my $title = titlepanel($env,"Reserves","Searching");
if ($itemnumber ne '' || $isbn ne ''){
($count,@results)=&CatSearch($env,'precise',\%search,$num,$offset);
} else {
@ -106,36 +106,46 @@ sub EnterReserves{
my $line;
while ($i < $no_ents) {
my @ents = split("\t",@results[$i]);
$line = fmtstr($env,@ents[1],"L60");
my $auth = substr(@ents[2],0,20);
substr($line,(60-length($auth)-2),length($auth)+2) = " ".$auth;
$line = fmtstr($env,@ents[1],"L70");
my $auth = substr(@ents[2],0,30);
substr($line,(70-length($auth)-2),length($auth)+2) = " ".$auth;
@bibtitles[$i]=$line;
$biblio_xref{$line}=@ents[0];
$i++;
}
titlepanel($env,"Reserves","Select Title");
my ($results,$bibres) = SelectBiblio($env,$count,\@bibtitles);
if ($results == 1) {
my $title = titlepanel($env,"Reserves","Select Title");
my ($results,$bibres) = SelectBiblio($env,$count,\@bibtitles);
if ($results eq "") {
$biblionumber = $biblio_xref{$bibres};
if ($biblionumber eq "") {
error_msg($env,"No item selected");
} else {
$donext = $results;
}
} else {
$donext = $results;
}
}
debug_msg($env,"Do Next $donext");
debug_msg($env,"Biblio $biblionumber ");
if ($biblionumber eq "") {
error_msg($env,"No items found");
} else {
debug_msg($env,"getting items ");
my @items = GetItems($env,$biblionumber);
my $cnt_it = @items;
debug_msg($env,"got items ");
my $cnt_it = @items;
my $dbh = &C4Connect;
debug_msg($env,"select biblio $biblionumber ");
my $query = "Select * from biblio where biblionumber = $biblionumber";
my $sth = $dbh->prepare($query);
$sth->execute;
my $data=$sth->fetchrow_hashref;
$sth->finish;
my @branches;
debug_msg($env,"select branches ");
my $query = "select * from branches order by branchname";
my $sth=$dbh->prepare($query);
$sth->execute;
@ -147,9 +157,9 @@ sub EnterReserves{
$sth->finish;
$donext = "";
while ($donext eq "") {
clearscreen();
titlepanel($env,"Reserves","Create Reserve");
my ($reason,$borcode,$branch,$constraint,$bibitems) =
my $title = titlepanel($env,"Reserves","Create Reserve");
debug_msg($env,"make reserves");
my ($reason,$borcode,$branch,$constraint,$bibitems) =
MakeReserveScreen($env, $data, \@items, \@branches);
my ($borrnum,$borrower) = findoneborrower($env,$dbh,$borcode);
if ($reason eq "") {

31
C4/Search.pm

@ -7,7 +7,7 @@ use strict;
require Exporter;
use DBI;
use C4::Database;
use C4::Interface;
use C4::InterfaceCDK;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
@ -149,7 +149,7 @@ sub CatSearch {
$search->{'subject'}=uc $search->{'subject'};
$query=$query." ((lower(catalogueentry.catalogueentry) = lower(bibliosubject.subject))
and (lower(catalogueentry.catalogueentry) like
lower('$search->{'subject'}%'))
lower('$search->{'subject'}%'))
and (entrytype = 's'))";
}
}
@ -161,11 +161,36 @@ lower('$search->{'subject'}%'))
items.biblionumber=biblio.biblionumber ";
}
if ($search->{'isbn'} ne ''){
my $search2=uc $search->{'isbn'};
#
# Commented code does not work properly, but would be much faster
# if it did
# Can't make it returne the biblionumber properly
#
#my $query1 = "select biblionumber from biblioitems where isbn='$search2'";
#debug_msg($env,$query1);
#my $sth1=$dbh->prepare($query);
#$sth1->execute;
#my @biblioarr;
#my $bibcnt=0;
#while (my @data=$sth1->fetchrow_array) {
# debug_msg($env,$data[0]);
# @biblioarr[$bibcnt] =
# "biblio.biblionumber = '".$data[0]."'";
# $bibcnt++;
#};
#$sth1->finish();
#my $bibsel = join(" or ",@biblioarr);
#debug_msg($env,$bibsel);
#$query = "select count(*) from items,biblio,biblioitems ";
#$query=$query." where ($bibsel) ";
#$query=$query." and items.biblionumber=biblioitems.biblionumber and";
#$query=$query." biblioitems.biblionumber=biblio.biblionumber";
$query="select count(*) from items,biblio,biblioitems ";
my $search2=uc $search->{'isbn'};
$query=$query." where biblioitems.isbn='$search2' and
items.biblioitemnumber=biblioitems.biblioitemnumber
and biblioitems.biblionumber=biblio.biblionumber";
and biblioitems.biblionumber=biblio.biblionumber";
}
}
#print $query;

Loading…
Cancel
Save