--- /dev/null
+package C4::Accounts; #asummes C4/Accounts
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Format;
+use C4::Search;
+use C4::Stats;
+use C4::InterfaceCDK;
+use C4::Interface::AccountsCDK;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&checkaccount &reconcileaccount &getnextacctno);
+%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 displayaccounts{
+ my ($env)=@_;
+}
+
+sub checkaccount {
+ #take borrower number
+ #check accounts and list amounts owing
+ my ($env,$bornumber,$dbh)=@_;
+ my $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
+ borrowernumber=$bornumber and amountoutstanding<>0");
+ $sth->execute;
+ my $total=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $total=$total+$data->{'sum(amountoutstanding)'};
+ }
+ $sth->finish;
+ # output(1,2,"borrower owes $total");
+ #if ($total > 0){
+ # # output(1,2,"borrower owes $total");
+ # if ($total > 5){
+ # reconcileaccount($env,$dbh,$bornumber,$total);
+ # }
+ #}
+ # pause();
+ return($total);
+}
+
+sub reconcileaccount {
+ #print put money owing give person opportunity to pay it off
+ my ($env,$dummy,$bornumber,$total)=@_;
+ my $dbh = &C4Connect;
+ #get borrower record
+ my $sth=$dbh->prepare("select * from borrowers
+ where borrowernumber=$bornumber");
+ $sth->execute;
+ my $borrower=$sth->fetchrow_hashref;
+ $sth->finish();
+ #get borrower information
+ $sth=$dbh->prepare("Select * from accountlines where
+ borrowernumber=$bornumber and amountoutstanding<>0 order by date");
+ $sth->execute;
+ #display account information
+ &clearscreen();
+ #&helptext('F11 quits');
+ output(20,0,"Accounts");
+ my @accountlines;
+ my $row=4;
+ my $i=0;
+ my $text;
+ #output (1,2,"Account Info");
+ #output (1,3,"Item\tDate \tAmount\tDescription");
+ while (my $data=$sth->fetchrow_hashref){
+ my $line=$i+1;
+ my $amount=0+$data->{'amountoutstanding'};
+ my $itemdata = itemnodata($env,$dbh,$data->{'itemnumber'});
+ $line= $data->{'accountno'}." ".$data->{'date'}." ".$data->{'accounttype'}." ";
+ my $title = $itemdata->{'title'};
+ if (length($title) > 15 ) {$title = substr($title,0,15);}
+ $line= $line.$itemdata->{'barcode'}." $title ".$data->{'description'};
+ $line = fmtstr($env,$line,"L65")." ".fmtdec($env,$amount,"52");
+ push @accountlines,$line;
+ $i++;
+ }
+ #get amount paid and update database
+ my ($data,$reason)=
+ &accountsdialog($env,"Payment Entry",$borrower,\@accountlines,$total);
+ if ($data>0) {
+ &recordpayment($env,$bornumber,$dbh,$data);
+ #Check if the borrower still owes
+ $total=&checkaccount($env,$bornumber,$dbh);
+ }
+ $dbh->disconnect;
+ return($total);
+
+}
+
+sub recordpayment{
+ #here we update both the accountoffsets and the account lines
+ my ($env,$bornumber,$dbh,$data)=@_;
+ my $updquery = "";
+ my $newamtos = 0;
+ my $accdata = "";
+ my $amountleft = $data;
+ # begin transaction
+# my $sth = $dbh->prepare("begin");
+# $sth->execute;
+ my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
+ # get lines with outstanding amounts to offset
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornumber') and (amountoutstanding<>0)
+ order by date";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ # offset transactions
+ while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft = $amountleft - $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{accountno};
+ $updquery = "update accountlines set amountoutstanding= '$newamtos'
+ where (borrowernumber = '$bornumber') and (accountno='$thisacct')";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ $updquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values ($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos)";
+ my $usth = $dbh->prepare($updquery);
+# print $updquery
+ $usth->execute;
+ $usth->finish;
+ }
+ # create new line
+ #$updquery = "insert into accountlines (borrowernumber,
+ #accountno,date,amount,description,accounttype,amountoutstanding) values
+ #($bornumber,$nextaccntno,datetime('now'::abstime),0-$data,'Payment,thanks',
+ #'Pay',0-$amountleft)";
+ $updquery = "insert into accountlines
+ (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
+ values ($bornumber,$nextaccntno,now(),0-$data,'Payment,thanks',
+ 'Pay',0-$amountleft)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ UpdateStats($env,'branch','payment',$data)
+# $sth->finish;
+# $query = "commit";
+# $sth = $dbh->prepare;
+# $sth->execute;
+# $sth-finish;
+}
+
+sub getnextacctno {
+ my ($env,$bornumber,$dbh)=@_;
+ my $nextaccntno = 1;
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornumber')
+ order by accountno desc";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ if (my $accdata=$sth->fetchrow_hashref){
+ $nextaccntno = $accdata->{'accountno'} + 1;
+ }
+ $sth->finish;
+ return($nextaccntno);
+}
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Accounts2; #asummes C4/Accounts2
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Stats;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&recordpayment &fixaccounts &makepayment);
+%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 displayaccounts{
+ my ($env)=@_;
+}
+
+sub recordpayment{
+ #here we update both the accountoffsets and the account lines
+ my ($env,$bornumber,$data)=@_;
+ my $dbh=C4Connect;
+ my $updquery = "";
+ my $newamtos = 0;
+ my $accdata = "";
+ my $amountleft = $data;
+ # begin transaction
+ my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
+ # get lines with outstanding amounts to offset
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornumber') and (amountoutstanding<>0)
+ order by date";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ # offset transactions
+ while (($accdata=$sth->fetchrow_hashref) and ($amountleft>0)){
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft = $amountleft - $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{accountno};
+ $updquery = "update accountlines set amountoutstanding= '$newamtos'
+ where (borrowernumber = '$bornumber') and (accountno='$thisacct')";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ $updquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values ($bornumber,$accdata->{'accountno'},$nextaccntno,$newamtos)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ # create new line
+ $updquery = "insert into accountlines
+ (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
+ values ($bornumber,$nextaccntno,now(),0-$data,'Payment,thanks',
+ 'Pay',0-$amountleft)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ UpdateStats($env,'branch','payment',$data);
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub makepayment{
+ #here we update both the accountoffsets and the account lines
+ my ($bornumber,$accountno,$amount,$user)=@_;
+ my $env;
+ my $dbh=C4Connect;
+ # begin transaction
+ my $nextaccntno = getnextacctno($env,$bornumber,$dbh);
+ my $newamtos=0;
+ my $updquery="Update accountlines set amountoutstanding=0 where
+ borrowernumber=$bornumber and accountno=$accountno";
+ my $sth=$dbh->prepare($updquery);
+ $sth->execute;
+ $sth->finish;
+# print $updquery;
+ $updquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values ($bornumber,$accountno,$nextaccntno,$newamtos)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ # create new line
+ my $payment=0-$amount;
+ $updquery = "insert into accountlines
+ (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
+ values ($bornumber,$nextaccntno,now(),$payment,'Payment,thanks - $user', 'Pay',0)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ UpdateStats($env,$user,'payment',$amount);
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub getnextacctno {
+ my ($env,$bornumber,$dbh)=@_;
+ my $nextaccntno = 1;
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornumber')
+ order by accountno desc";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ if (my $accdata=$sth->fetchrow_hashref){
+ $nextaccntno = $accdata->{'accountno'} + 1;
+ }
+ $sth->finish;
+ return($nextaccntno);
+}
+
+sub fixaccounts {
+ my ($borrowernumber,$accountno,$amount)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from accountlines where borrowernumber=$borrowernumber
+ and accountno=$accountno";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ my $diff=$amount-$data->{'amount'};
+ my $outstanding=$data->{'amountoutstanding'}+$diff;
+ $sth->finish;
+ $query="Update accountlines set amount='$amount',amountoutstanding='$outstanding' where
+ borrowernumber=$borrowernumber and accountno=$accountno";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+ }
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Acquisitions; #asummes C4/Acquisitions.pm
+
+use strict;
+require Exporter;
+use C4::Database;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&getorders &bookseller &breakdown &basket &newbasket &bookfunds
+&ordersearch &newbiblio &newbiblioitem &newsubject &newsubtitle &neworder
+ &newordernum &modbiblio &modorder &getsingleorder &invoice &receiveorder
+ &bookfundbreakdown &curconvert &updatesup &insertsup &makeitems &modbibitem
+&getcurrencies &modsubtitle &modsubject &modaddauthor &moditem &countitems
+&findall &needsmod &delitem &delbibitem &delbiblio &delorder &branches
+&getallorders &updatecurrencies &getorder);
+%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 getorders {
+ my ($supplierid)=@_;
+ my $dbh=C4Connect;
+ my $query = "Select count(*),authorisedby,entrydate,basketno from aqorders where
+ booksellerid='$supplierid' and (datereceived = '0000-00-00' or
+ datereceived is NULL) and (cancelledby is NULL or cancelledby = '')";
+ $query.=" group by basketno order by entrydate";
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return ($i,\@results);
+}
+
+sub itemcount{
+ my ($biblio)=@_;
+ my $dbh=C4Connect;
+ my $query="Select count(*) from items where biblionumber=$biblio";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data->{'count(*)'});
+}
+
+sub getorder{
+ my ($bi,$bib)=@_;
+ my $dbh=C4Connect;
+ my $query="Select ordernumber from aqorders where biblionumber=$bib and
+ biblioitemnumber='$bi'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $ordnum=$sth->fetchrow_hashref;
+ $sth->finish;
+ my $order=getsingleorder($ordnum->{'ordernumber'});
+ $dbh->disconnect;
+# print $query;
+ return ($order);
+}
+
+sub getsingleorder {
+ my ($ordnum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
+ where aqorders.ordernumber=$ordnum
+ and biblio.biblionumber=aqorders.biblionumber and
+ biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
+ aqorders.ordernumber=aqorderbreakdown.ordernumber";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+sub invoice {
+ my ($invoice)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from aqorders,biblio,biblioitems where
+ booksellerinvoicenumber='$invoice'
+ and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
+ aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber";
+ my $i=0;
+ my @results;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub getallorders {
+ #gets all orders from a certain supplier, orders them alphabetically
+ my ($supid)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
+ and (cancelledby is NULL or cancelledby = '')
+ and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
+ aqorders.biblioitemnumber
+ group by aqorders.biblioitemnumber
+ order by
+ biblio.title";
+ my $i=0;
+ my @results;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub ordersearch {
+ my ($search,$biblio,$catview)=@_;
+ my $dbh=C4Connect;
+ my $query="Select *,biblio.title from aqorders,biblioitems,biblio
+ where aqorders.biblioitemnumber=
+ biblioitems.biblioitemnumber and biblio.biblionumber=aqorders.biblionumber
+ and (datecancellationprinted is NULL or datecancellationprinted =
+'000-00-00')
+ and ((";
+ my @data=split(' ',$search);
+ my $count=@data;
+ for (my $i=0;$i<$count;$i++){
+ $query.= "(biblio.title like '$data[$i]%' or biblio.title like '% $data[$i]%') and ";
+ }
+ $query=~ s/ and $//;
+ $query.=" ) or biblioitems.isbn='$search'
+ or (aqorders.ordernumber='$search' and aqorders.biblionumber='$biblio')) ";
+ if ($catview ne 'yes'){
+ $query.=" and (quantityreceived < quantity or quantityreceived is NULL)";
+ }
+ $query.=" group by aqorders.ordernumber";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ my $sth2=$dbh->prepare("Select * from biblio where
+ biblionumber='$data->{'biblionumber'}'");
+ $sth2->execute;
+ my $data2=$sth2->fetchrow_hashref;
+ $sth2->finish;
+ $data->{'author'}=$data2->{'author'};
+ $data->{'seriestitle'}=$data2->{'seriestitle'};
+ $sth2=$dbh->prepare("Select * from aqorderbreakdown where
+ ordernumber=$data->{'ordernumber'}");
+ $sth2->execute;
+ $data2=$sth2->fetchrow_hashref;
+ $sth2->finish;
+ $data->{'branchcode'}=$data2->{'branchcode'};
+ $data->{'bookfundid'}=$data2->{'bookfundid'};
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+
+sub bookseller {
+ my ($searchstring)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from aqbooksellers where name like '%$searchstring%' or
+ id = '$searchstring'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub breakdown {
+ my ($id)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from aqorderbreakdown where ordernumber='$id'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+sub basket {
+ my ($basketno)=@_;
+ my $dbh=C4Connect;
+ my $query="Select *,biblio.title from aqorders,biblio,biblioitems
+ where basketno='$basketno'
+ and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
+ =aqorders.biblioitemnumber
+ and (datecancellationprinted is NULL or datecancellationprinted =
+ '0000-00-00')
+ group by aqorders.ordernumber";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+# print $query;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub newbasket {
+ my $dbh=C4Connect;
+ my $query="Select max(basketno) from aqorders";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_arrayref;
+ my $basket=$$data[0];
+ $basket++;
+ $sth->finish;
+ $dbh->disconnect;
+ return($basket);
+}
+
+sub bookfunds {
+ my $dbh=C4Connect;
+ my $query="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
+ =aqbudget.bookfundid group by aqbookfund.bookfundid order by bookfundname";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub branches {
+ my $dbh=C4Connect;
+ my $query="Select * from branches";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub bookfundbreakdown {
+ my ($id)=@_;
+ my $dbh=C4Connect;
+ my $query="Select quantity,datereceived,freight,unitprice,listprice
+ from aqorders,aqorderbreakdown where bookfundid='$id' and
+ aqorders.ordernumber=aqorderbreakdown.ordernumber and entrydate >=
+ '2000-07-01' ";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $comtd=0;
+ my $spent=0;
+ while (my $data=$sth->fetchrow_hashref){
+ if ($data->{'datereceived'} =~ /0000/){
+ $comtd+=($data->{'listprice'}+$data->{'freight'})*$data->{'quantity'};
+ } else {
+ $spent+=($data->{'unitprice'}+$data->{'freight'})*$data->{'quantity'};
+ }
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($spent,$comtd);
+}
+
+
+sub newbiblio {
+ my ($title,$author,$copyright)=@_;
+ my $dbh=C4Connect;
+ my $query="Select max(biblionumber) from biblio";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_arrayref;
+ my $bibnum=$$data[0];
+ $bibnum++;
+ $sth->finish;
+ $query="insert into biblio (biblionumber,title,author,copyrightdate) values
+ ($bibnum,'$title','$author','$copyright')";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+ return($bibnum);
+}
+
+sub modbiblio {
+ my ($bibnum,$title,$author,$copyright,$seriestitle,$serial,$unititle,$notes)=@_;
+ my $dbh=C4Connect;
+# $title=~ s/\'/\\\'/g;
+# $author=~ s/\'/\\\'/g;
+ my $query="update biblio set title='$title',
+ author='$author',copyrightdate='$copyright',
+ seriestitle='$seriestitle',serial='$serial',unititle='$unititle',notes='$notes'
+ where
+ biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+ return($bibnum);
+}
+
+sub modsubtitle {
+ my ($bibnum,$subtitle)=@_;
+ my $dbh=C4Connect;
+ my $query="update bibliosubtitle set subtitle='$subtitle' where biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub modaddauthor {
+ my ($bibnum,$author)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from additionalauthors where biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my $data=$sth->fetchrow_hashref){
+ $query="update additionalauthors set author='$author' where biblionumber=$bibnum";
+ } else {
+ $query="insert into additionalauthors (author,biblionumber) values ('$author','$bibnum')";
+ }
+ $sth->finish;
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub modsubject {
+ my ($bibnum,$force,@subject)=@_;
+ my $dbh=C4Connect;
+ my $count=@subject;
+ my $error;
+ for (my $i=0;$i<$count;$i++){
+ $subject[$i]=~ s/^ //g;
+ $subject[$i]=~ s/ $//g;
+ my $query="select * from catalogueentry where entrytype='s' and
+ catalogueentry='$subject[$i]'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my $data=$sth->fetchrow_hashref){
+
+ } else {
+ if ($force eq $subject[$i]){
+ #subject not in aut, chosen to force anway
+ #so insert into cataloguentry so its in auth file
+ $query="Insert into catalogueentry (entrytype,catalogueentry)
+ values ('s','$subject[$i]')";
+ my $sth2=$dbh->prepare($query);
+# print $query;
+ $sth2->execute;
+ $sth2->finish;
+ } else {
+ $error="$subject[$i]\n does not exist in the subject authority file";
+ $query= "Select * from catalogueentry where
+ entrytype='s' and (catalogueentry like '$subject[$i] %' or
+ catalogueentry like '% $subject[$i] %' or catalogueentry like
+ '% $subject[$i]')";
+ my $sth2=$dbh->prepare($query);
+# print $query;
+ $sth2->execute;
+ while (my $data=$sth2->fetchrow_hashref){
+ $error=$error."<br>$data->{'catalogueentry'}";
+ }
+ $sth2->finish;
+# $error=$error."<br>$query";
+ }
+ }
+ $sth->finish;
+ }
+ if ($error eq ''){
+ my $query="Delete from bibliosubject where biblionumber=$bibnum";
+# print $query;
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ for (my $i=0;$i<$count;$i++){
+ $sth=$dbh->prepare("Insert into bibliosubject values ('$subject[$i]',$bibnum)");
+# print $subject[$i];
+ $sth->execute;
+ $sth->finish;
+ }
+ }
+ $dbh->disconnect;
+ return($error);
+}
+
+sub modbibitem {
+ my ($bibitemnum,$itemtype,$isbn,$publishercode,$publicationdate,$classification,$dewey,$subclass,$illus,$pages,$volumeddesc,$notes,$size,$place)=@_;
+ my $dbh=C4Connect;
+ my $query="update biblioitems set itemtype='$itemtype',
+ isbn='$isbn',publishercode='$publishercode',publicationyear='$publicationdate',
+ classification='$classification',dewey='$dewey',subclass='$subclass',illus='$illus',
+ pages='$pages',volumeddesc='$volumeddesc',notes='$notes',size='$size',place='$place'
+ where
+ biblioitemnumber=$bibitemnum";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub newbiblioitem {
+ my ($bibnum,$itemtype,$isbn,$volinf,$class)=@_;
+ my $dbh=C4Connect;
+ my $query="Select max(biblioitemnumber) from biblioitems";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_arrayref;
+ my $bibitemnum=$$data[0];
+ $bibitemnum++;
+ $sth->finish;
+ $query="insert into biblioitems (biblionumber,biblioitemnumber,
+ itemtype,isbn,volumeddesc,classification)
+ values
+ ($bibnum,$bibitemnum,'$itemtype','$isbn','$volinf','$class')";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+ return($bibitemnum);
+}
+
+sub newsubject {
+ my ($bibnum)=@_;
+ my $dbh=C4Connect;
+ my $query="insert into bibliosubject (biblionumber) values
+ ($bibnum)";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub newsubtitle {
+ my ($bibnum)=@_;
+ my $dbh=C4Connect;
+ my $query="insert into bibliosubtitle (biblionumber) values
+ ($bibnum)";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub neworder {
+ my ($bibnum,$title,$ordnum,$basket,$quantity,$listprice,$supplier,$who,
+ $notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst)=@_;
+ my $dbh=C4Connect;
+ my $query="insert into aqorders (biblionumber,title,basketno,
+ quantity,listprice,booksellerid,entrydate,requisitionedby,authorisedby,notes,
+ biblioitemnumber,rrp,ecost,gst)
+ values
+ ($bibnum,'$title',$basket,$quantity,$listprice,'$supplier',now(),
+ '$who','$who','$notes',$bibitemnum,'$rrp','$ecost','$gst')";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $query="select * from aqorders where
+ biblionumber=$bibnum and basketno=$basket and ordernumber >=$ordnum";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $ordnum=$data->{'ordernumber'};
+ $query="insert into aqorderbreakdown (ordernumber,bookfundid) values
+ ($ordnum,'$bookfund')";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub delorder {
+ my ($bibnum,$ordnum)=@_;
+ my $dbh=C4Connect;
+ my $query="update aqorders set datecancellationprinted=now()
+ where biblionumber='$bibnum' and
+ ordernumber='$ordnum'";
+ my $sth=$dbh->prepare($query);
+ print $query;
+ $sth->execute;
+ $sth->finish;
+ my $count=itemcount($bibnum);
+ if ($count == 0){
+ delbiblio($bibnum);
+ }
+ $dbh->disconnect;
+}
+
+sub modorder {
+ my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst)=@_;
+ my $dbh=C4Connect;
+ my $query="update aqorders set title='$title',
+ quantity='$quantity',listprice='$listprice',basketno='$basketno',
+ rrp='$rrp',ecost='$ecost'
+ where
+ ordernumber=$ordnum and biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $query="update aqorderbreakdown set bookfundid=$bookfund where
+ ordernumber=$ordnum";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub newordernum {
+ my $dbh=C4Connect;
+ my $query="Select max(ordernumber) from aqorders";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_arrayref;
+ my $ordnum=$$data[0];
+ $ordnum++;
+ $sth->finish;
+ $dbh->disconnect;
+ return($ordnum);
+}
+
+sub receiveorder {
+ my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund)=@_;
+ my $dbh=C4Connect;
+ my $query="update aqorders set quantityreceived='$quantrec',
+ datereceived=now(),booksellerinvoicenumber='$invoiceno',
+ biblioitemnumber=$bibitemno,unitprice='$cost',freight='$freight'
+ where biblionumber=$biblio and ordernumber=$ordnum
+ ";
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $query="update aqorderbreakdown set bookfundid=$bookfund where
+ ordernumber=$ordnum";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub curconvert {
+ my ($currency,$price)=@_;
+ my $dbh=C4Connect;
+ my $query="Select rate from currency where currency='$currency'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ my $cur=$data->{'rate'};
+ if ($cur==0){
+ $cur=1;
+ }
+ my $price=$price / $cur;
+ return($price);
+}
+
+sub getcurrencies {
+ my $dbh=C4Connect;
+ my $query="Select * from currency";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+sub updatecurrencies {
+ my ($currency,$rate)=@_;
+ my $dbh=C4Connect;
+ my $query="update currency set rate=$rate where currency='$currency'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub updatesup {
+ my ($data)=@_;
+ my $dbh=C4Connect;
+ my $query="Update aqbooksellers set
+ name='$data->{'name'}',address1='$data->{'address1'}',address2='$data->{'address2'}',
+ address3='$data->{'address3'}',address4='$data->{'address4'}',postal='$data->{'postal'}',
+ phone='$data->{'phone'}',fax='$data->{'fax'}',url='$data->{'url'}',
+ contact='$data->{'contact'}',contpos='$data->{'contpos'}',
+ contphone='$data->{'contphone'}', contfax='$data->{'contfax'}', contaltphone=
+ '$data->{'contaltphone'}', contemail='$data->{'contemail'}', contnotes=
+ '$data->{'contnotes'}', active=$data->{'active'},
+ listprice='$data->{'listprice'}', invoiceprice='$data->{'invoiceprice'}',
+ gstreg=$data->{'gstreg'}, listincgst=$data->{'listincgst'},
+ invoiceincgst=$data->{'invoiceincgst'}, specialty='$data->{'specialty'}',
+ discount='$data->{'discount'}'
+ where id='$data->{'id'}'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+# print $query;
+}
+
+sub insertsup {
+ my ($data)=@_;
+ my $dbh=C4Connect;
+ my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
+ $sth->execute;
+ my $data2=$sth->fetchrow_hashref;
+ $sth->finish;
+ $data2->{'max(id)'}++;
+ $sth=$dbh->prepare("Insert into aqbooksellers (id) values ($data2->{'max(id)'})");
+ $sth->execute;
+ $sth->finish;
+ $data->{'id'}=$data2->{'max(id)'};
+ $dbh->disconnect;
+ updatesup($data);
+ return($data->{'id'});
+}
+
+sub makeitems {
+ my
+($count,$bibitemno,$biblio,$replacement,$price,$booksellerid,$branch,$loan,@barcodes)=@_;
+ my $dbh=C4Connect;
+ my $sth=$dbh->prepare("Select max(itemnumber) from items");
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ my $item=$data->{'max(itemnumber)'};
+ $sth->finish;
+ $item++;
+ my $error;
+ for (my $i=0;$i<$count;$i++){
+ $barcodes[$i]=uc $barcodes[$i];
+ my $query="Insert into items (biblionumber,biblioitemnumber,itemnumber,barcode,
+ booksellerid,dateaccessioned,homebranch,holdingbranch,price,replacementprice,
+ replacementpricedate,notforloan) values
+ ($biblio,$bibitemno,$item,'$barcodes[$i]','$booksellerid',now(),'$branch',
+ '$branch','$price','$replacement',now(),$loan)";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $error.=$sth->errstr;
+ $sth->finish;
+ $item++;
+# print $query;
+ }
+ $dbh->disconnect;
+ return($error);
+}
+
+sub moditem {
+ my ($loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn)=@_;
+ my $dbh=C4Connect;
+ my $query="update items set biblioitemnumber=$bibitemnum,
+ barcode='$barcode',itemnotes='$notes'
+ where itemnumber=$itemnum";
+ if ($barcode eq ''){
+ $query="update items set biblioitemnumber=$bibitemnum,notforloan=$loan where itemnumber=$itemnum";
+ }
+ if ($lost ne ''){
+ $query="update items set biblioitemnumber=$bibitemnum,
+ barcode='$barcode',itemnotes='$notes',homebranch='$homebranch',
+ itemlost='$lost',wthdrawn='$wthdrawn' where itemnumber=$itemnum";
+ }
+
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub countitems{
+ my ($bibitemnum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data->{'count(*)'});
+}
+
+sub findall {
+ my ($biblionumber)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from biblioitems,items,itemtypes where
+ biblioitems.biblionumber=$biblionumber
+ and biblioitems.biblioitemnumber=items.biblioitemnumber and
+ itemtypes.itemtype=biblioitems.itemtype
+ order by items.biblioitemnumber";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return(@results);
+}
+
+sub needsmod{
+ my ($bibitemnum,$itemtype)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from biblioitems where biblioitemnumber=$bibitemnum
+ and itemtype='$itemtype'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $result=0;
+ if (my $data=$sth->fetchrow_hashref){
+ $result=1;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($result);
+}
+
+sub delitem{
+ my ($itemnum)=@_;
+ my $dbh=C4Connect;
+ my $query="select * from items where itemnumber=$itemnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @data=$sth->fetchrow_array;
+ $sth->finish;
+ $query="Insert into deleteditems values (";
+ foreach my $temp (@data){
+ $query=$query."'$temp',";
+ }
+ $query=~ s/\,$/\)/;
+# print $query;
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $query = "Delete from items where itemnumber=$itemnum";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub delbibitem{
+ my ($itemnum)=@_;
+ my $dbh=C4Connect;
+ my $query="select * from biblioitems where biblioitemnumber=$itemnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my @data=$sth->fetchrow_array){
+ $sth->finish;
+ $query="Insert into deletedbiblioitems values (";
+ foreach my $temp (@data){
+ $temp=~ s/\'/\\\'/g;
+ $query=$query."'$temp',";
+ }
+ $query=~ s/\,$/\)/;
+# print $query;
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $query = "Delete from biblioitems where biblioitemnumber=$itemnum";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub delbiblio{
+ my ($biblio)=@_;
+ my $dbh=C4Connect;
+ my $query="select * from biblio where biblionumber=$biblio";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my @data=$sth->fetchrow_array){
+ $sth->finish;
+ $query="Insert into deletedbiblio values (";
+ foreach my $temp (@data){
+ $temp=~ s/\'/\\\'/g;
+ $query=$query."'$temp',";
+ }
+ $query=~ s/\,$/\)/;
+# print $query;
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $query = "Delete from biblio where biblionumber=$biblio";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+package C4::Circmain; #asummes C4/Circulation
+
+#package to deal with circulation
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Circulation::Main;
+use C4::Circulation::Issues;
+use C4::Circulation::Returns;
+use C4::Circulation::Renewals;
+use C4::Circulation::Borrower;
+use C4::Reserves;
+use C4::InterfaceCDK;
+use C4::Security;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&Start_circ);
+%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 Start_circ{
+ my ($env)=@_;
+ #connect to database
+ #start interface
+ &startint($env,'Circulation');
+ getbranch($env);
+ getprinter($env);
+ my $donext = 'Circ';
+ my $reason;
+ my $data;
+ while ($donext ne 'Quit') {
+ if ($donext eq "Circ") {
+ #($reason,$data) = menu($env,'console','Circulation',
+ # ('Issues','Returns','Borrower Enquiries','Reserves','Log In'));
+ #&startint($env,"Menu");
+ ($reason,$data) = menu($env,'console','Circulation',
+ ('Issues','Returns','Select Branch','Select Printer'));
+ } else {
+ $data = $donext;
+ }
+ if ($data eq 'Issues') {
+ $donext=Issue($env); #C4::Circulation::Issues
+ } elsif ($data eq 'Returns') {
+ $donext=Returns($env); #C4::Circulation::Returns
+ } elsif ($data eq 'Select Branch') {
+ getbranch($env);
+ } elsif ($data eq 'Select Printer') {
+ getprinter($env);
+ } elsif ($data eq 'Borrower Enquiries') {
+ # $donext=Borenq($env); #C4::Circulation::Borrower - conversion
+ } elsif ($data eq 'Reserves'){
+ $donext=EnterReserves($env); #C4::Reserves
+ } elsif ($data eq 'Quit') {
+ $donext = $data;
+ }
+ }
+ &endint($env)
+}
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation; #asummes C4/Circulation
+
+#package to deal with circulation
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Circulation::Issues;
+use C4::Circulation::Returns;
+use C4::Circulation::Renewals;
+use C4::Circulation::Borrower;
+use C4::Reserves;
+#use C4::Interface;
+use C4::Security;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&Start_circ &scanborrower);
+#@EXPORT = qw(&Start_circ checkoverdues);
+%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 Start_circ{
+ my ($env)=@_;
+ #connect to database
+ #start interface
+ &startint($env,'Circulation');
+ my $donext = 'Circ';
+ my $reason;
+ my $data;
+ while ($donext ne 'Quit') {
+ if ($donext eq "Circ") {
+ clearscreen();
+ ($reason,$data) = menu($env,'console','Circulation',
+ ('Issues','Returns','Borrower Enquiries','Reserves','Log In'));
+ #debug_msg($env,"data = $data");
+ } else {
+ $data = $donext;
+ }
+ if ($data eq 'Issues') {
+ $donext=Issue($env); #C4::Circulation::Issues
+ #debug_msg("","do next $donext");
+ } elsif ($data eq 'Returns') {
+ $donext=Returns($env); #C4::Circulation::Returns
+ } elsif ($data eq 'Borrower Enquiries'){
+ $donext=Borenq($env); #C4::Circulation::Borrower
+ } elsif ($data eq 'Reserves'){
+ $donext=EnterReserves($env); #C4::Reserves
+ } elsif ($data eq 'Log In') {
+ &endint($env);
+ &Login($env); #C4::Security
+ &startint($env,'Circulation');
+ } elsif ($data eq 'Quit') {
+ $donext = $data;
+ }
+ #debug_msg($env,"donext - $donext");
+ }
+ &endint($env)
+}
+
+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
+ where borrowernumber=$bornum and issues.itemnumber=items.itemnumber
+ and items.biblionumber=biblio.biblionumber
+ and returndate is null
+ order by date_due");
+ $sth->execute;
+ my $i=0;
+ my @items;
+ my @items2;
+ #$items[0]=" "x29;
+ #$items2[0]=" "x29;
+ $items[0]=" "x72;
+ $items2[0]=" "x72;
+ while (my $data=$sth->fetchrow_hashref) {
+ my $line = "$data->{'date_due'} $data->{'title'}";
+ # $items[$i]=fmtstr($env,$line,"L29");
+ $items[$i]=fmtstr($env,$line,"L72");
+ $i++;
+ }
+ return(\@items,\@items2);
+ $sth->finish;
+}
+
+sub checkoverdues{
+ #checks whether a borrower has overdue items
+ my ($env,$bornum,$dbh)=@_;
+ my $sth=$dbh->prepare("Select * from issues,items,biblio where
+ borrowernumber=$bornum and issues.itemnumber=items.itemnumber and
+ items.biblionumber=biblio.biblionumber");
+ $sth->execute;
+ my $row=1;
+ my $col=40;
+ while (my $data=$sth->fetchrow_hashref){
+ output($row,$col,$data->{'title'});
+ $row++;
+ }
+ $sth->finish;
+}
+
+sub previousissue {
+ my ($env,$itemnum,$dbh,$bornum)=@_;
+ my $sth=$dbh->prepare("Select firstname,surname,issues.borrowernumber,cardnumber,returndate
+ from issues,borrowers where
+ issues.itemnumber='$itemnum' and
+ issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
+NULL");
+ $sth->execute;
+ my $borrower=$sth->fetchrow_hashref;
+ $sth->finish;
+ if ($borrower->{'borrowernumber'} ne ''){
+ if ($bornum eq $borrower->{'borrowernumber'}){
+ # no need to issue
+ my ($renewstatus) = &renewstatus($env,$dbh,$bornum,$itemnum);
+ my $resp = &msg_yn("Book is issued to this borrower", "Renew?");
+ if ($resp == "y") {
+ &renewbook($env,$dbh,$bornum,$itemnum);
+ }
+
+ } else {
+ my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
+ my $resp = &msg_yn($text,"Mark as returned?");
+ if ($resp == "y") {
+ &returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
+ # can issue
+ } else {
+ # can't issue
+ }
+ }
+ }
+ return($borrower->{'borrowernumber'});
+ $sth->finish;
+}
+
+
+sub checkreserve{
+ # Check for reserves for biblio
+ # does not look at constraints yet
+ my ($env,$dbh,$itemnum)=@_;
+ my $resbor = "";
+ my $query = "select * from reserves,items
+ where (items.itemnumber = '$itemnum')
+ and (items.biblionumber = reserves.biblionumber)
+ and (reserves.found is null) order by priority";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ if (my $data=$sth->fetchrow_hashref) {
+ $resbor = $data->{'borrowernumber'};
+ }
+ return ($resbor);
+ $sth->finish;
+}
+
+sub checkwaiting{
+ # check for reserves waiting
+ my ($env,$dbh,$bornum)=@_;
+ my @itemswaiting="";
+ my $query = "select * from reserves
+ where (borrowernumber = '$bornum')
+ and (reserves.found='W')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ if (my $data=$sth->fetchrow_hashref) {
+ push @itemswaiting,$data->{'itemnumber'};
+ }
+ return (\@itemswaiting);
+ $sth->finish;
+}
+
+sub scanbook {
+ my ($env,$interface)=@_;
+ #scan barcode
+ my ($number,$reason)=dialog("Book Barcode:");
+ $number=uc $number;
+ return ($number,$reason);
+}
+
+sub scanborrower {
+ my ($env,$interface)=@_;
+ #scan barcode
+ my ($number,$reason,$book)=&borrower_dialog($env); #C4::Interface
+ $number= $number;
+ $book=uc $book;
+ return ($number,$reason,$book);
+}
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Borrissues; #assumes C4/Circulation/Borrissues
+
+#package to deal with Issues
+#written 3/11/99 by chris@katipo.co.nz
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Print;
+use C4::Format;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&printallissues);
+%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 printallissues {
+ my ($env,$borrower)=@_;
+ my @issues;
+ my $dbh=C4Connect;
+ my $query = "select * from issues,items,biblioitems,biblio
+ where borrowernumber = '$borrower->{'borrowernumber'}'
+ and (returndate is null)
+ and (issues.itemnumber = items.itemnumber)
+ and (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and (items.biblionumber = biblio.biblionumber)
+ order by date_due";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $x;
+ while (my $data = $sth->fetchrow_hashref) {
+ @issues[$x] =$data;
+ $x++;
+ }
+ $sth->finish();
+ $dbh->disconnect();
+ remoteprint ($env,\@issues,$borrower);
+}
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Borrower; #assumes C4/Circulation/Borrower
+
+#package to deal with Issues
+#written 3/11/99 by chris@katipo.co.nz
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Accounts;
+use C4::InterfaceCDK;
+use C4::Interface::FlagsCDK;
+use C4::Circulation::Main;
+use C4::Circulation::Issues;
+use C4::Circulation::Renewals;
+use C4::Scan;
+use C4::Search;
+use C4::Stats;
+use C4::Format;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&findborrower &Borenq &findoneborrower &NewBorrowerNumber
+&findguarantees);
+%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 findborrower {
+ my ($env,$dbh) = @_;
+ C4::InterfaceCDK::helptext('');
+ C4::InterfaceCDK::clearscreen();
+ my $bornum = "";
+ my $sth = "";
+ my $borcode = "";
+ my $borrower;
+ my $reason = "";
+ my $book;
+ while (($bornum eq '') && ($reason eq "")) {
+ #get borrowerbarcode from scanner
+ my $title = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Borrower Entry");
+ if ($env->{'newborrower'} eq "") {
+ ($borcode,$reason,$book)=&C4::Circulation::Main::scanborrower($env);
+ } else {
+ $borcode = $env->{'newborrower'};
+ $reason = "";
+ $book = "";
+ $env->{'newborrower'}= "";
+ }
+ #C4::Circulation::Main
+ if ($reason eq "") {
+ if ($borcode ne '') {
+ ($bornum,$borrower) = findoneborrower($env,$dbh,$borcode);
+ $env->{'IssuesAllowed'} = 1;
+ } elsif ($book ne "") {
+ my $query = "select * from issues,items where (barcode = '$book')
+ and (items.itemnumber = issues.itemnumber)
+ and (issues.returndate is null)";
+ my $iss_sth=$dbh->prepare($query);
+ $iss_sth->execute;
+ if (my $issdata = $iss_sth->fetchrow_hashref) {
+ $bornum=$issdata->{'borrowernumber'};
+ $sth = $dbh->prepare("Select * from borrowers
+ where borrowernumber = '$bornum'");
+ $sth->execute;
+ $borrower=$sth->fetchrow_hashref;
+ $sth->finish;
+ } else {
+ error_msg($env,"Item $book not found");
+ }
+ $iss_sth->finish;
+ }
+ }
+ }
+ my ($issuesallowed,$owing);
+ if ($reason eq "") {
+ $env->{'bornum'} = $bornum;
+ $env->{'bcard'} = $borrower->{'cardnumber'};
+ my $borrowers=join(' ',($borrower->{'title'},$borrower->{'firstname'},$borrower->{'surname'}));
+ my $odues;
+ ($issuesallowed,$odues,$owing) = &checktraps($env,$dbh,$bornum,$borrower);
+# error_msg ($env,"bcard = $env->{'bcard'}");
+ }
+ #debug_msg ($env,"2 = $env->{'IssuesAllowed'}");
+ return ($bornum, $issuesallowed,$borrower,$reason,$owing);
+};
+
+
+sub findoneborrower {
+ # output(1,1,$borcode);
+ my ($env,$dbh,$borcode)=@_;
+ 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) {
+ $bornum=$borrower->{'borrowernumber'};
+ $sth->finish;
+ } else {
+ $sth->finish;
+ # my $borquery = "Select * from borrowers
+ # where surname ~* '$borcode' order by surname";
+
+ my $borquery = "Select * from borrowers
+ where lower(surname) like \"$lcborcode%\" order by surname,firstname";
+ my $sthb =$dbh->prepare($borquery);
+ $sthb->execute;
+ my $cntbor = 0;
+ my @borrows;
+ my @bornums;
+ while ($borrower= $sthb->fetchrow_hashref) {
+ my $line = $borrower->{'cardnumber'}.' '.$borrower->{'categorycode'}.' '.$borrower->{'surname'}.
+ ', '.$borrower->{'othernames'};
+ $borrows[$cntbor] = fmtstr($env,$line,"L50");
+ $bornums[$cntbor] =$borrower->{'borrowernumber'};
+ $cntbor++;
+ }
+ if ($cntbor == 1) {
+ $bornum = $bornums[0];
+ my $query = "select * from borrowers where borrowernumber = '$bornum'";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+ $borrower =$sth->fetchrow_hashref;
+ $sth->finish;
+ } elsif ($cntbor > 0) {
+ my ($cardnum) = C4::InterfaceCDK::selborrower($env,$dbh,\@borrows,\@bornums);
+ my $query = "select * from borrowers where cardnumber = '$cardnum'";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+ $borrower =$sth->fetchrow_hashref;
+ $sth->finish;
+ $bornum=$borrower->{'borrowernumber'};
+ #C4::InterfaceCDK::clearscreen();
+ if ($bornum eq '') {
+ error_msg($env,"Borrower not found");
+ }
+ }
+ }
+ return ($bornum,$borrower);
+}
+sub checktraps {
+ my ($env,$dbh,$bornum,$borrower) = @_;
+ my $issuesallowed = "1";
+ #my @traps_set;
+ #check amountowing
+ my $traps_done;
+ my $odues;
+ my $amount;
+ while ($traps_done ne "DONE") {
+ my @traps_set;
+ $amount=C4::Accounts::checkaccount($env,$bornum,$dbh); #from C4::Accounts
+ if ($amount > 0) { push (@traps_set,"CHARGES");}
+ if ($borrower->{'gonenoaddress'} == 1){ push (@traps_set,"GNA");}
+ #check if member has a card reported as lost
+ if ($borrower->{'lost'} ==1){push (@traps_set,"LOST");}
+ #check the notes field if notes exist display them
+ if ($borrower->{'borrowernotes'} ne ''){ push (@traps_set,"NOTES");}
+ #check if borrower has overdue items
+ #call overdue checker
+ my $odues = &C4::Circulation::Main::checkoverdues($env,$bornum,$dbh);
+ if ($odues > 0) {push (@traps_set,"ODUES");}
+ #check if borrower has any items waiting
+ my ($nowaiting,$itemswaiting) = &C4::Circulation::Main::checkwaiting($env,$dbh,$bornum);
+ if ($nowaiting > 0) { push (@traps_set,"WAITING"); }
+ if (@traps_set[0] ne "" ) {
+ ($issuesallowed,$traps_done,$amount,$odues) =
+ process_traps($env,$dbh,$bornum,$borrower,
+ $amount,$odues,\@traps_set,$itemswaiting);
+ } else {
+ $traps_done = "DONE";
+ }
+ }
+ return ($issuesallowed, $odues,$amount);
+}
+
+sub process_traps {
+ my ($env,$dbh,$bornum,$borrower,$amount,$odues,$traps_set,$waiting) = @_;
+ my $issuesallowed = 1;
+ my $x = 0;
+ my %traps;
+ while (@$traps_set[$x] ne "") {
+ $traps{@$traps_set[$x]} = 1;
+ $x++;
+ }
+ my $traps_done;
+ my $trapact;
+ my $issues;
+ while ($trapact ne "NONE") {
+ $trapact = &trapscreen($env,$bornum,$borrower,$amount,$traps_set);
+ if ($trapact eq "CHARGES") {
+ C4::Accounts::reconcileaccount($env,$dbh,$bornum,$amount,$borrower,$odues);
+ ($odues,$issues,$amount)=borrdata2($env,$bornum);
+ if ($amount <= 0) {
+ $traps{'CHARGES'} = 0;
+ my @newtraps;
+ $x =0;
+ while ($traps_set->[$x] ne "") {
+ if ($traps_set->[$x] ne "CHARGES") {
+ push @newtraps,$traps_set->[$x];
+ }
+ $x++;
+ }
+ $traps_set = \@newtraps;
+ }
+ } elsif ($trapact eq "WAITING") {
+ reserveslist($env,$borrower,$amount,$odues,$waiting);
+ } elsif ($trapact eq "ODUES") {
+ C4::Circulation::Renewals::bulkrenew($env,$dbh,$bornum,$amount,$borrower,$odues);
+ ($odues,$issues,$amount)=borrdata2($env,$bornum);
+ if ($odues == 0) {
+ $traps{'ODUES'} = 0;
+ my @newtraps;
+ $x =0;
+ while ($traps_set->[$x] ne "") {
+ if ($traps_set->[$x] ne "ODUES") {
+ push @newtraps,$traps_set->[$x];
+ }
+ $x++;
+ }
+ $traps_set = \@newtraps;
+ }
+ } elsif ($trapact eq "NOTES") {
+ my $notes = trapsnotes($env,$bornum,$borrower,$amount);
+ if ($notes ne $borrower->{'borrowernotes'}) {
+ my $query = "update borrowers set borrowernotes = '$notes'
+ where borrowernumber = $bornum";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ $sth->finish();
+ $borrower->{'borrowernotes'} = $notes;
+ }
+ if ($notes eq "") {
+ $traps{'NOTES'} = 0;
+ my @newtraps;
+ $x =0;
+ while ($traps_set->[$x] ne "") {
+ if ($traps_set->[$x] ne "NOTES") {
+ push @newtraps,$traps_set->[$x];
+ }
+ $x++;
+ }
+ $traps_set = \@newtraps;
+ }
+ }
+ my $notr = @$traps_set;
+ if ($notr == 0) {
+ $trapact = "NONE";
+ }
+ $traps_done = "DONE";
+ }
+ if ($traps{'GNA'} eq 1 ) {
+ $issuesallowed=0;
+ $env->{'IssuesAllowed'} = 0;
+ }
+ if ($traps{'CHARGES'} eq 1) {
+ if ($amount > 5) {
+ $env->{'IssuesAllowed'} = 0;
+ $issuesallowed=0;
+ }
+ }
+ return ($issuesallowed,$traps_done,$amount,$odues);
+} # end of process_traps
+
+sub Borenq {
+ my ($env)=@_;
+ my $dbh=C4Connect;
+ #get borrower guff
+ my $bornum;
+ my $issuesallowed;
+ my $borrower;
+ my $reason;
+ $env->{'sysarea'} = "Enquiries";
+ while ($reason eq "") {
+ $env->{'sysarea'} = "Enquiries";
+ ($bornum,$issuesallowed,$borrower,$reason) = &findborrower($env,$dbh);
+ if ($reason eq "") {
+ my ($data,$reason)=&borrowerwindow($env,$borrower);
+ if ($reason eq 'Modify'){
+ modifyuser($env,$borrower);
+ $reason = "";
+ } elsif ($reason eq 'New'){
+ $reason = "";
+ }
+ }
+ $dbh->disconnect;
+ }
+ return $reason;
+}
+
+sub modifyuser {
+ my ($env,$borrower) = @_;
+ debug_msg($env,"Please use intranet");
+ #return;
+}
+
+sub reserveslist {
+ my ($env,$borrower,$amount,$odues,$waiting) = @_;
+ my $dbh=C4Connect;
+ my @items;
+ my $x=0;
+ my $query="Select * from reserves where
+ borrowernumber='$borrower->{'borrowernumber'}' and found='W' and
+ cancellationdate is null order by timestamp";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ my $itemdata = itemnodata($env,$dbh,$data->{'itemnumber'});
+ if ($itemdata){
+ push @items,$itemdata;
+ }
+ }
+ $sth->finish;
+ reservesdisplay($env,$borrower,$amount,$odues,\@items);
+ $dbh->disconnect;
+}
+
+sub NewBorrowerNumber {
+ my $dbh=C4Connect;
+ my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers");
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $data->{'max(borrowernumber)'}++;
+ return($data->{'max(borrowernumber)'});
+ $dbh->disconnect;
+}
+
+sub findguarantees{
+ my ($bornum)=@_;
+ my $dbh=C4Connect;
+ my $query="select cardnumber,borrowernumber from borrowers where
+ guarantor='$bornum'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @dat;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $dat[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@dat);
+}
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Fines; #asummes C4/Circulation/Fines
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine);
+%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 Getoverdues{
+ my $dbh=C4Connect;
+ my $query="Select * from issues where date_due < now() and returndate is
+ NULL order by borrowernumber";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+# print @results;
+ return($i,\@results);
+}
+
+sub CalcFine {
+ my ($itemnumber,$bortype,$difference)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from items,biblioitems,itemtypes,categoryitem where items.itemnumber=$itemnumber
+ and items.biblioitemnumber=biblioitems.biblioitemnumber and
+ biblioitems.itemtype=itemtypes.itemtype and
+ categoryitem.itemtype=itemtypes.itemtype and
+ categoryitem.categorycode='$bortype' and items.itemlost <> 1";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ my $amount=0;
+ my $printout;
+ if ($difference == $data->{'firstremind'}){
+ $amount=$data->{'fine'};
+ $printout="First Notice";
+ }
+ my $second=$data->{'firstremind'}+$data->{'chargeperiod'};
+ if ($difference == $second){
+ $amount=$data->{'fine'}*2;
+ $printout="Second Notice";
+ }
+ if ($difference == $data->{'accountsent'} && $data->{'fine'} > 0){
+ $amount=5;
+ $printout="Final Notice";
+ }
+ $dbh->disconnect;
+ return($amount,$data->{'chargename'},$printout);
+}
+
+sub UpdateFine {
+ my ($itemnum,$bornum,$amount,$type,$due)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from accountlines where itemnumber=$itemnum and
+ borrowernumber=$bornum and (accounttype='FU' or accounttype='O' or
+ accounttype='F' or accounttype='M')";
+ my $sth=$dbh->prepare($query);
+# print "$query\n";
+ $sth->execute;
+
+ if (my $data=$sth->fetchrow_hashref){
+# print "in accounts ...";
+ if ($data->{'amount'} != $amount){
+
+# print "updating";
+ my $diff=$amount - $data->{'amount'};
+ my $out=$data->{'amountoutstanding'}+$diff;
+ my $query2="update accountlines set date=now(), amount=$amount,
+ amountoutstanding=$out,accounttype='FU' where
+ borrowernumber=$data->{'borrowernumber'} and itemnumber=$data->{'itemnumber'}
+ and (accounttype='FU' or accounttype='O');";
+ my $sth2=$dbh->prepare($query2);
+ $sth2->execute;
+ $sth2->finish;
+ } else {
+# print "no update needed $data->{'amount'}"
+ }
+ } else {
+ my $query2="select title from biblio,items where items.itemnumber=$itemnum
+ and biblio.biblionumber=items.biblionumber";
+ my $sth4=$dbh->prepare($query2);
+ $sth4->execute;
+ my $title=$sth4->fetchrow_hashref;
+ $sth4->finish;
+ # print "not in account";
+ my $query2="Select max(accountno) from accountlines";
+ my $sth3=$dbh->prepare($query2);
+ $sth3->execute;
+ my @accountno=$sth3->fetchrow_array;
+ $sth3->finish;
+ $accountno[0]++;
+ $title->{'title'}=~ s/\'/\\\'/g;
+ $query2="Insert into accountlines
+ (borrowernumber,itemnumber,date,amount,
+ description,accounttype,amountoutstanding,accountno) values
+ ($bornum,$itemnum,now(),$amount,'$type $title->{'title'} $due','FU',
+ $amount,$accountno[0])";
+ my $sth2=$dbh->prepare($query2);
+ $sth2->execute;
+ $sth2->finish;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub BorType {
+ my ($borrowernumber)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from borrowers,categories where
+ borrowernumber=$borrowernumber and
+borrowers.categorycode=categories.categorycode";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+package C4::Circulation::Issues; #asummes C4/Circulation/Issues
+
+#package to deal with Issues
+#written 3/11/99 by chris@katipo.co.nz
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Accounts;
+use C4::InterfaceCDK;
+use C4::Circulation::Main;
+use C4::Circulation::Borrower;
+use C4::Scan;
+use C4::Stats;
+use C4::Print;
+use C4::Format;
+use C4::Input;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&Issue &formatitem);
+%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 Issue {
+ my ($env) = @_;
+ my $dbh=&C4Connect;
+ #clear help
+ helptext('');
+ #clearscreen();
+ my $done;
+ my ($items,$items2,$amountdue);
+ my $itemsdet;
+ $env->{'sysarea'} = "Issues";
+ $done = "Issues";
+ while ($done eq "Issues") {
+ my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = &findborrower($env,$dbh);
+ #C4::Circulation::Borrowers
+ $env->{'loanlength'}="";
+ if ($reason ne "") {
+ $done = $reason;
+ } elsif ($env->{'IssuesAllowed'} eq '0') {
+ error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
+ } 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,$amountdue,$itemsdet) =
+ &processitems($env,$bornum,$borrower,$items,
+ $items2,$it2p,$amountdue,$itemsdet);
+ }
+ #&endint($env);
+ }
+ }
+ $dbh->disconnect;
+ Cdk::refreshCdkScreen();
+ return ($done);
+}
+
+
+sub processitems {
+ #process a users items
+ my ($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet,$odues)=@_;
+ my $dbh=&C4Connect;
+ $env->{'newborrower'} = "";
+ my ($itemnum,$reason) =
+ issuewindow($env,'Issues',$dbh,$items,$items2,$borrower,fmtdec($env,$amountdue,"32"));
+ if ($itemnum eq ""){
+ $reason = "Finished user";
+ } else {
+ my ($item,$charge,$datedue) = &issueitem($env,$dbh,$itemnum,$bornum,$items);
+ if ($datedue ne "") {
+ my $line = formatitem($env,$item,$datedue,$charge);
+ unshift @$items2,$line;
+ #$items2->[$it2p] = $line;
+ $item->{'date_due'} = $datedue;
+ $item->{'charge'} = $charge;
+ $itemsdet->[$it2p] = $item;
+ $it2p++;
+ $amountdue += $charge;
+ }
+ }
+ $dbh->disconnect;
+ #check to see if more books to process for this user
+ my @done;
+ if ($env->{'newborrower'} ne "") {$reason = "Finished user";}
+ if ($reason eq 'Finished user'){
+ if (@$items2[0] ne "") {
+ remoteprint($env,$itemsdet,$borrower);
+ if ($amountdue > 0) {
+ &reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},$amountdue);
+ }
+ }
+ @done = ("Issues");
+ } elsif ($reason eq "Print"){
+ remoteprint($env,$itemsdet,$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
+ @done = ("No",$items2,$it2p,$amountdue,$itemsdet);
+ } else {
+ @done = ("Circ");
+ }
+ }
+ #debug_msg($env, "return from issues $done[0]");
+ $dbh->disconnect;
+ return @done;
+}
+
+sub formatitem {
+ my ($env,$item,$datedue,$charge) = @_;
+ my $line = $datedue." ".$item->{'barcode'}." ".$item->{'title'}.": ".$item->{'author'};
+ my $iclass = $item->{'itemtype'};
+ if ($item->{'dewey'} > 0) {
+ my $dewey = $item->{'dewey'};
+ $dewey =~ s/0*$//;
+ $dewey =~ s/\.$//;
+ $iclass = $iclass.$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,biblioitems where (barcode='$itemnum') and
+ (items.biblionumber=biblio.biblionumber) and
+ (items.biblioitemnumber=biblioitems.biblioitemnumber) ";
+ my $item;
+ my $charge;
+ my $datedue = $env->{'loanlength'};
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if ($item=$sth->fetchrow_hashref) {
+ $sth->finish;
+ #check if item is restricted
+ if ($item->{'notforloan'} == 1) {
+ error_msg($env,"Item Not for Loan");
+ $canissue = 0;
+ } elsif ($item->{'wthdrawn'} == 1) {
+ error_msg($env,"Item Withdrawn");
+ $canissue = 0;
+# } elsif ($item->{'itemlost'} == 1) {
+# error_msg($env,"Item Lost");
+# $canissue = 0;
+ } elsif ($item->{'restricted'} == 1 ){
+ error_msg($env,"Restricted Item");
+ #check borrowers status to take out restricted items
+ # if borrower allowed {
+ # $canissue = 1
+ # } else {
+ $canissue = 0;
+ # }
+ } elsif ($item->{'itemtype'} eq 'REF'){
+ error_msg($env,"Item Not for Loan");
+ $canissue=0;
+ }
+ #check if item is on issue already
+ if ($canissue == 1) {
+ my ($currbor,$issuestat,$newdate) =
+ &C4::Circulation::Main::previousissue($env,$item->{'itemnumber'},$dbh,$bornum);
+ if ($issuestat eq "N") {
+ $canissue = 0;
+ } elsif ($issuestat eq "R") {
+ $canissue = -1;
+ $datedue = $newdate;
+ $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
+ if ($charge > 0) {
+ createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
+ }
+ &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
+ }
+ }
+ if ($canissue == 1) {
+ #check reserve
+ my ($resbor,$resrec) = &C4::Circulation::Main::checkreserve($env,$dbh,$item->{'itemnumber'});
+ #debug_msg($env,$resbor);
+ if ($resbor eq $bornum) {
+ my $rquery = "update reserves
+ set found = 'F'
+ where reservedate = '$resrec->{'reservedate'}'
+ and borrowernumber = '$resrec->{'borrowernumber'}'
+ and biblionumber = '$resrec->{'biblionumber'}'";
+ my $rsth = $dbh->prepare($rquery);
+ $rsth->execute;
+ $rsth->finish;
+ } elsif ($resbor ne "") {
+ my $bquery = "select * from borrowers
+ where borrowernumber = '$resbor'";
+ my $btsh = $dbh->prepare($bquery);
+ $btsh->execute;
+ my $resborrower = $btsh->fetchrow_hashref;
+ my $msgtxt = chr(7)."Res for $resborrower->{'cardnumber'},";
+ $msgtxt = $msgtxt." $resborrower->{'initials'} $resborrower->{'surname'}";
+ my $ans = msg_ny($env,$msgtxt,"Allow issue?");
+ if ($ans eq "N") {
+ # print a docket;
+ printreserve($env,$resrec,$resborrower,$item);
+ $canissue = 0;
+ } else {
+ my $ans = msg_ny($env,"Cancel reserve?");
+ if ($ans eq "Y") {
+ my $rquery = "update reserves
+ set found = 'F'
+ where reservedate = '$resrec->{'reservedate'}'
+ and borrowernumber = '$resrec->{'borrowernumber'}'
+ and biblionumber = '$resrec->{'biblionumber'}'";
+ my $rsth = $dbh->prepare($rquery);
+ $rsth->execute;
+ $rsth->finish;
+ }
+ }
+ $btsh->finish();
+ };
+ }
+ #if charge deal with it
+
+ if ($canissue == 1) {
+ $charge = calc_charges($env,$dbh,$item->{'itemnumber'},$bornum);
+ }
+ if ($canissue == 1) {
+ #now mark as issued
+ $datedue=&updateissues($env,$item->{'itemnumber'},$item->{'biblioitemnumber'},$dbh,$bornum);
+ #debug_msg("","date $datedue");
+ &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$item->{'itemnumber'},$item->{'itemtype'});
+ if ($charge > 0) {
+ createcharge($env,$dbh,$item->{'itemnumber'},$bornum,$charge);
+ }
+ } elsif ($canissue == 0) {
+ info_msg($env,"Can't issue $item->{'cardnumber'}");
+ }
+ } else {
+ my $valid = checkdigit($env,$itemnum);
+ if ($valid ==1) {
+ if (substr($itemnum,0,1) = "V") {
+ #this is a borrower
+ $env->{'newborrower'} = $itemnum;
+ } else {
+ error_msg($env,"$itemnum not found - rescan");
+ }
+ } else {
+ error_msg($env,"Invalid Number");
+ }
+ }
+ $sth->finish;
+ #debug_msg($env,"date $datedue");
+ return($item,$charge,$datedue);
+}
+
+sub createcharge {
+ my ($env,$dbh,$itemno,$bornum,$charge) = @_;
+ my $nextaccntno = getnextacctno($env,$bornum,$dbh);
+ my $query = "insert into accountlines
+ (borrowernumber,itemnumber,accountno,date,amount,
+ description,accounttype,amountoutstanding)
+ values ($bornum,$itemno,$nextaccntno,now(),$charge,'Rental','Rent',$charge)";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+}
+
+
+
+sub updateissues{
+ # issue the book
+ my ($env,$itemno,$bitno,$dbh,$bornum)=@_;
+ my $loanlength=21;
+ my $query="Select * from biblioitems,itemtypes
+ where (biblioitems.biblioitemnumber='$bitno')
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my $data=$sth->fetchrow_hashref) {
+ $loanlength = $data->{'loanlength'}
+ }
+ $sth->finish;
+ my $dateduef;
+ if ($env->{'loanlength'} eq "") {
+ my $ti = time;
+ my $datedue = time + ($loanlength * 86400);
+ my @datearr = localtime($datedue);
+ $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ } else {
+ $dateduef = $env->{'loanlength'};
+ }
+ $query = "Insert into issues (borrowernumber,itemnumber, date_due,branchcode)
+ values ($bornum,$itemno,'$dateduef','$env->{'branchcode'}')";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $query = "Select * from items where itemnumber=$itemno";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $item=$sth->fetchrow_hashref;
+ $sth->finish;
+ $item->{'issues'}++;
+ $query="Update items set issues=$item->{'issues'} where itemnumber=$itemno";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($datedue);
+ my @datearr = split('-',$dateduef);
+ my $dateret = join('-',$datearr[2],$datearr[1],$datearr[0]);
+# debug_msg($env,"query $query");
+ return($dateret);
+}
+
+sub calc_charges {
+ # calculate charges due
+ my ($env, $dbh, $itemno, $bornum)=@_;
+ my $charge=0;
+ my $item_type;
+ my $q1 = "select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
+ where (items.itemnumber ='$itemno')
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth1= $dbh->prepare($q1);
+ $sth1->execute;
+ if (my $data1=$sth1->fetchrow_hashref) {
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
+ my $q2 = "select rentaldiscount from borrowers,categoryitem
+ where (borrowers.borrowernumber = '$bornum')
+ and (borrowers.categorycode = categoryitem.categorycode)
+ and (categoryitem.itemtype = '$item_type')";
+ my $sth2=$dbh->prepare($q2);
+ $sth2->execute;
+ if (my $data2=$sth2->fetchrow_hashref) {
+ my $discount = $data2->{'rentaldiscount'};
+ $charge = ($charge *(100 - $discount)) / 100;
+ }
+ $sth2->{'finish'};
+ }
+ $sth1->finish;
+ return ($charge);
+}
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Main; #asummes C4/Circulation/Main
+
+#package to deal with circulation
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Circulation::Issues;
+use C4::Circulation::Returns;
+use C4::Circulation::Renewals;
+use C4::Circulation::Borrower;
+use C4::Reserves;
+use C4::Search;
+use C4::InterfaceCDK;
+use C4::Security;
+use C4::Format;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&pastitems &checkoverdues &previousissue
+&checkreserve &checkwaiting &scanbook &scanborrower &getbranch &getprinter);
+%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 getbranch {
+ my ($env) = @_;
+ my $dbh = C4Connect;
+ my $query = "select * from branches order by branchcode";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @branches;
+ while (my $data = $sth->fetchrow_hashref) {
+ push @branches,$data;
+ }
+ brmenu ($env,\@branches);
+ my $query = "select * from branches
+ where branchcode = '$env->{'branchcode'}'";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $data = $sth->fetchrow_hashref;
+ $env->{'brdata'} = $data;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub getprinter {
+ my ($env) = @_;
+ my $dbh = C4Connect;
+ my $query = "select * from printers order by printername";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @printers;
+ while (my $data = $sth->fetchrow_hashref) {
+ push @printers,$data;
+ }
+ prmenu ($env,\@printers);
+ $sth->finish;
+ $dbh->disconnect;
+ }
+
+sub pastitems{
+ #Get list of all items borrower has currently on issue
+ my ($env,$bornum,$dbh)=@_;
+ my $query1 = "select * from issues where (borrowernumber=$bornum)
+ and (returndate is null) order by date_due";
+ my $sth=$dbh->prepare($query1);
+ $sth->execute;
+ my $i=0;
+ my @items;
+ my @items2;
+ while (my $data1=$sth->fetchrow_hashref) {
+ my $data = itemnodata($env,$dbh,$data1->{'itemnumber'}); #C4::Search
+ my @date = split("-",$data1->{'date_due'});
+ my $odate = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
+ my $line = C4::Circulation::Issues::formatitem($env,$data,$odate,"");
+ $items[$i]=$line;
+ $i++;
+ }
+ $sth->finish();
+ return(\@items,\@items2);
+}
+
+sub checkoverdues{
+ #checks whether a borrower has overdue items
+ my ($env,$bornum,$dbh)=@_;
+ my @datearr = localtime;
+ my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
+ my $query = "Select count(*) from issues where borrowernumber=$bornum and
+ returndate is NULL and date_due < '$today'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ return $data->{'count(*)'};
+}
+
+sub previousissue {
+ my ($env,$itemnum,$dbh,$bornum)=@_;
+ my $sth=$dbh->prepare("Select
+ firstname,surname,issues.borrowernumber,cardnumber,returndate
+ from issues,borrowers where
+ issues.itemnumber='$itemnum' and
+ issues.borrowernumber=borrowers.borrowernumber
+ and issues.returndate is NULL");
+ $sth->execute;
+ my $borrower=$sth->fetchrow_hashref;
+ my $canissue = "Y";
+ $sth->finish;
+ my $newdate;
+ if ($borrower->{'borrowernumber'} ne ''){
+ if ($bornum eq $borrower->{'borrowernumber'}){
+ # no need to issue
+ my ($renewstatus) = C4::Circulation::Renewals::renewstatus($env,$dbh,$bornum,$itemnum);
+ my ($resbor,$resrec) = checkreserve($env,$dbh,$itemnum);
+ if ($renewstatus == "0") {
+ info_msg($env,"</S>Issued to this borrower - No renewals<!S>");
+ $canissue = "N";
+ } elsif ($resbor ne "") {
+ my $resp = C4::InterfaceCDK::msg_ny($env,"Book is issued to this borrower",
+ "and is reserved - Renew?");
+ if ($resp eq "Y") {
+ $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
+ $canissue = "R";
+ } else {
+ $canissue = "N";
+ }
+ } else {
+ my $resp = C4::InterfaceCDK::msg_yn($env,"Book is issued to this borrower", "Renew?");
+ if ($resp eq "Y") {
+ $newdate = C4::Circulation::Renewals::renewbook($env,$dbh,$bornum,$itemnum);
+ $canissue = "R";
+ } else {
+ $canissue = "N";
+ }
+ }
+ } else {
+ my $text="Issued to $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'})";
+ my $resp = C4::InterfaceCDK::msg_yn($env,$text,"Mark as returned?");
+ if ( $resp eq "Y") {
+ &returnrecord($env,$dbh,$borrower->{'borrowernumber'},$itemnum);
+ } else {
+ $canissue = "N";
+ }
+ }
+ }
+ return($borrower->{'borrowernumber'},$canissue,$newdate);
+}
+
+
+sub checkreserve{
+ # Check for reserves for biblio
+ my ($env,$dbh,$itemnum)=@_;
+ my $resbor = "";
+ my $query = "select * from reserves,items
+ where (items.itemnumber = '$itemnum')
+ and (reserves.cancellationdate is NULL)
+ and (items.biblionumber = reserves.biblionumber)
+ and ((reserves.found = 'W')
+ or (reserves.found is null))
+ order by priority";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $resrec;
+ if (my $data=$sth->fetchrow_hashref) {
+ $resrec=$data;
+ my $const = $data->{'constrainttype'};
+ if ($const eq "a") {
+ $resbor = $data->{'borrowernumber'};
+ } else {
+ my $found = 0;
+ my $cquery = "select * from reserveconstraints,items
+ where (borrowernumber='$data->{'borrowernumber'}')
+ and reservedate='$data->{'reservedate'}'
+ and reserveconstraints.biblionumber='$data->{'biblionumber'}'
+ and (items.itemnumber=$itemnum and
+ items.biblioitemnumber = reserveconstraints.biblioitemnumber)";
+ my $csth = $dbh->prepare($cquery);
+ $csth->execute;
+ if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
+ if ($const eq 'o') {
+ if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
+ } else {
+ if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
+ }
+ $csth->finish();
+ }
+ }
+ $sth->finish;
+ return ($resbor,$resrec);
+}
+
+sub checkwaiting{
+ # check for reserves waiting
+ my ($env,$dbh,$bornum)=@_;
+ my @itemswaiting;
+ my $query = "select * from reserves
+ where (borrowernumber = '$bornum')
+ and (reserves.found='W') and cancellationdate is NULL";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my $cnt=0;
+ if (my $data=$sth->fetchrow_hashref) {
+ @itemswaiting[$cnt] =$data;
+ $cnt ++
+ }
+ $sth->finish;
+ return ($cnt,\@itemswaiting);
+}
+
+sub scanbook {
+ my ($env,$interface)=@_;
+ #scan barcode
+ my ($number,$reason)=dialog("Book Barcode:");
+ $number=uc $number;
+ return ($number,$reason);
+}
+
+sub scanborrower {
+ my ($env,$interface)=@_;
+ #scan barcode
+ my ($number,$reason,$book)=C4::InterfaceCDK::borrower_dialog($env); #C4::InterfaceCDK
+ $number= $number;
+ $book=uc $book;
+ return ($number,$reason,$book);
+}
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Renewals; #assumes C4/Circulation/Renewals
+
+#package to deal with Renewals
+#written 7/11/99 by olwen@katipo.co.nz
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Format;
+use C4::Accounts;
+use C4::InterfaceCDK;
+use C4::Interface::RenewalsCDK;
+use C4::Circulation::Issues;
+use C4::Circulation::Main;
+
+use C4::Search;
+use C4::Scan;
+use C4::Stats;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&renewstatus &renewbook &bulkrenew);
+%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 Return {
+
+}
+
+sub renewstatus {
+ # check renewal status
+ my ($env,$dbh,$bornum,$itemno)=@_;
+ my $renews = 1;
+ my $renewokay = 0;
+ my $q1 = "select * from issues
+ where (borrowernumber = '$bornum')
+ and (itemnumber = '$itemno')
+ and returndate is null";
+ my $sth1 = $dbh->prepare($q1);
+ $sth1->execute;
+ if (my $data1 = $sth1->fetchrow_hashref) {
+ my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
+ where (items.itemnumber = '$itemno')
+ and (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth2 = $dbh->prepare($q2);
+ $sth2->execute;
+ if (my $data2=$sth2->fetchrow_hashref) {
+ $renews = $data2->{'renewalsallowed'};
+ }
+ if ($renews > $data1->{'renewals'}) {
+ $renewokay = 1;
+ }
+ $sth2->finish;
+ }
+ $sth1->finish;
+ return($renewokay);
+}
+
+
+sub renewbook {
+ # mark book as renewed
+ my ($env,$dbh,$bornum,$itemno,$datedue)=@_;
+ if ($datedue eq "" ) {
+ my $loanlength=21;
+ my $query= "Select * from biblioitems,items,itemtypes
+ where (items.itemnumber = '$itemno')
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my $data=$sth->fetchrow_hashref) {
+ $loanlength = $data->{'loanlength'}
+ }
+ $sth->finish;
+ my $ti = time;
+ my $datedu = time + ($loanlength * 86400);
+ my @datearr = localtime($datedu);
+ $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ }
+ my @date = split("-",$datedue);
+ my $odatedue = (@date[2]+0)."-".(@date[1]+0)."-".@date[0];
+ my $issquery = "select * from issues where borrowernumber='$bornum' and
+ itemnumber='$itemno' and returndate is null";
+ my $sth=$dbh->prepare($issquery);
+ $sth->execute;
+ my $issuedata=$sth->fetchrow_hashref;
+ $sth->finish;
+ my $renews = $issuedata->{'renewals'} +1;
+ my $updquery = "update issues
+ set date_due = '$datedue', renewals = '$renews'
+ where borrowernumber='$bornum' and
+ itemnumber='$itemno' and returndate is null";
+ my $sth=$dbh->prepare($updquery);
+
+ $sth->execute;
+ $sth->finish;
+ return($odatedue);
+}
+
+sub bulkrenew {
+ my ($env,$dbh,$bornum,$amount,$borrower,$odues) = @_;
+ my $query = "select * from issues
+ where borrowernumber = '$bornum' and returndate is null order by date_due";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my @items;
+ my @issues;
+ my @renewdef;
+ my $x;
+ my @barcodes;
+ my @rstatuses;
+ while (my $issrec = $sth->fetchrow_hashref) {
+ my $itemdata = C4::Search::itemnodata($env,$dbh,$issrec->{'itemnumber'});
+ my @date = split("-",$issrec->{'date_due'});
+ #my $line = $issrec->{'date_due'}." ";
+ my $line = @date[2]."-".@date[1]."-".@date[0]." ";
+ my $renewstatus = renewstatus($env,$dbh,$bornum,$issrec->{'itemnumber'});
+ my ($resbor,$resrec) = C4::Circulation::Main::checkreserve($env,
+ $dbh,$issrec->{'itemnumber'});
+ if ($resbor ne "") {
+ $line = $line."R";
+ $rstatuses[$x] ="R";
+ } elsif ($renewstatus == 0) {
+ $line = $line."N";
+ $rstatuses[$x] = "N";
+ } else {
+ $line = $line."Y";
+ $rstatuses[$x] = "Y";
+ }
+ $line = $line.fmtdec($env,$issrec->{'renewals'},"20")." ";
+ $line = $line.$itemdata->{'barcode'}." ".$itemdata->{'itemtype'}." ".$itemdata->{'title'};
+ $items[$x] = $line;
+ #debug_msg($env,$line);
+ $issues[$x] = $issrec;
+ $barcodes[$x] = $itemdata->{'barcode'};
+ my $rdef = 1;
+ if ($issrec->{'renewals'} > 0) {
+ $rdef = 0;
+ }
+ $renewdef[$x] = $rdef;
+ $x++;
+ }
+ if ($x < 1) {
+ return;
+ }
+ my $renews = C4::Interface::RenewalsCDK::renew_window($env,
+ \@items,$borrower,$amount,$odues);
+ my $isscnt = $x;
+ $x =0;
+ my $y = 0;
+ my @renew_errors = "";
+ while ($x < $isscnt) {
+ if (@$renews[$x] == 1) {
+ my $issrec = $issues[$x];
+ if ($rstatuses[$x] eq "Y") {
+ renewbook($env,$dbh,$issrec->{'borrowernumber'},$issrec->{'itemnumber'},"");
+ my $charge = C4::Circulation::Issues::calc_charges($env,$dbh,
+ $issrec->{'itemnumber'},$issrec->{'borrowernumber'});
+ if ($charge > 0) {
+ C4::Circulation::Issues::createcharge($env,$dbh,
+ $issrec->{'itemnumber'},$issrec->{'borrowernumber'},$charge);
+ }
+ &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$issrec->{'itemnumber'});
+ } elsif ($rstatuses[$x] eq "N") {
+ C4::InterfaceCDK::info_msg($env,
+ "</S>$barcodes[$x] - can't renew");
+ } else {
+ C4::InterfaceCDK::info_msg($env,
+ "</S>$barcodes[$x] - on reserve");
+ }
+ }
+ $x++;
+ }
+ $sth->finish();
+}
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Renewals2; #assumes C4/Circulation/Renewals2.pm
+
+#package to deal with Renewals
+#written 7/11/99 by olwen@katipo.co.nz
+
+#modified by chris@katipo.co.nz
+#18/1/2000
+#need to update stats with renewals
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Stats;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&renewstatus &renewbook &calc_charges);
+%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 Return {
+
+}
+
+sub renewstatus {
+ # check renewal status
+ my ($env,$bornum,$itemno)=@_;
+ my $dbh=C4Connect;
+ my $renews = 1;
+ my $renewokay = 0;
+ my $q1 = "select * from issues
+ where (borrowernumber = '$bornum')
+ and (itemnumber = '$itemno')
+ and returndate is null";
+ my $sth1 = $dbh->prepare($q1);
+ $sth1->execute;
+ if (my $data1 = $sth1->fetchrow_hashref) {
+ my $q2 = "select renewalsallowed from items,biblioitems,itemtypes
+ where (items.itemnumber = '$itemno')
+ and (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth2 = $dbh->prepare($q2);
+ $sth2->execute;
+ if (my $data2=$sth2->fetchrow_hashref) {
+ $renews = $data2->{'renewalsallowed'};
+ }
+ if ($renews > $data1->{'renewals'}) {
+ $renewokay = 1;
+ }
+ $sth2->finish;
+ }
+ $sth1->finish;
+ $dbh->disconnect;
+ return($renewokay);
+}
+
+
+sub renewbook {
+ # mark book as renewed
+ my ($env,$bornum,$itemno,$datedue)=@_;
+ my $dbh=C4Connect;
+ if ($datedue eq "" ) {
+ #debug_msg($env, "getting date");
+ my $loanlength=21;
+ my $query= "Select * from biblioitems,items,itemtypes
+ where (items.itemnumber = '$itemno')
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my $data=$sth->fetchrow_hashref) {
+ $loanlength = $data->{'loanlength'}
+ }
+ $sth->finish;
+ my $ti = time;
+ my $datedu = time + ($loanlength * 86400);
+ my @datearr = localtime($datedu);
+ $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ }
+ my $issquery = "select * from issues where borrowernumber='$bornum' and
+ itemnumber='$itemno' and returndate is null";
+ my $sth=$dbh->prepare($issquery);
+ $sth->execute;
+ my $issuedata=$sth->fetchrow_hashref;
+ $sth->finish;
+ my $renews = $issuedata->{'renewals'} +1;
+ my $updquery = "update issues
+ set date_due = '$datedue', renewals = '$renews'
+ where borrowernumber='$bornum' and
+ itemnumber='$itemno' and returndate is null";
+ my $sth=$dbh->prepare($updquery);
+ $sth->execute;
+ $sth->finish;
+ UpdateStats($env,$env->{'branchcode'},'renew','','',$itemno);
+ $dbh->disconnect;
+# return();
+}
+
+
+sub calc_charges {
+ # calculate charges due
+ my ($env, $itemno, $bornum)=@_;
+ my $charge=0;
+ my $dbh=C4Connect;
+ my $item_type;
+ my $q1 = "select itemtypes.itemtype,rentalcharge from
+ items,biblioitems,itemtypes
+ where (items.itemnumber ='$itemno')
+ and (biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)";
+ my $sth1= $dbh->prepare($q1);
+ $sth1->execute;
+ if (my $data1=$sth1->fetchrow_hashref) {
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
+ my $q2 = "select rentaldiscount from
+ borrowers,categoryitem
+ where (borrowers.borrowernumber = '$bornum')
+ and (borrowers.categorycode = categoryitem.categorycode)
+ and (categoryitem.itemtype = '$item_type')";
+ my $sth2=$dbh->prepare($q2);
+ $sth2->execute;
+ if (my$data2=$sth2->fetchrow_hashref) {
+ my $discount = $data2->{'rentaldiscount'};
+ $charge = ($charge *(100 - $discount)) / 100;
+ }
+ $sth2->{'finish'};
+ }
+ $sth1->finish;
+ $dbh->disconnect;
+# print "item $item_type";
+ return ($charge,$item_type);
+}
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Circulation::Returns; #assumes C4/Circulation/Returns
+
+#package to deal with Returns
+#written 3/11/99 by olwen@katipo.co.nz
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Accounts;
+use C4::InterfaceCDK;
+use C4::Circulation::Main;
+use C4::Format;
+use C4::Scan;
+use C4::Stats;
+use C4::Search;
+use C4::Print;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&returnrecord &calc_odues &Returns);
+%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 Returns {
+ my ($env)=@_;
+ my $dbh=&C4Connect;
+ my @items;
+ @items[0]=" "x50;
+ my $reason;
+ my $item;
+ my $reason;
+ my $borrower;
+ my $itemno;
+ my $itemrec;
+ my $bornum;
+ my $amt_owing;
+ my $odues;
+ my $issues;
+ my $resp;
+# until (($reason eq "Circ") || ($reason eq "Quit")) {
+ until ($reason ne "") {
+ ($reason,$item) =
+ returnwindow($env,"Enter Returns",
+ $item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
+ #debug_msg($env,"item = $item");
+ #if (($reason ne "Circ") && ($reason ne "Quit")) {
+ if ($reason eq "") {
+ $resp = "";
+ ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
+ checkissue($env,$dbh,$item);
+ if ($bornum ne "") {
+ ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
+ } else {
+ $issues = "";
+ $odues = "";
+ $amt_owing = "";
+ }
+ if ($resp ne "") {
+ #if ($resp eq "Returned") {
+ if ($itemno ne "" ) {
+ my $item = itemnodata($env,$dbh,$itemno);
+ my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
+ unshift @items,$fmtitem;
+ if ($items[20] > "") {
+ pop @items;
+ }
+ }
+ #} elsif ($resp ne "") {
+ # error_msg($env,"$resp");
+ #}
+ #if ($resp ne "Returned") {
+ # error_msg($env,"$resp");
+ # $bornum = "";
+ #}
+ }
+ }
+ }
+# clearscreen;
+ $dbh->disconnect;
+ return($reason);
+ }
+
+sub checkissue {
+ my ($env,$dbh, $item) = @_;
+ my $reason='Circ';
+ my $bornum;
+ my $borrower;
+ my $itemno;
+ my $itemrec;
+ my $amt_owing;
+ $item = uc $item;
+ my $query = "select * from items,biblio
+ where barcode = '$item'
+ and (biblio.biblionumber=items.biblionumber)";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if ($itemrec=$sth->fetchrow_hashref) {
+ $sth->finish;
+ $itemno = $itemrec->{'itemnumber'};
+ $query = "select * from issues
+ where (itemnumber='$itemrec->{'itemnumber'}')
+ and (returndate is null)";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ if (my $issuerec=$sth->fetchrow_hashref) {
+ $sth->finish;
+ $query = "select * from borrowers where
+ (borrowernumber = '$issuerec->{'borrowernumber'}')";
+ my $sth= $dbh->prepare($query);
+ $sth->execute;
+ $env->{'bornum'}=$issuerec->{'borrowernumber'};
+ $borrower = $sth->fetchrow_hashref;
+ $bornum = $issuerec->{'borrowernumber'};
+ $itemno = $issuerec->{'itemnumber'};
+ $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
+ $reason = "Returned";
+ } else {
+ $sth->finish;
+ updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
+ $reason = "Item not issued";
+ }
+ my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
+ if ($resfound eq "y") {
+ my $bquery = "select * from borrowers
+ where borrowernumber = '$resrec->{'borrowernumber'}'";
+ my $btsh = $dbh->prepare($bquery);
+ $btsh->execute;
+ my $resborrower = $btsh->fetchrow_hashref;
+ #printreserve($env,$resrec,$resborrower,$itemrec);
+ my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
+ C4::InterfaceCDK::error_msg($env,$mess);
+ $btsh->finish;
+ }
+ } else {
+ $sth->finish;
+ $reason = "Item not found";
+ }
+ return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
+ # end checkissue
+ }
+
+sub returnrecord {
+ # mark items as returned
+ my ($env,$dbh,$bornum,$itemno)=@_;
+ #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
+ 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 = '$bornum') and (itemnumber = '$itemno')
+ and (returndate is null)";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ updatelastseen($env,$dbh,$itemno);
+ # check for overdue fine
+ my $oduecharge;
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornum')
+ and (itemnumber = '$itemno')
+ and (accounttype = 'FU' or accounttype='O')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ if (my $data = $sth->fetchrow_hashref) {
+ # alter fine to show that the book has been returned.
+ my $uquery = "update accountlines
+ set accounttype = 'F'
+ where (borrowernumber = '$bornum')
+ and (itemnumber = '$itemno')
+ and (accountno = '$data->{'accountno'}') ";
+ my $usth = $dbh->prepare($uquery);
+ $usth->execute();
+ $usth->finish();
+ $oduecharge = $data->{'amountoutstanding'};
+ }
+ $sth->finish;
+ # check for charge made for lost book
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornum')
+ and (itemnumber = '$itemno')
+ and (accounttype = 'L')";
+ my $sth = $dbh->prepare($query);
+ $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 = '$bornum')
+ and (itemnumber = '$itemno')
+ and (accountno = '$acctno') ";
+ my $usth = $dbh->prepare($uquery);
+ $usth->execute();
+ $usth->finish;
+ my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
+ $uquery = "insert into accountlines
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values ($bornum,$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 ($bornum,$data->{'accountno'},$nextaccntno,$offset)";
+ $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ $sth->finish;
+ UpdateStats($env,'branch','return','0','',$itemno);
+ return($oduecharge);
+}
+
+sub calc_odues {
+ # calculate overdue fees
+ my ($env,$dbh,$bornum,$itemno)=@_;
+ my $amt_owing;
+ return($amt_owing);
+}
+
+sub updatelastseen {
+ my ($env,$dbh,$itemnumber)= @_;
+ my $br = $env->{'branchcode'};
+ my $query = "update items
+ set datelastseen = now(), holdingbranch = '$br'
+ where (itemnumber = '$itemnumber')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+
+}
+sub find_reserves {
+ my ($env,$dbh,$itemno) = @_;
+ my $itemdata = itemnodata($env,$dbh,$itemno);
+ my $query = "select * from reserves where found is null
+ and biblionumber = $itemdata->{'biblionumber'} and cancellationdate is NULL
+ order by priority,reservedate ";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $resfound = "n";
+ my $resrec;
+ while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
+ if ($resrec->{'found'} eq "W") {
+ if ($resrec->{'itemnumber'} eq $itemno) {
+ $resfound = "y";
+ }
+ } elsif ($resrec->{'constrainttype'} eq "a") {
+ $resfound = "y";
+ } else {
+ my $conquery = "select * from reserveconstraints where borrowernumber
+= $resrec->{'borrowernumber'} and reservedate = '$resrec->{'reservedate'}' and biblionumber = $resrec->{'biblionumber'} and biblioitemnumber = $itemdata->{'biblioitemnumber'}";
+ my $consth = $dbh->prepare($conquery);
+ $consth->execute;
+ if (my $conrec=$consth->fetchrow_hashref) {
+ if ($resrec->{'constrainttype'} eq "o") {
+ $resfound = "y";
+ }
+ } else {
+ if ($resrec->{'constrainttype'} eq "e") {
+ $resfound = "y";
+ }
+ }
+ $consth->finish;
+ }
+ if ($resfound eq "y") {
+ my $updquery = "update reserves
+ set found = 'W',itemnumber='$itemno'
+ where borrowernumber = $resrec->{'borrowernumber'}
+ and reservedate = '$resrec->{'reservedate'}'
+ and biblionumber = $resrec->{'biblionumber'}";
+ my $updsth = $dbh->prepare($updquery);
+ $updsth->execute;
+ $updsth->finish;
+ my $itbr = $resrec->{'branchcode'};
+ if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
+ my $updquery = "update items
+ set holdingbranch = 'TR'
+ where itemnumber = $itemno";
+ my $updsth = $dbh->prepare($updquery);
+ $updsth->execute;
+ $updsth->finish;
+ }
+ }
+ }
+ $sth->finish;
+ return ($resfound,$resrec);
+}
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Database; #asummes C4/Database
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+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(&C4Connect &sqlinsert &sqlupdate &getmax &makelist
+&OpacConnect);
+%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 C4Connect {
+ my $dbname="c4";
+# my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "chris", "");
+ my $database='c4test';
+ my $hostname='localhost';
+ my $user='hdl';
+ my $pass='testing';
+ my $dbh=DBI->connect("DBI:mysql:$database:$hostname",$user,$pass);
+ return $dbh;
+}
+
+sub Opaconnect {
+ my $dbname="c4";
+# my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "chris", "");
+ my $database='c4test';
+ my $hostname='localhost';
+ my $user='hdl';
+ my $pass='testing';
+ my $dbh=DBI->connect("DBI:mysql:$database:$hostname",$user,$pass);
+ return $dbh;
+}
+
+sub sqlinsert {
+ my ($table,%data)=@_;
+ my $dbh=C4Connect;
+ my $query="INSERT INTO $table \(";
+ while (my ($key,$value) = each %data){
+ if ($key ne 'type' && $key ne 'updtype'){
+ $query=$query."$key,";
+ }
+ }
+ $query=~ s/\,$/\)/;
+ $query=$query." VALUES (";
+ while (my ($key,$value) = each %data){
+ if ($key ne 'type' && $key ne 'updtype'){
+ $query=$query."'$value',";
+ }
+ }
+ $query=~ s/\,$/\)/;
+ print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub sqlupdate {
+ my ($table,$keyfld,$keyval,%data)=@_;
+ my $dbh=C4Connect;
+ my $query="UPDATE $table SET ";
+ my @sets;
+ my @keyarr = split("\t",$keyfld);
+ my @keyvalarr = split("\t",$keyval);
+ my $numkeys = @keyarr;
+ while (my ($key,$value) = each %data){
+ if (($key ne 'type')&&($key ne 'updtype')){
+ my $temp = " ".$key."='".$value."' ";
+ push(@sets,$temp);
+ }
+ }
+ my $fsets = join(",", @sets);
+ $query=$query.$fsets." WHERE $keyarr[0] = '$keyvalarr[0]'";
+ if ($numkeys > 1) {
+ my $i = 1;
+ while ($i < $numkeys) {
+ $query=$query." AND $keyarr[$i] = '$keyvalarr[$i]'";
+ $i++;
+ }
+ }
+# $query=~ s/\,$/\)/;
+ print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+
+sub getmax {
+ my ($table,$item)=@_;
+ my $dbh=C4Connect;
+ my $sth=$dbh->prepare("Select max($item) from $table");
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+sub makelist {
+ my ($table,$kfld,$dfld)=@_;
+ my $data;
+ my $dbh=C4Connect;
+ my $sth=$dbh->prepare("Select $kfld,$dfld from $table order by $dfld");
+ $sth->execute;
+ while (my $drec=$sth->fetchrow_hashref) {
+ $data = $data."\t".$drec->{$kfld}."\t".$drec->{$dfld};
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Format; #asummes C4/Format
+
+use strict;
+require Exporter;
+
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&fmtstr &fmtdec);
+%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 fmtstr {
+ # format (space pad) a string
+ # $fmt is Ln.. or Rn.. where n is the length
+ my ($env,$strg,$fmt)=@_;
+ my $align = substr($fmt,0,1);
+ my $lenst = substr($fmt,1,length($fmt)-1);
+ if ($align eq"R" ) {
+ $strg = substr((" "x$lenst).$strg,0-$lenst,$lenst);
+ } elsif ($align eq "C" ) {
+ $strg =
+ substr((" "x(($lenst/2)-(length($strg)/2))).$strg.(" "x$lenst),0,$lenst);
+ } else {
+ $strg = substr($strg.(" "x$lenst),0,$lenst);
+ }
+ return ($strg);
+}
+
+sub fmtdec {
+ # format a decimal
+ # $fmt is [$][,]n[m]
+ my ($env,$numb,$fmt)=@_;
+ my $curr = substr($fmt,0,1);
+ if ($curr eq "\$") {
+ $fmt = substr($fmt,1,length($fmt)-1);
+ };
+ my $comma = substr($fmt,0,1);
+ if ($comma eq ",") {
+ $fmt = substr($fmt,1,length($fmt)-1);
+ };
+ my $right;
+ my $left = substr($fmt,0,1);
+ if (length($fmt) == 1) {
+ $right = 0;
+ } else {
+ $right = substr($fmt,1,1);
+ }
+ my $fnumb = "";
+ my $tempint = "";
+ my $tempdec = "";
+ if (index($numb,".") == 0 ){
+ $tempint = 0;
+ $tempdec = substr($numb,1,length($numb)-1);
+ } else {
+ if (index($numb,".") > 0) {
+ my $decpl = index($numb,".");
+ $tempint = substr($numb,0,$decpl);
+ $tempdec = substr($numb,$decpl+1,length($numb)-1-$decpl);
+ } else {
+ $tempint = $numb;
+ $tempdec = 0;
+ }
+ if ($comma eq ",") {
+ while (length($tempdec) > 3) {
+ $fnumb = ",".substr($tempint,-3,3).$fnumb;
+ substr($tempint,-3,3) = "";
+ }
+ $fnumb = substr($tempint,-3,3).$fnumb;
+ } else {
+ $fnumb = $tempint;
+ }
+ }
+ if ($curr eq "\$") {
+ $fnumb = fmtstr($env,$curr.$fnumb,"R".$left+1);
+ } else {
+ if ($left==0) {
+ $fnumb = "";
+ } else {
+ $fnumb = fmtstr($env,$fnumb,"R".$left);
+ }
+ }
+ if ($right > 0) {
+ $tempdec = $tempdec.("0"x$right);
+ $tempdec = substr($tempdec,0,$right);
+ $fnumb = $fnumb.".".$tempdec;
+ }
+ return ($fnumb);
+}
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Input; #asummes C4/Input
+
+#package to deal with marking up output
+
+use strict;
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&checkflds &checkdigit);
+%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 checkflds {
+ my ($env,$reqflds,$data) = @_;
+ my $numrflds = @$reqflds;
+ my @probarr;
+ my $i = 0;
+ while ($i < $numrflds) {
+ if ($data->{@$reqflds[$i]} eq "") {
+ push(@probarr, @$reqflds[$i]);
+ }
+ $i++
+ }
+ return (\@probarr);
+}
+
+sub checkdigit {
+ my ($env,$infl) = @_;
+ $infl = uc $infl;
+ my @weightings = (8,4,6,3,5,2,1);
+ my $sum;
+ my $i = 1;
+ my $valid = 0;
+ # print $infl."<br>";
+ while ($i <8) {
+ my $temp1 = $weightings[$i-1];
+ my $temp2 = substr($infl,$i,1);
+ $sum = $sum + ($temp1*$temp2);
+# print "$sum $temp1 $temp2<br>";
+ $i++;
+ }
+ my $rem = ($sum%11);
+ if ($rem == 10) {
+ $rem = "X";
+ }
+ #print $rem."<br>";
+ if ($rem eq substr($infl,8,1)) {
+ $valid = 1;
+ }
+ return $valid;
+}
+
+END { } # module clean-up code here (global destructor)
+
--- /dev/null
+package C4::Interface::AccountsCDK; #asummes C4/Interface/AccountsCDK
+
+#uses Newt
+use C4::Format;
+use C4::InterfaceCDK;
+use C4::Accounts2;
+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");
+ my $borpanel = borrowerbox($env,$borrower,$amountowing);
+ $borpanel->draw();
+ my @sel = ("N ","Y ");
+ my $acctlist = new Cdk::Selection ('Title'=>"Outstanding Items",
+ 'List'=>\@$accountlines,'Choices'=>\@sel,'Height'=>12,'Width'=>80,
+ 'Xpos'=>1,'Ypos'=>10);
+ my @amounts=$acctlist->activate();
+ my $accountno;
+ my $amount2;
+ my $count=@amounts;
+ my $amount;
+ my $check=0;
+ for (my $i=0;$i<$count;$i++){
+ if ($amounts[$i] == 1){
+ $check=1;
+ if ($accountlines->[$i]=~ /(^[0-9]+)/){
+ $accountno=$1;
+ }
+ if ($accountlines->[$i]=~/([0-9]+\.[0-9]+)/){
+ $amount2=$1;
+ }
+ my $borrowerno=$borrower->{'borrowernumber'};
+ makepayment($borrowerno,$accountno,$amount2);
+ $amount+=$amount2;
+ }
+
+ }
+ my $amountentry = new Cdk::Entry('Label'=>"Amount: ",
+ 'Max'=>"10",'Width'=>"10",
+ 'Xpos'=>"1",'Ypos'=>"3",
+ 'Type'=>"INT");
+ $amountentry->preProcess ('Function' => sub{preamt(@_,$env,$acctlist);});
+ #
+
+ if ($amount eq ''){
+ $amount =$amountentry->activate();
+ } else {
+ $amountentry->set('Value'=>$amount);
+ $amount=$amountentry->activate();
+ }
+# debug_msg($env,"accounts $amount barcode=$accountno");
+ if (!defined $amount) {
+ #debug_msg($env,"escaped");
+ #$reason="Finished user";
+ }
+ $borpanel->erase();
+ $acctlist->erase();
+ $amountentry->erase();
+ undef $acctlist;
+ undef $borpanel;
+ undef $borpanel;
+ undef $titlepanel;
+ if ($check == 1){
+ $amount=0;
+ }
+ return($amount,$reason);
+}
+
+sub preamt {
+ my ($input,$env,$acctlist)= @_;
+ my $key_tab = chr(9);
+ if ($input eq $key_tab) {
+ actlist ($env,$acctlist);
+ return 0;
+ }
+ return 1;
+}
+
+sub actlist {
+ my ($env,$acctlist) = @_;
+ $acctlist->activate();
+}
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Interface::BorrowerCDK; #asummes C4/Interface/BorrowerCDK
+
+#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(&BorrowerAddress);
+%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 BorrowerAddress {
+ my ($env,$bornum,$borrower)=@_;
+ my $titlepanel = titlepanel($env,$env{'sysarea'},"Update Borrower");
+ $titlepanel->draw();
+ my BorrAdd = BorrAddpame
+
+sub BorrAddpanel {
+ my ($env,$bornum,$borrower)=@_;
+ my $titlepanel = titlepanel($env,$env{'sysarea'},"Update Borrower");
+ my @rowtitl = ("Card Number","Surname","First Name","Other Names","Initials",
+ "Address","Area","Town","Telephone","Email","Fax Number","Alt Address",
+ "Alt Area","Alt Town","Alt Phone","Contact Name");
+ my @coltitles = ("");
+ my @coltypes = ("UMIXED");
+ my @colwidths = (40);
+ my $entrymatrix = new Cdk::Matrix (
+ 'ColTitles'=> \@coltitles,
+ 'RowTitles'=> \@rowtitles,
+ 'ColWidths'=> \@colwidths,
+ 'ColTypes'=> \@coltypes,
+ 'Vrows'=> 16,
+ 'Vcols'=> 1,
+ 'RowSpace'=> 0);
+ my @data;
+ $data[0] = $borrower{'cardnumber'};
+ $data[1] = $borrower{'surname'};
+ $data[2] = $borrower{'firstname'};
+ $data[3] = $borrower{'
+ $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);
+}
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Interface::FlagsCDK; #asummes C4/Interface/FlagsCDK
+
+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(&trapscreen &trapsnotes &reservesdisplay);
+%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 trapscreen {
+ my ($env,$bornum,$borrower,$amount,$traps_set)=@_;
+ my $titlepanel = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Borrower Flags");
+ my @borinfo;
+ #debug_msg($env,"owwing = $amount");
+ my $borpanel = C4::InterfaceCDK::borrowerbox($env,$borrower,$amount);
+ $borpanel->draw();
+ my $hght = @$traps_set+4;
+ my $flagsset = new Cdk::Scroll ('Title'=>"Act On Flag",
+ 'List'=>\@$traps_set,'Height'=>$hght,'Width'=>15,
+ 'Xpos'=>4,'Ypos'=>3);
+ my $act =$flagsset->activate();
+ my $action;
+ if (!defined $act) {
+ $action = "NONE";
+ } else {
+ $action = @$traps_set[$act];
+ }
+ undef $titlepanel;
+ undef $flagsset;
+ undef $borpanel;
+ return($action);
+}
+
+sub trapsnotes {
+ my ($env,$bornum,$borrower,$amount) = @_;
+ my $titlepanel = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Borrower Notes");
+ my $borpanel = C4::InterfaceCDK::borrowerbox($env,$borrower,$amount);
+ $borpanel->draw();
+ my $notesbox = new Cdk::Mentry ('Label'=>"Notes: ",
+ 'Width'=>40,'Prows'=>10,'Lrows'=>30,
+ 'Lpos'=>"Top",'Xpos'=>"RIGHT",'Ypos'=>10);
+ my $ln = length($borrower->{'borrowernotes'});
+ my $x = 0;
+ while ($x < $ln) {
+ my $y = substr($borrower->{'borrowernotes'},$x,1);
+ $notesbox->inject('Input'=>$y);
+ $x++;
+ }
+ my $notes = $notesbox->activate();
+ if (!defined $notes) {
+ $notes = $borrower->{'borrowernotes'};
+ } else {
+ while (substr($notes,0,1) eq " ") {
+ my $temp;
+ if (length($notes) == 1) {
+ $temp = "";
+ } else {
+ $temp = substr($notes,1,length($notes)-1);
+ }
+ $notes = $temp;
+ }
+ }
+ undef $notesbox;
+ undef $borpanel;
+ undef $titlepanel;
+ return $notes;
+}
+
+sub reservesdisplay {
+ my ($env,$borrower,$amount,$odues,$items) = @_;
+ my $titlepanel = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Reserves Waiting");
+ my $borpanel = C4::InterfaceCDK::borrowerbox($env,$borrower,$amount);
+ $borpanel->draw();
+ my $x = 0;
+ my @itemslist;
+ while (@$items[$x] ne "") {
+ my $itemdata = @$items[$x];
+ my $itemrow = fmtstr($env,$itemdata->{'holdingbranch'},"L6");
+ $itemrow = $itemrow.$itemdata->{'title'}.": ".$itemdata->{'author'};
+ $itemrow = fmtstr($env,$itemrow,"L68").$itemdata->{'itemtype'};
+ @itemslist[$x] = $itemrow;
+ $x++;
+ }
+ my $reslist = new Cdk::Scroll('Title'=>"",'List'=>\@itemslist,
+ 'Height'=>10,'Width'=>76,'Xpos'=>1,'Ypos'=>10);
+ $reslist->activate();
+ undef $reslist;
+ undef $borpanel;
+ undef $titlepanel;
+}
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Interface::RenewalsCDK; #asummes C4/Interface/RenewalsCDK
+
+#uses Newt
+use strict;
+use Cdk;
+use C4::Format;
+use C4::InterfaceCDK;
+use Date::Manip;
+#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(renew_window);
+%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 se them.
+
+# file-private lexicals go here
+my $priv_var = '';
+my %secret_hash = ();
+
+#defining keystrokes used for screens
+
+# 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 renew_window {
+ my ($env,$issueditems,$borrower,$amountowing,$odues)=@_;
+ my $titlepanel = C4::InterfaceCDK::titlepanel($env,$env->{'sysarea'},"Renewals");
+ my @sel = ("N ","Y ");
+ my $issuelist = new Cdk::Selection ('Title'=>"Renew items",
+ 'List'=>\@$issueditems,'Choices'=>\@sel,
+ 'Height'=> 14,'Width'=>78,'Ypos'=>8);
+ my $x = 0;
+ my $borrbox = C4::InterfaceCDK::borrowerbox($env,$borrower,$amountowing);
+ $borrbox->draw();
+ my @renews = $issuelist->activate();
+ $issuelist->erase();
+ undef $titlepanel;
+ undef $issuelist;
+ undef $borrbox;
+ return \@renews;
+}
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+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'=>"20",'Ypos'=>"5",'Width'=>"18",'Height'=>"6");
+ $branchlist->draw();
+ my $i = 0;
+ my $brcnt = @$branches;
+ my $brdef = 0;
+ while (($brdef == 0) && ($i < $brcnt)) {
+ my $brcode = substr(@$branches[$i],0,2);
+ my $brtest = fmtstr($env,$env->{'branchcode'},"L2");
+ if ($brcode eq $brtest) {
+ $brdef = 1
+ } else {
+ $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'=>"5",'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'=>"1",'Ypos'=>"12",'Width'=>"70",'Height'=>"8");
+ $itemlist->draw();
+ my $borrowerentry = new Cdk::Entry('Label'=>"",'Title'=>"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;
+ 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;
+ }
+ }
+ }
+ }
+ } else {
+ $complete = 3;
+ }
+ }
+ }
+ }
+ }
+ }
+ return ($reason,@answers);
+}
+END { } # module clean-up code here (global destructor)
--- /dev/null
+
+package C4::InterfaceCDK; #asummes C4/InterfaceCDK
+
+#uses Newt
+use C4::Format;
+use strict;
+use Cdk;
+use Date::Manip;
+use C4::Accounts;
+use C4::Circulation::Borrissues;
+use C4::Circulation::Renewals;
+#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 &msg_ny &borrower_dialog &debug_msg &error_msg
+&info_msg &selborrower &returnwindow &logondialog &borrowerwindow &titlepanel
+&borrbind &borrfill &preeborr &borrowerbox &brmenu &prmenu);
+%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 se them.
+
+# file-private lexicals go here
+my $priv_var = '';
+my %secret_hash = ();
+
+#defining keystrokes used for screens
+my $key_tab = chr(9);
+my $key_ctlr = chr(18);
+my $lastval = $key_ctlr;
+
+# 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,"Koha","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.
+ undef $menu;
+ 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;
+ @header[0] = fmtstr($env,$title,"L24");
+ @header[0] = @header[0].fmtstr($env,
+ $env->{'branchname'}."-".$env->{'queue'},"C28");
+ @header[0] = @header[0].fmtstr($env,$title2,"R24");
+ my $label = new Cdk::Label ('Message' =>\@header,'Ypos'=>0,'Xpos'=>0);
+ $label->draw();
+ return $label;
+ }
+
+sub msg_yn {
+ my ($env,$text1,$text2)=@_;
+ # 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";
+ }
+ undef $dialog;
+ return $response;
+}
+sub msg_ny {
+ my ($env,$text1,$text2)=@_;
+ # Cdk::init();
+ # Create the dialog buttons.
+ my @buttons = ("No", "Yes");
+ 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 = "N";
+ if ($resp == 1) {
+ $response = "Y";
+ }
+ undef $dialog;
+ return $response;
+}
+
+sub debug_msg {
+ my ($env,$text)=@_;
+ if ($env->{'telnet'} eq "Y") {
+ popupLabel (["Debug </R>$text"]);
+# } else {
+# print "****DEBUG $text****";
+ }
+ return();
+}
+
+sub error_msg {
+ my ($env,$text)=@_;
+ popupLabel (["<C>Error </R>$text"]);
+ return();
+}
+
+sub info_msg {
+ my ($env,$text)=@_;
+ popupLabel ([$text]);
+ return();
+}
+
+sub endint {
+ Cdk::end();
+}
+
+
+sub brmenu {
+ my ($env,$brrecs)=@_;
+ $env->{'sysarea'}="Menu";
+ my $titlebar=titlepanel($env,"Koha","Select branch");
+ my @mitems;
+ my $x = 0;
+ while (@$brrecs[$x] ne "") {
+ my $brrec =@$brrecs[$x];
+ $mitems[$x]=fmtstr($env,$brrec->{'branchcode'},"L6");
+ $mitems[$x]=$mitems[$x].fmtstr($env,$brrec->{'branchname'},"L20");
+ $x++;
+ }
+ my $menu = new Cdk::Scroll ('Title'=>" ",
+ 'List'=>\@mitems,
+ 'Height'=> 16,
+ 'Width'=> 30);
+ # Activate the object.
+ my ($menuItem) = $menu->activate();
+ # Check the results.
+ if (defined $menuItem) {
+ my $brrec = @$brrecs[$menuItem];
+ $env->{'branchcode'} = $brrec->{'branchcode'};
+ $env->{'branchname'} = $brrec->{'branchname'};
+ }
+ undef $menu;
+ undef $titlebar;
+ return();
+
+}
+
+sub prmenu {
+ my ($env,$prrecs)=@_;
+ $env->{'sysarea'}="Menu";
+ my $titlebar=titlepanel($env,"Koha","Select printer");
+ my @mitems;
+ my $x = 0;
+ while (@$prrecs[$x] ne "") {
+ my $prrec =@$prrecs[$x];
+ $mitems[$x]=fmtstr($env,$prrec->{'printername'},"L20");
+ $x++;
+ }
+ my $menu = new Cdk::Scroll ('Title'=>" ",
+ 'List'=>\@mitems,
+ 'Height'=> 16,
+ 'Width'=> 30);
+ # Activate the object.
+ my ($menuItem) = $menu->activate();
+ undef $menu;
+ undef $titlebar;
+ # Check the results.
+ if (defined $menuItem) {
+ my $prrec = @$prrecs[$menuItem];
+ $env->{'queue'} = $prrec->{'printqueue'};
+ $env->{'printtype'} = $prrec->{'printtype'};
+ }
+ return();
+
+}
+
+
+sub borrower_dialog {
+ my ($env)=@_;
+ my $result;
+ my $borrower;
+ my $book;
+ my @coltitles = ("Borrower","Item");
+ my @rowtitles = (" ");
+ my @coltypes = ("UMIXED","UMIXED");
+ my @colwidths = (12,12);
+ 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();
+ if ((!defined $rows) && ($info->[0][0] eq "")) {
+ $result = "Circ";
+ } else {
+ $borrower = $info->[0][0];
+ $book = $info->[0][1];
+ }
+ $matrix->erase();
+ $matrix->unregister();
+ undef $matrix;
+ Cdk::refreshCdkScreen();
+ 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);
+ }
+ $scroll->erase();
+ #$scroll->unregister();
+ undef $scroll;
+ Cdk::refreshCdkScreen();
+ return $result;
+}
+
+sub issuewindow {
+ my ($env,$title,$dbh,$items1,$items2,$borrower,$amountowing,$odues)=@_;
+ my @functs=("Due Date","Renewals","Payments","Print","Current","Previous");
+ my $titlepanel = titlepanel($env,"Issues","Issue an Item");
+ my $scroll2 = new Cdk::Scroll ('Title'=>"Previous Issues",
+ 'List'=>\@$items1,'Height'=> 8,'Width'=>78,'Ypos'=>18);
+ my $scroll1 = new Cdk::Scroll ('Title'=>"Current Issues",
+ 'List'=>\@$items2,'Height'=> 8,'Width'=>78,'Ypos'=>9);
+ my $funcmenu = new Cdk::Scroll ('Title'=>"",
+ 'List'=>\@functs,'Height'=>5,'Width'=>12,'Ypos'=>3,'Xpos'=>28);
+ my $loanlength = new Cdk::Entry('Label'=>"Due Date: ",
+ 'Max'=>"30",'Width'=>"11",
+ 'Xpos'=>0,'Ypos'=>5,'Type'=>"UMIXED");
+ my $x = 0;
+ while ($x < length($env->{'loanlength'})) {
+ $loanlength->inject('Input'=>substr($env->{'loanlength'},$x,1));
+ $x++;
+ }
+ my $borrbox = borrowerbox($env,$borrower,$amountowing);
+ my $entryBox = new Cdk::Entry('Label'=>"Item Barcode: ",
+ 'Max'=>"11",'Width'=>"11",
+ 'Xpos'=>"0",'Ypos'=>3,'Type'=>"UMIXED");
+ $scroll2->draw();
+ $scroll1->draw();
+ $funcmenu->draw();
+ $loanlength->draw();
+ $borrbox->draw();
+ #$env->{'loanlength'} = "";
+ #debug_msg($env,"clear len");
+ my $x;
+ my $barcode;
+ $entryBox->preProcess ('Function' =>
+ sub{prebook(@_,$env,$dbh,$funcmenu,$entryBox,$loanlength,
+ $scroll1,$scroll2,$borrower,$amountowing,$odues);});
+ $barcode = $entryBox->activate();
+ my $reason;
+ if (!defined $barcode) {
+ $reason="Finished user"
+ }
+ $borrbox->erase();
+ $entryBox->erase();
+ $scroll2->erase();
+ $scroll1->erase();
+ $funcmenu->erase();
+ $loanlength->erase();
+ undef $titlepanel;
+ undef $borrbox;
+ undef $entryBox;
+ undef $scroll2;
+ undef $scroll1;
+ undef $funcmenu;
+ undef $loanlength;
+ Cdk::refreshCdkScreen();
+ #debug_msg($env,"exiting");
+ return $barcode,$reason;
+}
+sub actfmenu {
+ my ($env,$dbh,$funcmenu,$entryBox,$loanlength,$scroll1,
+ $scroll2,$borrower,$amountowing,$odues) = @_;
+ my $funct = $funcmenu->activate();
+ if (!defined $funct) {
+ } elsif ($funct == 0 ) {
+ actloanlength ($env,$entryBox,$loanlength,$scroll1,$scroll2);
+ } elsif ($funct == 1 ) {
+ $entryBox->erase();
+ $scroll1->erase();
+ $scroll2->erase();
+ $loanlength->erase();
+ $funcmenu->erase();
+ #debug_msg($env,"");
+ C4::Circulation::Renewals::bulkrenew($env,$dbh,
+ $borrower->{'borrowernumber'},$amountowing,$borrower,$odues);
+ } elsif ($funct == 2 ) {
+ $entryBox->erase();
+ $scroll1->erase();
+ $scroll2->erase();
+ $loanlength->erase();
+ $funcmenu->erase();
+ C4::Accounts::reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},
+ $amountowing,$borrower,$odues);
+ } elsif ($funct == 3 ) {
+ C4::Circulation::Borrissues::printallissues ($env,$borrower);
+ } elsif ($funct == 4 ) {
+ actscroll1 ($env,$entryBox,$loanlength,$scroll1,$scroll2);
+ } elsif ($funct == 5 ) {
+ actscroll2 ($env,$entryBox,$loanlength,$scroll1,$scroll2);
+ }
+ Cdk::refreshCdkScreen();
+ $entryBox->unregister();
+ $entryBox->register();
+ return
+}
+sub actscroll1 {
+ my ($env,$entryBox,$loanlength,$scroll1,$scroll2) = @_;
+ $scroll1->activate();
+ return 1;
+}
+sub actscroll2 {
+ my ($env,$entryBox,$loanlength,$scroll1,$scroll2) = @_;
+ $scroll2->activate();
+ return 1;
+}
+sub actloanlength {
+ my ($env,$entryBox,$loanlength,$scroll1,$scroll2) = @_;
+ my $validdate = "N";
+ while ($validdate eq "N") {
+ my $loanlength = $loanlength->activate();
+ if (!defined $loanlength) {
+ $env->{'loanlength'} = "";
+ $validdate = "Y";
+ } elsif ($loanlength eq "") {
+ $env->{'loanlength'} = "";
+ $validdate = "Y";
+ } else {
+ my $date = ParseDate($loanlength);
+ if ( $date > ParseDate('today')){
+ $validdate="Y";
+ my $fdate = substr($date,0,4).'-'.substr($date,4,2).'-'.substr($date,6,2);
+ #debug_msg($env,"$date $fdate");
+ $env->{'loanlength'} = $fdate;
+ } else {
+ error_msg($env,"Invalid date");
+ }
+ }
+ }
+ return;
+}
+
+sub prebook {
+ my ($input,$env,$dbh,$funcmenu,$entryBox,$loanlength,
+ $scroll1,$scroll2,$borrower,$amountowing,$odues)= @_;
+ if ($input eq $key_tab) {
+ actfmenu ($env,$dbh,$funcmenu,$entryBox,$loanlength,$scroll1,
+ $scroll2,$borrower,$amountowing,$odues);
+ return 0;
+ }
+ return 1;
+}
+
+sub borrowerbox {
+ my ($env,$borrower,$amountowing,$odues) = @_;
+ my @borrinfo;
+ my $amountowing = fmtdec($env,$amountowing,"42");
+ my $line = "$borrower->{'cardnumber'} ";
+ $line = $line."$borrower->{'surname'}, ";
+ $line = $line."$borrower->{'title'} $borrower->{'firstname'}";
+ $borrinfo[0]=$line;
+ $line = "$borrower->{'streetaddress'}, $borrower->{'city'}";
+ $borrinfo[1]=$line;
+ $line = "$borrower->{'categorycode'}";
+ if ($borrower->{'gonenoaddress'} == 1) {
+ $line = $line." </R>GNA<!R>";
+ }
+ if ($borrower->{'lost'} == 1) {
+ $line = $line." </R>LOST<!R>";
+ }
+ if ($odues > 0) {
+ $line = $line." </R>ODUE<!R>";
+ }
+ if ($borrower->{'borrowernotes'} ne "" ) {
+ $line = $line." </R>NOTES<!R>";
+ }
+ if ($amountowing > 0) {
+ $line = $line." </B>\$$amountowing";
+ }
+ $borrinfo[2]=$line;
+ if ($borrower->{'borrowernotes'} ne "" ) {
+ $borrinfo[3]=substr($borrower->{'borrowernotes'},0,40);
+ }
+ my $borrbox = new Cdk::Label ('Message' =>\@borrinfo,
+ 'Ypos'=>3, 'Xpos'=>"RIGHT");
+ return $borrbox;
+}
+
+sub returnwindow {
+ my ($env,$title,$item,$items,$borrower,$amountowing,$odues,$dbh,$resp)=@_;
+ #debug_msg($env,$borrower);
+ my $titlepanel = titlepanel($env,"Returns","Scan Item");
+ my @functs=("Payments","Renewal");
+ my $funcmenu = new Cdk::Scroll ('Title'=>"",
+ 'List'=>\@functs,'Height'=>5,'Width'=>12,'Ypos'=>3,'Xpos'=>16);
+ my $returnlist = new Cdk::Scroll ('Title'=>"Items Returned",
+ 'List'=>\@$items,'Height'=> 12,'Width'=>74,'Ypos'=>10,'Xpos'=>1);
+ $returnlist->draw();
+ $funcmenu->draw();
+ my $borrbox;
+ if ($borrower->{'cardnumber'} ne "") {
+ $borrbox = borrowerbox($env,$borrower,$amountowing);
+ $borrbox->draw();
+ } else {
+ if ($resp ne "") {
+ my @text;
+ @text[0] = $resp;
+ $borrbox = new Cdk::Label ('Message' =>\@text, 'Ypos'=>3, 'Xpos'=>"RIGHT");
+ $borrbox->draw();
+ }
+ }
+ my $bookentry = new Cdk::Entry('Label'=>" ",
+ 'Max'=>"11",'Width'=>"11",
+ 'Xpos'=>"2",'Ypos'=>"3",'Title'=>"Item Barcode",
+ 'Type'=>"UMIXED");
+ $bookentry->preProcess ('Function' =>sub{preretbook(@_,$env,$dbh,
+ $funcmenu,$bookentry,$borrower,$amountowing,
+ $odues,$titlepanel,$borrbox,$returnlist);});
+ my $barcode = $bookentry->activate();
+ my $reason;
+ if (!defined $barcode) {
+ $barcode="";
+ $reason="Circ";
+ $bookentry->erase();
+ $funcmenu->erase();
+ if ($borrbox ne "") {$borrbox->erase();}
+ $returnlist->erase();
+ } else {
+ $reason="";
+ }
+ undef $bookentry;
+ undef $funcmenu;
+ undef $borrbox;
+ undef $returnlist;
+ undef $titlepanel;
+ return($reason,$barcode);
+ }
+
+sub preretbook {
+ my ($input,$env,$dbh,$funcmenu,$bookentry,$borrower,
+ $amountowing,$odues,$titlepanel,$borrbox,$returnlist)=@_;
+ if ($input eq $key_tab) {
+ actrfmenu($env,$dbh,$funcmenu,$bookentry,$borrower,
+ $amountowing,$odues,$titlepanel,$borrbox,$returnlist);
+ return 0;
+ }
+ return 1;
+ }
+
+sub actrfmenu {
+ my ($env,$dbh,$funcmenu,$bookentry,$borrower,
+ $amountowing,$odues,$titlepanel,$borrbox,$returnlist)= @_;
+ my $funct = $funcmenu->activate();
+ #debug_msg($env,"funtion $funct");
+ if (!defined $funct) {
+ } elsif ($funct == 1 ) {
+ if ($borrower->{'borrowernumber'} ne "") {
+ $funcmenu->erase();
+ $bookentry->erase();
+ $titlepanel->erase();
+ $borrbox->erase();
+ $returnlist->erase();
+ C4::Circulation::Renewals::bulkrenew($env,$dbh,
+ $borrower->{'borrowernumber'},$amountowing,$borrower,$odues);
+ Cdk::refreshCdkScreen();
+ $funcmenu->draw();
+ $bookentry->draw();
+ $titlepanel->draw();
+ $borrbox->draw();
+ $returnlist->draw();
+ }
+ } elsif ($funct == 0 ) {
+ if ($borrower->{'borrowernumber'} ne "") {
+ $funcmenu->erase();
+ $bookentry->erase();
+ $titlepanel->erase();
+ $borrbox->erase();
+ $returnlist->erase();
+ C4::Accounts::reconcileaccount($env,$dbh,$borrower->{'borrowernumber'},
+ $amountowing,$borrower,$odues);
+ $funcmenu->draw();
+ $bookentry->draw();
+ $titlepanel->draw();
+ $borrbox->draw();
+ $returnlist->draw();
+ #Cdk::refreshCdkScreen();
+ }
+ }
+}
+
+sub act {
+ my ($obj) = @_;
+ my $ans = $obj->activate();
+ return $ans;
+ }
+
+sub borrbind {
+ my ($env,$entry) = @_;
+ my $lastborr = $env->{"bcard"};
+ $entry->preProcess ('Function' => sub {preborr (@_, $env,$entry);});
+}
+
+sub preborr {
+ my ($input,$env, $entry) = @_;
+ if ($env->{"bcard"} ne "") {
+# error_msg($env,"hi there");
+ if ($input eq $lastval) {
+# error_msg($env,"its a ctrl-r");
+ borfill($env,$entry);
+ return 0;
+ }
+ }
+ return 1;
+}
+
+
+sub borfill {
+ my ($env,$entry) = @_;
+ error_msg($env,"in borfill: $env->{'bcard'}");
+ my $lastborr = $env->{"bcard"};
+ my $i = 1;
+ $entry->inject('Input'=>$lastborr);
+ while ($i < 9) {
+# my $temp=substr($lastborr,$i,1);
+# $entry->inject('Input'=>$temp);
+ $i++;
+ }
+
+}
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+package C4::Maintainance; #asummes C4/Maintainance
+
+#package to deal with marking up output
+
+use strict;
+use C4::Database;
+
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&listsubjects &updatesub);
+%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 listsubjects {
+ my ($sub,$num,$offset)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from bibliosubject where subject like '$sub%' group by subject";
+ if ($num != 0){
+ $query.=" limit $offset,$num";
+ }
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+sub updatesub{
+ my ($sub,$oldsub)=@_;
+ my $dbh=C4Connect;
+ my $query="update bibliosubject set subject='$sub' where subject='$oldsub'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+END { } # module clean-up code here (global destructor)
+
--- /dev/null
+package C4::Output; #asummes C4/Output
+
+#package to deal with marking up output
+#You will need to edit parts of this pm
+#set the value of path to be where your html lives
+
+use strict;
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink
+&startmenu &endmenu &mkheadr ¢er &endcenter &mkform &mkform2 &bold
+&gotopage &mkformnotable &mkform3);
+%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.
+
+#
+# Change this value to reflect where you will store your includes
+#
+my $path="/usr/local/www/hdl/htdocs/includes";
+
+
+# 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 startpage{
+ my $string="<html>\n";
+ return($string);
+}
+
+sub gotopage{
+ my ($target) = @_;
+ print "<br>goto target = $target<br>";
+ my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
+ return $string;
+}
+
+
+sub startmenu{
+ # edit the paths in here
+ my ($type)=@_;
+ if ($type eq 'issue') {
+ open (FILE,"$path/issues-top.inc") || die;
+ } elsif ($type eq 'opac') {
+ open (FILE,"$path/opac-top.inc") || die;
+ } elsif ($type eq 'member') {
+ open (FILE,"$path/members-top.inc") || die;
+ } elsif ($type eq 'acquisitions'){
+ open (FILE,"$path/aquisitions-top.inc")|| die;
+ } elsif ($type eq 'report'){
+ open (FILE,"$path/reports-top.inc") || die;
+ } else {
+ open (FILE,"$path/cat-top.inc") || die;
+ }
+ my @string=<FILE>;
+ close FILE;
+ my $count=@string;
+ # $string[$count]="<BLOCKQUOTE>";
+ return @string;
+}
+
+
+sub endmenu{
+ my ($type)=@_;
+ if ($type eq 'issue'){
+ open (FILE,"$path/issues-bottom.inc") || die;
+ } elsif ($type eq 'opac') {
+ open (FILE,"$path/opac-bottom.inc") || die;
+ } elsif ($type eq 'member') {
+ open (FILE,"$path/members-bottom.inc") || die;
+ } elsif ($type eq 'acquisitions') {
+ open (FILE,"$path/aquisitions-bottom.inc") || die;
+ } elsif ($type eq 'report') {
+ open (FILE,"$path/reports-bottom.inc") || die;
+ } else {
+ open (FILE,"$path/cat-bottom.inc") || die;
+ }
+ my @string=<FILE>;
+ close FILE;
+ return @string;
+}
+
+sub mktablehdr {
+ my $string="<table border=0 cellspacing=0 cellpadding=5>\n";
+ return($string);
+}
+
+
+sub mktablerow {
+ #the last item in data may be a backgroundimage
+ my ($cols,$colour,@data)=@_;
+ my $i=0;
+ my $string="<tr valign=top bgcolor=$colour>";
+ while ($i <$cols){
+ if ($data[$cols] ne ''){
+ #check for backgroundimage
+ $string.="<td background=\"$data[$cols]\">";
+ } else {
+ $string.="<td>";
+ }
+ if ($data[$i] eq "") {
+ $string.=" </td>";
+ } else {
+ $string.="$data[$i]</td>";
+ }
+ $i++;
+ }
+ $string=$string."</tr>\n";
+ return($string);
+}
+
+sub mktableft {
+ my $string="</table>\n";
+ return($string);
+}
+
+sub mkform{
+ my ($action,%inputs)=@_;
+ my $string="<form action=$action method=post>\n";
+ $string=$string.mktablehdr();
+ my $key;
+ my @keys=sort keys %inputs;
+
+ my $count=@keys;
+ my $i2=0;
+ while ( $i2<$count) {
+ my $value=$inputs{$keys[$i2]};
+ my @data=split('\t',$value);
+ #my $posn = shift(@data);
+ if ($data[0] eq 'hidden'){
+ $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
+ } else {
+ my $text;
+ if ($data[0] eq 'radio') {
+ $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
+ <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
+ }
+ if ($data[0] eq 'text') {
+ $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
+ }
+ if ($data[0] eq 'textarea') {
+ $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
+ }
+ if ($data[0] eq 'select') {
+ $text="<select name=$keys[$i2]>";
+ my $i=1;
+ while ($data[$i] ne "") {
+ my $val = $data[$i+1];
+ $text = $text."<option value=$data[$i]>$val";
+ $i = $i+2;
+ }
+ $text=$text."</select>";
+ }
+ $string=$string.mktablerow(2,'white',$keys[$i2],$text);
+ #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
+ }
+ $i2++;
+ }
+ #$string=$string.join("\n",@order);
+ $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
+ $string=$string.mktableft;
+ $string=$string."</form>";
+}
+
+sub mkform3{
+ my ($action,%inputs)=@_;
+ my $string="<form action=$action method=post>\n";
+ $string=$string.mktablehdr();
+ my $key;
+ my @keys=sort keys %inputs;
+ my @order;
+ my $count=@keys;
+ my $i2=0;
+ while ( $i2<$count) {
+ my $value=$inputs{$keys[$i2]};
+ my @data=split('\t',$value);
+ my $posn = $data[2];
+ if ($data[0] eq 'hidden'){
+ $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
+ } else {
+ my $text;
+ if ($data[0] eq 'radio') {
+ $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
+ <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
+ }
+ if ($data[0] eq 'text') {
+ $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
+ }
+ if ($data[0] eq 'textarea') {
+ $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
+ }
+ if ($data[0] eq 'select') {
+ $text="<select name=$keys[$i2]>";
+ my $i=1;
+ while ($data[$i] ne "") {
+ my $val = $data[$i+1];
+ $text = $text."<option value=$data[$i]>$val";
+ $i = $i+2;
+ }
+ $text=$text."</select>";
+ }
+# $string=$string.mktablerow(2,'white',$keys[$i2],$text);
+ $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
+ }
+ $i2++;
+ }
+ my $temp=join("\n",@order);
+ $string=$string.$temp;
+ $string=$string.mktablerow(1,'white','<input type=submit>');
+ $string=$string.mktableft;
+ $string=$string."</form>";
+}
+
+sub mkformnotable{
+ my ($action,@inputs)=@_;
+ my $string="<form action=$action method=post>\n";
+ my $count=@inputs;
+ for (my $i=0; $i<$count; $i++){
+ if ($inputs[$i][0] eq 'hidden'){
+ $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
+ }
+ if ($inputs[$i][0] eq 'radio') {
+ $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
+ }
+ if ($inputs[$i][0] eq 'text') {
+ $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
+ }
+ if ($inputs[$i][0] eq 'textarea') {
+ $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
+ }
+ if ($inputs[$i][0] eq 'reset'){
+ $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
+ }
+ if ($inputs[$i][0] eq 'submit'){
+ $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
+ }
+ }
+ $string=$string."</form>";
+}
+
+sub mkform2{
+ my ($action,%inputs)=@_;
+ my $string="<form action=$action method=post>\n";
+ $string=$string.mktablehdr();
+ my $key;
+ my @order;
+ while ( my ($key, $value) = each %inputs) {
+ my @data=split('\t',$value);
+ my $posn = shift(@data);
+ my $reqd = shift(@data);
+ my $ltext = shift(@data);
+ if ($data[0] eq 'hidden'){
+ $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
+ } else {
+ my $text;
+ if ($data[0] eq 'radio') {
+ $text="<input type=radio name=$key value=$data[1]>$data[1]
+ <input type=radio name=$key value=$data[2]>$data[2]";
+ } elsif ($data[0] eq 'text') {
+ my $size = $data[1];
+ if ($size eq "") {
+ $size=40;
+ }
+ $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
+ } elsif ($data[0] eq 'textarea') {
+ my @size=split("x",$data[1]);
+ if ($data[1] eq "") {
+ $size[0] = 40;
+ $size[1] = 4;
+ }
+ $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
+ } elsif ($data[0] eq 'select') {
+ $text="<select name=$key>";
+ my $sel=$data[1];
+ my $i=2;
+ while ($data[$i] ne "") {
+ my $val = $data[$i+1];
+ $text = $text."<option value=\"$data[$i]\"";
+ if ($data[$i] eq $sel) {
+ $text = $text." selected";
+ }
+ $text = $text.">$val";
+ $i = $i+2;
+ }
+ $text=$text."</select>";
+ }
+ if ($reqd eq "R") {
+ $ltext = $ltext." (Req)";
+ }
+ @order[$posn] =mktablerow(2,'white',$ltext,$text);
+ }
+ }
+ $string=$string.join("\n",@order);
+ $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
+ $string=$string.mktableft;
+ $string=$string."</form>";
+}
+
+
+sub endpage{
+ my $string="</body></html>\n";
+ return($string);
+}
+
+sub mklink {
+ my ($url,$text)=@_;
+ my $string="<a href=\"$url\">$text</a>";
+ return ($string);
+}
+
+sub mkheadr {
+ my ($type,$text)=@_;
+ my $string;
+ if ($type eq '1'){
+ $string="<FONT SIZE=6><em>$text</em></FONT><br>";
+ }
+ if ($type eq '2'){
+ $string="<FONT SIZE=6><em>$text</em></FONT>";
+ }
+ if ($type eq '3'){
+ $string="<FONT SIZE=6><em>$text</em></FONT><p>";
+ }
+ return ($string);
+}
+
+sub center {
+ my ($text)=@_;
+ my $string="<CENTER>\n";
+ return ($string);
+}
+
+sub endcenter {
+ my ($text)=@_;
+ my $string="</CENTER>\n";
+ return ($string);
+}
+
+sub bold {
+ my ($text)=@_;
+ my $string="<b>$text</b>";
+ return($string);
+}
+
+END { } # module clean-up code here (global destructor)
+
--- /dev/null
+
+package C4::Print; #asummes C4/Print.pm
+
+use strict;
+require Exporter;
+use C4::InterfaceCDK;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&remoteprint &printreserve);
+%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 remoteprint {
+ my ($env,$items,$borrower)=@_;
+ #open (FILE,">/tmp/olwen");
+ #print FILE "queue $env->{'queue'}";
+ #close FILE;
+ #debug_msg($env,"In print");
+ my $file=time;
+ my $queue = $env->{'queue'};
+ if ($queue eq "") {
+ open (PRINTER,">/tmp/kohaiss");
+ } else {
+ open(PRINTER, "| lpr -P $queue") or die "Couldn't write to queue:$!\n";
+ }
+# print $queue;
+ #open (FILE,">/tmp/$file");
+ my $i=0;
+ my $brdata = $env->{'brdata'};
+ print PRINTER "Horowhenua Library Trust\r\n";
+# print PRINTER "$brdata->{'branchname'}\r\n";
+ print PRINTER "Phone: 368-1953\r\n";
+ print PRINTER "Fax: 367-9218\r\n";
+ print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n";
+ print PRINTER "$borrower->{'cardnumber'}\r\n";
+ print PRINTER "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n";
+ while ($items->[$i]){
+ my $itemdata = $items->[$i];
+ print PRINTER "$itemdata->{'title'}\r\n";
+ print PRINTER "$itemdata->{'barcode'}";
+ print PRINTER " "x15;
+ print PRINTER "$itemdata->{'date_due'}\r\n";
+ $i++;
+ }
+ print PRINTER "\r\n\r\n\r\n\r\n\r\n\r\n\r\n";
+ if ($env->{'printtype'} eq "docket"){
+ #print chr(27).chr(105);
+ }
+ close PRINTER;
+ #system("lpr /tmp/$file");
+}
+
+sub printreserve {
+ my($env,$resrec,$rbordata,$itemdata)=@_;
+ my $file=time;
+ my $queue = $env->{'queue'};
+ #if ($queue eq "") {
+ open (PRINTER,">/tmp/kohares");
+ #} else {
+ # open (PRINTER, "| lpr -P $queue") or die "Couldn't write to queue:$!\n";
+ #}
+ print PRINTER "Collect at $resrec->{'branchcode'}\r\n\r\n";
+ print PRINTER "$rbordata->{'surname'}; $rbordata->{'firstname'}\r\n";
+ print PRINTER "$rbordata->{'cardnumber'}\r\n";
+ print PRINTER "Phone: $rbordata->{'phone'}\r\n";
+ print PRINTER "$rbordata->{'streetaddress'}\r\n";
+ print PRINTER "$rbordata->{'suburb'}\r\n";
+ print PRINTER "$rbordata->{'town'}\r\n";
+ print PRINTER "$rbordata->{'emailaddress'}\r\n\r\n";
+ print PRINTER "$itemdata->{'barcode'}\r\n";
+ print PRINTER "$itemdata->{'title'}\r\n";
+ print PRINTER "$itemdata->{'author'}";
+ print PRINTER "\r\n\r\n\r\n\r\n\r\n\r\n\r\n";
+ if ($env->{'printtype'} eq "docket"){
+ #print chr(27).char(105);
+ }
+ close PRINTER;
+ #system("lpr /tmp/$file");
+}
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+package C4::Reserves; #asummes C4/Reserves
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Format;
+use C4::Accounts;
+use C4::Stats;
+use C4::InterfaceCDK;
+use C4::Interface::ReserveentCDK;
+use C4::Circulation::Main;
+use C4::Circulation::Borrower;
+use C4::Search;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&EnterReserves CalcReserveFee CreateReserve );
+%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 EnterReserves{
+ my ($env)=@_;
+ 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 "") {
+ $donext = $reason;
+ } else {
+ my %search;
+ $search{'title'}= $title;
+ $search{'keyword'}=$keyword;
+ $search{'author'}=$author;
+ $search{'subject'}=$subject;
+ $search{'item'}=$itemnumber;
+ $search{'isbn'}=$isbn;
+ my @results;
+ my $count;
+ if ($num < 1 ) {
+ $num = 30;
+ }
+ my $offset = 0;
+ my $title = titlepanel($env,"Reserves","Searching");
+ if ($itemnumber ne '' || $isbn ne ''){
+ ($count,@results)=&CatSearch($env,'precise',\%search,$num,$offset);
+ } else {
+ if ($subject ne ''){
+ ($count,@results)=&CatSearch($env,'subject',\%search,$num,$offset);
+ } else {
+ if ($keyword ne ''){
+ ($count,@results)=&KeywordSearch($env,'intra',\%search,$num,$offset);
+ } else {
+ ($count,@results)=&CatSearch($env,'loose',\%search,$num,$offset);
+ }
+ }
+ }
+ my $no_ents = @results;
+ my $biblionumber;
+ if ($no_ents > 0) {
+ if ($no_ents == 1) {
+ my @ents = split("\t",@results[0]);
+ $biblionumber = @ents[2];
+ } else {
+ my %biblio_xref;
+ my @bibtitles;
+ my $i = 0;
+ my $line;
+ while ($i < $no_ents) {
+ my @ents = split("\t",@results[$i]);
+ $line = fmtstr($env,@ents[1],"L70");
+ my $auth = substr(@ents[0],0,30);
+ substr($line,(70-length($auth)-2),length($auth)+2) = " ".$auth;
+ @bibtitles[$i]=$line;
+ $biblio_xref{$line}=@ents[2];
+ $i++;
+ }
+ my $title = titlepanel($env,"Reserves","Select Title");
+ my ($results,$bibres) = SelectBiblio($env,$count,\@bibtitles);
+ if ($results eq "") {
+ $biblionumber = $biblio_xref{$bibres};
+ } else {
+ $donext = $results;
+ }
+ }
+
+ if ($biblionumber eq "") {
+ error_msg($env,"No items found");
+ } else {
+ my @items = GetItems($env,$biblionumber);
+ my $cnt_it = @items;
+ my $dbh = &C4Connect;
+ my $query = "Select * from biblio where biblionumber = $biblionumber";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ my @branches;
+ my $query = "select * from branches where issuing=1 order by branchname";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $branchrec=$sth->fetchrow_hashref) {
+ my $branchdet =
+ fmtstr($env,$branchrec->{'branchcode'},"L2")." ".$branchrec->{'branchname'};
+ push @branches,$branchdet;
+ }
+ $sth->finish;
+ $donext = "";
+ while ($donext eq "") {
+ my $title = titlepanel($env,"Reserves","Create Reserve");
+ my ($reason,$borcode,$branch,$constraint,$bibitems) =
+ MakeReserveScreen($env, $data, \@items, \@branches);
+ if ($borcode ne "") {
+ my ($borrnum,$borrower) = findoneborrower($env,$dbh,$borcode);
+ if ($reason eq "") {
+ if ($borrnum ne "") {
+ my $fee =
+ CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems);
+ CreateReserve($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$fee);
+ $donext = "Circ"
+ }
+
+ } else {
+ $donext = $reason;
+ }
+ } else { $donext = "Circ" }
+ }
+ $dbh->disconnect;
+ }
+ }
+ }
+ return ($donext);
+}
+
+sub CalcReserveFee {
+ my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_;
+ #check for issues;
+ my $dbh = &C4Connect;
+ my $const = lc substr($constraint,0,1);
+ my $query = "select * from borrowers,categories
+ where (borrowernumber = '$borrnum')
+ and (borrowers.categorycode = categories.categorycode)";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish();
+ my $fee = $data->{'reservefee'};
+ my $cntitems = @->$bibitems;
+ if ($fee > 0) {
+ # check for items on issue
+ # first find biblioitem records
+ my @biblioitems;
+ my $query1 = "select * from biblio,biblioitems
+ where (biblio.biblionumber = '$biblionumber')
+ and (biblio.biblionumber = biblioitems.biblionumber)";
+ my $sth1 = $dbh->prepare($query1);
+ $sth1->execute();
+ while (my $data1=$sth1->fetchrow_hashref) {
+ if ($const eq "a") {
+ push @biblioitems,$data1;
+ } else {
+ my $found = 0;
+ my $x = 0;
+ while ($x < $cntitems) {
+ if (@$bibitems->{'biblioitemnumber'} == $data->{'biblioitemnumber'}) {
+ $found = 1;
+ }
+ $x++;
+ }
+ if ($const eq 'o') {if ($found == 1) {push @biblioitems,$data;}
+ } else {if ($found == 0) {push @biblioitems,$data;} }
+ }
+ }
+ $sth1->finish;
+ my $cntitemsfound = @biblioitems;
+ my $issues = 0;
+ my $x = 0;
+ my $allissued = 1;
+ while ($x < $cntitemsfound) {
+ my $bitdata = @biblioitems[$x];
+ my $query2 = "select * from items
+ where biblioitemnumber = '$bitdata->{'biblioitemnumber'}'";
+ my $sth2 = $dbh->prepare($query2);
+ $sth2->execute;
+ while (my $itdata=$sth2->fetchrow_hashref) {
+ my $query3 = "select * from issues
+ where itemnumber = '$itdata->{'itemnumber'}' and returndate is null";
+ my $sth3 = $dbh->prepare($query3);
+ $sth3->execute();
+ if (my $isdata=$sth3->fetchrow_hashref) { } else {$allissued = 0; }
+ }
+ $x++;
+ }
+ if ($allissued == 0) {
+ my $rquery = "select * from reserves
+ where biblionumber = '$biblionumber'";
+ my $rsth = $dbh->prepare($rquery);
+ $rsth->execute();
+ if (my $rdata = $rsth->fetchrow_hashref) { } else {
+ $fee = 0;
+ }
+ }
+ }
+ $dbh->disconnect();
+ return $fee;
+} # end CalcReserveFee
+
+sub CreateReserve {
+ my ($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$fee) = @_;
+ my $dbh = &C4Connect;
+ #$dbh->{RaiseError} = 1;
+ #$dbh->{AutoCommit} = 0;
+ my $const = lc substr($constraint,0,1);
+ my @datearr = localtime(time);
+ my $resdate = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ #eval {
+ # updates take place here
+ if ($fee > 0) {
+ my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
+ my $updquery = "insert into accountlines
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values ($borrnum,$nextacctno,now(),$fee,'Reserve Charge','Res',$fee)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ my $query="insert into reserves (borrowernumber,biblionumber,reservedate,branchcode,constrainttype) values ('$borrnum','$biblionumber','$resdate','$branch','$const')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ if (($const eq "o") || ($const eq "e")) {
+ my $numitems = @$bibitems;
+ my $i = 0;
+ while ($i < $numitems) {
+ my $biblioitem = @$bibitems[$i];
+ my $query = "insert into reserveconstraints
+ (borrowernumber,biblionumber,reservedate,biblioitemnumber)
+ values ('$borrnum','$biblionumber','$resdate','$biblioitem')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ $i++;
+ }
+ }
+ UpdateStats($env,'branch','reserve',$fee);
+ #$dbh->commit();
+ #};
+ #if (@_) {
+ # # update failed
+ # my $temp = @_;
+ # # error_msg($env,"Update failed");
+ # $dbh->rollback();
+ #}
+ $dbh->disconnect();
+ return();
+} # end CreateReserve
+
+
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Reserves2; #asummes C4/Reserves2
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+#use C4::Accounts;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&FindReserves &CreateReserve &updatereserves &getreservetitle);
+%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 FindReserves {
+ my ($bib,$bor)=@_;
+ my $dbh=C4Connect;
+ my $query="Select *,reserves.branchcode
+ from reserves,borrowers,biblio ";
+ if ($bib ne ''){
+ if ($bor ne ''){
+ $query=$query." where reserves.biblionumber=$bib and
+ reserves.borrowernumber=borrowers.borrowernumber and
+ biblio.biblionumber=$bib and cancellationdate is NULL and
+ (found <> 'F' or found is NULL)";
+ } else {
+ $query=$query." where reserves.borrowernumber=borrowers.borrowernumber
+ and biblio.biblionumber=$bib and reserves.biblionumber=$bib
+ and cancellationdate is NULL and
+ (found <> 'F' or found is NULL)";
+ }
+ } else {
+ $query=$query." where borrowers.borrowernumber=$bor and
+ reserves.borrowernumber=borrowers.borrowernumber and reserves.biblionumber
+ =biblio.biblionumber and cancellationdate is NULL and
+ (found <> 'F' or found is NULL)";
+ }
+ $query.=" order by priority";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+# print $query;
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+sub CreateReserve {
+ my
+($env,$branch,$borrnum,$biblionumber,$constraint,$bibitems,$priority,$notes,$title)= @_;
+ my $fee=CalcReserveFee($env,$borrnum,$biblionumber,$constraint,$bibitems);
+ my $dbh = &C4Connect;
+ my $const = lc substr($constraint,0,1);
+ my @datearr = localtime(time);
+ my $resdate =(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ #eval {
+ # updates take place here
+ if ($fee > 0) {
+# print $fee;
+ my $nextacctno = &getnextacctno($env,$borrnum,$dbh);
+ my $updquery = "insert into accountlines
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values
+ ($borrnum,$nextacctno,now(),$fee,'Reserve Charge - $title','Res',$fee)";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ #if ($const eq 'a'){
+ my $query="insert into reserves
+ (borrowernumber,biblionumber,reservedate,branchcode,constrainttype,priority,reservenotes)
+ values
+('$borrnum','$biblionumber','$resdate','$branch','$const','$priority','$notes')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ $sth->finish;
+ #}
+ if (($const eq "o") || ($const eq "e")) {
+ my $numitems = @$bibitems;
+ my $i = 0;
+ while ($i < $numitems) {
+ my $biblioitem = @$bibitems[$i];
+ my $query = "insert into
+ reserveconstraints
+ (borrowernumber,biblionumber,reservedate,biblioitemnumber)
+ values
+ ('$borrnum','$biblionumber','$resdate','$biblioitem')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ $sth->finish;
+ $i++;
+ }
+ }
+# print $query;
+ $dbh->disconnect();
+ return();
+}
+
+sub CalcReserveFee {
+ my ($env,$borrnum,$biblionumber,$constraint,$bibitems) = @_;
+ #check for issues;
+ my $dbh = &C4Connect;
+ my $const = lc substr($constraint,0,1);
+ my $query = "select * from borrowers,categories
+ where (borrowernumber = '$borrnum')
+ and (borrowers.categorycode = categories.categorycode)";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish();
+ my $fee = $data->{'reservefee'};
+ my $cntitems = @->$bibitems;
+ if ($fee > 0) {
+ # check for items on issue
+ # first find biblioitem records
+ my @biblioitems;
+ my $query1 = "select * from biblio,biblioitems
+ where (biblio.biblionumber = '$biblionumber')
+ and (biblio.biblionumber = biblioitems.biblionumber)";
+ my $sth1 = $dbh->prepare($query1);
+ $sth1->execute();
+ while (my $data1=$sth1->fetchrow_hashref) {
+ if ($const eq "a") {
+ push @biblioitems,$data1;
+ } else {
+ my $found = 0;
+ my $x = 0;
+ while ($x < $cntitems) {
+ if (@$bibitems->{'biblioitemnumber'} == $data->{'biblioitemnumber'}) {
+ $found = 1;
+ }
+ $x++;
+ }
+ if ($const eq 'o') {if ($found == 1) {push @biblioitems,$data;}
+ } else {if ($found == 0) {push @biblioitems,$data;} }
+ }
+ }
+ $sth1->finish;
+ my $cntitemsfound = @biblioitems;
+ my $issues = 0;
+ my $x = 0;
+ my $allissued = 1;
+ while ($x < $cntitemsfound) {
+ my $bitdata = @biblioitems[$x];
+ my $query2 = "select * from items
+ where biblioitemnumber = '$bitdata->{'biblioitemnumber'}'";
+ my $sth2 = $dbh->prepare($query2);
+ $sth2->execute;
+ while (my $itdata=$sth2->fetchrow_hashref) {
+ my $query3 = "select * from issues
+ where itemnumber = '$itdata->{'itemnumber'}' and
+ returndate is null";
+ my $sth3 = $dbh->prepare($query3);
+ $sth3->execute();
+ if (my $isdata=$sth3->fetchrow_hashref) { } else
+ {$allissued = 0; }
+ }
+ $x++;
+ }
+ if ($allissued == 0) {
+ my $rquery = "select * from reserves
+ where biblionumber = '$biblionumber'";
+ my $rsth = $dbh->prepare($rquery);
+ $rsth->execute();
+ if (my $rdata = $rsth->fetchrow_hashref) { } else {
+ $fee = 0;
+ }
+ }
+ }
+# print "fee $fee";
+ $dbh->disconnect();
+ return $fee;
+}
+
+sub getnextacctno {
+ my ($env,$bornumber,$dbh)=@_;
+ my $nextaccntno = 1;
+ my $query = "select * from accountlines
+ where (borrowernumber = '$bornumber')
+ order by accountno desc";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ if (my $accdata=$sth->fetchrow_hashref){
+ $nextaccntno = $accdata->{'accountno'} + 1;
+ }
+ $sth->finish;
+ return($nextaccntno);
+}
+
+sub updatereserves{
+ #subroutine to update a reserve
+ my ($rank,$biblio,$borrower,$del,$branch)=@_;
+ my $dbh=C4Connect;
+ my $query="Update reserves ";
+ if ($del ==0){
+ $query.="set priority='$rank',branchcode='$branch' where
+ biblionumber=$biblio and borrowernumber=$borrower";
+ } else {
+ $query="Select * from reserves where biblionumber=$biblio and
+ borrowernumber=$borrower";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $query="Select * from reserves where biblionumber=$biblio and
+ priority > '$data->{'priority'}' and cancellationdate is NULL
+ order by priority";
+ my $sth2=$dbh->prepare($query) || die $dbh->errstr;
+ $sth2->execute || die $sth2->errstr;
+ while (my $data=$sth2->fetchrow_hashref){
+ $data->{'priority'}--;
+ $query="Update reserves set priority=$data->{'priority'} where
+ biblionumber=$data->{'biblionumber'} and
+ borrowernumber=$data->{'borrowernumber'}";
+ my $sth3=$dbh->prepare($query);
+ $sth3->execute || die $sth3->errstr;
+ $sth3->finish;
+ }
+ $sth2->finish;
+ $query="update reserves set cancellationdate=now() where biblionumber=$biblio
+ and borrowernumber=$borrower";
+ }
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub getreservetitle {
+ my ($biblio,$bor,$date,$timestamp)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from reserveconstraints,biblioitems where
+ reserveconstraints.biblioitemnumber=biblioitems.biblioitemnumber
+ and reserveconstraints.biblionumber=$biblio and reserveconstraints.borrowernumber
+ = $bor and reserveconstraints.reservedate='$date' and
+ reserveconstraints.timestamp=$timestamp";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+# print $query;
+ return($data);
+}
+
+
+
+
+
+
+END { } # module clean-up code here (global destructor)
--- /dev/null
+package C4::Scan; #asummes C4/Scan.pm
+
+use strict;
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&getbarcode);
+%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 Getbarcode {
+}
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+package C4::Search; #asummes C4/Search
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Reserves2;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&CatSearch &BornameSearch &ItemInfo &KeywordSearch &subsearch
+&itemdata &bibdata &GetItems &borrdata &getacctlist &itemnodata &itemcount
+&OpacSearch &borrdata2 &NewBorrowerNumber &bibitemdata &borrissues
+&getboracctrecord &ItemType &itemissues &FrontSearch &subject &subtitle
+&addauthor &bibitems &barcodes &findguarantees &allissues);
+%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 findguarantees{
+ my ($bornum)=@_;
+ my $dbh=C4Connect;
+ my $query="select cardnumber,borrowernumber from borrowers where
+ guarantor='$bornum'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @dat;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $dat[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@dat);
+}
+
+sub NewBorrowerNumber {
+ my $dbh=C4Connect;
+ my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers");
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $data->{'max(borrowernumber)'}++;
+ $dbh->disconnect;
+ return($data->{'max(borrowernumber)'});
+}
+
+sub OpacSearch {
+ my ($env,$type,$search,$num,$offset)=@_;
+ my $dbh = &C4Connect;
+ $search->{'keyword'}=~ s/'/\\'/g;
+ my @key=split(' ',$search->{'keyword'});
+ my $count=@key;
+ my $i=1;
+ my @results;
+ my $query ="Select count(*) from biblio where
+ ((title like '$key[0]%' or title like '% $key[0]%')";
+ while ($i < $count){
+ $query=$query." and (title like '$key[$i]%' or title like '% $key[$i]%')";
+ $i++;
+ }
+ $query=$query.") or ((author like '$key[0]%' or author like '% $key[0]%')";
+ $i=1;
+ while ($i < $count){
+ $query=$query." and (author like '$key[$i]%' or author like '% $key[$i]%')";
+ $i++;
+ }
+ $query.=") or ((seriestitle like '$key[0]%' or seriestitle like '% $key[0]%')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (seriestitle like '$key[$i]%' or seriestitle like '% $key[$i]%')";
+ }
+ $query.= ") or ((notes like '$key[0]%' or notes like '% $key[0]%')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (notes like '$key[$i]%' or notes like '% $key[$i]%')";
+ }
+ $query=$query.") order by title";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ my $count=$data->{'count(*)'};
+ $sth->finish;
+ $query=~ s/count\(\*\)/\*/;
+ $query= $query." limit $offset,$num";
+ $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}";
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($count,@results);
+}
+
+
+
+sub FrontSearch {
+ my ($env,$type,$search,$num,$offset)=@_;
+ my $dbh = &C4Connect;
+ $search->{'front'}=~ s/ +$//;
+ $search->{'front'}=~ s/'/\\'/;
+ my @key=split(' ',$search->{'front'});
+ my $count=@key;
+ my $i=1;
+ my @results;
+ my $query ="Select * from biblio,bibliosubtitle where
+ biblio.biblionumber=bibliosubtitle.biblionumber and
+ ((title like '$key[0]%' or title like '% $key[0]%'
+ or subtitle like '$key[0]%' or subtitle like '% $key[0]%'
+ or author like '$key[0]%' or author like '% $key[0]%')";
+ while ($i < $count){
+ $query=$query." and (title like '%$key[$i]%' or subtitle like '%$key[$i]%')";
+ $i++;
+ }
+ $query=$query.") group by biblio.biblionumber order by author,title";
+ print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}";
+# print $results[$i];
+ $i++;
+ }
+ $sth->finish;
+ $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject
+ like '%$search->{'keyword'}%'");
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ my $sth2=$dbh->prepare("Select * from biblio where
+ biblionumber=$data->{'biblionumber'}");
+ $sth2->execute;
+ while (my $data2=$sth2->fetchrow_hashref){
+
+$results[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data->{'copyrightdate'}";
+# print $results[$i];
+ $i++;
+ }
+ $sth2->finish;
+ }
+ my $i2=1;
+ @results=sort @results;
+ my @res;
+ my $count=@results;
+ $i=1;
+ $res[0]=$results[0];
+ while ($i2 < $count){
+ if ($results[$i2] ne $res[$i-1]){
+ $res[$i]=$results[$i2];
+ $i++;
+ }
+ $i2++;
+ }
+ $i2=0;
+ my @res2;
+ $count=@res;
+ while ($i2 < $num && $i2 < $count){
+ $res2[$i2]=$res[$i2+$offset];
+# print $res2[$i2];
+ $i2++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@res2);
+}
+
+
+sub KeywordSearch {
+ my ($env,$type,$search,$num,$offset)=@_;
+ my $dbh = &C4Connect;
+ $search->{'keyword'}=~ s/ +$//;
+ $search->{'keyword'}=~ s/'/\\'/;
+ my @key=split(' ',$search->{'keyword'});
+ my $count=@key;
+ my $i=1;
+ my @results;
+ my $query ="Select * from biblio,bibliosubtitle,biblioitems where
+ biblio.biblionumber=bibliosubtitle.biblionumber and
+ biblioitems.biblionumber=biblio.biblionumber and
+ (((title like '$key[0]%' or title like '% $key[0]%')";
+ while ($i < $count){
+ $query=$query." and (title like '$key[$i]%' or title like '% $key[$i]%')";
+ $i++;
+ }
+ $query.= ") or ((subtitle like '$key[0]%' or subtitle like '% $key[0]%')";
+ for ($i=1;$i<$count;$i++){
+ $query.= " and (subtitle like '$key[$i]%' or subtitle like '% $key[$i]%')";
+ }
+ $query.= ") or ((seriestitle like '$key[0]%' or seriestitle like '% $key[0]%')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (seriestitle like '$key[$i]%' or seriestitle like '% $key[$i]%')";
+ }
+ $query.= ") or ((biblio.notes like '$key[0]%' or biblio.notes like '% $key[0]%')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (biblio.notes like '$key[$i]%' or biblio.notes like '% $key[$i]%')";
+ }
+ $query.= ") or ((biblioitems.notes like '$key[0]%' or biblioitems.notes like '% $key[0]%')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (biblioitems.notes like '$key[$i]%' or biblioitems.notes like '% $key[$i]%')";
+ }
+ if ($search->{'keyword'} =~ /new zealand/i){
+ $query.= "or (title like 'nz%' or title like '% nz %' or title like '% nz' or subtitle like 'nz%'
+ or subtitle like '% nz %' or subtitle like '% nz' or author like 'nz %'
+ or author like '% nz %' or author like '% nz')"
+ }
+ if ($search->{'keyword'} eq 'nz' || $search->{'keyword'} eq 'NZ' ||
+ $search->{'keyword'} =~ /nz /i || $search->{'keyword'} =~ / nz /i ||
+ $search->{'keyword'} =~ / nz/i){
+ $query.= "or (title like 'new zealand%' or title like '% new zealand %'
+ or title like '% new zealand' or subtitle like 'new zealand%' or
+ subtitle like '% new zealand %'
+ or subtitle like '% new zealand' or author like 'new zealand%'
+ or author like '% new zealand %' or author like '% new zealand' or
+ seriestitle like 'new zealand%' or seriestitle like '% new zealand %'
+ or seriestitle like '% new zealand')"
+ }
+ $query=$query."))";
+ if ($search->{'class'} ne ''){
+ my @temp=split(/\|/,$search->{'class'});
+ my $count=@temp;
+ $query.= "and ( itemtype='$temp[0]'";
+ for (my $i=1;$i<$count;$i++){
+ $query.=" or itemtype='$temp[$i]'";
+ }
+ $query.=")";
+ }
+ $query.="group by biblio.biblionumber order by author,title";
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}";
+# print $results[$i];
+ $i++;
+ }
+ $sth->finish;
+ $sth=$dbh->prepare("Select biblionumber from bibliosubject where subject
+ like '%$search->{'keyword'}%'");
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ $query="Select * from biblio,biblioitems where
+ biblio.biblionumber=$data->{'biblionumber'} and biblio.biblionumber=biblioitems.biblionumber";
+ if ($search->{'class'} ne ''){
+ my @temp=split(/\|/,$search->{'class'});
+ my $count=@temp;
+ $query.= " and ( itemtype='$temp[0]'";
+ for (my $i=1;$i<$count;$i++){
+ $query.=" or itemtype='$temp[$i]'";
+ }
+ $query.=")";
+ }
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+# print $query;
+ while (my $data2=$sth2->fetchrow_hashref){
+ $results[$i]="$data2->{'author'}\t$data2->{'title'}\t$data2->{'biblionumber'}\t$data2->{'copyrightdate'}";
+# print $results[$i];
+ $i++;
+ }
+ $sth2->finish;
+ }
+ my $i2=1;
+ @results=sort @results;
+ my @res;
+ my $count=@results;
+ $i=1;
+ if ($count > 0){
+ $res[0]=$results[0];
+ }
+ while ($i2 < $count){
+ if ($results[$i2] ne $res[$i-1]){
+ $res[$i]=$results[$i2];
+ $i++;
+ }
+ $i2++;
+ }
+ $i2=0;
+ my @res2;
+ $count=@res;
+ while ($i2 < $num && $i2 < $count){
+ $res2[$i2]=$res[$i2+$offset];
+# print $res2[$i2];
+ $i2++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+# $i--;
+ return($i,@res2);
+}
+
+sub CatSearch {
+ my ($env,$type,$search,$num,$offset)=@_;
+ my $dbh = &C4Connect;
+ my $query = '';
+ my @results;
+ $search->{'title'}=~ s/'/\\'/g;
+ $search->{'author'}=~ s/'/\\'/g;
+ my $title = lc($search->{'title'});
+
+ if ($type eq 'loose') {
+ if ($search->{'author'} ne ''){
+ my @key=split(' ',$search->{'author'});
+ my $count=@key;
+ my $i=1;
+ $query="select *,biblio.author,biblio.biblionumber from
+ biblioitems,biblio
+ left join additionalauthors
+ on additionalauthors.biblionumber =biblio.biblionumber
+ where biblioitems.biblionumber=biblio.biblionumber
+ and
+ ((biblio.author like '$key[0]%' or biblio.author like '% $key[0]%' or
+ additionalauthors.author like '$key[0]%' or additionalauthors.author
+ like '% $key[0]%'
+ )";
+ while ($i < $count){
+ $query=$query." and (
+ biblio.author like '$key[$i]%' or biblio.author like '% $key[$i]%' or
+ additionalauthors.author like '$key[$i]%' or additionalauthors.author like '% $key[$i]%'
+ )";
+ $i++;
+ }
+ $query=$query.")";
+ if ($search->{'title'} ne ''){
+ $query=$query. " and title like '%$search->{'title'}%'";
+ }
+ if ($search->{'class'} ne ''){
+ my @temp=split(/\|/,$search->{'class'});
+ my $count=@temp;
+ $query.= "and ( itemtype='$temp[0]'";
+ for (my $i=1;$i<$count;$i++){
+ $query.=" or itemtype='$temp[$i]'";
+ }
+ $query.=") ";
+ }
+ if ($search->{'dewey'} ne ''){
+ $query.=" and dewey='$search->{'dewey'}' ";
+ }
+
+ $query.=" group by biblio.biblionumber";
+ } else {
+ if ($search->{'title'} ne ''){
+ if ($search->{'ttype'} eq 'exact'){
+ $query="select * from biblio
+ where
+ (biblio.title='$search->{'title'}' or (biblio.unititle = '$search->{'title'}'
+ or biblio.unititle like '$search->{'title'} |%' or
+ biblio.unititle like '%| $search->{'title'} |%' or
+ biblio.unititle like '%| $search->{'title'}') or
+ (biblio.seriestitle = '$search->{'title'}' or
+ biblio.seriestitle like '$search->{'title'} |%' or
+ biblio.seriestitle like '%| $search->{'title'} |%' or
+ biblio.seriestitle like '%| $search->{'title'}')
+ )";
+ } else {
+ my @key=split(' ',$search->{'title'});
+ my $count=@key;
+ my $i=1;
+ $query="select * from biblio,bibliosubtitle,biblioitems
+ where
+ (biblio.biblionumber=bibliosubtitle.biblionumber and
+ biblioitems.biblionumber=biblio.biblionumber) and
+ (((title like '$key[0]%' or title like '% $key[0]%' or title like '% $key[0]')";
+ while ($i<$count){
+ $query=$query." and (title like '$key[$i]%' or title like '% $key[$i]%' or title like '% $key[$i]')";
+ $i++;
+ }
+ $query.=") or ((subtitle like '$key[0]%' or subtitle like '% $key[0] %' or subtitle like '% $key[0]')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (subtitle like '$key[$i]%' or subtitle like '% $key[$i] %' or subtitle like '% $key[$i]')";
+ }
+ $query.=") or ((seriestitle like '$key[0]%' or seriestitle like '% $key[0] %' or seriestitle like '% $key[0]')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (seriestitle like '$key[$i]%' or seriestitle like '% $key[$i] %')";
+ }
+ $query.=") or ((unititle like '$key[0]%' or unititle like '% $key[0] %' or unititle like '% $key[0]')";
+ for ($i=1;$i<$count;$i++){
+ $query.=" and (unititle like '$key[$i]%' or unititle like '% $key[$i] %')";
+ }
+ $query=$query."))";
+ if ($search->{'class'} ne ''){
+ my @temp=split(/\|/,$search->{'class'});
+ my $count=@temp;
+ $query.= " and ( itemtype='$temp[0]'";
+ for (my $i=1;$i<$count;$i++){
+ $query.=" or itemtype='$temp[$i]'";
+ }
+ $query.=")";
+ }
+ if ($search->{'dewey'} ne ''){
+ $query.=" and dewey='$search->{'dewey'}' ";
+ }
+ }
+ } elsif ($search->{'class'} ne ''){
+ $query="select * from biblioitems,biblio where biblio.biblionumber=biblioitems.biblionumber";
+ my @temp=split(/\|/,$search->{'class'});
+ my $count=@temp;
+ $query.= " and ( itemtype='$temp[0]'";
+ for (my $i=1;$i<$count;$i++){
+ $query.=" or itemtype='$temp[$i]'";
+ }
+ $query.=")";
+ } elsif ($search->{'dewey'} ne ''){
+ $query="select * from biblioitems,biblio
+ where biblio.biblionumber=biblioitems.biblionumber
+ and biblioitems.dewey like '$search->{'dewey'}%'";
+ }
+ $query .=" group by biblio.biblionumber";
+ }
+
+ }
+ if ($type eq 'subject'){
+ my @key=split(' ',$search->{'subject'});
+ my $count=@key;
+ my $i=1;
+ $query="select distinct(subject) from bibliosubject where( subject like
+ '$key[0]%' or subject like '% $key[0]%' or subject like '% $key[0]' or subject like '%($key[0])%')";
+ while ($i<$count){
+ $query.=" and (subject like '$key[$i]%' or subject like '% $key[$i]%'
+ or subject like '% $key[$i]'
+ or subject like '%($key[$i])%')";
+ $i++;
+ }
+ if ($search->{'subject'} eq 'NZ' || $search->{'subject'} eq 'nz'){
+ $query.= " or (subject like 'NEW ZEALAND %' or subject like '% NEW ZEALAND %'
+ or subject like '% NEW ZEALAND' or subject like '%(NEW ZEALAND)%' ) ";
+ } elsif ( $search->{'subject'} =~ /^nz /i || $search->{'subject'} =~ / nz /i || $search->{'subject'} =~ / nz$/i){
+ $query=~ s/ nz/ NEW ZEALAND/ig;
+ $query=~ s/nz /NEW ZEALAND /ig;
+ $query=~ s/\(nz\)/\(NEW ZEALAND\)/gi;
+ }
+ }
+ if ($type eq 'precise'){
+ $query="select * from items,biblio ";
+ if ($search->{'item'} ne ''){
+ my $search2=uc $search->{'item'};
+ $query=$query." where
+ items.biblionumber=biblio.biblionumber
+ and barcode='$search2'";
+ }
+ if ($search->{'isbn'} ne ''){
+ my $search2=uc $search->{'isbn'};
+ my $query1 = "select * from biblioitems where isbn='$search2'";
+ my $sth1=$dbh->prepare($query1);
+# print $query1;
+ $sth1->execute;
+ my $i2=0;
+ while (my $data=$sth1->fetchrow_hashref) {
+ $query="select * from biblioitems,biblio where
+ biblio.biblionumber = $data->{'biblionumber'}
+ and biblioitems.biblionumber = biblio.biblionumber";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $results[$i2]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}\t$data->{'isbn'}\t$data->{'itemtype'}";
+ $i2++;
+ $sth->finish;
+ }
+ $sth1->finish;
+ }
+ }
+#print $query;
+if ($type ne 'precise' && $type ne 'subject'){
+ if ($search->{'author'} ne ''){
+ $query=$query." order by biblio.author,title";
+ } else {
+ $query=$query." order by title";
+ }
+} else {
+ if ($type eq 'subject'){
+ $query=$query." order by subject";
+ }
+}
+#print $query;
+my $sth=$dbh->prepare($query);
+$sth->execute;
+my $count=1;
+my $i=0;
+my $limit= $num+$offset;
+while (my $data=$sth->fetchrow_hashref){
+ if ($count > $offset && $count <= $limit){
+ if ($type ne 'subject' && $type ne 'precise'){
+ $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}";
+ } elsif ($search->{'isbn'} ne '' || $search->{'item'} ne ''){
+ $results[$i]="$data->{'author'}\t$data->{'title'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}";
+ } else {
+ $results[$i]="$data->{'author'}\t$data->{'subject'}\t$data->{'biblionumber'}\t$data->{'copyrightdate'}";
+ }
+ $i++;
+ }
+ $count++;
+}
+$sth->finish;
+#if ($type ne 'precise'){
+ $count--;
+#}
+#$count--;
+return($count,@results);
+}
+
+sub updatesearchstats{
+ my ($dbh,$query)=@_;
+
+}
+
+sub subsearch {
+ my ($env,$subject)=@_;
+ my $dbh=C4Connect();
+ my $query="Select * from biblio,bibliosubject where
+ biblio.biblionumber=bibliosubject.biblionumber and
+ bibliosubject.subject='$subject' group by biblio.biblionumber
+ order by biblio.title";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+# print $query;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]="$data->{'title'}\t$data->{'author'}\t$data->{'biblionumber'}";
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return(@results);
+}
+
+
+sub ItemInfo {
+ my ($env,$biblionumber,$type)=@_;
+ my $dbh = &C4Connect;
+ my $query="Select * from items,biblio,biblioitems,branches
+ where (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and biblioitems.biblionumber=biblio.biblionumber
+ and biblio.biblionumber='$biblionumber' and branches.branchcode=
+ items.holdingbranch ";
+# print $type;
+ if ($type ne 'intra'){
+ $query.=" and (items.itemlost<>1 or items.itemlost is NULL)
+ and (wthdrawn <> 1 or wthdrawn is NULL)";
+ }
+ $query=$query."order by items.dateaccessioned desc";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+ my @results;
+# print $query;
+ while (my $data=$sth->fetchrow_hashref){
+ my $iquery = "Select * from issues
+ where itemnumber = '$data->{'itemnumber'}'
+ and returndate is null";
+ my $datedue = '';
+ my $isth=$dbh->prepare($iquery);
+ $isth->execute;
+ if (my $idata=$isth->fetchrow_hashref){
+ my @temp=split('-',$idata->{'date_due'});
+ $datedue = "$temp[2]/$temp[1]/$temp[0]";
+ }
+ if ($data->{'itemlost'} eq '1'){
+ $datedue='Itemlost';
+ }
+ if ($data->{'wthdrawn'} eq '1'){
+ $datedue="Cancelled";
+ }
+ if ($datedue eq ''){
+ my ($rescount,$reserves)=FindReserves($biblionumber,'');
+ if ($rescount >0){
+ $datedue='Request';
+ }
+ }
+ $isth->finish;
+ my $class = $data->{'classification'};
+ my $dewey = $data->{'dewey'};
+ $dewey =~ s/0+$//;
+ if ($dewey eq "000.") { $dewey = "";};
+ if ($dewey < 10){$dewey='00'.$dewey;}
+ if ($dewey < 100 && $dewey > 10){$dewey='0'.$dewey;}
+ if ($dewey <= 0){
+ $dewey='';
+ }
+ $dewey=~ s/\.$//;
+ $class = $class.$dewey;
+ $class = $class.$data->{'subclass'};
+ # $results[$i]="$data->{'title'}\t$data->{'barcode'}\t$datedue\t$data->{'branchname'}\t$data->{'dewey'}";
+ my @temp=split('-',$data->{'datelastseen'});
+ my $date="$temp[2]/$temp[1]/$temp[0]";
+ $results[$i]="$data->{'title'}\t$data->{'barcode'}\t$datedue\t$data->{'branchname'}\t$class\t$data->{'itemnumber'}\t$data->{'itemtype'}\t$date\t$data->{'biblioitemnumber'}\t$data->{'volumeddesc'}";
+# print "$results[$i] <br>";
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return(@results);
+}
+
+sub GetItems {
+ my ($env,$biblionumber)=@_;
+ #debug_msg($env,"GetItems");
+ my $dbh = &C4Connect;
+ my $query = "Select * from biblioitems where (biblionumber = $biblionumber)";
+ #debug_msg($env,$query);
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ #debug_msg($env,"executed query");
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref) {
+ #debug_msg($env,$data->{'biblioitemnumber'});
+ my $dewey = $data->{'dewey'};
+ $dewey =~ s/0+$//;
+ my $line = $data->{'biblioitemnumber'}."\t".$data->{'itemtype'};
+ $line = $line."\t$data->{'classification'}\t$dewey";
+ $line = $line."\t$data->{'subclass'}\t$data->{isbn}";
+ $line = $line."\t$data->{'volume'}\t$data->{number}";
+ my $isth= $dbh->prepare("select * from items where biblioitemnumber = $data->{'biblioitemnumber'}");
+ $isth->execute;
+ while (my $idata = $isth->fetchrow_hashref) {
+ my $iline = $idata->{'barcode'}."[".$idata->{'holdingbranch'}."[";
+ if ($idata->{'notforloan'} == 1) {
+ $iline = $iline."NFL ";
+ }
+ if ($idata->{'itemlost'} == 1) {
+ $iline = $iline."LOST ";
+ }
+ $line = $line."\t$iline";
+ }
+ $isth->finish;
+ $results[$i] = $line;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return(@results);
+}
+
+sub itemdata {
+ my ($barcode)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from items,biblioitems where barcode='$barcode'
+ and items.biblioitemnumber=biblioitems.biblioitemnumber";
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+sub bibdata {
+ my ($bibnum,$type)=@_;
+ my $dbh=C4Connect;
+ my $query="Select *,biblio.notes from biblio,biblioitems,bibliosubtitle where biblio.biblionumber=$bibnum
+ and biblioitems.biblionumber=$bibnum and
+(bibliosubtitle.biblionumber=$bibnum)";
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $query="Select * from bibliosubject where biblionumber='$bibnum'";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $dat=$sth->fetchrow_hashref){
+ $data->{'subject'}.=" | $dat->{'subject'}";
+
+ }
+ #print $query;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+sub bibitemdata {
+ my ($bibitem)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from biblio,biblioitems,itemtypes where biblio.biblionumber=
+ biblioitems.biblionumber and biblioitemnumber=$bibitem and
+ biblioitems.itemtype=itemtypes.itemtype";
+# print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+sub subject {
+ my ($bibnum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from bibliosubject where biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+sub addauthor {
+ my ($bibnum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from additionalauthors where biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+sub subtitle {
+ my ($bibnum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from bibliosubtitle where biblionumber=$bibnum";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+
+
+sub itemissues {
+ my ($bibitem,$biblio)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from items where
+ items.biblioitemnumber='$bibitem'";
+# print $query;
+ my $sth=$dbh->prepare($query) || die $dbh->errstr;
+ $sth->execute || die $sth->errstr;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ my $query2="select * from issues,borrowers where itemnumber=$data->{'itemnumber'}
+ and returndate is NULL and issues.borrowernumber=borrowers.borrowernumber";
+ my $sth2=$dbh->prepare($query2);
+ $sth2->execute;
+ if (my $data2=$sth2->fetchrow_hashref){
+ $data->{'date_due'}=$data2->{'date_due'};
+ $data->{'card'}=$data2->{'cardnumber'};
+ } else {
+ if ($data->{'wthdrawn'} eq '1'){
+ $data->{'date_due'}='Cancelled';
+ } else {
+# my ($rescount,$reserves)=FindReserves($biblio,'');
+# if ($rescount >0){#
+# $data->{'date_due'}='Request';
+# } else {
+ $data->{'date_due'}='Available';
+# }
+ }
+ }
+ $sth2->finish;
+ $query2="select * from issues,borrowers where itemnumber='$data->{'itemnumber'}'
+ and issues.borrowernumber=borrowers.borrowernumber
+ order by date_due desc";
+ my $sth2=$dbh->prepare($query2) || die $dbh->errstr;
+# print $query2;
+ $sth2->execute || die $sth2->errstr;
+ for (my $i2=0;$i2<2;$i2++){
+ if (my $data2=$sth2->fetchrow_hashref){
+ $data->{"timestamp$i2"}=$data2->{'timestamp'};
+ $data->{"card$i2"}=$data2->{'cardnumber'};
+ $data->{"borrower$i2"}=$data2->{'borrowernumber'};
+ }
+ }
+ $sth2->finish;
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return(@results);
+}
+
+sub itemnodata {
+ my ($env,$dbh,$itemnumber) = @_;
+ $dbh=C4Connect;
+ my $query="Select * from biblio,items,biblioitems
+ where items.itemnumber = '$itemnumber'
+ and biblio.biblionumber = items.biblionumber
+ and biblioitems.biblioitemnumber = items.biblioitemnumber";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+#used by member enquiries from the intranet
+#called by member.pl
+sub BornameSearch {
+ my ($env,$searchstring,$type)=@_;
+ my $dbh = &C4Connect;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my $count=@data;
+ my $query="Select * from borrowers
+ where ((surname like \"$data[0]%\" or surname like \"% $data[0]%\"
+ or firstname like \"$data[0]%\" or firstname like \"% $data[0]%\"
+ or othernames like \"$data[0]%\" or othernames like \"% $data[0]%\")
+ ";
+ for (my $i=1;$i<$count;$i++){
+ $query=$query." and (surname like \"$data[$i]%\" or surname like \"% $data[$i]%\"
+ or firstname like \"$data[$i]%\" or firstname like \"% $data[$i]%\"
+ or othernames like \"$data[$i]%\" or othernames like \"% $data[$i]%\")";
+ }
+ $query=$query.") or cardnumber = \"$searchstring\"
+ order by surname,firstname";
+# print $query,"\n";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $cnt=0;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ $cnt ++;
+ }
+# $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+ return ($cnt,\@results);
+}
+
+sub borrdata {
+ my ($cardnumber,$bornum)=@_;
+ $cardnumber = uc $cardnumber;
+ my $dbh=C4Connect;
+ my $query;
+ if ($bornum eq ''){
+ $query="Select * from borrowers where cardnumber='$cardnumber'";
+ } else {
+ $query="Select * from borrowers where borrowernumber='$bornum'";
+ }
+ #print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data);
+}
+
+sub borrissues {
+ my ($bornum)=@_;
+ my $dbh=C4Connect;
+ my $query;
+ $query="Select * from issues,biblio,items where borrowernumber='$bornum' and
+items.itemnumber=issues.itemnumber and
+items.biblionumber=biblio.biblionumber and issues.returndate is NULL order
+by date_due";
+ #print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @result;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $result[$i]=$data;;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@result);
+}
+
+sub allissues {
+ my ($bornum)=@_;
+ my $dbh=C4Connect;
+ my $query;
+ $query="Select * from issues,biblio,items where borrowernumber='$bornum' and
+items.itemnumber=issues.itemnumber and
+items.biblionumber=biblio.biblionumber order
+by date_due";
+ #print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @result;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $result[$i]=$data;;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@result);
+}
+
+
+
+sub borrdata2 {
+ my ($env,$bornum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select count(*) from issues where borrowernumber='$bornum' and
+ returndate is NULL";
+ # print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $sth=$dbh->prepare("Select count(*) from issues where
+ borrowernumber='$bornum' and date_due < now() and returndate is NULL");
+ $sth->execute;
+ my $data2=$sth->fetchrow_hashref;
+ $sth->finish;
+ $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
+ borrowernumber='$bornum'");
+ $sth->execute;
+ my $data3=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+
+return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'});
+}
+
+sub getacctlist {
+ my ($env,$params) = @_;
+ my $dbh=C4Connect;
+ my @acctlines;
+ my $numlines;
+ my $query = "Select borrowernumber, accountno, date, amount, description,
+ dispute, accounttype, amountoutstanding, barcode, title
+ from accountlines,items,biblio
+ where borrowernumber = $params->{'borrowernumber'} ";
+ if ($params->{'acctno'} ne "") {
+ my $query = $query." and accountlines.accountno = $params->{'acctno'} ";
+ }
+ my $query = $query." and accountlines.itemnumber = items.itemnumber
+ and items.biblionumber = biblio.biblionumber
+ and accountlines.amountoutstanding<>0 order by date";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my $total=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $acctlines[$numlines] = $data;
+ $numlines++;
+ $total = $total+ $data->{'amountoutstanding'};
+ }
+ return ($numlines,\@acctlines,$total);
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub getboracctrecord {
+ my ($env,$params) = @_;
+ my $dbh=C4Connect;
+ my @acctlines;
+ my $numlines=0;
+ my $query= "Select * from accountlines where
+borrowernumber=$params->{'borrowernumber'} order by date desc,timestamp desc";
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my $total=0;
+ while (my $data=$sth->fetchrow_hashref){
+# if ($data->{'itemnumber'} ne ''){
+# $query="Select * from items,biblio where items.itemnumber=
+# '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
+# my $sth2=$dbh->prepare($query);
+# $sth2->execute;
+# my $data2=$sth2->fetchrow_hashref;
+# $sth2->finish;
+# $data=$data2;
+ # }
+ $acctlines[$numlines] = $data;
+ $numlines++;
+ $total = $total+ $data->{'amountoutstanding'};
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return ($numlines,\@acctlines,$total);
+}
+
+sub itemcount {
+ my ($env,$bibnum,$type)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from items where
+ biblionumber=$bibnum ";
+ if ($type ne 'intra'){
+ $query.=" and (itemlost <>1 or itemlost is NULL) and
+ (wthdrawn <> 1 or wthdrawn is NULL)";
+ }
+ my $sth=$dbh->prepare($query);
+ # print $query;
+ $sth->execute;
+ my $count=0;
+ my $lcount=0;
+ my $nacount=0;
+ my $fcount=0;
+ my $scount=0;
+ my $lostcount=0;
+ my $mending=0;
+ my $transit=0;
+ my $ocount=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $count++;
+ my $query2="select * from issues,items where issues.itemnumber=
+ '$data->{'itemnumber'}' and returndate is NULL
+ and items.itemnumber=issues.itemnumber and (items.itemlost <>1 or
+ items.itemlost is NULL)";
+ my $sth2=$dbh->prepare($query2);
+ $sth2->execute;
+ if (my $data2=$sth2->fetchrow_hashref){
+ $nacount++;
+ } else {
+ if ($data->{'holdingbranch'} eq 'C'){
+ $lcount++;
+ }
+ if ($data->{'holdingbranch'} eq 'F' || $data->{'holdingbranch'} eq 'FP'){
+ $fcount++;
+ }
+ if ($data->{'holdingbranch'} eq 'S' || $data->{'holdingbranch'} eq 'SP'){
+ $scount++;
+ }
+ if ($data->{'itemlost'} eq '1'){
+ $lostcount++;
+ }
+ if ($data->{'holdingbranch'} eq 'FM'){
+ $mending++;
+ }
+ if ($data->{'holdingbranch'} eq 'TR'){
+ $transit++;
+ }
+ }
+ $sth2->finish;
+ }
+# if ($count == 0){
+ my $query2="Select * from aqorders where biblionumber=$bibnum";
+ my $sth2=$dbh->prepare($query2);
+ $sth2->execute;
+ if (my $data=$sth2->fetchrow_hashref){
+ $ocount=$data->{'quantity'} - $data->{'quantityreceived'};
+ }
+# $count+=$ocount;
+ $sth2->finish;
+ $sth->finish;
+ $dbh->disconnect;
+ return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount);
+}
+
+sub ItemType {
+ my ($type)=@_;
+ my $dbh=C4Connect;
+ my $query="select description from itemtypes where itemtype='$type'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $dat=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return ($dat->{'description'});
+}
+
+sub bibitems {
+ my ($bibnum)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from biblioitems,itemtypes,items where
+ biblioitems.biblionumber='$bibnum' and biblioitems.itemtype=itemtypes.itemtype and
+ biblioitems.biblioitemnumber=items.biblioitemnumber group by
+ items.biblioitemnumber";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,@results);
+}
+
+sub barcodes{
+ my ($biblioitemnumber)=@_;
+ my $dbh=C4Connect;
+ my $query="Select barcode from items where
+ biblioitemnumber='$biblioitemnumber'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @barcodes;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $barcodes[$i]=$data->{'barcode'};
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return(@barcodes);
+
+}
+END { } # module clean-up code here (global destructor)
+
+
+
+
+
+
--- /dev/null
+package C4::Security; #asummes C4/Security
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use C4::Format;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&Login &CheckAccess);
+%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 Login {
+ my ($env)=@_;
+ my $dbh=C4Connect;
+ my @branches;
+ my $query = "select * from branches order by branchname";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $branchrec=$sth->fetchrow_hashref) {
+ my $branchdet =
+ fmtstr($env,$branchrec->{'branchcode'},"L2")." ".$branchrec->{'branchname'};
+ push @branches,$branchdet;
+ }
+ $sth->finish;
+ my $valid = "f";
+ &startint($env,"Logging In");
+ until ($valid eq "t") {
+ my ($reason,$username,$password,$branch) = logondialog ($env,"Logon to System",\@branches);
+ $username = uc $username;
+ $password = uc $password;
+ my $query = "select * from users where usercode = '$username' and password ='$password'";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+# debug_msg("",$query);
+ if (my $userrec = $sth->fetchrow_hashref) {
+ if ($userrec->{'usercode'} ne ''){
+ if ($branch ne "") {
+ $valid = "t";
+ my @dummy = split ' ', $branch;
+ $branch = $dummy[0];
+ $env->{'usercode'} = $username;
+ $env->{'branchcode'} = $branch;
+ }
+
+ } else {
+ debug_msg("","not found");
+ }
+ }
+ $sth->finish;
+ }
+ $dbh->disconnect;
+ &endint();
+}
+
+sub CheckAccess {
+ my ($env)=@_;
+ }
+
+END { } # module clean-up code here (global destructor)
+
--- /dev/null
+package C4::Stats; #asummes C4/Stats
+
+#requires DBI.pm to be installed
+#uses DBD:Pg
+
+use strict;
+require Exporter;
+use DBI;
+use C4::Database;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&UpdateStats &statsreport &Count &Overdues &TotalOwing
+&TotalPaid &getcharges &Getpaidbranch &unfilledreserves);
+%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 UpdateStats {
+ #module to insert stats data into stats table
+ my ($env,$branch,$type,$amount,$other,$itemnum,$itemtype)=@_;
+ my $dbh=C4Connect();
+ my $branch=$env->{'branchcode'};
+ my $user = $env->{'usercode'};
+ my $sth=$dbh->prepare("Insert into statistics
+ (datetime,branch,type,usercode,value,other,itemnumber,itemtype)
+ values (now(),'$branch',
+ '$type','$user','$amount','$other','$itemnum','$itemtype')");
+ $sth->execute;
+ $sth->finish;
+ $dbh->disconnect;
+}
+
+sub statsreport {
+ #module to return a list of stats for a given day,time,branch type
+ #or to return search stats
+ my ($type,$time)=@_;
+ my @data;
+# print "here";
+# if ($type eq 'issue'){
+ @data=circrep($time,$type);
+# }
+ return(@data);
+}
+
+sub circrep {
+ my ($time,$type)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from statistics";
+ if ($time eq 'today'){
+ $query=$query." where type='$type' and datetime
+ >=datetime('yesterday'::date)";
+ }
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]="$data->{'datetime'}\t$data->{'branch'}";
+ $i++;
+ }
+ $sth->finish;
+# print $query;
+ $dbh->disconnect;
+ return(@results);
+
+}
+
+sub Count {
+ my ($type,$branch,$time,$time2)=@_;
+ my $dbh=C4Connect;
+ my $query="Select count(*) from statistics where type='$type'";
+ $query.=" and datetime >= '$time' and datetime< '$time2' and branch='$branch'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+# print $query;
+ $dbh->disconnect;
+ return($data->{'count(*)'});
+}
+
+sub Overdues{
+ my $dbh=C4Connect;
+ my $query="Select count(*) from issues where date_due >= now()";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $count=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($count->{'count(*)'});
+}
+
+sub TotalOwing{
+ my ($type)=@_;
+ my $dbh=C4Connect;
+ my $query="Select sum(amountoutstanding) from accountlines";
+ if ($type eq 'fine'){
+ $query=$query." where accounttype='F' or accounttype='FN'";
+ }
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ my $total=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($total->{'sum(amountoutstanding)'});
+}
+
+sub TotalPaid {
+ my ($time)=@_;
+ my $dbh=C4Connect;
+ my $query="Select * from accountlines,borrowers where accounttype = 'Pay'
+ and accountlines.borrowernumber = borrowers.borrowernumber";
+ if ($time eq 'today'){
+ $query=$query." and date = now()";
+ } else {
+ $query.=" and date='$time'";
+ }
+# $query.=" order by timestamp";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my @results;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+# print $query;
+ return(@results);
+}
+
+sub getcharges{
+ my($borrowerno,$timestamp)=@_;
+ my $dbh=C4Connect;
+ my $timestamp2=$timestamp-1;
+ my $query="Select * from accountlines where borrowernumber=$borrowerno
+ and timestamp <= '$timestamp' and accounttype <> 'Pay' and
+ accounttype <> 'W'";
+ my $sth=$dbh->prepare($query);
+# print $query,"<br>";
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ if ($data->{'timestamp'} == $timestamp){
+ $results[$i]=$data;
+ $i++;
+ }
+ }
+ $dbh->disconnect;
+ return(@results);
+}
+
+sub Getpaidbranch{
+ my($date)=@_;
+ my $dbh=C4Connect;
+ my $query="select * from statistics where type='payment' and datetime='$date'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+# print $query;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $dbh->disconnect;
+ return($data->{'branch'});
+}
+
+sub unfilledreserves {
+ my $dbh=C4Connect;
+ my $query="select *,biblio.title from reserves,reserveconstraints,biblio,borrowers,biblioitems where found <> 'F' and cancellationdate
+is NULL and biblio.biblionumber=reserves.biblionumber and
+reserves.constrainttype='o'
+and (reserves.biblionumber=reserveconstraints.biblionumber
+and reserves.borrowernumber=reserveconstraints.borrowernumber)
+and
+reserves.borrowernumber=borrowers.borrowernumber and
+biblioitems.biblioitemnumber=reserveconstraints.biblioitemnumber order by
+biblio.title,reserves.reservedate";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $i=0;
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $query="select *,biblio.title from reserves,biblio,borrowers where found <> 'F' and cancellationdate
+is NULL and biblio.biblionumber=reserves.biblionumber and reserves.constrainttype='a' and
+reserves.borrowernumber=borrowers.borrowernumber
+order by
+biblio.title,reserves.reservedate";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ @results[$i]=$data;
+ $i++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return($i,\@results);
+}
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+package C4::Stock; #asummes C4/Stock.pm
+
+use strict;
+require Exporter;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use C4::Database;
+
+# set the version for version checking
+$VERSION = 0.01;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&stockreport);
+%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 stockreport {
+ my $dbh=C4Connect;
+ my @results;
+ my $query="Select count(*) from items where homebranch='C'";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $count=$sth->fetchrow_hashref;
+ $results[0]="$count->{'count'}\t Levin";
+ $sth->finish;
+ $query="Select count(*) from items where homebranch='F'";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $count=$sth->fetchrow_hashref;
+ $results[1]="$count->{'count'}\t Foxton";
+ $sth->finish;
+ $dbh->disconnect;
+ return(@results);
+}
+
+END { } # module clean-up code here (global destructor)
+
+
--- /dev/null
+#!/usr/bin/perl
+
+#script to recieve orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $id=$input->param('id');
+
+print startpage;
+
+print startmenu('acquisitions');
+
+my $search=$input->param('recieve');
+my $invoice=$input->param('invoice');
+my $freight=$input->param('freight');
+my $biblio=$input->param('biblio');
+my $catview=$input->param('catview');
+my $gst=$input->param('gst');
+my ($count,@results)=ordersearch($search,$biblio,$catview);
+my ($count2,@booksellers)=bookseller($results[0]->{'booksellerid'});
+#print $count;
+my @date=split('-',$results[0]->{'entrydate'});
+my $date="$date[2]/$date[1]/$date[0]";
+
+if ($count == 1){
+
+
+print <<EOP
+
+<script language="javascript" type="text/javascript">
+<!--
+function messenger(X,Y,etc){
+win=window.open("","mess","height="+X+",width="+Y+",screenX=150,screenY=0");
+win.focus();
+win.document.close();
+win.document.write("<body link='#333333' bgcolor='#ffffff' text='#000000'><font size=2><p><br>");
+win.document.write(etc);
+win.document.write("<center><form><input type=button onclick='self.close()' value=Close></form></center>");
+win.document.write("</font></body></html>");
+}
+//-->
+</script>
+<form action="/cgi-bin/koha/acqui/finishreceive.pl" method=post>
+<input type=hidden name=biblio value=$results[0]->{'biblionumber'}>
+<input type=hidden name=ordnum value=$results[0]->{'ordernumber'}>
+<input type=hidden name=biblioitemnum value=$results[0]->{'biblioitemnumber'}>
+<input type=hidden name=bookseller value=$results[0]->{'booksellerid'}>
+<input type=hidden name=freight value=$freight>
+<input type=hidden name=gst value=$gst>
+EOP
+;
+if ($catview ne 'yes'){
+ print "<input type=image name=submit src=/images/save-changes.gif border=0 width=187 height=42 align=right>";
+} else {
+ print "<a href=/cgi-bin/koha/acqui/newbiblio.pl?ordnum=$results[0]->{'ordernumber'}&id=$results[0]->{'booksellerid'}><image src=/images/modify-mem.gif align=right border=0></a>";
+}
+print <<EOP
+<FONT SIZE=6><em>$results[0]->{'ordernumber'} - Receive Order</em></FONT><br>
+Shopping Basket For: $booksellers[0]->{'name'}
+<br> Order placed: $date
+<P>
+<CENTER>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width="40%">
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>CATALOGUE DETAILS</B></td></tr>
+
+<TR VALIGN=TOP>
+<TD><b>Title *</b></td>
+<td><input type=text size=20 name=title value="$results[0]->{'title'}" >
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Author</td>
+<td><input type=text size=20 name=author value="$results[0]->{'author'}" >
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Copyright Date</td>
+<td><input type=text size=20 name=copyright value="$results[0]->{'copyrightdate'}" >
+</td>
+</tr>
+<TR VALIGN=TOP>
+
+<TD><A HREF="popbox.html" onclick="messenger(600,300,'ITEMTYPES<BR>ART = Art Print<BR>BCD = CD-ROM from book<BR>CAS = Cassette<BR>CD = Compact disc (WN)<BR>F = Free Fiction<BR>FVID = Free video<BR>FYA = Young Adult Fiction<BR>GWB = Get Well Bag<BR>HCVF = Horowhenua Collection Vertical File<BR>IL = Interloan<BR>JCF = Junior Castle Fiction<BR>JCNF = Junior Castle Non-fiction<BR>JF = Junior Fiction<BR>JHC = Junior Horowhenua Collection VF<BR>JIG = Jigsaw puzzle<BR>JK = Junior Kermit<BR>JNF = Junior Non-Fiction<BR>JPB = Junior Paperbacks<BR>JPC = Junior Picture Book<BR>JPER = Junior Periodical<BR>JREF = Junior Reference<BR>JVF = Junior Vertical File<BR>LP = Large Print<BR>MAP = Map<BR>NF = Adult NonFiction<BR>NFLP = NonFiction LargePrint<BR>NGA = Nga Pukapuka<BR>PAY = Pay Collection<BR>PB = Pamphlet Box<BR>PER = Periodical<BR>PHOT = Photograph<BR>POS = Junior Poster<BR>REF = Adult Reference<BR>ROM = CD-Rom<BR>STF = Stack Fiction<BR>STJ = Stack Junior<BR>STLP = Stack Large Print<BR>STNF = Stack Non-fiction<BR>TB = Talking Book<BR>TREF = Taonga<BR>VF = Vertical File<BR>VID = Video'); return false"><B>Format *</B></A></td>
+<td><input type=text size=20 name=format value="$results[0]->{'itemtype'}">
+
+</td>
+</tr>
+
+<TR VALIGN=TOP>
+
+<TD>ISBN</td>
+<td><input type=text size=20 name=ISBN value="$results[0]->{'isbn'}">
+</td>
+</tr>
+
+<TR VALIGN=TOP>
+
+<TD>Series</td>
+<td><input type=text size=20 name=Series value="$results[0]->{'seriestitle'}">
+</td>
+</tr>
+
+<TR VALIGN=TOP>
+<TD>Branch</td>
+<td><select name=branch size=1>
+EOP
+;
+my ($count2,@branches)=branches();
+for (my $i=0;$i<$count2;$i++){
+ print "<option value=$branches[$i]->{'branchcode'}";
+ if ($results[0]->{'branchcode'} == $branches[$i]->{'branchcode'}){
+ print " Selected";
+ }
+ print ">$branches[$i]->{'branchname'}";
+}
+print <<EOP
+</select>
+</td>
+</tr>
+
+<TR VALIGN=TOP bgcolor=#ffffcc >
+<TD><B>Item Barcode *</B></td>
+
+<td><input type=text size=20 name=barcode>
+</td>
+</tr>
+
+<TR VALIGN=TOP bgcolor=#ffffcc >
+<TD><B>Volume Info (for serials) *</B></td>
+
+<td><input type=text size=20 name=volinf>
+</td>
+</tr>
+</table>
+
+
+
+<img src="/images/holder.gif" width=32 height=250 align=left>
+
+<table border=1 cellspacing=0 cellpadding=5 width="40%">
+
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>ACCOUNTING DETAILS</B></td></tr>
+<TR VALIGN=TOP>
+<TD><B>Bookfund *</B></td>
+<td><select name=bookfund size=1>
+EOP
+;
+my ($count2,@bookfund)=bookfunds;
+for (my $i=0;$i<$count2;$i++){
+ print "<option value=$bookfund[$i]->{'bookfundid'}";
+ if ($bookfund[$i]->{'bookfundid'}==$results[0]->{'bookfundid'}){
+ print " Selected";
+ }
+ print ">$bookfund[$i]->{'bookfundname'}";
+}
+
+my $rrp=$results[0]->{'rrp'};
+if ($results[0]->{'quantityreceived'} == 0){
+ $results[0]->{'quantityreceived'}='';
+}
+if ($results[0]->{'unitprice'} == 0){
+ $results[0]->{'unitprice'}='';
+}
+print <<EOP
+</select>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Quantity Ordered</td>
+<td><input type=text size=20 name=quantity value=$results[0]->{'quantity'}>
+</td>
+</tr>
+<TR VALIGN=TOP bgcolor=#ffffcc>
+<TD><B>Quantity Received *</B></td>
+<td><input type=text size=20 name=quantityrec value=$results[0]->{'quantityreceived'}>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Replacement Cost</td>
+<td><input type=text size=20 name=rrp value=$rrp>
+</tr>
+<TR VALIGN=TOP>
+<TD>
+Budgeted Cost </td>
+<td><input type=text size=20 name=ecost value="$results[0]->{'ecost'}">
+</td>
+</tr>
+<TR VALIGN=TOP bgcolor=#ffffcc>
+<TD><B>Actual Cost *</B></td>
+<td><input type=text size=20 name=cost value="$results[0]->{'unitprice'}">
+</td>
+</tr>
+<TR VALIGN=TOP bgcolor=#ffffcc>
+<TD>Invoice Number</td>
+<td>$invoice
+<input type=hidden name=invoice value=$invoice>
+<TR VALIGN=TOP>
+<TD>Notes</td>
+<td><input type=text size=20 name=notes value="$results[0]->{'notes'}">
+</td>
+</tr>
+</table>
+</form>
+</center>
+<br clear=all>
+<p> </p>
+
+EOP
+;
+} else {
+print "<center><table>";
+print <<EOP
+<tr valign=top bgcolor=#99cc33>
+
+<td background="/images/background-mem.gif"><b>ISBN</b></td>
+<td background="/images/background-mem.gif"><b>TITLE</b></td>
+<td background="/images/background-mem.gif"><b>AUTHOR</b></td>
+</tr>
+EOP
+;
+for (my $i=0;$i<$count;$i++){
+ print "<tr><td>$results[$i]->{'isbn'}</td>
+ <td><a href=acquire.pl?recieve=$results[$i]->{'ordernumber'}&biblio=$results[$i]->{'biblionumber'}&invoice=$invoice&freight=$freight&gst=$gst>$results[$i]->{'title'}</a></td>
+ <td>$results[$i]->{'author'}</td></tr>";
+}
+print "</table></center>";
+}
+
+
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to add an order into the system
+#written 29/2/00 by chris@katipo.co.nz
+
+use strict;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+#use Date::Manip;
+
+my $input = new CGI;
+#print $input->header;
+#print startpage();
+#print startmenu('acquisitions');
+#print $input->dump;
+my $existing=$input->param('existing');
+my $title=$input->param('title');
+$title=~ s/\'/\\\'/g;
+my $author=$input->param('author');
+$author=~ s/\'/\\\'/g;
+my $copyright=$input->param('copyright');
+my $isbn=$input->param('ISBN');
+my $itemtype=$input->param('format');
+my $ordnum=$input->param('ordnum');
+my $basketno=$input->param('basket');
+my $quantity=$input->param('quantity');
+my $listprice=$input->param('list_price');
+my $series=$input->param('Series');
+if ($listprice eq ''){
+ $listprice=0;
+}
+my $supplier=$input->param('supplier');
+my $notes=$input->param('notes');
+my $bookfund=$input->param('bookfund');
+my $who=$input->remote_user;
+my $bibnum;
+my $bibitemnum;
+my $rrp=$input->param('rrp');
+my $ecost=$input->param('ecost');
+my $gst=$input->param('GST');
+#check to see if orderexists
+my $orderexists=$input->param('orderexists');
+
+#check to see if biblio exists
+if ($quantity ne '0'){
+
+ if ($existing eq 'no'){
+ #if it doesnt create it
+ $bibnum=newbiblio($title,$author,$copyright);
+ $bibitemnum=newbiblioitem($bibnum,$itemtype,$isbn);
+ newsubtitle($bibnum);
+ modbiblio($bibnum,$title,$author,$copyright,$series);
+ } else {
+ $bibnum=$input->param('biblio');
+ $bibitemnum=$input->param('bibitemnum');
+ my $oldtype=$input->param('oldtype');
+ if ($bibitemnum eq '' || $itemtype ne $oldtype){
+ $bibitemnum=newbiblioitem($bibnum,$itemtype,$isbn);
+ }
+ modbiblio($bibnum,$title,$author,$copyright,$series);
+ }
+ if ($orderexists ne ''){
+ modorder($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst);
+ }else {
+ neworder($bibnum,$title,$ordnum,$basketno,$quantity,$listprice,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst);
+ }
+} else {
+ #print $input->header;
+ #print "del";
+ $bibnum=$input->param('biblio');
+ delorder($bibnum,$ordnum);
+}
+
+print $input->redirect("newbasket.pl?id=$supplier&basket=$basketno");
+#print $input->dump;
+#print endmenu('acquisitions');
+#print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to show display basket of orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $basket=$input->param('basket');
+my ($count,@results)=basket($basket);
+print startpage;
+
+print startmenu('acquisitions');
+
+#print $count;
+my ($count2,@booksellers)=bookseller($results[0]->{'booksellerid'});
+
+print <<printend
+<div align=right>
+Our Reference: $basket<br>
+Authorised By: $results[0]->{'authorisedby'}<br>
+$results[0]->{'entrydate'};
+
+</div>
+<FONT SIZE=6><em>Shopping Basket For: <a href=supplier.pl?id=$results[0]->{'booksellerid'}></a> $booksellers[0]->{'name'}</em></FONT>
+
+<a href=newbasket.pl?id=$results[0]->{'booksellerid'}&basket=$basket>Add more orders</a>
+
+
+<CENTER>
+
+<FORM ACTION="/cgi-bin/koha/search.pl" method=post>
+<b>Search ISBN, Title or Author:</b> <INPUT TYPE="text" SIZE="25" NAME="recieve">
+</form>
+<p>
+<FORM ACTION="/cgi-bin/koha/acqui/modorders.pl" method=post name=orderform>
+<table border=0 cellspacing=0 cellpadding=5>
+<tr valign=top bgcolor=#99cc33>
+<td background="/images/background-mem.gif"><b>ORDER</b></td>
+<td background="/images/background-mem.gif"><b>ISBN</b></td>
+<td background="/images/background-mem.gif"><b>TITLE</b></td>
+<td background="/images/background-mem.gif"><b>AUTHOR</b></td>
+<td background="/images/background-mem.gif"><b>RRP</b></td><td background="/images/background-mem.gif"><b>\$EST</b></td><td background="/images/background-mem.gif"><b>QUANTITY</b></td><td background="/images/background-mem.gif"><b>TOTAL</b></td></tr>
+printend
+;
+for (my $i=0;$i<$count;$i++){
+my $rrp=$results[$i]->{'listprice'};
+if ($results[$i]->{'currency'} ne 'NZD'){
+ $rrp=curconvert($results[$i]->{'currency'},$rrp);
+}
+print <<EOP
+
+
+<tr valign=top bgcolor=#ffffcc>
+<td>$results[$i]->{'ordernumber'}</td>
+<td>$results[$i]->{'isbn'}</td>
+<td><a href="newbiblio.pl?ordnum=$results[$i]->{'ordernumber'}&id=$results[$i]->{'booksellerid'}&basket=$basket">$results[$i]->{'title'}</a></td>
+<td>$results[$i]->{'author'}</td>
+<td>\$<input type=text name=rrp$i size=6 value="$results[$i]->{'rrp'}"></td>
+<td>\$<input type=text name=eup$i size=6 value="$results[$i]->{'ecost'}"></td>
+<td><input type=text name=quantity$i size=6 value=$results[$i]->{'quantity'}></td>
+<td>\$<input type=text name=total$i size=10 value=16.95></td>
+<input type=hidden name=ordnum$i value=$results[$i]->{'ordernumber'}>
+<input type=hidden name=bibnum$i value=$results[$i]->{'biblionumber'}>
+</tr>
+
+EOP
+;
+}
+# onchange='update(this.form)'></td>
+print "<input type=hidden name=number value=$count>
+<input type=hidden name=basketno value=\"$basket\">";
+print <<EOP
+<tr valign=top bgcolor=white>
+
+<td colspan=6 rowspan=3 bgcolor=#cccc99 background="/images/background-mem.gif">
+<b>HELP</b><br>
+To cancel an order, just change the quantity to 0 and click "save changes".<br>
+To change any of the catalogue or accounting information attached to an order, click on the title.<br>
+To add new orders to this supplier, start with a search. </td>
+<td><b>SubTotal</b></td>
+<td>\$<input type=text name=subtotal size=10></td>
+</tr>
+<tr valign=top bgcolor=white>
+<td><b>GST</b></td>
+<td>\$<input type=text name=gst size=10></td>
+
+</tr>
+
+<tr valign=top bgcolor=white>
+
+
+<td><b>TOTAL</b></td>
+<td>\$<input type=text name=grandtotal size=10></td>
+
+</tr>
+
+<tr valign=top bgcolor=white>
+<td></td>
+<td></td>
+<td></td>
+<td></td>
+<td></td>
+<td></td>
+<td colspan=3><input type=image name=submit src=/images/save-changes.gif border=0 width=187 height=42 align=right></td>
+
+</tr>
+
+
+
+
+</table>
+</CENTER>
+
+
+
+EOP
+;
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to add a new item and to mark orders as received
+#written 1/3/00 by chris@katipo.co.nz
+
+use C4::Output;
+use C4::Acquisitions;
+use CGI;
+use C4::Search;
+
+my $input=new CGI;
+#print $input->header;
+
+my $user=$input->remote_user;
+#print $input->dump;
+my $biblio=$input->param('biblio');
+my $ordnum=$input->param('ordnum');
+my $quantrec=$input->param('quantityrec');
+my $quantity=$input->param('quantity');
+my $notes=$input->param('notes');
+my $cost=$input->param('cost');
+my $invoiceno=$input->param('invoice');
+my $id=$input->param('id');
+my $bibitemno=$input->param('biblioitemnum');
+my $data=bibitemdata($bibitemno);
+my $publisher=$data->{'publishercode'};
+my $pubdate=$data->{'publicationdate'};
+my $class=$data->{'classification'};
+my $dewey=$data->{'dewey'};
+my $subclass=$data->{'subclass'};
+
+my $size=$data->{'size'};
+my $illus=$data->{'illus'};
+my $pages=$data->{'pages'};
+my $replacement=$input->param('rrp');
+my $branch=$input->param('branch');
+my $bookfund=$input->param('bookfund');
+my $itemtype=$input->param('format');
+my $isbn=$input->param('ISBN');
+my $series=$input->param('Series');
+my $bookseller=$input->param('bookseller');
+$id=$bookseller;
+my $title=$input->param('title');
+my $author=$input->param('author');
+my $copyright=$input->param('copyright');
+
+if ($quantrec != 0){
+ $cost=$cost / $quantrec;
+}
+
+my $gst=$input->param('gst');
+my $freight=$input->param('freight');
+my $volinf=$input->param('volinf');
+my $loan=0;
+if ($itemtype =~ /REF/){
+ $loan=1;
+}
+
+if ($itemtype =~ /PER/){
+# print "$bibitemno";
+ $class="Periodical";
+ $bibitemno=newbiblioitem($biblio,$itemtype,$isbn,$volinf,$class);
+# print "here $bibitemno";
+}
+if ($quantity != 0){
+ receiveorder($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund);
+ modbiblio($biblio,$title,$author,$copyright,$series);
+ modbibitem($bibitemno,$itemtype,$isbn,$publisher,$pubdate,$class,$dewey,$subclass,$illus,$pages,$volinf,$notes,$size);
+ #print $notes;
+ my $barcode=$input->param('barcode');
+ my @barcodes;
+ if ($barcode =~ /\,/){
+ @barcodes=split(/\,/,$barcode);
+ }elsif ($barcode =~ /\|/){
+ @barcodes=split(/\|/,$barcode);
+ } else {
+ $barcodes[0]=$barcode;
+ # print $input->header;
+ # print @barcodes;
+ # print $barcode;
+ }
+ my ($error)=makeitems($quantrec,$bibitemno,$biblio,$replacement,$cost,$bookseller,$branch,$loan,@barcodes);
+ if ($error eq ''){
+ if ($itemtype ne 'PER'){
+ print $input->redirect("/cgi-bin/koha/acqui/receive.pl?invoice=$invoiceno&id=$id&freight=$freight&gst=$gst");
+ } else {
+ print $input->redirect("/acquisitions/");
+ }
+ } else {
+ print $input->header;
+ print $error;
+ }
+} else {
+ print $input->header;
+ delorder($biblio,$ordnum);
+ print $input->redirect("/acquisitions/");
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to add an order into the system
+#written 29/2/00 by chris@katipo.co.nz
+
+use strict;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+#use Date::Manip;
+
+my $input = new CGI;
+#print $input->header;
+#print startpage();
+#print startmenu('acquisitions');
+#print $input->Dump;
+my $basketno=$input->param('basketno');
+my $count=$input->param('number');
+for (my $i=0;$i<$count;$i++){
+ my $bibnum=$input->param("bibnum$i");
+ my $ordnum=$input->param("ordnum$i");
+ my $quantity=$input->param("quantity$i");
+ if ($quantity == 0){
+ delorder($bibnum,$ordnum);
+ }
+}
+print $input->redirect("basket.pl?basket=$basketno");
+#print $input->dump;
+#print endmenu('acquisitions');
+#print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to show display basket of orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $user=$input->remote_user;
+my $id=$input->param('id');
+my ($count,@booksellers)=bookseller($id);
+print startpage;
+
+print startmenu('acquisitions');
+
+my $basket=$input->param('basket');
+if ($basket eq ''){
+ $basket=newbasket();
+}
+my $date=localtime(time);
+print <<printend
+
+
+<div align=right>
+Our Reference: HLT-$basket<br>
+Authorsed By: $user<br>
+$date
+</div>
+<FONT SIZE=6><em>Shopping Basket For: <a href=/cgi-bin/koha/acqui/supplier.pl?id=$booksellers[0]->{'id'}>
+$booksellers[0]->{'name'}</a></em></FONT><br>
+Ph: $booksellers[0]->{'phone'}, Fax: $booksellers[0]->{'fax'},
+$booksellers[0]->{'address1'}, $booksellers[0]->{'address2'},
+$booksellers[0]->{'address3'}, $booksellers[0]->{'address4'}
+
+
+<p>
+<FORM ACTION="/cgi-bin/koha/acqui/newbasket2.pl" method=post>
+<input type=hidden name=id value="$id">
+<input type=hidden name=basket value="$basket">
+<b> Search Keyword or Title: </b><INPUT TYPE="text" SIZE="25" NAME="search">
+
+</form>
+
+
+
+<br clear=all>
+<DL>
+<dt><b>DELIVERY ADDRESS: </b></dt>
+<dd><b>Horowhenua Library Trust</b><br>
+10 Bath St<br>
+Levin<br>
+New Zealand<p>
+
+Ph: +64-6-368 1953<br>
+Email: <a href="mailto:orders\@library.org.nz">orders\@library.org.nz</a>
+
+</dl>
+
+
+printend
+;
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+#origninally script to provide intranet (librarian) advanced search facility
+#now script to do searching for acquisitions
+
+use strict;
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+
+my $env;
+my $input = new CGI;
+print $input->header;
+#whether it is called from the opac of the intranet
+my $type=$input->param('type');
+if ($type eq ''){
+ $type = 'intra';
+}
+#setup colours
+my $main;
+my $secondary;
+ $main='#cccc99';
+ $secondary='#ffffcc';
+
+
+#print $input->dump;
+my $blah;
+my %search;
+#build hash of users input
+my $title=$input->param('search');
+$search{'title'}=$title;
+my $keyword=$input->param('search');
+$search{'keyword'}=$keyword;
+my $author=$input->param('search');
+$search{'author'}=$author;
+
+my @results;
+my $offset=$input->param('offset');
+if ($offset eq ''){
+ $offset=0;
+}
+my $num=$input->param('num');
+if ($num eq ''){
+ $num=10;
+}
+my $id=$input->param('id');
+my $basket=$input->param('basket');
+
+my ($count,@booksellers)=bookseller($id);
+ print startpage();
+
+print startpage();
+print startmenu('acquisitions');
+print mkheadr(1,"Shopping Basket For: $booksellers[0]->{'name'}");
+
+print <<printend
+
+<a href=newbiblio.pl?id=$id&basket=$basket><img src=/images/add-biblio.gif width=187 heigth=42 border=0 align=right alt="Add New Biblio"></a>
+<a href=basket.pl?basket=$basket><img src=/images/view-basket.gif width=187 heigth=42 border=0 align=right alt="View Basket"></a>
+
+<FORM ACTION="/cgi-bin/koha/acqui/newbasket2.pl">
+<input type=hidden name=id value="$id">
+<input type=hidden name=basket value="$basket">
+<b>New Search: </b><INPUT TYPE="text" SIZE="25" NAME="search"></form>
+<br clear=all>
+
+printend
+;
+
+print center();
+my $count;
+my @results;
+
+ if ($keyword ne ''){
+# print "hey";
+ ($count,@results)=&KeywordSearch(\$blah,'intra',\%search,$num,$offset);
+ } elsif ($search{'front'} ne '') {
+ ($count,@results)&FrontSearch(\$blah,'intra',\%search,$num,$offset);
+ }else {
+ ($count,@results)=&CatSearch(\$blah,'loose',\%search,$num,$offset);
+# print "hey";
+ }
+
+print "You searched on ";
+while ( my ($key, $value) = each %search) {
+ if ($value ne ''){
+ $value=~ s/\\//g;
+ print bold("$key $value,");
+ }
+}
+print " $count results found";
+my $offset2=$num+$offset;
+my $dispnum=$offset+1;
+print "<br> Results $dispnum to $offset2 displayed";
+print mktablehdr;
+
+
+print mktablerow(6,$main,'<b>TITLE</b>','<b>AUTHOR</b>',bold('©'),'<b>COUNT</b>',bold('LOCATION'),'','/images/background-mem.gif');
+
+
+my $count2=@results;
+if ($keyword ne '' && $offset > 0){
+ $count2=$count-$offset;
+ if ($count2 > 10){
+ $count2=10;
+ }
+}
+#print $count2;
+my $i=0;
+my $colour=1;
+while ($i < $count2){
+# print $results[$i]."\n";
+ my @stuff=split('\t',$results[$i]);
+ $stuff[1]=~ s/\`/\\\'/g;
+ my $title2=$stuff[1];
+ my $author2=$stuff[0];
+ my $copyright=$stuff[3];
+ $author2=~ s/ /%20/g;
+ $title2=~ s/ /%20/g;
+ $title2=~ s/\#/\&\#x23;/g;
+ $stuff[1]=mklink("/cgi-bin/koha/acqui/newbiblio.pl?title=$title2&author=$author2©right=$copyright&id=$id&basket=$basket&biblio=$stuff[2]",$stuff[1]);
+ my $word=$stuff[0];
+# print $word;
+ $word=~ s/([a-z]) +([a-z])/$1%20$2/ig;
+ $word=~ s/ //g;
+ $word=~ s/ /%20/g;
+ $word=~ s/\,/\,%20/g;
+ $word=~ s/\n//g;
+ my $url="/cgi-bin/koha/search.pl?author=$word&type=$type";
+ $stuff[0]=mklink($url,$stuff[0]);
+ my ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit)=itemcount($env,$stuff[2],$type);
+ $stuff[4]=$count;
+ if ($nacount > 0){
+ $stuff[5]=$stuff[5]."On Loan";
+ if ($nacount >1 ){
+ $stuff[5]=$stuff[5]." ($nacount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($lcount > 0){
+ $stuff[5]=$stuff[5]."Levin";
+ if ($lcount >1 ){
+ $stuff[5]=$stuff[5]." ($lcount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($fcount > 0){
+ $stuff[5]=$stuff[5]."Foxton";
+ if ($fcount >1 ){
+ $stuff[5]=$stuff[5]." ($fcount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($scount > 0){
+ $stuff[5]=$stuff[5]."Shannon";
+ if ($scount >1 ){
+ $stuff[5]=$stuff[5]." ($scount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($lostcount > 0){
+ $stuff[5]=$stuff[5]."Lost";
+ if ($lostcount >1 ){
+ $stuff[5]=$stuff[5]." ($lostcount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($mending > 0){
+ $stuff[5]=$stuff[5]."Mending";
+ if ($mending >1 ){
+ $stuff[5]=$stuff[5]." ($mending)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($transit > 0){
+ $stuff[5]=$stuff[5]."In Transiit";
+ if ($transit >1 ){
+ $stuff[5]=$stuff[5]." ($transit)";
+ }
+ $stuff[5].=" ";
+ }
+
+ if ($colour == 1){
+ print mktablerow(6,$secondary,$stuff[1],$stuff[0],$stuff[3],$stuff[4],$stuff[5],$stuff[6]);
+ $colour=0;
+ } else{
+ print mktablerow(6,'white',$stuff[1],$stuff[0],$stuff[3],$stuff[4],$stuff[5],$stuff[6]);
+ $colour=1;
+ }
+ $i++;
+}
+$offset=$num+$offset;
+
+ print mktablerow(6,$main,' ',' ',' ',' ','','','/images/background-mem.gif');
+
+print mktableft();
+if ($offset < $count){
+ my $search="num=$num&offset=$offset&type=$type&id=$id&basket=$basket&search=$keyword";
+ my $stuff=mklink("/cgi-bin/koha/acqui/newbasket2.pl?$search",'Next');
+ print $stuff;
+}
+
+print endcenter();
+print endmenu('acquisitions');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to show display basket of orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use C4::Search;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $id=$input->param('id');
+my $title=$input->param('title');
+my $author=$input->param('author');
+my $copyright=$input->param('copyright');
+my ($count,@booksellers)=bookseller($id);
+my $ordnum=$input->param('ordnum');
+my $biblio=$input->param('biblio');
+my $data;
+my $new;
+if ($ordnum eq ''){
+ $new='yes';
+ $ordnum=newordernum;
+ $data=bibdata($biblio);
+ if ($data->{'title'} eq ''){
+ $data->{'title'}=$title;
+ $data->{'author'}=$author;
+ $data->{'copyrightdate'}=$copyright;
+ }
+}else {
+ $data=getsingleorder($ordnum);
+ $biblio=$data->{'biblionumber'};
+}
+
+print startpage;
+
+print startmenu('acquisitions');
+
+
+my $basket=$input->param('basket');
+print <<printend
+
+
+<script language="javascript" type="text/javascript">
+
+<!--
+
+function update(f){
+ //collect values
+ quantity=f.quantity.value
+ discount=f.discount.value
+ listinc=parseInt(f.listinc.value)
+ currency=f.currency.value
+ applygst=parseInt(f.applygst.value)
+ listprice=f.list_price.value
+ // rrp=f.rrp.value
+ // ecost=f.ecost.value //budgetted cost
+ // GST=f.GST.value
+ // total=f.total.value
+ //make useful constants out of the above
+ exchangerate=f.elements[currency].value //get exchange rate
+ gst_on=(!listinc && applygst);
+ //do real stuff
+ rrp=listprice*exchangerate;
+ ecost=rrp*(100-discount)/100
+ GST=0;
+ if (gst_on){
+ rrp=rrp*1.125;
+ GST=ecost*0.125
+ }
+
+ total=(ecost+GST)*quantity
+
+
+ f.rrp.value=display(rrp)
+ f.ecost.value=display(ecost)
+ f.GST.value=display(GST)
+ f.total.value=display(total)
+
+}
+
+
+
+function messenger(X,Y,etc){
+win=window.open("","mess","height="+X+",width="+Y+",screenX=150,screenY=0");
+win.focus();
+win.document.close();
+win.document.write("<body link='#333333' bgcolor='#ffffff' text='#000000'><font size=2><p><br>");
+win.document.write(etc);
+win.document.write("<center><form><input type=button onclick='self.close()' value=Close></form></center>");
+win.document.write("</font></body></html>");
+}
+//-->
+
+</script>
+<form action=/cgi-bin/koha/acqui/addorder.pl method=post name=frusin>
+printend
+;
+
+if ($biblio eq ''){
+ print "<input type=hidden name=existing value=no>";
+}
+
+print <<printend
+<!--$title-->
+<input type=hidden name=ordnum value=$ordnum>
+<input type=hidden name=basket value=$basket>
+<input type=hidden name=supplier value=$id>
+<input type=hidden name=biblio value=$biblio>
+<input type=hidden name=bibitemnum value=$data->{'biblioitemnumber'}>
+<input type=hidden name=oldtype value=$data->{'itemtype'}>
+<input type=hidden name=discount value=$booksellers[0]->{'discount'}>
+<input type=hidden name=listinc value=$booksellers[0]->{'listincgst'}>
+<input type=hidden name=currency value=$booksellers[0]->{'listprice'}>
+<input type=hidden name=applygst value=$booksellers[0]->{'gstreg'}>
+printend
+;
+my ($count2,$currencies)=getcurrencies;
+for (my $i=0;$i<$count2;$i++){
+ print "<input type=hidden name=\"$currencies->[$i]->{'currency'}\" value=$currencies->[0]->{'rate'}>\n";
+}
+if ($new ne 'yes'){
+ print "<input type=hidden name=orderexists value=yes>\n";
+}
+print <<printend
+<a href=basket.pl?basket=$basket><img src=/images/view-basket.gif width=187 heigth=42 border=0 align=right alt="View Basket"></a>
+<FONT SIZE=6><em>$ordnum - Order Details </em></FONT><br>
+Shopping Basket For: $booksellers[0]->{'name'}
+<P>
+<CENTER>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width="40%">
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>CATALOGUE DETAILS</B></td></tr>
+<TR VALIGN=TOP>
+<TD><b>Title *</b></td>
+<td><input type=text size=20 name=title value="$data->{'title'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Author</td>
+<td><input type=text size=20 name=author value="$data->{'author'}" >
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Copyright Date</td>
+<td><input type=text size=20 name=copyright value="$data->{'copyrightdate'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD><A HREF="popbox.html" onclick="messenger(600,300,'ITEMTYPES<BR>ART = Art Print<BR>BCD = CD-ROM from book<BR>CAS = Cassette<BR>CD = Compact disc (WN)<BR>F = Free Fiction<BR>FVID = Free video<BR>FYA = Young Adult Fiction<BR>GWB = Get Well Bag<BR>HCVF = Horowhenua Collection Vertical File<BR>IL = Interloan<BR>JCF = Junior Castle Fiction<BR>JCNF = Junior Castle Non-fiction<BR>JF = Junior Fiction<BR>JHC = Junior Horowhenua Collection VF<BR>JIG = Jigsaw puzzle<BR>JK = Junior Kermit<BR>JNF = Junior Non-Fiction<BR>JPB = Junior Paperbacks<BR>JPC = Junior Picture Book<BR>JPER = Junior Periodical<BR>JREF = Junior Reference<BR>JVF = Junior Vertical File<BR>LP = Large Print<BR>MAP = Map<BR>NF = Adult NonFiction<BR>NFLP = NonFiction LargePrint<BR>NGA = Nga Pukapuka<BR>PAY = Pay Collection<BR>PB = Pamphlet Box<BR>PER = Periodical<BR>PHOT = Photograph<BR>POS = Junior Poster<BR>REF = Adult Reference<BR>ROM = CD-Rom<BR>STF = Stack Fiction<BR>STJ = Stack Junior<BR>STLP = Stack Large Print<BR>STNF = Stack Non-fiction<BR>TB = Talking Book<BR>TREF = Taonga<BR>VF = Vertical File<BR>VID = Video'); return false"><b>Format *</b></A></td>
+<td><input type=text size=20 name=format value=$data->{'itemtype'}>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>ISBN</td>
+<td><input type=text size=20 name=ISBN value=$data->{'isbn'}>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Series</td>
+<td><input type=text size=20 name=Series value="$data->{'seriestitle'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Branch</td>
+<td><select name=branch size=1>
+printend
+;
+my ($count2,@branches)=branches;
+for (my $i=0;$i<$count2;$i++){
+ print "<option value=$branches[$i]->{'branchcode'}";
+ if ($data->{'branchcode'} == $branches[$i]->{'branchcode'}){
+ print " Selected";
+ }
+ print ">$branches[$i]->{'branchname'}";
+}
+
+print <<printend
+</select>
+</td>
+</tr>
+<TR VALIGN=TOP bgcolor=#ffffcc>
+<TD >Item Barcode</td>
+<td><input type=text size=20 name=barcode>
+</td>
+</tr>
+</table>
+<img src="/images/holder.gif" width=32 height=250 align=left>
+<table border=1 cellspacing=0 cellpadding=5 width="40%">
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>ACCOUNTING DETAILS</B></td></tr>
+<TR VALIGN=TOP>
+<TD>Quantity</td>
+<td><input type=text size=20 name=quantity value="$data->{'quantity'}" onchange='update(this.form)' >
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Bookfund</td>
+<td><select name=bookfund size=1>
+printend
+;
+
+my ($count2,@bookfund)=bookfunds;
+for (my $i=0;$i<$count2;$i++){
+ print "<option value=$bookfund[$i]->{'bookfundid'}";
+ if ($data->{'bookfundid'} == $bookfund[$i]->{'bookfundid'}){
+ print " Selected";
+ }
+ print ">$bookfund[$i]->{'bookfundname'}";
+}
+
+print <<printend
+</select>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Suppliers List Price</td>
+<td><input type=text size=20 name=list_price value="$data->{'listprice'}" onchange='update(this.form)'>
+</tr>
+<TR VALIGN=TOP>
+<TD>Replacement Cost <br>
+<FONT SIZE=2>(NZ\$ inc GST)</td>
+<td><input type=text size=20 name=rrp value="$data->{'rrp'}" onchange='update(this.form)'>
+</tr>
+<TR VALIGN=TOP>
+<TD>
+Budgeted Cost<BR>
+<FONT SIZE=2>(NZ\$ ex GST, inc discount)</FONT> </td>
+<td><input type=text size=20 name=ecost value="$data->{'ecost'}" onchange='update(this.form)'>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>
+Budgeted GST</td>
+<td><input type=text size=20 name=GST value="" onchange='update(this.form)'>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD><B>
+BUDGETED TOTAL</B></td>
+<td><input type=text size=20 name=total value="" onchange='update(this.form)'>
+</td>
+</tr>
+<TR VALIGN=TOP bgcolor=#ffffcc>
+<TD>Actual Cost</td>
+<td><input type=text size=20 name=cost>
+</td>
+</tr>
+<TR VALIGN=TOP bgcolor=#ffffcc>
+<TD>Invoice Number *</td>
+<td><input type=text size=20 name=invoice >
+<TR VALIGN=TOP>
+<TD>Notes</td>
+<td><input type=text size=20 name=notes value="$data->{'notes'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD colspan=2>
+<input type=image name=submit src=/images/add-order.gif border=0 width=187 height=42 align=right>
+</td>
+</tr>
+</table>
+</form>
+</center>
+<table>
+<tr><td bgcolor=#cccc99 background="/images/background-mem.gif"><B>HELP</B><br>
+<UL>
+<LI>If ordering more than one copy of an item you will be prompted to choose additional bookfunds, and put in additional barcodes at the next screen<P>
+<LI><B>Bold</B> fields must be filled in to create a new bibilo and item.<p>
+<LI>Shaded fields can be used to do a "quick" receive, when items have been purchased locally or gifted. In this case the quantity "ordered" will also be entered into the database as the quantity received.
+</UL>
+</td></tr></table>
+<p> </p>
+printend
+;
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to show suppliers and orders
+#written by chris@katipo.co.nz 23/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $supplier=$input->param('supplier');
+print startpage;
+
+print startmenu('acquisitions');
+my ($count,@suppliers)=bookseller($supplier);
+
+print <<printend
+<FONT SIZE=6><em>Supplier Search Results</em></FONT>
+<div align=right>
+<a href=supplier.pl?id=0><img alt="Add New Supplier" src="/images/new-supplier.gif" WIDTH=187 HEIGHT=42 BORDER=0 border=0></a>
+</div>
+<CENTER>
+You searched on <b>supplier $supplier,</b> $count results found<p>
+<table border=0 cellspacing=0 cellpadding=5>
+<tr valign=top bgcolor=#99cc33>
+<td background="/images/background-mem.gif"> </td>
+<td background="/images/background-mem.gif"><b>COMPANY</b></td>
+<td background="/images/background-mem.gif"><b>BASKETS</b></td><td background="/images/background-mem.gif"><b>ITEMS</b></td><td background="/images/background-mem.gif"><b>STAFF</b></td><td background="/images/background-mem.gif"><b>DATE</b></td></tr>
+printend
+;
+my $colour='#ffffcc';
+my $toggle=0;
+for (my $i=0; $i<$count; $i++) {
+ if ($toggle==0){
+ $colour='#ffffcc';
+ $toggle=1;
+ } else {
+ $colour='white';
+ $toggle=0;
+ }
+ my ($ordcount,$orders)=getorders($suppliers[$i]->{'id'});
+# print $ordcount;
+ print <<printend
+ <tr valign=top bgcolor=$colour>
+ <td><a href="newbasket.pl?id=$suppliers[$i]->{'id'}"><img src="/images/new-basket-short.gif" alt="New Basket" width=77 height=32 border=0 ></a>
+ <a href="recieveorder.pl?id=$suppliers[$i]->{'id'}"><img src="/images/receive-order-short.gif" alt="Receive Order" width=77 height=32 border=0 ></a></td>
+ <td><a href="supplier.pl?id=$suppliers[$i]->{'id'}">$suppliers[$i]->{'name'}</a></td>
+ <td><a href="/cgi-bin/koha/acqui/basket.pl?basket=$orders->[0]->{'basketno'}">HLT-$orders->[0]->{'basketno'}</a></td>
+ <td>$orders->[0]->{'count(*)'}</td>
+ <td>$orders->[0]->{'authorisedby'}</td>
+ <td>$orders->[0]->{'entrydate'}</td></tr>
+printend
+;
+ for (my $i2=1;$i2<$ordcount;$i2++){
+ print <<printend
+ <tr valign=top bgcolor=$colour>
+ <td> </td>
+ <td> </td>
+ <td><a href="/cgi-bin/koha/acqui/basket.pl?basket=$orders->[$i2]->{'basketno'}">HLT-$orders->[$i2]->{'basketno'}</a></td>
+ <td>$orders->[$i2]->{'count(*)'}</td><td>$orders->[$i2]->{'authorisedby'} </td>
+ <td>$orders->[$i2]->{'entrydate'}</td></tr>
+
+printend
+;
+ }
+}
+
+print <<printend
+</table>
+
+</CENTER>
+printend
+;
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to recieve orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $id=$input->param('id');
+my ($count,@booksellers)=bookseller($id);
+my $invoice=$input->param('invoice');
+my $freight=$input->param('freight');
+my $gst=$input->param('gst');
+my $user=$input->remote_user;
+my $date=localtime(time);
+print startpage;
+
+print startmenu('acquisitions');
+
+print <<EOP
+
+<div align=right>
+Invoice: $invoice<br>
+Received By: $user<br>
+$date
+</div>
+<FONT SIZE=6><em>Receipt Summary For : <a href=whitcoulls.html>$booksellers[0]->{'name'}</a> </em></FONT>
+<CENTER>
+
+<FORM ACTION="/cgi-bin/koha/acqui/acquire.pl">
+<input type=hidden name=gst value=$gst>
+<input type=hidden name=freight value=$freight>
+<input type=hidden name=invoice value=$invoice>
+
+<b>Search ISBN or Title:</b> <INPUT TYPE="text" SIZE="25" NAME="recieve">
+</form>
+<p>
+<FORM ACTION="" method=post name=orderform>
+
+<table border=0 cellspacing=0 cellpadding=5>
+<tr valign=top bgcolor=#99cc33>
+<td background="/images/background-mem.gif"><b>BASKET</b></td>
+<td background="/images/background-mem.gif"><b>ISBN</b></td>
+<td background="/images/background-mem.gif"><b>TITLE</b></td>
+<td background="/images/background-mem.gif"><b>AUTHOR</b></td>
+<td background="/images/background-mem.gif"><b>ACTUAL</b></td>
+<td background="/images/background-mem.gif"><b>P&P</b></td>
+<td background="/images/background-mem.gif"><b>QTY</b></td>
+<td background="/images/background-mem.gif"><b>TOTAL</b></td></tr>
+
+EOP
+;
+my ($count,@results)=invoice($invoice);
+if ($invoice eq ''){
+ ($count,@results)=getallorders($id);
+}
+print $count;
+my $totalprice=0;
+my $totalfreight=0;
+my $totalquantity=0;
+my $total;
+my $tototal;
+for (my$i=0;$i<$count;$i++){
+ $total=($results[$i]->{'unitprice'} + $results[$i]->{'freight'}) * $results[$i]->{'quantityreceived'};
+$results[$i]->{'unitprice'}+=0;
+print <<EOP
+<tr valign=top bgcolor=#ffffcc>
+<td>$results[$i]->{'basketno'}</td>
+<td>$results[$i]->{'isbn'}</td>
+<td><a href="acquire.pl?recieve=$results[$i]->{'ordernumber'}&biblio=$results[$i]->{'biblionumber'}&invoice=$invoice&gst=$gst&freight=$freight">$results[$i]->{'title'}</a></td>
+<td>$results[$i]->{'author'}</td>
+<td>\$$results[$i]->{'unitprice'}</td>
+<td></td>
+<td>$results[$i]->{'quantityreceived'}</td>
+<td>\$ $total</td>
+</tr>
+EOP
+;
+$totalprice+=$results[$i]->{'unitprice'};
+$totalfreight+=$results[$i]->{'freight'};
+$totalquantity+=$results[$i]->{'quantityreceived'};
+$tototal+=$total;
+}
+$totalfreight=$freight;
+$tototal=$tototal+$freight;
+
+my $grandtot=$tototal+$gst;
+print <<EOP
+<tr valign=top bgcolor=white>
+<td colspan=8><hr>
+</td></tr>
+
+
+
+<tr valign=top bgcolor=white>
+<td></td>
+<td></td>
+<td></td>
+<td><b>SUBTOTALS</b></td>
+<td>\$$totalprice</td>
+<td>$totalfreight</td>
+<td>$totalquantity</td>
+<td>\$$tototal</td>
+</tr>
+<tr valign=top bgcolor=white>
+<td colspan=5 rowspan=2 bgcolor=#99cc33 background="/images/background-mem.gif">
+<b>HELP</b>
+<br>
+The total at the bottom of the page should be within a few cents of the total for the invoice.<p>
+When you have finished this invoice save the changes.
+</td>
+<td colspan=2 align=right><b>GST</b></td>
+<td>\$$gst</td>
+</tr>
+<tr valign=top bgcolor=white>
+<td colspan=2 align=right ><b>TOTAL</b></td>
+<td>\$$grandtot</td>
+</tr>
+<tr valign=top bgcolor=white>
+<td></td>
+<td></td>
+<td></td>
+<td></td>
+<td></td>
+<td></td>
+<td colspan=3><input type=image name=submit src=/images/save-changes.gif border=0 width=187 height=42 align=right></td>
+</tr>
+</table>
+</CENTER>
+EOP
+;
+
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to show display basket of orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $id=$input->param('id');
+my ($count,@booksellers)=bookseller($id);
+print startpage;
+
+print startmenu('acquisitions');
+
+print <<EOP
+
+<FONT SIZE=6><em>Receive Orders From Supplier <a href=whitcoulls.html>$booksellers[0]->{'name'}</a></em></FONT>
+<p>
+<CENTER>
+<form method=post action="receive.pl">
+<input type=hidden name=id value=$id>
+<p>
+<table border=1 cellspacing=0 cellpadding=5>
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>SUPPLIER INVOICE INFORMATION</B></td></tr>
+<TR VALIGN=TOP >
+<TD>Supplier Invoice Number</td>
+<td><input type=text size=20 name=invoice>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>GST</td>
+<td><input type=text size=20 name=gst>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Freight</td>
+<td><input type=text size=20 name=freight>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD></td>
+<td><input type=image name=submit src=/images/continue.gif border=0 width=120 height=42>
+</td>
+</tr>
+</table>
+</CENTER>
+
+EOP
+;
+
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to show display basket of orders
+#written by chris@katipo.co.nz 24/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+print $input->header();
+my $id=$input->param('id');
+my ($count,@booksellers)=bookseller($id);
+print startpage;
+
+print startmenu('acquisitions');
+
+print <<EOP
+<form action=updatesupplier.pl method=post>
+
+<input type=hidden name=id value=$id>
+<FONT SIZE=6><em>Update: $booksellers[0]->{'name'}</em></FONT>
+<P>
+<CENTER>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width="40%">
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>COMPANY DETAILS</B></td></tr>
+<TR VALIGN=TOP>
+<TD><b>Company Name</b></td>
+<td><input type=text size=20 name=company value="$booksellers[0]->{'name'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Postal Address</td>
+<td><textarea name=company_postal cols=20 rows=3>$booksellers[0]->{'postal'}
+</textarea></td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Physical Address</td>
+<td><textarea name=physical cols=20 rows=4>$booksellers[0]->{'address1'}
+$booksellers[0]->{'address2'}
+$booksellers[0]->{'address3'}
+$booksellers[0]->{'address4'}
+</textarea>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Phone</td>
+<td><input type=text size=20 name=company_phone value="$booksellers[0]->{'phone'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Fax</td>
+<td><input type=text size=20 name=company_fax value="$booksellers[0]->{'fax'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Website</td>
+<td><input type=text size=20 name=website value="$booksellers[0]->{'url'}">
+</td>
+</tr>
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>CONTACT DETAILS</B></td></tr>
+<TR VALIGN=TOP>
+<TD>Contact Name</td>
+<td><input type=text size=20 name=company_contact_name value="$booksellers[0]->{'contact'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Position</td>
+<td><input type=text size=20 name=company_contact_position value="$booksellers[0]->{'contpos'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Phone</td>
+<td><input type=text size=20 name=contact_phone value="$booksellers[0]->{'contphone'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Alternative Phone</td>
+<td><input type=text size=20 name=contact_phone_2 value="$booksellers[0]->{'contaltphone'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Fax</td>
+<td><input type=text size=20 name=contact_fax value="$booksellers[0]->{'contfax'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>E-mail</td>
+<td><input type=text size=20 name=company_email value="$booksellers[0]->{'contemail'}">
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Notes</td>
+<td><textarea name=notes cols=20 rows=4>$booksellers[0]->{'contnotes'}</textarea>
+</td>
+</tr>
+<tr valign=right><td><input type=image name=submit src=/images/save-changes.gif border=0 width=187 height=42 align=right></td></tr>
+</table>
+<img src="/images/holder.gif" width=32 height=250 align=left>
+
+<table border=1 cellspacing=0 cellpadding=5 width="40%">
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>CURRENT STATUS</B></td></tr>
+<TR VALIGN=TOP>
+<TD>Supplier is</td>
+<td><input type=radio name=status value=1
+EOP
+;
+if ($booksellers[0]->{'active'}==1){
+ print " checked ";
+}
+print ">Active
+<input type=radio name=status value=0";
+if ($booksellers[0]->{'active'}==0){
+ print " checked ";
+}
+print <<EOP
+>Inactive
+</td>
+</tr>
+<tr valign=top bgcolor=#99cc33><td background="/images/background-mem.gif" colspan=2><B>ORDERING INFORMATION</B></td></tr>
+<TR VALIGN=TOP>
+<TD>Publishers and Imprints</td>
+<td><textarea name=publishers_imprints cols=20 rows=4>$booksellers[0]->{'specialty'}</textarea>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>List Prices are</td>
+<td><select name=list_currency size=1>
+<option value=NZD
+EOP
+;
+if ($booksellers[0]->{'listprice'} eq 'NZD'){
+ print " selected";
+}
+print ">\$ NZ
+<option value=AUD";
+if ($booksellers[0]->{'listprice'} eq 'AUD'){
+ print " selected";
+}
+print ">\$ Aus
+<option value=USD";
+if ($booksellers[0]->{'listprice'} eq 'USD'){
+ print " selected";
+}
+print ">\$ USA
+<option value=UKP";
+if ($booksellers[0]->{'listprice'} eq 'UKP'){
+ print " selected";
+}
+
+print <<EOP
+>£ Sterling
+</select>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Invoice Prices are</td>
+<td><select name=invoice_currency size=1>
+<option value=NZD
+EOP
+;
+if ($booksellers[0]->{'invoiceprice'} eq 'NZD'){
+ print " selected";
+}
+print ">\$ NZ
+<option value=AUD";
+if ($booksellers[0]->{'invoiceprice'} eq 'AUD'){
+ print " selected";
+}
+print ">\$ Aus
+<option value=USD";
+if ($booksellers[0]->{'invoiceprice'} eq 'USD'){
+ print " selected";
+}
+print ">\$ USA
+<option value=UKP";
+if ($booksellers[0]->{'invoiceprice'} eq 'UKP'){
+ print " selected";
+}
+print <<EOP
+>£ Sterling
+</select>
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>GST Registered</td>
+<td><input type=radio name=gst value=1
+EOP
+;
+if ($booksellers[0]->{'gstreg'}==1){
+ print " checked";
+}
+print ">Yes
+<input type=radio name=gst value=0";
+if ($booksellers[0]->{'gstreg'}==0){
+ print " checked";
+}
+print <<EOP
+>No
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>List Item Price Includes GST</td>
+<td><input type=radio name=list_gst value=1
+EOP
+;
+if ($booksellers[0]->{'listincgst'}==1){
+ print " checked";
+}
+print ">Yes
+<input type=radio name=list_gst value=0";
+if ($booksellers[0]->{'listincgst'}==0){
+ print " checked";
+}
+print <<EOP
+>No
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Invoice Item Price Includes GST</td>
+<td><input type=radio name=invoice_gst value=1
+EOP
+;
+if ($booksellers[0]->{'invoiceincgst'}==1){
+ print " checked";
+}
+print ">Yes
+<input type=radio name=invoice_gst value=0";
+if ($booksellers[0]->{'invoiceincgst'}==0){
+ print " checked";
+}
+print <<EOP
+>No
+</td>
+</tr>
+<TR VALIGN=TOP>
+<TD>Discount</td>
+<td><input type=text size=3 name=discount value=$booksellers[0]->{'discount'}> %
+</tr>
+</table>
+
+</form>
+</center>
+EOP
+;
+
+
+print endmenu('acquisitions');
+
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#script to show suppliers and orders
+#written by chris@katipo.co.nz 23/2/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+use strict;
+
+my $input=new CGI;
+#print $input->header();
+my $supplier=$input->param('supplier');
+#print startpage;
+my %data;
+$data{'id'}=$input->param('id');
+
+$data{'name'}=$input->param('company');
+$data{'name'}=~ s/\'/\\\'/g;
+$data{'postal'}=$input->param('company_postal');
+my $address=$input->param('physical');
+my @addresses=split('\n',$address);
+$data{'address1'}=$addresses[0];
+$data{'address2'}=$addresses[1];
+$data{'address3'}=$addresses[2];
+$data{'address4'}=$addresses[3];
+$data{'phone'}=$input->param('company_phone');
+$data{'fax'}=$input->param('company_fax');
+$data{'url'}=$input->param('website');
+$data{'contact'}=$input->param('company_contact_name');
+$data{'contpos'}=$input->param('company_contact_position');
+$data{'contphone'}=$input->param('contact_phone');
+$data{'contaltphone'}=$input->param('contact_phone_2');
+$data{'contfax'}=$input->param('contact_fax');
+$data{'contemail'}=$input->param('company_email');
+$data{'contnotes'}=$input->param('notes');
+$data{'active'}=$input->param('status');
+$data{'specialty'}=$input->param('publishers_imprints');
+$data{'listprice'}=$input->param('list_currency');
+$data{'invoiceprice'}=$input->param('invoice_currency');
+$data{'gstreg'}=$input->param('gst');
+$data{'listincgst'}=$input->param('list_gst');
+$data{'invoiceincgst'}=$input->param('invoice_gst');
+$data{'discount'}=$input->param('discount');
+my $id=$input->param('id');
+if ($data{'id'} != 0){
+ updatesup(\%data);
+} else {
+ $id=insertsup(\%data);
+}
+#print startmenu('acquisitions');
+#my ($count,@suppliers)=bookseller($supplier);
+
+#print $input->dump;
+
+
+#print endmenu('acquisitions');
+
+#print endpage;
+
+print $input->redirect("order.pl?supplier=$id");
--- /dev/null
+#!/usr/bin/perl
+
+#wrriten 11/1/2000 by chris@katipo.oc.nz
+#script to display borrowers account details
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+my $input=new CGI;
+
+
+my $bornum=$input->param('bornum');
+#get borrower details
+my $data=borrdata('',$bornum);
+
+
+#get account details
+my %bor;
+$bor{'borrowernumber'}=$bornum;
+my ($numaccts,$accts,$total)=getboracctrecord('',\%bor);
+
+
+
+print $input->header;
+print startpage();
+print startmenu('member');
+print <<printend
+<FONT SIZE=6><em>Account for $data->{'firstname'} $data->{'surname'}</em></FONT><P>
+<center>
+<p>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=2><B>FINES & CHARGES</TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=1><B>AMOUNT</TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=1><B>STILL OWING</TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=1><B>FIX</B></TD>
+</TR>
+
+<form method=post action=tidyaccounts.pl>
+printend
+;
+for (my $i=0;$i<$numaccts;$i++){
+ $accts->[$i]{'amount'}+=0.00;
+ $accts->[$i]{'amountoutstanding'}+=0.00;
+ print <<printend
+ <tr VALIGN=TOP >
+ <td>$accts->[$i]{'date'}</td>
+ <TD>$accts->[$i]{'description'}
+printend
+;
+ if ($accts->[$i]{'accounttype'} ne 'F' && $accts->[$i]{'accounttype'} ne 'FU'){
+ print "$accts->[$i]{'title'}";
+ }
+ print <<printend
+ </td>
+
+ <td>$accts->[$i]{'amount'}</td>
+ <TD>$accts->[$i]{'amountoutstanding'}</td>
+ <td><input type=text size=5 name=$accts->[$i]{'accountno'} value="$accts->[$i]{'amount'}"></td>
+</tr>
+printend
+;
+}
+print <<printend
+<tr VALIGN=TOP >
+<TD></td>
+<TD colspan=2><b>Total Due</b></td>
+
+<TD><b>$total</b></td>
+
+</tr>
+
+
+
+
+</table>
+<input type=hidden name=bornum value=$bornum>
+<input type=submit value="Tidy Accounts">
+</form>
+
+
+
+<br clear=all>
+<p> </p>
+
+printend
+;
+print endmenu('member');
+print endpage();
+
--- /dev/null
+#!/usr/bin/perl
+
+use DBI;
+use C4::Database;
+use C4::Circulation::Issues;
+use C4::Circulation::Main;
+use C4::InterfaceCDK;
+use C4::Circulation::Borrower;
+
+# my @args=('issuewrapper.pl',"$env{'branchcode'}","$env{'usercode'}","$env{'telnet'}","$env{'queue'}","$env{'printtype'}");
+my %env = (
+ branchcode => $ARGV[0], usercode => $ARGV[1], proccode => "lgon", borrowernumber => "",
+ logintime => "", lasttime => "", tempuser => "", debug => "9",
+ telnet => $ARGV[2], queue => $ARGV[3], printtype => $ARGV[4], brdata => $ARGV[5],
+ bcard=>$ARGV[6]
+ );
+my ($env) = \%env;
+ startint();
+ helptext('');
+my $done;
+my ($items,$items2,$amountdue);
+my $itemsdet;
+$env->{'sysarea'} = "Issues";
+$done = "Issues";
+my $i=0;
+my $dbh=&C4Connect;
+ my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = C4::Circulation::Borrower::findborrower($env,$dbh);
+ $env->{'loanlength'}="";
+ if ($reason ne "") {
+ $done = $reason;
+ } elsif ($env->{'IssuesAllowed'} eq '0') {
+ error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
+ } else {
+ $env->{'bornum'} = $bornum;
+ $env->{'bcard'} = $borrower->{'cardnumber'};
+ ($items,$items2)=C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
+ $done = "No";
+ my $it2p=0;
+ while ($done eq 'No'){
+ ($done,$items2,$it2p,$amountdue,$itemsdet) = C4::Circulation::Issues::processitems($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet);
+ }
+
+ }
+ if ($done ne 'Issues'){
+ $dbh->disconnect;
+ die "test";
+ }
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+#script to do some serious catalogue maintainance
+#written 22/11/00
+# by chris@katipo.co.nz
+
+use strict;
+use CGI;
+use C4::Output;
+use C4::Database;
+use C4::Maintainance;
+
+my $input = new CGI;
+print $input->header;
+my $type=$input->param('type');
+print startpage();
+print startmenu('catalog');
+my $blah;
+my $num=0;
+my $offset=0;
+if ($type eq 'allsub'){
+ my $sub=$input->param('sub');
+ my ($count,$results)=listsubjects($sub,$num,$offset);
+ for (my $i=0;$i<$count;$i++){
+ my $sub2=$results->[$i]->{'subject'};
+ $sub2=~ s/ /%20/g;
+ print "\"<a href=\"/cgi-bin/koha/catmaintain.pl?type=allsub&sub=$sub\" onclick=\'messenger(\"/cgi-bin/koha/catmaintain.pl?type=modsub&sub=$sub2\");window1.focus()\'>$results->[$i]->{'subject'}\"</a><br>\n";
+ }
+} elsif ($type eq 'modsub'){
+ my $sub=$input->param('sub');
+ print "<form action=/cgi-bin/koha/catmaintain.pl>";
+ print "Subject:<input type=text value=\"$sub\" name=sub size=40><br>\n";
+ print "<input type=hidden name=type value=upsub>";
+ print "<input type=hidden name=oldsub value=\"$sub\">";
+ print "<input type=submit value=modify>";
+# print "<a href=\"nowhere\" onclick=\"document.forms[0].submit();\">Modify</a>";
+ print "</form>";
+ print "<p> This will change the subject headings on all the biblios this subject is applied to"
+} elsif ($type eq 'upsub'){
+ my $sub=$input->param('sub');
+ my $oldsub=$input->param('oldsub');
+ updatesub($sub,$oldsub);
+ print "Successfully modified $oldsub is now $sub";
+ print "<p><a href=/cgi-bin/koha/catmaintain.pl target=window0 onclick=\"window0.focus()\">Back to catalogue maintenance</a><br>";
+ print "<a href=nowhere onclick=\"self.close()\">Close this window</a>";
+} else {
+ print "<form action=/cgi-bin/koha/catmaintain.pl method=post>";
+ print "<input type=hidden name=type value=allsub>";
+ print "Show all subjects beginning with <input type=text name=sub><br>";
+ print "<input type=submit value=Show>";
+ print "</form>";
+}
+print endmenu('catalog');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to display reports
+#written 8/11/99
+
+use strict;
+use CGI;
+use C4::Output;
+use C4::Database;
+
+my $input = new CGI;
+print $input->header;
+my $type=$input->param('type');
+print startpage();
+print startmenu('issue');
+print "Each box needs to be filled in with fine,time to start charging,charging cycle<br>
+eg 1,7,7 = $1 fine, after 7 days, every 7 days";
+
+my $dbh=C4Connect;
+my $query="Select description,categorycode from categories";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+print mktablehdr;
+my @trow;
+my @trow3;
+my $i=0;
+while (my $data=$sth->fetchrow_hashref){
+ $trow[$i]=$data->{'description'};
+ $trow3[$i]=$data->{'categorycode'};
+ $i++;
+}
+$sth->finish;
+print mktablerow(10,'white','',@trow);
+print "<form action=/cgi-bin/koha/updatecharges.pl method=post>";
+$query="Select description,itemtype from itemtypes";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$i=0;
+
+while (my $data=$sth->fetchrow_hashref){
+ my @trow2;
+ for ($i=0;$i<9;$i++){
+ $query="select * from categoryitem where categorycode='$trow3[$i]' and itemtype='$data->{'itemtype'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ my $dat=$sth2->fetchrow_hashref;
+ $sth2->finish;
+ my $fine=$dat->{'fine'}+0;
+ $trow2[$i]="<input type=text name=\"$trow3[$i]$data->{'itemtype'}\" value=\"$fine,$dat->{'startcharge'},$dat->{'chargeperiod'}\" size=6>";
+ }
+ print mktablerow(11,'white',$data->{'description'},@trow2);
+}
+
+$sth->finish;
+
+
+print "</table>";
+print "<input type=submit></form>";
+print endmenu('issue');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#written by chris@katipo.co.nz
+#9/10/2000
+#script to display and update currency rates
+
+use CGI;
+use C4::Acquisitions;
+
+my $input=new CGI;
+
+my $type=$input->param('type');
+#find out what the script is being called for
+#print $input->header();
+if ($type ne 'change'){
+ #display, we must fetch the exchange rate data and output it
+ print $input->header();
+ print <<printend
+ <TABLE width="40%" cellspacing=0 cellpadding=5 border=1 >
+ <FORM ACTION="/cgi-bin/koha/currency.pl">
+ <input type=hidden name=type value=change>
+ <TR VALIGN=TOP>
+ <TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2 ><b>EXCHANGE RATES </b></TD></TR>
+ <TR VALIGN=TOP>
+ <TD>
+printend
+;
+ my ($count,$rates)=getcurrencies();
+ for (my $i=0;$i<$count;$i++){
+ if ($rates->[$i]->{'currency'} ne 'NZD'){
+ print "$rates->[$i]->{'currency'}<INPUT TYPE=\"text\" SIZE=\"5\" NAME=\"$rates->[$i]->{'currency'}\" value=$rates->[$i]->{'rate'}>";
+ }
+# print $rates->[$i]->{'currency'};
+ }
+ print <<printend
+ <p>
+ <input type=image name=submit src=/images/save-changes.gif border=0 width=187 height=42>
+
+ </TD></TR>
+ </form>
+ </table>
+printend
+;
+} else {
+# print $input->Dump;
+ my @params=$input->param;
+ foreach my $param (@params){
+ if ($param ne 'type' && $param !~ /submit/){
+ my $data=$input->param($param);
+ updatecurrencies($param,$data);
+ }
+ }
+ print $input->redirect('/acquisitions/');
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to delete biblios
+#written 2/5/00
+#by chris@katipo.co.nz
+
+use strict;
+
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+
+my $input = new CGI;
+#print $input->header;
+
+
+my $biblio=$input->param('biblio');
+
+delbiblio($biblio);
+print $input->redirect("/catalogue/");
--- /dev/null
+#!/usr/bin/perl
+
+#script to delete items
+#written 2/5/00
+#by chris@katipo.co.nz
+
+use strict;
+
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+
+my $input = new CGI;
+#print $input->header;
+my $item=$input->param('itemnum');
+delitem($item);
+my $bibitemnum=$input->param('bibitemnum');
+print $input->redirect("/cgi-bin/koha/moredetail.pl?bi=$bibitemnum");
--- /dev/null
+#!/usr/bin/perl
+
+#script to display detailed information
+#written 8/11/99
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+
+my $input = new CGI;
+print $input->header;
+#whether it is called from the opac of the intranet
+my $type=$input->param('type');
+if ($type eq ''){
+ $type='intra';
+}
+#setup colours
+my $main;
+my $secondary;
+if ($type eq 'opac'){
+ $main='#99cccc';
+ $secondary='#efe5ef';
+} else {
+ $main='#cccc99';
+ $secondary='#ffffcc';
+}
+print startpage();
+print startmenu($type);
+#print $type;
+my $blah;
+my $bib=$input->param('bib');
+my $title=$input->param('title');
+if ($type ne 'opac'){
+ print "<a href=request.pl?bib=$bib><img height=42 WIDTH=120 BORDER=0 src=\"/images/requests.gif\" align=right border=0></a>";
+}
+
+
+my @items=ItemInfo(\$blah,$bib,$type);
+my $dat=bibdata($bib);
+my $count=@items;
+my ($count3,$addauthor)=addauthor($bib);
+my $additional=$addauthor->[0]->{'author'};
+for (my $i=1;$i<$count3;$i++){
+ $additional=$additional."|".$addauthor->[$i]->{'author'};
+}
+my @temp=split('\t',$items[0]);
+print mkheadr(3,"$dat->{'title'} ($dat->{'author'}) $temp[4]");
+print <<printend
+
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width="220">
+
+<!-----------------BIBLIO RECORD TABLE--------->
+
+
+<form action=/cgi-bin/koha/modbib.pl method=post>
+<input type=hidden name=bibnum value=$bib>
+<TR VALIGN=TOP>
+
+<td bgcolor="$main"
+printend
+;
+if ($type ne 'opac'){
+ print "background=\"/images/background-mem.gif\"";
+}
+print <<printend
+><B>BIBLIO RECORD
+printend
+;
+if ($type ne 'opac'){
+ print "$bib";
+}
+print <<printend
+</TD></TR>
+
+
+<tr VALIGN=TOP >
+<TD>
+printend
+;
+if ($type ne 'opac'){
+ print "<INPUT TYPE=\"image\" name=\"submit\" VALUE=\"modify\" height=42 WIDTH=93 BORDER=0 src=\"/images/modify-mem.gif\">
+ <INPUT TYPE=\"image\" name=\"delete\" VALUE=\"delete\" height=42 WIDTH=93 BORDER=0 src=\"/images/delete-mem.gif\">";
+}
+print <<printend
+<br>
+<FONT SIZE=2 face="arial, helvetica">
+printend
+;
+
+
+if ($type ne 'opac'){
+print <<printend
+<b>Subtitle:</b> $dat->{'subtitle'}<br>
+<b>Author:</b> $dat->{'author'}<br>
+<b>Additional Author:</b> $additional<br>
+<b>Series Title:</b> $dat->{'seriestitle'}<br>
+<b>Subject:</b> $dat->{'subject'}<br>
+<b>Copyright:</b> $dat->{'copyrightdate'}<br>
+<b>Notes:</b> $dat->{'notes'}<br>
+<b>Unititle:</b> $dat->{'unititle'}<br>
+<b>Analytical Author:</b> <br>
+<b>Analytical Title:</b> <br>
+<b>Serial:</b> $dat->{'serial'}<br>
+<b>Total Number of Items:</b> $count
+<p>
+printend
+;
+}
+else {
+if ($dat->{'subtitle'} ne ''){
+ print "<b>Subtitle:</b> $dat->{'subtitle'}<br>";
+}
+if ($dat->{'author'} ne ''){
+ print "<b>Author:</b> $dat->{'author'}<br>";
+}
+#Additional Author: <br>
+if ($dat->{'seriestitle'} ne ''){
+ print "<b>Seriestitle:</b> $dat->{'seriestitle'}<br>";
+}
+if ($dat->{'subject'} ne ''){
+ print "<b>Subject:</b> $dat->{'subject'}<br>";
+}
+if ($dat->{'copyrightdate'} ne ''){
+ print "<b>Copyright:</b> $dat->{'copyrightdate'}<br>";
+}
+if ($dat->{'notes'} ne ''){
+ print "<b>Notes:</b> $dat->{'notes'}<br>";
+}
+if ($dat->{'unititle'} ne ''){
+ print "<b>Unititle:</b> $dat->{'unititle'}<br>";
+}
+#Analytical Author: <br>
+#Analytical Title: <br>
+if ($dat->{'serial'} ne '0'){
+ print "<b>Serial:</b> Yes<br>";
+}
+print "<b>Total Number of Items:</b> $count
+<p>
+";
+
+}
+print <<printend
+</form>
+</font></TD>
+</TR>
+
+</TABLE>
+<img src="/images/holder.gif" width=16 height=300 align=left>
+
+printend
+;
+
+
+#print @items;
+
+my $i=0;
+print center();
+print mktablehdr;
+if ($type eq 'opac'){
+
+ print mktablerow(6,$main,'Item Type','Class','Branch','Date Due','Last Seen');
+} else {
+ print mktablerow(6,$main,'Itemtype','Class','Location','Date Due','Last Seen','Barcode',"/images/background-mem.gif");
+}
+my $colour=1;
+while ($i < $count){
+# print $items[$i],"<br>";
+ my @results=split('\t',$items[$i]);
+ if ($type ne 'opac'){
+ $results[1]=mklink("/cgi-bin/koha/moredetail.pl?item=$results[5]&bib=$bib&bi=$results[8]",$results[1]);
+ }
+ if ($results[2] eq ''){
+ $results[2]='Available';
+ }
+ if ($colour == 1){
+ if ($type ne 'opac'){
+# if ($results[6] eq 'PER'){
+ print mktablerow(7,$secondary,$results[6],$results[4],$results[3],$results[2],$results[7],$results[1],$results[9]);
+# } else {
+# print mktablerow(6,$secondary,$results[6],$results[4],$results[3],$results[2],$results[7],$results[1]);
+# }
+ } else {
+ $results[6]=ItemType($results[6]);
+# if ($results[6] =~ /Periodical/){
+ print mktablerow(6,$secondary,$results[6],$results[4],$results[3],$results[2],$results[7],$results[9]);
+# } else {
+# print mktablerow(5,$secondary,$results[6],$results[4],$results[3],$results[2],$results[7]);
+# }
+ }
+ $colour=0;
+ } else{
+ if ($type ne 'opac'){
+# if ($results[6] eq 'PER'){
+ print mktablerow(7,'white',$results[6],$results[4],$results[3],$results[2],$results[7],$results[1],$results[9]);
+# }else{
+# print mktablerow(6,'white',$results[6],$results[4],$results[3],$results[2],$results[7],$results[1]);
+# }
+ } else {
+ $results[6]=ItemType($results[6]);
+# if ($results[6] =~ /Periodical/){
+ print mktablerow(6,'white',$results[6],$results[4],$results[3],$results[2],$results[7],$results[9]);
+# } else {
+# print mktablerow(5,'white',$results[6],$results[4],$results[3],$results[2],$results[7]);
+# }
+ }
+ $colour=1;
+ }
+ $i++;
+}
+
+print mktableft();
+print "<p>";
+print mktablehdr();
+if ($type ne 'opac'){
+print <<printend
+<TR VALIGN=TOP>
+<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2><p><b>HELP</b><br>
+<b>Update Biblio for all Items:</b> Click on the <b>Modify</b> button [left] to amend the biblio. Any changes you make will update the record for <b>all</b> the items listed above. <p>
+<b>Updating the Biblio for only ONE or SOME Items:</b> If some of the items listed above need a different biblio, or are on the wrong biblio, you must use the <a href="acquisitions/">acquisitions</a> process to fix this. You will need to "re-order" the items, and delete them from this biblio.<p>
+
+ </TR>
+printend
+;
+}
+print mktableft();
+print endcenter();
+print "<br clear=all>";
+print endmenu($type);
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to calculate fines
+
+
+use C4::Circulation::Fines;
+use Date::Manip;
+
+open (FILE,'>/tmp/fines') || die;
+my ($count,$data)=Getoverdues();
+#print $count;
+my $count2=0;
+#$count=1000;
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
+$mon++;
+$year=$year+1900;
+#my $date=Date_DaysSince999($mon,$mday,$year);
+my $date=Date_DaysSince999(2,20,2000);
+my $bornum;
+my $borrower;
+my $total=0;
+my $max=5;
+my $bornum2;
+for (my $i=0;$i<$count;$i++){
+ my @dates=split('-',$data->[$i]->{'date_due'});
+ my $date2=Date_DaysSince999($dates[1],$dates[2],$dates[0]);
+ my $due="$dates[2]/$dates[1]/$dates[0]";
+ if ($date2 <= $date){
+ $count2++;
+ my $difference=$date-$date2;
+ if ($bornum != $data->[$i]->{'borrowernumber'}){
+
+ $bornum=$data->[$i]->{'borrowernumber'};
+ $borrower=BorType($bornum);
+ }
+
+
+ my ($amount,$type,$printout)=CalcFine($data->[$i]->{'itemnumber'},$borrower->{'categorycode'},$difference);
+ if ($amount > $max){
+ $amount=$max;
+ }
+ if ($amount > 0){
+ UpdateFine($data->[$i]->{'itemnumber'},$bornum,$amount,$type,$due);
+ if ($bornum2 == $data->[$i]->{'borrowernumber'}){
+ $total=$total+$amount;
+ } else {
+ print FILE "\"$borrower->{'cardnumber'}\"\,\"$borrower->{'phone'}\"\,\"Overdue or Extd Rental$total\"\,\"$borrower->{'homebranch'}\"\n";
+ $total=$amount;
+ }
+ if ($amount ==5){
+# marklost();
+ }
+ print "$printout\t$borrower->{'cardnumber'}\t$borrower->{'firstname'}\t$borrower->{'surname'}\t$data->[$i]->{'date_due'}\t$type\t$difference\t$borrower->{'emailaddress'}\t$borrower->{'phone'}\t$borrower->{'streetaddress'}\t$borrower->{'city'}\n";
+ } else {
+# print "0 fine\n";
+ }
+
+ }
+ $bornum2=$data->[$i]->{'borrowernumber'};
+}
+close FILE;
--- /dev/null
+#!/usr/bin/perl
+
+#script to set up screen for modification of borrower details
+#written 20/12/99 by chris@katipo.co.nz
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+
+
+my $input = new CGI;
+my $member=$input->param('bornum');
+if ($member eq ''){
+ $member=NewBorrowerNumber();
+}
+my $type=$input->param('type');
+
+print $input->header;
+print startpage();
+print startmenu('member');
+my $data=borrdata('',$member);
+print <<printend
+<BLOCKQUOTE>
+
+<FONT SIZE=6><em>Add New Institution</em></FONT><br>
+<form action=/cgi-bin/koha/newimember.pl method=post>
+<input type=hidden name=joining value="">
+<input type=hidden name=expiry value="">
+<input type=hidden name=type value="borrowers">
+<input type=hidden name=borrowernumber value="$member">
+<input type=hidden name=updtype value=I>
+<table border=0 cellspacing=0 cellpadding=5 >
+
+
+<tr valign=top><td ><input type=reset value="Clear all Fields"></td></tr><tr>
+<TR align=right><td COLSPAN=2 ALIGN=RIGHT ><font size=3 face='arial,helvetica'>
+<STRONG>Member# $member, Card Number*</STRONG> </TD><TD align=right><input type=text name=cardnumber_institution size=20 value=" "><br>
+</td></TR>
+<tr><td> </TD></TR>
+
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<B>INSTITUTION DETAILS</b></td> <td COLSPAN=2 ALIGN=RIGHT background="/images/background-mem.gif">
+
+</td></tr>
+<tr valign=top bgcolor=white>
+
+<td colspan=3><input type=text name=institution_name size=50 value=""></td>
+</tr>
+<tr valign=top bgcolor=white>
+
+<td><FONT SIZE=2>Institution Name</FONT></td>
+</tr>
+
+<tr><td> </TD></TR>
+
+
+ <tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+ <B>INSTITUTION ADDRESS</b></td></tr>
+ <tr valign=top bgcolor=white>
+ <td><input type=text name=address size=40 value="">
+ <td><input type=text name=city size=20 value=""></td>
+ <td>
+ <SELECT NAME="area" SIZE="1">
+ <OPTION value=L
+
+ >L - Levin
+ <OPTION value=F>F - Foxton
+ <OPTION value=S>S - Shannon
+ <OPTION value=H>H - Horowhenua
+ <OPTION value=K>K - Kapiti
+ <OPTION value=O>O - Out of District
+ <OPTION value=X>X - Temporary Visitor
+ <OPTION value=Z>Z - Interloan Libraries
+ <OPTION value=V>V - Villlage</SELECT></td></tr>
+ <tr valign=top bgcolor=white>
+ <td ><FONT SIZE=2>Postal Address*</FONT></td>
+ <td><FONT SIZE=2>Town*</FONT></td>
+ <td><FONT SIZE=2>Area</FONT></td>
+ </tr>
+ <tr><td> </TD></TR>
+ <tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+ <B>CONTACT DETAILS</b></td></tr>
+ <tr valign=top bgcolor=white>
+ <td COLSPAN=3 ><input type=text name=contactname size=40 value=""></td>
+ </tr>
+
+ <tr valign=top bgcolor=white>
+ <td COLSPAN=3 ><FONT SIZE=2>Contact Name*</td></tr>
+
+ <tr valign=top bgcolor=white>
+
+ <td ><input type=text name=phoneday size=20 value=""></td>
+ <td><input type=text name=faxnumber size=20 value=""></td>
+ <td ><input type=text name=emailaddress size=20 value=""></td></tr>
+
+ <tr valign=top bgcolor=white>
+
+ <td><FONT SIZE=2>Phone (day)</td>
+ <td><FONT SIZE=2>Fax</td>
+ <td><FONT SIZE=2>Email</td></tr>
+ <tr><td> </TD></TR>
+
+
+ <tr valign=top bgcolor=white>
+
+
+ <td COLSPAN=4><textarea name=altnotes wrap=physical cols=70 rows=3></textarea></td></tr>
+ </tr>
+ <tr valign=top bgcolor=white>
+ <td><FONT SIZE=2>Notes</font></td></tr>
+ <tr><td> </TD></TR>
+
+
+ <tr valign=top bgcolor="99cc33" >
+
+ <td COLSPAN=5 background="/images/background-mem.gif"><B>LIBRARY USE</B></td>
+ </tr>
+
+
+ <tr valign=top >
+
+
+ <td COLSPAN=5><textarea name=borrowernotes wrap=physical cols=70 rows=3></textarea></td></tr>
+ <tr><td> </TD></TR>
+ <tr valign=top bgcolor=white>
+ <td ><FONT SIZE=2>Notes</font></td>
+ </tr><tr valign=top bgcolor=white>
+
+
+ <td COLSPAN=5 align=right >
+ <input type=image src="/images/save-changes.gif" WIDTH=188 HEIGHT=44 ALT="Add New Member" border=0 ></td>
+ </tr>
+ </TABLE>
+ </table>
+ </form>
+
+
+
+ <br clear=all>
+
+ <p> </p>
+
+
+printend
+;
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to enter borrower data into the data base
+#needs to be moved into a perl module
+# written 9/11/99 by chris@katipo.co.nz
+
+use CGI;
+use C4::Database;
+use C4::Input;
+use Date::Manip;
+use strict;
+
+my $input= new CGI;
+#print $input->header;
+#print $input->dump;
+
+#get all the data into a hash
+my @names=$input->param;
+my %data;
+my $keyfld;
+my $keyval;
+my $problems;
+my $env;
+foreach my $key (@names){
+ $data{$key}=$input->param($key);
+}
+my $dbh=C4Connect;
+my $query="Select * from borrowers where borrowernumber=$data{'borrowernumber'}";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+if (my $data=$sth->fetchrow_hashref){
+ $query="update borrowers set title='$data{'title'}',expiry='$data{'expiry'}',
+ cardnumber='$data{'cardnumber'}',sex='$data{'sex'}',ethnotes='$data{'ethnicnotes'}',
+ streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',firstname='$data{'firstname'}',
+ altnotes='$data{'altnotes'}',dateofbirth='$data{'dateofbirth'}',contactname='$data{'contactname'}',
+ emailaddress='$data{'emailaddress'}',dateenrolled='$data{'joining'}',streetcity='$data{'streetcity'}',
+ altrelationship='$data{'altrelationship'}',othernames='$data{'othernames'}',phoneday='$data{'phoneday'}',
+ categorycode='$data{'categorycode'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}',
+ borrowernotes='$data{'borrowernotes'}',altphone='$data{'altphone'}',surname='$data{'surname'}',
+ initials='$data{'initials'}',streetaddress='$data{'address'}',ethnicity='$data{'ethnicity'}'
+ where borrowernumber=$data{'borrowernumber'}";
+# print $query;
+
+}else{
+ $data{'dateofbirth'}=ParseDate($data{'dateofbirth'});
+ $data{'dateofbirth'}=UnixDate($data{'dateofbirth'},'%Y-%m-%d');
+ $data{'joining'}=ParseDate($data{'joining'});
+ $data{'joining'}=UnixDate($data{'joining'},'%Y-%m-%d');
+ $query="insert into borrowers (title,expiry,cardnumber,sex,ethnotes,streetaddress,faxnumber,
+ firstname,altnotes,dateofbirth,contactname,emailaddress,dateenrolled,streetcity,
+ altrelationship,othernames,phoneday,categorycode,city,area,phone,borrowernotes,altphone,surname,
+ initials,ethnicity,borrowernumber) values ('$data{'title'}','$data{'expiry'}','$data{'cardnumber'}',
+ '$data{'sex'}','$data{'ethnotes'}','$data{'address'}','$data{'faxnumber'}',
+ '$data{'firstname'}','$data{'altnotes'}','$data{'dateofbirth'}','$data{'contactname'}','$data{'emailaddress'}',
+ '$data{'joining'}','$data{'streetcity'}','$data{'altrelationship'}','$data{'othernames'}',
+ '$data{'phoneday'}','$data{'categorycode'}','$data{'city'}','$data{'area'}','$data{'phone'}',
+ '$data{'borrowernotes'}','$data{'altphone'}','$data{'surname'}','$data{'initials'}',
+ '$data{'ethnicity'}','$data{'borrowernumber'}')";
+}
+#print $query;
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+$sth->finish;
+$dbh->disconnect;
+print $input->redirect("/cgi-bin/koha/moremember.pl?bornum=$data{'borrowernumber'}");
--- /dev/null
+#!/usr/bin/perl
+
+#script to enter borrower data into the data base
+#needs to be moved into a perl module
+# written 9/11/99 by chris@katipo.co.nz
+
+use CGI;
+use C4::Database;
+use C4::Input;
+use Date::Manip;
+use strict;
+
+my $input= new CGI;
+#print $input->header;
+#print $input->Dump;
+
+#get all the data into a hash
+my @names=$input->param;
+my %data;
+my $keyfld;
+my $keyval;
+my $problems;
+my $env;
+foreach my $key (@names){
+ $data{$key}=$input->param($key);
+}
+my $dbh=C4Connect;
+my $surname=$data{'institution_name'};
+my $query="insert into borrowers (title,expiry,cardnumber,sex,ethnotes,streetaddress,faxnumber,
+firstname,altnotes,dateofbirth,contactname,emailaddress,dateenrolled,streetcity,
+altrelationship,othernames,phoneday,categorycode,city,area,phone,borrowernotes,altphone,surname,
+initials,ethnicity,borrowernumber,guarantor,school)
+values ('','$data{'expiry'}','$data{'cardnumber_institution'}',
+'','$data{'ethnotes'}','$data{'address'}','$data{'faxnumber'}',
+'$data{'firstname'}','$data{'altnotes'}','','$data{'contactname'}',
+'$data{'emailaddress'}',
+now(),'$data{'streetcity'}','$data{'altrelationship'}','$data{'othernames'}',
+'$data{'phoneday'}','I','$data{'city'}','$data{'area'}','$data{'phone'}',
+'$data{'borrowernotes'}','$data{'altphone'}','$surname','$data{'initials'}',
+'$data{'ethnicity'}','$data{'borrowernumber'}','','')";
+
+
+#print $query;
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+#$sth->finish;
+
+$dbh->disconnect;
+print $input->redirect("/cgi-bin/koha/moremember.pl?bornum=$data{'borrowernumber'}");
--- /dev/null
+#!/usr/bin/perl
+
+#script to enter borrower data into the data base
+#needs to be moved into a perl module
+# written 9/11/99 by chris@katipo.co.nz
+
+use CGI;
+use C4::Database;
+use C4::Input;
+use Date::Manip;
+use strict;
+
+my $input= new CGI;
+#print $input->header;
+#print $input->Dump;
+
+#get all the data into a hash
+my @names=$input->param;
+my %data;
+my $keyfld;
+my $keyval;
+my $problems;
+my $env;
+foreach my $key (@names){
+ $data{$key}=$input->param($key);
+}
+my $dbh=C4Connect;
+
+for (my $i=0;$i<3;$i++){
+my $query="Select * from borrowers where borrowernumber=$data{'bornumber_child_$i'}";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+if (my $data=$sth->fetchrow_hashref){
+ $query="update borrowers set title='$data{'title'}',expiry='$data{'expiry'}',
+ cardnumber='$data{'cardnumber'}',sex='$data{'sex'}',ethnotes='$data{'ethnicnotes'}',
+ streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',firstname='$data{'firstname'}',
+ altnotes='$data{'altnotes'}',dateofbirth='$data{'dateofbirth'}',contactname='$data{'contactname'}',
+ emailaddress='$data{'emailaddress'}',dateenrolled='$data{'joining'}',streetcity='$data{'streetcity'}',
+ altrelationship='$data{'altrelationship'}',othernames='$data{'othernames'}',phoneday='$data{'phoneday'}',
+ categorycode='$data{'categorycode'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}',
+ borrowernotes='$data{'borrowernotes'}',altphone='$data{'altphone'}',surname='$data{'surname'}',
+ initials='$data{'initials'}',streetaddress='$data{'address'}',ethnicity='$data{'ethnicity'}'
+ where borrowernumber=$data{'borrowernumber'}";
+# print $query;
+
+}elsif ($data{"cardnumber_child_$i"} ne ''){
+ my $dob=$data{"dateofbirth_child_$i"};
+ $dob=ParseDate($dob);
+ $dob=UnixDate($dob,'%Y-%m-%d');
+ $data{'joining'}=ParseDate("today");
+ $data{'joining'}=UnixDate($data{'joining'},'%Y-%m-%d');
+ my $cardnumber=$data{"cardnumber_child_$i"};
+ my $bornum=$data{"bornumber_child_$i"};
+ my $firstname=$data{"firstname_child_$i"};
+ my $surname=$data{"surname_child_$i"};
+ my $school=$data{"school_child_$i"};
+ my $guarant=$data{'borrowernumber'};
+ my $notes=$data{"altnotes_child_$i"};
+ my $sex=$data{"sex_child_$i"};
+ $data{'contactname'}=$data{'firstname_guardian'}." ".$data{'surname_guardian'};
+ $data{'altrelationship'}="Guarantor";
+ $data{'altphone'}=$data{'phone'};
+ $query="insert into borrowers (title,expiry,cardnumber,sex,ethnotes,streetaddress,faxnumber,
+ firstname,altnotes,dateofbirth,contactname,emailaddress,dateenrolled,streetcity,
+ altrelationship,othernames,phoneday,categorycode,city,area,phone,borrowernotes,altphone,surname,
+ initials,ethnicity,borrowernumber,guarantor,school)
+ values ('','$data{'expiry'}',
+ '$cardnumber',
+ '$sex','$data{'ethnotes'}','$data{'address'}','$data{'faxnumber'}',
+ '$firstname','$data{'altnotes'}','$dob','$data{'contactname'}','$data{'emailaddress'}',
+ '$data{'joining'}','$data{'streetcity'}','$data{'altrelationship'}','$data{'othernames'}',
+ '$data{'phoneday'}','C','$data{'city'}','$data{'area'}','$data{'phone'}',
+ '$notes','$data{'altphone'}','$surname','$data{'initials'}',
+ '$data{'ethnicity'}','$bornum','$guarant','$school')";
+}
+
+#print $query;
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+$sth->finish;
+}
+$dbh->disconnect;
+print $input->redirect("/cgi-bin/koha/moremember.pl?bornum=$data{'borrowernumber'}");
--- /dev/null
+#!/usr/bin/perl
+
+#script to set up screen for modification of borrower details
+#written 20/12/99 by chris@katipo.co.nz
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+
+
+my $input = new CGI;
+my $member=$input->param('bornum');
+if ($member eq ''){
+ $member=NewBorrowerNumber();
+}
+my $type=$input->param('type');
+
+print $input->header;
+print startpage();
+print startmenu('member');
+my $data=borrdata('',$member);
+print <<printend
+<BLOCKQUOTE>
+
+<FONT SIZE=6><em>Add New Junior Member </em></font><br>
+<form action=/cgi-bin/koha/newjmember.pl method=post>
+<!--<input type=hidden name=joining value="">
+<input type=hidden name=expiry value="">
+<input type=hidden name=type value="borrowers">-->
+<input type=hidden name=borrowernumber value=$member>
+<input type=hidden name=updtype value=I>
+<input type=hidden name=area value="$data->{'area'}">
+<input type=hidden name=city value="$data->{'city'}">
+<input type=hidden name=street value="$data->{'address'}">
+<input type=hidden name=streetaddress value="$data->{'streetaddress'}">
+<input type=hidden name=streetcity value="$data->{'streetcity'}">
+<input type=hidden name=phone value="$data->{'phone'}">
+<input type=hidden name=phoneday value="$data->{'phoneday'}">
+
+<input type=hidden name=faxnumber value="$data->{'faxnumber'}">
+<input type=hidden name=emailaddress value="$data->{'emailaddress'}">
+<input type=hidden name=contactname value="$data->{'contactname'}">
+<input type=hidden name=altphone value"$data->{'altphone'}">
+<table border=0 cellspacing=0 cellpadding=5 >
+
+
+<tr valign=top><td COLSPAN=1><input type=reset value="Clear all Fields"></td></tr>
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<B>PARENT OR GUARDIAN </b></td></tr>
+<tr valign=top bgcolor=white>
+<td><SELECT NAME="title" SIZE="1">
+<OPTION value=" ">No Title
+<OPTION value=Miss
+printend
+;
+if ($data->{'title'} eq 'Miss'){
+ print " Selected";
+}
+print ">Miss
+<OPTION value=Mrs";
+if ($data->{'title'} eq 'Mrs'){
+ print " Selected";
+}
+print ">Mrs
+<OPTION value=Ms";
+if ($data->{'title'} eq 'Ms'){
+ print " Selected";
+}
+print ">Ms
+<OPTION value=Mr";
+if ($data->{'title'} eq 'Mr'){
+ print " Selected";
+}
+print ">Mr
+<OPTION value=Dr";
+if ($data->{'title'} eq 'Dr'){
+ print " Selected";
+}
+print ">Dr
+<OPTION value=Sir";
+if ($data->{'title'} eq 'Sir'){
+ print " Selected";
+}
+print <<printend
+ >Sir
+</SELECT>
+</td>
+
+
+<td><input type=text name=firstname_guardian size=20 value="$data->{'firstname'}"></td>
+<td colspan=2><input type=text name=surname_guardian size=20 value="$data->{'surname'}"></td>
+<td><input type=text name=guardian_number size=20 value="$data->{'cardnumber'}"></td></tr>
+<tr valign=top bgcolor=white>
+<td><FONT SIZE=2>Title</FONT></td>
+
+<td><FONT SIZE=2>Given Names*</FONT></td>
+<td colspan=2><FONT SIZE=2>Surname*</FONT></td>
+<td><FONT SIZE=2>Membership No.</FONT></td>
+</tr>
+
+<tr><td> </TD></TR>
+
+printend
+;
+my $cmember1=NewBorrowerNumber();
+for (my $i=0;$i<3;$i++){
+my $cmember=$cmember1+$i;
+my $count=$i+1;
+print <<printend
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<B>CHILD $count </b></td></TR>
+<tr valign=top></tr>
+
+<TR><td COLSPAN=4 ALIGN=RIGHT ><font size=3 face='arial,helvetica'>
+<STRONG>Member# $cmember, Card Number*</STRONG> </TD><TD><input type=text name=cardnumber_child_$i size=20 value=""><br>
+<input type=hidden name=bornumber_child_$i value=$cmember>
+</td></TR>
+<tr bgcolor=white>
+
+
+<td><input type=text name=firstname_child_$i size=20 value=""></td>
+<td><input type=text name=surname_child_$i size=20 value=""></td>
+<td>
+<input type=text name=dateofbirth_child_$i size=10 value="">
+</TD><TD>
+ <input type="radio" name="sex_child_$i" value="F">F
+ <input type="radio" name="sex_child_$i" value="M">M* </td>
+ <TD align=right>
+ <input type=text name=school_child_$i size=20 value="">
+ </TD>
+ </tr>
+ <tr valign=top bgcolor=white>
+ <td><FONT SIZE=2>Given Names*</FONT></td>
+ <td><FONT SIZE=2>Surname*</FONT></td>
+
+ <td><FONT SIZE=2>Date of Birth<BR> (dd/mm/yy)*</FONT></td>
+ <td><FONT SIZE=2> </FONT></td>
+ <td><FONT SIZE=2>School</FONT></td></tr>
+
+
+
+
+ <tr valign=top bgcolor=white>
+
+ <td COLSPAN=5><textarea name=altnotes_child_$i wrap=physical cols=70 rows=3></textarea></td></tr><tr valign=top bgcolor=white>
+
+ <td><FONT SIZE=2>Notes</font></td>
+ </tr>
+ <tr><td> </TD></TR>
+printend
+;
+}
+print <<printend
+ <tr valign=top bgcolor=white><td COLSPAN=5 align=right >
+ <input type=image src="/images/save-changes.gif" WIDTH=188 HEIGHT=44 ALT="Add New Member" border=0 ></td>
+ </tr>
+ </TABLE>
+ </table>
+
+
+printend
+;
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to do a borrower enquiery/brin up borrower details etc
+#written 20/12/99 by chris@katipo.co.nz
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+
+
+my $input = new CGI;
+my $member=$input->param('member');
+$member=~ s/\,//g;
+print $input->header;
+#start the page and read in includes
+print startpage();
+print startmenu('member');
+my @inputs=(["text","member",$member],
+ ["reset","reset","clr"]);
+print mkheadr(2,'Member Search');
+print mkformnotable("/cgi-bin/koha/member.pl",@inputs);
+print <<printend
+
+printend
+;
+print "You Searched for $member<p>";
+print mktablehdr;
+print mktablerow(8,'#99cc33',bold('Card'),bold('Surname'),bold('Firstname'),bold('Category')
+,bold('Address'),bold('OD/Issues'),bold('Fines'),bold('Notes'),'/images/background-mem.gif');
+my $env;
+my ($count,$results)=BornameSearch($env,$member,'web');
+#print $count;
+my $toggle="white";
+for (my $i=0; $i < $count; $i++){
+ #find out stats
+ my ($od,$issue,$fines)=borrdata2($env,$results->[$i]{'borrowernumber'});
+ $fines=$fines+0;
+ if ($toggle eq 'white'){
+ $toggle="#ffffcc";
+ } else {
+ $toggle="white";
+ }
+ #mklink("/cgi-bin/koha/memberentry.pl?bornum=".$results->[$i]{'borrowernumber'},$results->[$i]{'cardnumber'}),
+ print mktablerow(8,$toggle,mklink("/cgi-bin/koha/moremember.pl?bornum=".$results->[$i]{'borrowernumber'},$results->[$i]{'cardnumber'}),
+ $results->[$i]{'surname'},$results->[$i]{'firstname'},
+ $results->[$i]{'categorycode'},$results->[$i]{'streetaddress'}." ".$results->[$i]{'city'},"$od/$issue",$fines,
+ $results->[$i]{'borrowernotes'});
+}
+print mktableft;
+print <<printend
+<form action=/cgi-bin/koha/simpleredirect.pl method=post>
+<input type=image src="/images/button-add-member.gif" WIDTH=188 HEIGHT=44 ALT="Add New Member" BORDER=0 ></a><br>
+<INPUT TYPE="radio" name="chooseform" value="adult" checked>Adult
+<INPUT TYPE="radio" name="chooseform" value="organisation" >Organisation
+</form>
+printend
+;
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to set up screen for modification of borrower details
+#written 20/12/99 by chris@katipo.co.nz
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+
+
+my $input = new CGI;
+my $member=$input->param('bornum');
+if ($member eq ''){
+ $member=NewBorrowerNumber();
+}
+my $type=$input->param('type');
+
+print $input->header;
+print startpage();
+print startmenu('member');
+
+if ($type ne 'Add'){
+ print mkheadr(1,'Update Member Details');
+} else {
+ print mkheadr(1,'Add New Member');
+}
+my $data=borrdata('',$member);
+print <<printend
+<form action=/cgi-bin/koha/newmember.pl method=post>
+<input type=hidden name=joining value="$data->{'dateenrolled'}">
+<input type=hidden name=expiry value="$data->{'expiry'}">
+<input type=hidden name=type value="borrowers">
+<input type=hidden name=borrowernumber value="$member">
+printend
+;
+if ($type eq 'Add'){
+ print "<input type=hidden name=updtype value=I>";
+} else {
+ print "<input type=hidden name=updtype value=M>";
+}
+print <<printend
+
+<table border=0 cellspacing=0 cellpadding=5 >
+
+
+<tr valign=top><td COLSPAN=2><input type=reset value="Clear all Fields"></td><td COLSPAN=3 ALIGN=RIGHT ><font size=4 face='arial,helvetica'>
+Member# $member, Card Number* <input type=text name=cardnumber size=10 value="$data->{'cardnumber'}"><br>
+</td></tr>
+
+
+<tr valign=top ><td COLSPAN=3 background="/images/background-mem.gif">
+<B>MEMBER PERSONAL DETAILS</b></td> <td COLSPAN=2 ALIGN=RIGHT background="/images/background-mem.gif">
+* <input type="radio" name="sex" value="F"
+printend
+;
+if ($data->{'sex'} eq 'F'){
+ print " checked";
+}
+print <<printend
+>F
+<input type="radio" name="sex" value="M"
+printend
+;
+if ($data->{'sex'} eq 'M'){
+ print " checked";
+}
+print <<printend
+>M
+ <B>Date of Birth</B> (dd/mm/yy)
+<input type=text name=dateofbirth size=10 value="$data->{'dateofbirth'}">
+</td></tr>
+<tr valign=top bgcolor=white>
+<td><SELECT NAME="title" SIZE="1">
+<OPTION value=" ">No Title
+<OPTION value=Miss
+printend
+;
+if ($data->{'title'} eq 'Miss'){
+ print " Selected";
+}
+print ">Miss
+<OPTION value=Mrs";
+if ($data->{'title'} eq 'Mrs'){
+ print " Selected";
+}
+print ">Mrs
+<OPTION value=Ms";
+if ($data->{'title'} eq 'Ms'){
+ print " Selected";
+}
+print ">Ms
+<OPTION value=Mr";
+if ($data->{'title'} eq 'Mr'){
+ print " Selected";
+}
+print ">Mr
+<OPTION value=Dr";
+if ($data->{'title'} eq 'Dr'){
+ print " Selected";
+}
+print ">Dr
+<OPTION value=Sir";
+if ($data->{'title'} eq 'Sir'){
+ print " Selected";
+}
+print <<printend
+>Sir
+</SELECT>
+</td>
+
+<td><input type=text name=initials size=5 value="$data->{'initials'}"></td>
+<td><input type=text name=firstname size=20 value="$data->{'firstname'}"></td>
+<td><input type=text name=surname size=20 value="$data->{'surname'}"></td>
+<td><input type=text name=othernames size=20 value="$data->{'othernames'}"></td></tr>
+<tr valign=top bgcolor=white>
+<td><FONT SIZE=2>Title</FONT></td>
+<td><FONT SIZE=2>Initials</FONT></td>
+<td><FONT SIZE=2>Given Names*</FONT></td>
+<td><FONT SIZE=2>Surname*</FONT></td>
+<td><FONT SIZE=2>Prefered Name</FONT></td>
+</tr>
+
+<tr><td> </TD></TR>
+<tr valign=top bgcolor=white>
+<td colspan=2><SELECT NAME="ethnicity" SIZE="1">
+printend
+;
+print "<OPTION value=\" \">
+<OPTION value=european";
+if ($data->{'ethnicity'} eq 'european'){
+ print " selected";
+}
+print "
+>European/Pakeha
+<OPTION value=maori";
+if ($data->{'ethnicity'} eq 'maori'){
+ print " selected";
+}
+print ">Maori
+<OPTION value=asian";
+if ($data->{'ethnicity'} eq 'asian'){
+ print " selected";
+}
+print ">Asian
+<OPTION value=pi";
+if ($data->{'ethnicity'} eq 'pi'){
+ print " selected";
+}
+print ">Pacific Island
+<OPTION value=other";
+if ($data->{'ethnicity'} eq 'other'){
+ print " selected";
+}
+
+print <<printend
+>Other - please specify-->
+</SELECT>
+</td>
+<td colspan=2><input type=text name=ethnicnotes size=40 ></td>
+<td> <select name=categorycode>
+<option value="A"
+printend
+;
+if ($data->{'categorycode'} eq 'A'){
+ print " Selected";
+}
+print ">Adult
+<option value=B";
+if ($data->{'categorycode'} eq 'B'){
+ print " Selected";
+}
+print ">Homebound
+<option value=P";
+if ($data->{'categorycode'} eq 'P'){
+ print " Selected";
+}
+print ">Privileged
+<option value=E";
+if ($data->{'categorycode'} eq 'E'){
+ print " Selected";
+}
+print ">Senior Citizen
+<option value=W";
+if ($data->{'categorycode'} eq 'W'){
+ print " Selected";
+}
+print ">Staff
+<option value=I";
+if ($data->{'categorycode'} eq 'I'){
+ print " Selected";
+}
+print ">Institution
+<option value=C";
+if ($data->{'categorycode'} eq 'C'){
+ print " Selected";
+}
+print ">Child
+<option value=L";
+if ($data->{'categorycode'} eq 'L'){
+ print " Selected";
+}
+print ">Library
+<option value=F";
+if ($data->{'categorycode'} eq 'F'){
+ print " Selected";
+}
+print ">Family";
+print <<printend
+</select>
+</td>
+</tr>
+<tr valign=top bgcolor=white>
+<td colspan=2><FONT SIZE=2>Ethnicity</FONT></td>
+<td colspan=2><FONT SIZE=2>Ethnicity Notes</FONT></td>
+<td><FONT SIZE=2>Membership Category*</FONT></td>
+</tr>
+<tr><td> </TD></TR>
+
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<B>MEMBER ADDRESS</b></td></tr>
+<tr valign=top bgcolor=white>
+<td COLSPAN=3><input type=text name=address size=40 value="$data->{'streetaddress'}">
+<td><input type=text name=city size=20 value="$data->{'city'}"></td>
+<td>
+<SELECT NAME="area" SIZE="1">
+<OPTION value=L
+printend
+;
+if ($data->{'area'} eq 'L'){
+ print " Selected";
+}
+print ">L - Levin
+<OPTION value=F";
+if ($data->{'area'} eq 'F'){
+ print " Selected";
+}
+print ">F - Foxton
+<OPTION value=S";
+if ($data->{'area'} eq 'S'){
+ print " Selected";
+}
+print ">S - Shannon
+<OPTION value=H";
+if ($data->{'area'} eq 'H'){
+ print " Selected";
+}
+print ">H - Horowhenua
+<OPTION value=K";
+if ($data->{'area'} eq 'K'){
+ print " Selected";
+}
+print ">K - Kapiti
+<OPTION value=O";
+if ($data->{'area'} eq 'O'){
+ print " Selected";
+}
+print ">O - Out of District
+<OPTION value=X";
+if ($data->{'area'} eq 'X'){
+ print " Selected";
+}
+print ">X - Temporary Visitor
+<OPTION value=Z";
+if ($data->{'area'} eq 'Z'){
+ print " Selected";
+}
+print ">Z - Interloan Libraries
+<OPTION value=V";
+if ($data->{'area'} eq 'V'){
+ print " Selected";
+}
+print ">V - Villlage";
+print <<printend
+</SELECT></td></tr>
+<tr valign=top bgcolor=white>
+<td COLSPAN=3><FONT SIZE=2>Postal Address*</FONT></td>
+<td><FONT SIZE=2>Town*</FONT></td>
+<td><FONT SIZE=2>Area</FONT></td>
+</tr>
+<tr><td> </TD></TR>
+<tr valign=top bgcolor=white>
+
+<td COLSPAN=3><input type=text name=streetaddress size=40 value="$data->{'physstreet'}"></td>
+<td><input type=text name=streetcity size=20 value="$data->{'streetcity'}"></td>
+</tr>
+</tr>
+<tr valign=top bgcolor=white>
+
+<td COLSPAN=3><FONT SIZE=2>Street Address if different</FONT></td>
+<td><FONT SIZE=2>Town</FONT></td>
+</tr>
+<tr><td> </TD></TR>
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<B>MEMBER CONTACT DETAILS</b></td></tr>
+
+
+<tr valign=top bgcolor=white>
+<td COLSPAN=2 ><input type=text name=phone size=20 value="$data->{'phone'}"></td>
+<td><input type=text name=phoneday size=20 value="$data->{'phoneday'}"></td>
+<td><input type=text name=faxnumber size=20 value="$data->{'faxnumber'}"></td>
+<td><input type=text name=emailaddress size=20 value="$data->{'emailaddress'}"></td></tr>
+
+<tr valign=top bgcolor=white>
+<td COLSPAN=2 ><FONT SIZE=2>Phone (Home)</td>
+<td><FONT SIZE=2>Phone (day)</td>
+<td><FONT SIZE=2>Fax</td>
+<td><FONT SIZE=2>Email</td></tr>
+<tr><td> </TD></TR>
+<tr valign=top bgcolor="99cc33" ><td COLSPAN=5 background="/images/background-mem.gif">
+<B>ALTERNATE CONTACT DETAILS</b> </td></tr>
+
+<tr valign=top bgcolor=white>
+<td COLSPAN=3 ><input type=text name=contactname size=40 value="$data->{'contactname'}"></td>
+<td><input type=text name=altphone size=20 value="$data->{'altphone'}"></td>
+<td><select name=altrelationship size=1>
+<option value="workplace"
+printend
+;
+if ($data->{'altrelationship'} eq 'workplace'){
+ print " selected ";
+}
+
+print ">Workplace
+<option value=\"relative\"";
+if ($data->{'altrelationship'} eq 'relative'){
+ print " selected ";
+}
+print ">Relative
+<option value=\"friend\"";
+if ($data->{'altrelationship'} eq 'workplace'){
+ print " selected ";
+}
+print ">Friend
+<option value=\"neighbour\"";
+if ($data->{'altrelationship'} eq 'workplace'){
+ print " selected ";
+}
+print <<printend
+>Neighbour
+</select></td></tr>
+
+<tr valign=top bgcolor=white>
+<td COLSPAN=3 ><FONT SIZE=2>Name*</td>
+<td><FONT SIZE=2>Phone</td>
+<td><FONT SIZE=2>Relationship*</td></tr>
+
+
+
+<tr><td> </TD></TR>
+
+
+<tr valign=top bgcolor=white>
+
+<td><FONT SIZE=2>Notes</font></td>
+<td COLSPAN=4><textarea name=altnotes wrap=physical cols=70 rows=3>$data->{'altnotes'}</textarea></td></tr>
+</tr>
+
+
+<tr><td> </TD></TR>
+
+
+<tr valign=top bgcolor="99cc33" >
+
+<td COLSPAN=5 background="/images/background-mem.gif"><B>LIBRARY USE</B></td>
+</tr>
+
+
+<tr valign=top >
+
+<td><FONT SIZE=2>Notes</font></td>
+<td COLSPAN=4><textarea name=borrowernotes wrap=physical cols=70 rows=3>$data->{'borrowernotes'}</textarea></td></tr>
+<tr><td> </TD></TR>
+<tr valign=top bgcolor=white><td COLSPAN=5 align=right >
+printend
+;
+if ($type ne 'modify'){
+ print <<printend
+<input type=image src="/images/save-changes.gif" WIDTH=188 HEIGHT=44 ALT="Add New Member" border=0 ></td>
+printend
+;
+} else {
+print <<printend
+<input type=image src="/images/save-changes.gif" WIDTH=188 HEIGHT=44 ALT="Add New Member" border=0 ></td>
+printend
+;
+}
+print <<printend
+</tr>
+</TABLE>
+</table>
+ </form>
+
+
+
+printend
+;
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+use C4::Database;
+use strict;
+
+my $dbh=C4Connect;
+my $query = "Select * from categories where (categorycode like 'L%' or categorycode like 'F%'
+or categorycode like 'S%' or categorycode like 'O%' or categorycode like 'H%') and (categorycode <>'HR'
+and categorycode <> 'ST')";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ my $temp=substr($data->{'categorycode'},0,1);
+ $query="update borrowers set area='$temp' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $temp=substr($data->{'categorycode'},1,1);
+ $query="update borrowers set categorycode='$temp' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+
+$query = "Select * from categories where (categorycode like 'V%') and (categorycode <>'HR'
+and categorycode <> 'ST')";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+# my $temp=substr($data->{'categorycode'},0,1);
+ $query="update borrowers set area='V' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ my $temp=substr($data->{'categorycode'},1,1);
+ $query="update borrowers set categorycode='$temp' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+
+my $query = "Select * from categories where categorycode = 'ST'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ $query="update borrowers set area='' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update borrowers set categorycode='W' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+
+my $query = "Select * from categories where categorycode = 'BR' or categorycode='CO' or categorycode='IS'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ $query="update borrowers set area='' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update borrowers set categorycode='I' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+my $query = "Select * from categories where categorycode = 'TD' or categorycode='TR'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ $query="update borrowers set area='X' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update borrowers set categorycode='A' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+
+my $query = "Select * from categories where categorycode = 'HR'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ $query="update borrowers set area='K' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update borrowers set categorycode='A' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+
+my $query = "Select * from categories where categorycode = 'IL'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ $query="update borrowers set area='Z' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update borrowers set categorycode='L' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+my $query = "Select * from categories where categorycode = 'TB'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ #update borrowers corresponding
+ #update categories
+ $query="update borrowers set area='' where categorycode='$data->{'categorycode'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update borrowers set categorycode='P' where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="delete from categories where categorycode='$data->{'categorycode'}'";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+
+}
+
+$sth->finish;
+$query="insert into categories values ('A','Adult',5,99,0,'A',0,0,0,99,1)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('E','Senior Citizen',5,99,0,'A',0,0,0,99,1)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('C','Child',5,16,0,'A',0,0,0,99,0)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('B','Housebound',5,99,0,'E',0,0,0,99,0)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('F','Family',5,99,0,'A',0,0,0,99,1)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('W','Workers',5,99,0,'A',0,0,0,99,0)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('I','Institution',5,99,0,'A',0,0,0,99,0)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('P','Privileged',5,99,0,'A',0,0,0,99,0)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+$query="insert into categories values ('L','Library',5,99,0,'A',0,0,0,99,0)";
+$sth=$dbh->prepare($query);
+$sth->execute;
+$sth->finish;
+
+
+
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+use C4::Database;
+use strict;
+
+my $dbh=C4Connect;
+
+my $sth=$dbh->prepare("Select biblio.biblionumber,biblio.title from biblio,catalogueentry where catalogueentry.entrytype
+='t' and catalogueentry.catalogueentry=biblio.title limit 500");
+$sth->execute;
+while (my $data=$sth->fetchrow_hashref){
+ my $query="Update catalogueentry set biblionumber='$data->{'biblionumber'}' where catalogueentry.catalogueentry =
+ \"$data->{'title'}\" and catalogueentry.entrytype='t'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+}
+$sth->finish;
+
+
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+use C4::Database;
+use strict;
+
+my $dbh=C4Connect;
+
+my $sth=$dbh->prepare("Select ordernumber,biblionumber from aqorders order by ordernumber");
+$sth->execute;
+my $number;
+my $i=92000;
+while (my $data=$sth->fetchrow_hashref){
+ if ($data->{'ordernumber'} != $number){
+ } else {
+ my $query="update aqorders set ordernumber=$i where ordernumber=$data->{'ordernumber'} and biblionumber=$data->{'biblionumber'}";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $query="update aqorderbreakdown set ordernumber=$i where ordernumber=$data->{'ordernumber'}";
+ $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+ $i++;
+ }
+ $number=$data->{'ordernumber'};
+}
+$sth->finish;
+
+
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+
+use strict;
+my $olddat;
+while (my $dat =<STDIN>){
+ my @data=split(/\t/,$dat);
+ if ($dat eq $olddat){
+# print "oi";
+ } else {
+ print $dat;
+ }
+ $olddat=$dat;
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use C4::Database;
+
+my $dbh=C4Connect;
+my $count=0;
+my $query="Select * from biblioitems where itemtype='REF' or itemtype='TREF'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+
+while (my $data=$sth->fetchrow_hashref){
+ $query="update items set notforloan=1 where biblioitemnumber='$data->{'biblioitemnumber'}'";
+ my $sth2=$dbh->prepare($query);
+ $sth2->execute;
+ $sth2->finish;
+}
+$sth->finish;
+
+
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use C4::Database;
+
+my $dbh=C4Connect;
+my $count=0;
+my $basket='HLT-';
+for (my $i=1;$i<59;$i++){
+ my $query = "Select authorisedby,entrydate from aqorders where booksellerid='$i'";
+ $query.=" group by authorisedby,entrydate order by entrydate";
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ while (my $data=$sth->fetchrow_hashref){
+ $basket=$count;
+ $data->{'authorisedby'}=~ s/\'/\\\'/g;
+ my $query2="update aqorders set basketno='$basket' where booksellerid='$i' and authorisedby=
+ '$data->{'authorisedby'}' and entrydate='$data->{'entrydate'}'";
+ my $sth2=$dbh->prepare($query2);
+ $sth2->execute;
+ $sth2->finish;
+ $count++;
+ }
+ $sth->finish;
+}
+
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use C4::Database;
+
+my $dbh=C4Connect;
+my $count=0;
+my $query="Select biblionumber from aqorders where datereceived = '0000-00-00'";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+
+my $query2="Select max(biblioitemnumber) from biblioitems";
+my $sth2=$dbh->prepare($query2);
+$sth2->execute;
+my $data=$sth2->fetchrow_hashref;
+my $bibitemno=$data->{'max(biblioitemnumber)'};
+print $bibitemno;
+$bibitemno++;
+$sth2->finish;
+while (my $data=$sth->fetchrow_hashref){
+ $sth2=$dbh->prepare("insert into biblioitems (biblioitemnumber,biblionumber) values
+ ($bibitemno,$data->{'biblionumber'})");
+ $sth2->execute;
+ $sth2->finish;
+ $sth2=$dbh->prepare("update aqorders set biblioitemnumber=$bibitemno where biblionumber
+ =$data->{'biblionumber'}");
+ $sth2->execute;
+ $sth2->finish;
+ $bibitemno++
+
+}
+$sth->finish;
+
+
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+#
+# written 31/5/00 by chris@katipo.co.nz to make a way to fix account mistakes
+#
+
+use strict;
+use C4::Database;
+use CGI;
+use C4::Accounts2;
+
+my $input=new CGI;
+
+#print $input->header();
+#print $input->dump;
+
+my $bornum=$input->param('bornum');
+
+my @name=$input->param;
+
+foreach my $key (@name){
+ if ($key ne 'bornum'){
+ if (my $temp=$input->param($key)){
+ fixaccounts($bornum,$key,$temp);
+ }
+ }
+}
+
+print $input->redirect("boraccount.pl?bornum=$bornum");
--- /dev/null
+#!/usr/bin/perl
+
+#script to modify/delete biblios
+#written 8/11/99
+# modified 11/11/99 by chris@katipo.co.nz
+
+use strict;
+
+use C4::Search;
+use CGI;
+use C4::Output;
+
+my $input = new CGI;
+
+my $bibnum=$input->param('bibnum');
+my $data=bibdata($bibnum);
+my ($count,$subject)=subject($data->{'biblionumber'});
+my ($count2,$subtitle)=subtitle($data->{'biblionumber'});
+my ($count3,$addauthor)=addauthor($data->{'biblionumber'});
+my $submit=$input->param('submit.x');
+if ($submit eq ''){
+ print $input->redirect("/cgi-bin/koha/delbiblio.pl?biblio=$bibnum");
+}
+
+print $input->header;
+#my ($analytictitle)=analytic($biblionumber,'t');
+#my ($analyticauthor)=analytic($biblionumber,'a');
+print startpage();
+print startmenu();
+my %inputs;
+
+#have to get all subtitles, subjects and additional authors
+my $sub=$subject->[0]->{'subject'};
+for (my $i=1;$i<$count;$i++){
+ $sub=$sub."|".$subject->[$i]->{'subject'};
+}
+my $additional=$addauthor->[0]->{'author'};
+for (my $i=1;$i<$count3;$i++){
+ $additional=$additional."|".$addauthor->[$i]->{'author'};
+}
+
+
+#hash is set up with input name being the key then
+#the value is a tab separated list, the first item being the input type
+$inputs{'Author'}="text\t$data->{'author'}\t0";
+$data->{'title'}=tidyhtml($data->{'title'});
+$inputs{'Title'}="text\t$data->{'title'}\t1";
+my $dewey = $data->{'dewey'};
+$dewey =~ s/0+$//;
+if ($dewey eq "000.") { $dewey = "";};
+if ($dewey < 10){$dewey='00'.$dewey;}
+if ($dewey < 100 && $dewey > 10){$dewey='0'.$dewey;}
+if ($dewey <= 0){
+ $dewey='';
+}
+$dewey=~ s/\.$//;
+#$inputs{'Class'}="text\t$data->{'classification'}$dewey$data->{'subclass'}\t2";
+#$inputs{'Item Type'}="text\t$data->{'itemtype'}\t3";
+$inputs{'Subject'}="textarea\t$sub\t4";
+#$inputs{'Publisher'}="text\t$data->{'publishercode'}\t5";
+$inputs{'Copyright date'}="text\t$data->{'copyrightdate'}\t6";
+#$inputs{'ISBN'}="text\t$data->{'isbn'}\t7";
+#$inputs{'Publication Year'}="text\t$data->{'publicationyear'}\t8";
+#$inputs{'Pages'}="text\t$data->{'pages'}\t9";
+#$inputs{'Illustrations'}="text\t$data->{'illustration'}\t10";
+$inputs{'Series Title'}="text\t$data->{'seriestitle'}\t11";
+$inputs{'Additional Author'}="text\t$additional\t12";
+$inputs{'Subtitle'}="text\t$subtitle->[0]->{'subtitle'}\t13";
+$inputs{'Unititle'}="text\t$data->{'unititle'}\t14";
+$inputs{'Notes'}="textarea\t$data->{'notes'}\t15";
+$inputs{'Serial'}="text\t$data->{'serial'}\t16";
+#$inputs{'Volume'}="text\t$data->{'volumeddesc'}\t17";
+$inputs{'Analytic author'}="text\t\t18";
+$inputs{'Analytic title'}="text\t\t19";
+
+$inputs{'bibnum'}="hidden\t$data->{'biblionumber'}\t20";
+$inputs{'bibitemnum'}="hidden\t$data->{'biblioitemnumber'}\t21";
+
+
+print mkform3('updatebiblio.pl',%inputs);
+#print mktablehdr();
+#print mktableft();
+print endmenu();
+print endpage();
+
+sub tidyhtml {
+ my ($inp)=@_;
+ $inp=~ s/\"/\"\;/g;
+ return($inp);
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to modify/delete groups
+
+#written 8/11/99
+# modified 11/11/99 by chris@katipo.co.nz
+# modified 18/4/00 by chris@katipo.co.nz
+use strict;
+
+use C4::Search;
+use CGI;
+use C4::Output;
+
+my $input = new CGI;
+#
+my $bibitemnum=$input->param('bibitem');
+my $data=bibitemdata($bibitemnum);
+my $biblio=$input->param('biblio');
+my $submit=$input->param('submit.x');
+if ($submit eq ''){
+ print $input->redirect("/cgi-bin/koha/delbibitem.pl?bibitemnum=$bibitemnum&biblio=$biblio");
+}
+print $input->header;
+#my ($count,$subject)=subject($data->{'biblionumber'});
+#my ($count2,$subtitle)=subtitle($data->{'biblionumber'});
+#my ($count3,$addauthor)=addauthor($data->{'biblionumber'});
+
+#my ($analytictitle)=analytic($biblionumber,'t');
+#my ($analyticauthor)=analytic($biblionumber,'a');
+print startpage();
+print startmenu();
+my %inputs;
+
+#hash is set up with input name being the key then
+#the value is a tab separated list, the first item being the input type
+#$inputs{'Author'}="text\t$data->{'author'}\t0";
+#$inputs{'Title'}="text\t$data->{'title'}\t1";
+my $dewey = $data->{'dewey'};
+$dewey =~ s/0+$//;
+if ($dewey eq "000.") { $dewey = "";};
+if ($dewey < 10){$dewey='00'.$dewey;}
+if ($dewey < 100 && $dewey > 10){$dewey='0'.$dewey;}
+if ($dewey <= 0){
+ $dewey='';
+}
+$dewey=~ s/\.$//;
+$inputs{'Class'}="text\t$data->{'classification'}$dewey$data->{'subclass'}\t2";
+$inputs{'Item Type'}="text\t$data->{'itemtype'}\t3";
+#$inputs{'Subject'}="textarea\t$sub\t4";
+$inputs{'Publisher'}="text\t$data->{'publishercode'}\t5";
+#$inputs{'Copyright date'}="text\t$data->{'copyrightdate'}\t6";
+$inputs{'ISBN'}="text\t$data->{'isbn'}\t7";
+$inputs{'Publication Year'}="text\t$data->{'publicationyear'}\t8";
+$inputs{'Pages'}="text\t$data->{'pages'}\t9";
+$inputs{'Illustrations'}="text\t$data->{'illustration'}\t10";
+#$inputs{'Series Title'}="text\t$data->{'seriestitle'}\t11";
+#$inputs{'Additional Author'}="text\t$additional\t12";
+#$inputs{'Subtitle'}="text\t$subtitle->[0]->{'subtitle'}\t13";
+#$inputs{'Unititle'}="text\t$data->{'unititle'}\t14";
+#$inputs{'Notes'}="textarea\t$data->{'notes'}\t15";
+#$inputs{'Serial'}="text\t$data->{'serial'}\t16";
+$inputs{'Volume'}="text\t$data->{'volumeddesc'}\t17";
+#$inputs{'Analytic author'}="text\t\t18";
+#$inputs{'Analytic title'}="text\t\t19";
+
+$inputs{'bibnum'}="hidden\t$data->{'biblionumber'}\t20";
+$inputs{'bibitemnum'}="hidden\t$data->{'biblioitemnumber'}\t21";
+
+print <<printend
+
+<BLOCKQUOTE><FONT SIZE=6>
+<em><a href=/cgi-bin/koha/detail.pl?bib=$data->{'biblionumber'}&type=intra>$data->{'title'} ($data->{'author'})</a><br>
+Modify Group - $data->{'description'}</em></FONT><br>
+<form action=updatebibitem.pl method=post>
+<table border=0 cellspacing=0 cellpadding=5 align=left>
+
+<TR VALIGN=TOP bgcolor="99cc33">
+<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2 ><b><input type=radio name=existing value=YES > RE-ASSIGN TO EXISTING GROUP</b></td></tr>
+
+printend
+;
+my ($count,@bibitems)=bibitems($data->{'biblionumber'});
+print "<tr valign=top><td colspan=3><select name=existinggroup>\n";
+for (my $i=0;$i<$count;$i++){
+ print "<option value=$bibitems[$i]->{'biblioitemnumber'}>$bibitems[$i]->{'description'} - $bibitems[$i]->{'isbn'}\n";
+}
+print "</select></td></tr>";
+print <<printend
+<TR VALIGN=TOP bgcolor="99cc33">
+<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2 ><b><input type=radio name=existing value=NO checked >OR MODIFY DETAILS</b></td></tr>
+
+
+
+<tr valign=top bgcolor=white><td>Item Type</td><td><input type=text name=Item Type value="$data->{'itemtype'}" size=20></td></tr>
+
+<tr valign=top bgcolor=white><td>Class</td><td><input type=text name=Class value="$data->{'classification'}$dewey$data->{'subclass'}" size=20></td></tr>
+
+
+
+<tr valign=top bgcolor=white><td>Publisher</td><td><input type=text name=Publisher value="$data->{'publishercode'}" size=20></td></tr>
+<tr valign=top bgcolor=white><td>Place</td><td><input type=text name=Place value="$data->{'place'}" size=20></td></tr>
+
+
+<tr valign=top bgcolor=white><td>ISBN</td><td><input type=text name=ISBN value="$data->{'isbn'}" size=20></td></tr>
+
+<tr valign=top bgcolor=white><td>Publication Year</td><td><input type=text name=Publication Year value="$data->{'publicationyear'}" size=20></td></tr>
+
+<tr valign=top bgcolor=white><td>Pages</td><td><input type=text name=Pages value="$data->{'pages'}" size=20></td></tr>
+
+<tr valign=top bgcolor=white><td>Illustrations</td><td><input type=text name=Illustrations value="$data->{'illustration'}" size=20></td></tr>
+
+<tr valign=top bgcolor=white><td>Volume</td>
+<td><input type=text name=Volume value="$data->{'volumeddesc'}" size=20></td></tr>
+<tr valign=top bgcolor=white><td>Notes</td>
+<td><input type=text name=Notes value="$data->{'notes'}" size=20></td></tr>
+<tr valign=top bgcolor=white><td>Size</td>
+<td><input type=text name=Size value="$data->{'size'}" size=20></td></tr>
+
+<input type=hidden name=bibnum value="$data->{'biblionumber'}">
+
+<input type=hidden name=bibitemnum value="$data->{'biblioitemnumber'}">
+
+</table>
+
+<img src="/images/holder.gif" width=16 height=500 align=left>
+
+
+
+
+<TABLE cellspacing=0 cellpadding=5 border=0 >
+printend
+;
+
+
+print <<printend;
+<TR VALIGN=TOP bgcolor="99cc33">
+<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=5 ><b>CHANGES TO AFFECT THESE BARCODES<br>
+Tick ALL barcodes that changes are to apply too. Those left un-ticked will keep the original group record.</td></tr>
+
+<tr valign=top bgcolor=99cc33>
+<td background="/images/background-mem.gif"> </td>
+<td background="/images/background-mem.gif">Barcode</td>
+<td background="/images/background-mem.gif">Location</td>
+<td background="/images/background-mem.gif">Date Due</td>
+<td background="/images/background-mem.gif">Last Seen</td></tr>
+
+printend
+;
+my (@items)=itemissues($data->{'biblioitemnumber'});
+#print @items;
+my $count=@items;
+for (my $i=0;$i<$count;$i++){
+ my @temp=split('-',$items[$i]->{'datelastseen'});
+ $items[$i]->{'datelastseen'}="$temp[2]/$temp[1]/$temp[0]";
+ print <<printend
+<tr valign=top gcolor=#ffffcc>
+<td><input type=checkbox name="check_group_$items[$i]->{'barcode'}"></td>
+<td><a href="/cgi-bin/koha/moredetail.pl?item=$items[$i]->{'itemnumber'}&bib=$data->{'biblionumber'}&bi=$data->{'biblioitemnumber'}">$items[$i]->{'barcode'}</a></td>
+<td>$items[$i]->{'holdingbranch'}</td>
+<td></td>
+<td>$items[$i]->{'datelastseen'}</td>
+</tr>
+printend
+;
+}
+print <<printend
+
+</table>
+<p>
+
+<input type=image name=submit src=/images/save-changes.gif border=0 width=187 height=42>
+
+
+</form>
+<p>
+
+
+<B>HELP:</B> You <b>must</b> click on the appropriate radio button (in the green boxes), and choose to either re-assign the item/s to a record already in the system, or modify this record. IF your changes only apply to some
+ items, tick the appropriate ones and a new group record will be created automatically for them.
+ <br clear=all>
+
+ <p> </p>
+
+
+printend
+;
+
+
+print endmenu();
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to modify/delete biblios
+#written 8/11/99
+# modified 11/11/99 by chris@katipo.co.nz
+
+use strict;
+
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+
+my $input = new CGI;
+my $submit=$input->param('delete.x');
+my $itemnum=$input->param('item');
+my $bibitemnum=$input->param('bibitem');
+if ($submit ne ''){
+ print $input->redirect("/cgi-bin/koha/delitem.pl?itemnum=$itemnum&bibitemnum=$bibitemnum");
+}
+
+print $input->header;
+#print $input->dump;
+
+my $data=bibitemdata($bibitemnum);
+
+my $item=itemnodata('blah','',$itemnum);
+#my ($analytictitle)=analytic($biblionumber,'t');
+#my ($analyticauthor)=analytic($biblionumber,'a');
+print startpage();
+print startmenu();
+my %inputs;
+
+
+
+#hash is set up with input name being the key then
+#the value is a tab separated list, the first item being the input type
+#$inputs{'Author'}="text\t$data->{'author'}\t0";
+#$inputs{'Title'}="text\t$data->{'title'}\t1";
+my $dewey = $data->{'dewey'};
+$dewey =~ s/0+$//;
+if ($dewey eq "000.") { $dewey = "";};
+if ($dewey < 10){$dewey='00'.$dewey;}
+if ($dewey < 100 && $dewey > 10){$dewey='0'.$dewey;}
+if ($dewey <= 0){
+ $dewey='';
+}
+$dewey=~ s/\.$//;
+$inputs{'Barcode'}="text\t$item->{'barcode'}\t0";
+$inputs{'Class'}="hidden\t$data->{'classification'}$dewey$data->{'subclass'}\t2";
+#$inputs{'Item Type'}="text\t$data->{'itemtype'}\t3";
+#$inputs{'Subject'}="textarea\t$sub\t4";
+$inputs{'Publisher'}="hidden\t$data->{'publishercode'}\t5";
+#$inputs{'Copyright date'}="text\t$data->{'copyrightdate'}\t6";
+$inputs{'ISBN'}="hidden\t$data->{'isbn'}\t7";
+$inputs{'Publication Year'}="hidden\t$data->{'publicationyear'}\t8";
+$inputs{'Pages'}="hidden\t$data->{'pages'}\t9";
+$inputs{'Illustrations'}="hidden\t$data->{'illustration'}\t10";
+#$inputs{'Series Title'}="text\t$data->{'seriestitle'}\t11";
+#$inputs{'Additional Author'}="text\t$additional\t12";
+#$inputs{'Subtitle'}="text\t$subtitle->[0]->{'subtitle'}\t13";
+#$inputs{'Unititle'}="text\t$data->{'unititle'}\t14";
+$inputs{'ItemNotes'}="textarea\t$item->{'itemnotes'}\t15";
+#$inputs{'Serial'}="text\t$data->{'serial'}\t16";
+$inputs{'Volume'}="hidden\t$data->{'volumeddesc'}\t17";
+$inputs{'Home Branch'}="text\t$item->{'homebranch'}\t18";
+$inputs{'Lost'}="radio\t$item->{'itemlost'}\t19";
+#$inputs{'Analytic author'}="text\t\t18";
+#$inputs{'Analytic title'}="text\t\t19";
+
+$inputs{'bibnum'}="hidden\t$data->{'biblionumber'}\t20";
+$inputs{'bibitemnum'}="hidden\t$data->{'biblioitemnumber'}\t21";
+$inputs{'itemnumber'}="hidden\t$itemnum\t22";
+
+
+
+print <<printend
+<FONT SIZE=6><em>$data->{'title'} ($data->{'author'})</em></FONT><br>
+<table border=0 cellspacing=0 cellpadding=5>
+<tr valign=top bgcolor=white><td><form action=updateitem.pl method=post>
+<table border=0 cellspacing=0 cellpadding=5>
+<tr valign=top bgcolor=white><td>Barcode</td><td><input type=text name=Barcode value="$item->{'barcode'}" size=40></td></tr>
+<input type=hidden name=Class value="$data->{'classification'}$dewey$data->{'subclass'}">
+<input type=hidden name=Publisher value="$data->{'publisher'}">
+<input type=hidden name=ISBN value="$data->{'isbn'}">
+<input type=hidden name=Publication Year value="$data->{'publicationyear'}">
+<input type=hidden name=Pages value="$data->{'pages'}">
+<input type=hidden name=Illustrations value="$data->{'illustration'}">
+<tr valign=top bgcolor=white><td>ItemNotes</td><td><textarea name=ItemNotes cols=40 rows=4>$item->{'itemnotes'}</textarea></td></tr>
+<input type=hidden name=Volume value="$data->{'volumeddesc'}">
+<tr valign=top bgcolor=white><td>Home Branch</td><td><input type=text name=Home Branch value="$item->{'homebranch'}" size=40></td></tr>
+<tr valign=top bgcolor=white><td>Lost</td><td><input type=radio name=Lost value=1
+printend
+;
+if ($item->{'itemlost'} ==1){
+ print " checked ";
+}
+print <<printend
+>Yes
+<input type=radio name=Lost value=0
+printend
+;
+if ($item->{'itemlost'} ==0){
+ print " checked ";
+}
+print <<printend
+>No</td></tr>
+<tr valign=top bgcolor=white><td>Cancelled</td><td><input type=radio name=withdrawn value=1
+printend
+;
+if ($item->{'wthdrawn'} ==1){
+ print " checked ";
+}
+print <<printend
+>Yes
+<input type=radio name=withdrawn value=0
+printend
+;
+if ($item->{'wthdrawn'} ==0){
+ print " checked ";
+}
+print <<printend
+>No</td></tr>
+<input type=hidden name=bibnum value="$data->{'biblionumber'}">
+<input type=hidden name=bibitemnum value="$data->{'biblioitemnumber'}">
+<input type=hidden name=itemnumber value="$itemnum">
+<tr valign=top bgcolor=white><td></td><td>
+
+<input type=image name=submit src=/images/save-changes.gif border=0 width=187
+height=42></td></tr>
+</table>
+</form></td></tr>
+</table>
+
+printend
+;
+
+
+
+
+
+print endmenu();
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to modify reserves/requests
+#written 2/1/00 by chris@katipo.oc.nz
+#last update 27/1/2000 by chris@katipo.co.nz
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Reserves2;
+
+my $input = new CGI;
+#print $input->header;
+
+#print $input->dump;
+
+my @rank=$input->param('rank-request');
+my @biblio=$input->param('biblio');
+my @borrower=$input->param('borrower');
+my @branch=$input->param('pickup');
+my $count=@rank;
+my $del=0;
+for (my $i=0;$i<$count;$i++){
+ if ($rank[$i] ne 'del' && $del == 0){
+ updatereserves($rank[$i],$biblio[$i],$borrower[$i],0,$branch[$i]); #from C4::Reserves2
+
+ } elsif ($rank[$i] eq 'del'){
+ updatereserves($rank[$i],$biblio[$i],$borrower[$i],1); #from C4::Reserves2
+ $del=1;
+ }
+
+}
+my $from=$input->param('from');
+if ($from eq 'borrower'){
+ print $input->redirect("/cgi-bin/koha/moremember.pl?bornum=$borrower[0]");
+ } else {
+ print $input->redirect("/cgi-bin/koha/request.pl?bib=$biblio[0]");
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to display detailed information
+#written 8/11/99
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Acquisitions;
+
+my $input = new CGI;
+print $input->header;
+#whether it is called from the opac of the intranet
+my $type=$input->param('type');
+#setup colours
+my $main;
+my $secondary;
+if ($type eq 'opac'){
+ $main='#99cccc';
+ $secondary='#efe5ef';
+} else {
+ $main='#cccc99';
+ $secondary='#ffffcc';
+}
+print startpage();
+print startmenu($type);
+my $blah;
+
+my $bib=$input->param('bib');
+my $title=$input->param('title');
+my $bi=$input->param('bi');
+my $data=bibitemdata($bi);
+
+my (@items)=itemissues($bi);
+my ($order)=getorder($bi,$bib);
+#print @items;
+my $count=@items;
+
+my $i=0;
+print center();
+
+my $dewey = $data->{'dewey'};
+$dewey =~ s/0+$//;
+if ($dewey eq "000.") { $dewey = "";};
+if ($dewey < 10){$dewey='00'.$dewey;}
+if ($dewey < 100 && $dewey > 10){$dewey='0'.$dewey;}
+if ($dewey <= 0){
+ $dewey='';
+}
+$dewey=~ s/\.$//;
+print <<printend
+<br>
+<a href=/cgi-bin/koha/request.pl?bib=$bib><img src=/images/requests.gif width=120 height=42 border=0 align=right border=0></a>
+<FONT SIZE=6><em><a href=/cgi-bin/koha/detail.pl?bib=$bib&type=intra>$data->{'title'} ($data->{'author'})</a></em></FONT><P>
+<p>
+<form action=/cgi-bin/koha/modbibitem.pl>
+<input type=hidden name=bibitem value=$bi>
+<input type=hidden name=biblio value=$bib>
+<!-------------------BIBLIO ITEM------------>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left>
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif" ><B>$data->{'biblioitemnumber'} GROUP - $data->{'description'} </b> </TD>
+</TR>
+<tr VALIGN=TOP >
+<TD width=210 >
+<INPUT TYPE="image" name="submit" VALUE="modify" height=42 WIDTH=93 BORDER=0 src="/images/modify-mem.gif">
+<INPUT TYPE="image" name="delete" VALUE="delete" height=42 WIDTH=93 BORDER=0 src="/images/delete-mem.gif">
+<br>
+<FONT SIZE=2 face="arial, helvetica">
+<b>Biblionumber:</b> $bib<br>
+<b>Item Type:</b> $data->{'itemtype'}<br>
+<b>Loan Length:</b> $data->{'loanlength'}<br>
+<b>Rental Charge:</b> $data->{'rentalcharge'}<br>
+<b>Classification:</b> $data->{'classification'}$dewey$data->{'subclass'}<br>
+<b>ISBN:</b> $data->{'isbn'}<br>
+<b>Publisher:</b> $data->{'publishercode'} <br>
+<b>Place:</b> $data->{'place'}<br>
+<b>Date:</b> $data->{'publicationyear'}<br>
+<b>Volume:</b> $data->{'volumeddesc'}<br>
+<b>Pages:</b> $data->{'pages'}<br>
+<b>Illus:</b> $data->{'illus'}<br>
+<b>Size:</b> $data->{'size'}<br>
+<b>Notes:</b> $data->{'notes'}<br>
+<b>No. of Items:</b> $count
+</font>
+</TD>
+</tr>
+</table>
+</form>
+printend
+;
+
+for (my $i=0;$i<$count;$i++){
+print <<printend
+<img src="/images/holder.gif" width=16 height=300 align=left>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width=220 >
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>BARCODE $items[$i]->{'barcode'}</b></TD>
+</TR>
+<tr VALIGN=TOP >
+<TD width=220 >
+<form action=/cgi-bin/koha/moditem.pl method=post>
+<input type=hidden name=bibitem value=$bi>
+<input type=hidden name=item value=$items[$i]->{'itemnumber'}>
+<INPUT TYPE="image" name="submit" VALUE="modify" height=42 WIDTH=93 BORDER=0 src="/images/modify-mem.gif">
+<INPUT TYPE="image" name="delete" VALUE="delete" height=42 WIDTH=93 BORDER=0 src="/images/delete-mem.gif">
+<br>
+printend
+;
+$items[$i]->{'itemlost'}=~ s/0/No/;
+$items[$i]->{'itemlost'}=~ s/1/Yes/;
+$items[$i]->{'withdrawn'}=~ s/0/No/;
+$items[$i]->{'withdrawn'}=~ s/1/Yes/;
+$items[$i]->{'replacementprice'}+=0.00;
+my $year=substr($items[$i]->{'timestamp0'},0,4);
+my $mon=substr($items[$i]->{'timestamp0'},4,2);
+my $day=substr($items[$i]->{'timestamp0'},6,2);
+$items[$i]->{'timestamp0'}="$day/$mon/$year";
+my @temp=split('-',$items[$i]->{'dateaccessioned'});
+$items[$i]->{'dateaccessioned'}="$temp[2]/$temp[1]/$temp[0]";
+@temp=split('-',$items[$i]->{'datelastseen'});
+$items[$i]->{'datelastseen'}="$temp[2]/$temp[1]/$temp[0]";
+print <<printend
+<FONT SIZE=2 face="arial, helvetica">
+<b>Home Branch:</b> $items[$i]->{'homebranch'}<br>
+<b>Last seen:</b> $items[$i]->{'datelastseen'}<br>
+<b>Last borrowed:</b> $items[$i]->{'timestamp0'}<br>
+printend
+;
+if ($items[$i] eq 'Available'){
+ print "<b>Currently on issue to:</b><br>";
+} else {
+ print "<b>Currently on issue to:</b> <a href=/cgi-bin/koha/moremember.pl?bornum=$items[$i]->{'borrower0'}>$items[$i]->{'card'}</a><br>";
+}
+print <<printend
+<b>Last Borrower 1:</b> $items[$i]->{'card0'}<br>
+<b>Last Borrower 2:</b> $items[$i]->{'card1'}<br>
+<b>Current Branch:</b> $items[$i]->{'holdingbranch'}<br>
+<b>Replacement Price:</b> $items[$i]->{'replacementprice'}<br>
+<b>Item lost:</b> $items[$i]->{'itemlost'}<br>
+<b>paid by:</b><br>
+<b>Notes:</b> $items[$i]->{'itemnotes'}<br>
+<b>Renewals:</b> $items[$i]->{'renewals'}<br>
+<b><a href=/cgi-bin/koha/acqui/acquire.pl?recieve=$order->{'ordernumber'}&biblio=$bib&invoice=$order->{'booksellerinvoicenumber'}&catview=yes>Accession</a> Date: $items[$i]->{'dateaccessioned'}<br>
+printend
+;
+if ($items[$i]->{'wthdrawn'} eq '1'){
+ $items[$i]->{'wthdrawn'}="Yes";
+} else {
+ $items[$i]->{'wthdrawn'}="No";
+}
+print <<printend
+<b>Cancelled: $items[$i]->{'wthdrawn'}<br>
+<b>Total Issues:</b> $items[$i]->{'issues'}<br>
+<b>Group Number:</b> $bi <br>
+<b>Biblio number:</b> $bib <br>
+
+
+
+</font>
+</TD>
+</tr>
+</table>
+</form>
+printend
+;
+}
+print <<printend
+<p>
+</form>
+printend
+;
+
+
+print endcenter();
+
+print endmenu($type);
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to do a borrower enquiery/brin up borrower details etc
+#written 20/12/99 by chris@katipo.co.nz
+#Displays all the detailas about a borrower
+#needs html removed and to use the C4::Output more, but its tricky
+#last modified 21/1/2000 by chris@katipo.co.nz
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+use Date::Manip;
+use C4::Reserves2;
+use C4::Circulation::Renewals2;
+my $input = new CGI;
+my $bornum=$input->param('bornum');
+
+my %env;
+print $input->header;
+#start the page and read in includes
+print startpage();
+print startmenu('member');
+my $data=borrdata('',$bornum);
+my @temp=split('-',$data->{'dateenrolled'});
+$data->{'dateenrolled'}="$temp[2]/$temp[1]/$temp[0]";
+@temp=split('-',$data->{'expiry'});
+$data->{'expiry'}="$temp[2]/$temp[1]/$temp[0]";
+@temp=split('-',$data->{'dateofbirth'});
+$data->{'dateofbirth'}="$temp[2]/$temp[1]/$temp[0]";
+if ($data->{'ethnicity'} eq 'maori'){
+ $data->{'ethnicity'} = 'Maori';
+}
+if ($data->{'ethnicity'}eq 'european'){
+ $data->{'ethnicity'} = 'European/Pakeha';
+}
+if ($data->{'ethnicity'}eq 'pi'){
+ $data->{'ethnicity'} = 'Pacific Islander';
+}
+if ($data->{'ethnicity'}eq 'asian'){
+ $data->{'ethnicity'} = 'Asian';
+}
+print <<printend
+<FONT SIZE=6><em>$data->{'firstname'} $data->{'surname'}</em></FONT><P>
+<p>
+<form action=/cgi-bin/koha/jmemberentry.pl method=post>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width=270>
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>MEMBERSHIP RECORD</TD></TR>
+<tr VALIGN=TOP >
+<TD>
+<p align=right><INPUT TYPE="image" name="submit" VALUE="add-child" height=42 WIDTH=120 BORDER=0 src="/images/add-child.gif">
+<input type=hidden name=type value=Add>
+<input type=hidden name=bornum value=$data->{'borrowernumber'}>
+</form>
+</P><br>
+<FONT SIZE=2 face="arial, helvetica">$data->{'title'} $data->{'othernames'} $data->{'surname'} ($data->{'firstname'}, $data->{'initials'})<p>
+
+Card Number: $data->{'cardnumber'}<BR>
+Postal Address: $data->{'streetaddress'}, $data->{'city'}<BR>
+Home Address: $data->{'physstreet'}, $data->{'streetcity'}<BR>
+Phone (Home): $data->{'phone'}<BR>
+Phone (Daytime): $data->{'phoneday'}<BR>
+Fax: $data->{'faxnumber'}<BR>
+E-mail: <a href="mailto:$data->{'emailaddress'}">$data->{'emailaddress'}</a><P>
+Membership Number: $data->{'borrowernumber'}<BR>
+Membership: $data->{'categorycode'}<BR>
+Area: $data->{'area'}<BR>
+Fee:$30/year, Paid<BR>
+Joined: $data->{'dateenrolled'}, Expires: $data->{'expiry'} <BR>
+Joining Branch: $data->{'homebranch'}<P>
+Ethnicity: $data->{'ethnicity'}, $data->{'ethnotes'}<BR>
+DoB: $data->{'dateofbirth'}<BR>
+Sex: $data->{'sex'}<P>
+
+Alternative Contact:$data->{'contactname'}<BR>
+Phone: $data->{'altphone'}<BR>
+Relationship: $data->{'altrelationship'}<BR>
+Notes: $data->{'altnotes'}<P>
+Guarantees:
+printend
+;
+my ($count,$guarantees)=findguarantees($data->{'borrowernumber'});
+for (my $i=0;$i<$count;$i++){
+ print "<A HREF=\"/cgi-bin/koha/moremember.pl?bornum=$guarantees->[$i]->{'borrowernumber'}\">$guarantees->[$i]->{'cardnumber'}</a><br>";
+}
+print <<printend
+
+
+<P>
+
+General Notes: <A HREF="popbox.html" onclick="messenger(200,250,'Form that lets you add to and delete notes.'); return false">
+$data->{'borrowernotes'}</a>
+<p align=right>
+<form action=/cgi-bin/koha/memberentry.pl method=post>
+<input type=hidden name=bornum value=$bornum>
+<INPUT TYPE="image" name="submit" VALUE="modify" height=42 WIDTH=93 BORDER=0 src="/images/modify-mem.gif">
+
+<INPUT TYPE="image" name="submit" VALUE="delete" height=42 WIDTH=93 BORDER=0 src="/images/delete-mem.gif">
+</p>
+
+</TD>
+</TR>
+</TABLE>
+</FORM>
+<img src="/images/holder.gif" width=16 height=800 align=left>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=4><B>FINES & CHARGES</TD></TR>
+printend
+;
+my %bor;
+$bor{'borrowernumber'}=$bornum;
+my ($numaccts,$accts,$total)=getboracctrecord('',\%bor);
+#if ($numaccts > 10){
+# $numaccts=10;
+#}
+for (my$i=0;$i<$numaccts;$i++){
+#if ($accts->[$i]{'accounttype'} ne 'Pay'){
+ my $amount= $accts->[$i]{'amount'} + 0.00;
+ my $amount2= $accts->[$i]{'amountoutstanding'} + 0.00;
+ if ($amount2 > 0){
+ print "<tr VALIGN=TOP >";
+ my $item=" ";
+ @temp=split('-',$accts->[$i]{'date'});
+ $accts->[$i]{'date'}="$temp[2]/$temp[1]/$temp[0]";
+ if ($accts->[$i]{'accounttype'} ne 'Res'){
+ #get item data
+ #$item=
+ }
+ print "<td>$accts->[$i]{'date'}</td>";
+# print "<TD>$accts->[$i]{'accounttype'}</td>";
+ print "<TD>$accts->[$i]{'description'} $accts->[$i]{'title'}</td>
+ <TD>$amount</td><td>$amount2</td>
+ </tr>";
+ }
+}
+print <<printend
+
+<tr VALIGN=TOP >
+<TD colspan=3 align=right>
+<nobr>
+<a href=/cgi-bin/koha/boraccount.pl?bornum=$bornum><img height=42 WIDTH=187 BORDER=0 src="/images/view-account.gif"></a>
+<a href=/cgi-bin/koha/pay.pl?bornum=$bornum><img height=42 WIDTH=187 BORDER=0 src="/images/pay-fines.gif"></a></nobr>
+</td>
+
+</tr>
+
+
+</table>
+
+<p>
+<form action="renewscript.pl" method=post>
+<input type=hidden name=bornum value=$bornum>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+
+<TR VALIGN=TOP>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=6><B>ITEMS CURRENTLY ON ISSUE</b></TD>
+</TR>
+
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Title</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Due</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Itemtype</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Charge</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Renew</b></TD>
+</TR>
+printend
+;
+my ($count,$issue)=borrissues($bornum);
+my $today=ParseDate('today');
+for (my $i=0;$i<$count;$i++){
+ print "<tr VALIGN=TOP >
+ <TD>";
+ my $datedue=ParseDate($issue->[$i]{'date_due'});
+ @temp=split('-',$issue->[$i]{'date_due'});
+ $issue->[$i]{'date_due'}="$temp[2]/$temp[1]/$temp[0]";
+ if ($datedue < $today){
+ print "<font color=red>";
+ }
+ print "$issue->[$i]{'title'} $issue->[$i]{'barcode'}</td>
+ <TD>$issue->[$i]{'date_due'}</td>";
+ #find the charge for an item
+ my ($charge,$itemtype)=calc_charges(\%env,$issue->[$i]{'itemnumber'},$bornum);
+ print "<TD>$itemtype</td>";
+ print "<TD>$charge</td>";
+
+# if ($datedue < $today){
+# print "<td>Overdue</td>";
+# } else {
+# print "<td> </td>";
+# }
+ #check item is not reserved
+ my ($rescount,$reserves)=FindReserves($issue->[$i]{'biblionumber'},'');
+ if ($rescount >0){
+ print "<TD>On Request";
+ } else {
+ print "<TD>";
+ }
+ print "<input type=radio name=\"renew_item_$issue->[$i]{'itemnumber'}\" value=y>Y
+ <input type=radio name=\"renew_item_$issue->[$i]{'itemnumber'}\" value=n>N</td>
+ </tr>
+ ";
+
+}
+print <<printend
+
+<tr VALIGN=TOP >
+<TD colspan=5 align=right>
+<INPUT TYPE="image" name="submit" VALUE="update" height=42 WIDTH=187 BORDER=0 src="/images/update-renewals.gif">
+</td>
+</form>
+</tr>
+
+
+</table>
+
+
+<P>
+
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+
+<TR VALIGN=TOP>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=5><B>ITEMS REQUESTED</b></TD>
+</TR>
+
+<TR VALIGN=TOP>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Title</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Requested</b></TD>
+
+
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Charge</b></TD>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Remove</b></TD>
+</TR>
+<form action=/cgi-bin/koha/modrequest.pl method=post>
+<input type=hidden name=from value=borrower>
+printend
+;
+my ($rescount,$reserves)=FindReserves('',$bornum); #From C4::Reserves2
+for (my $i=0;$i<$rescount;$i++){
+ @temp=split('-',$reserves->[$i]{'reservedate'});
+ $reserves->[$i]{'reservedate'}="$temp[2]/$temp[1]/$temp[0]";
+ print "<tr VALIGN=TOP >
+ <TD><a href=\"/cgi-bin/koha/request.pl?bib=$reserves->[$i]{'biblionumber'}\">$reserves->[$i]{'title'}</a></td>
+ <TD>$reserves->[$i]{'reservedate'}</td>
+ <input type=hidden name=biblio value=$reserves->[$i]{'biblionumber'}>
+ <input type=hidden name=borrower value=$bornum>
+ <TD></td>
+ <TD><select name=\"rank-request\">
+ <option value=n>No
+ <option value=del>Yes
+ </select>
+ </tr>
+ ";
+}
+print <<printend
+
+<tr VALIGN=TOP >
+<TD colspan=5 align=right>
+<INPUT TYPE="image" name="submit" VALUE="update" height=42 WIDTH=187 BORDER=0 src="/images/cancel-requests.gif"></td>
+</tr>
+</table>
+</form>
+<p align=right>
+<a href=/cgi-bin/koha/readingrec.pl?bornum=$bornum><img height=42 WIDTH=187 BORDER=0 src="/images/reading-record.gif"></a>
+</p>
+printend
+;
+
+
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to print confirmation screen, then if accepted calls itself to insert data
+
+use strict;
+use C4::Output;
+use C4::Input;
+use CGI;
+use Date::Manip;
+
+my %env;
+my $input = new CGI;
+#get varibale that tells us whether to show confirmation page
+#or insert data
+my $insert=$input->param('insert');
+print $input->header;
+#get rest of data
+my %data;
+my @names=$input->param;
+foreach my $key (@names){
+ $data{$key}=$input->param($key);
+}
+my $ok=0;
+
+my $string="The following compulsary fields have been left blank. Please push the back button
+and try again<p>";
+if ($data{'cardnumber_institution'} eq ''){
+ $string.="Cardnumber<br>";
+ $ok=1;
+}
+if ($data{'institution_name'} eq ''){
+ $string.="Institution Name<br>";
+ $ok=1;
+}
+if ($data{'address'} eq ''){
+ $string.="Postal Address<br>";
+ $ok=1;
+}
+if ($data{'city'} eq ''){
+ $string.="City<br>";
+ $ok=1;
+}
+if ($data{'contactname'} eq ''){
+ $string.="Contact Name";
+ $ok=1;
+}
+#print $input->Dump;
+#print $string;
+print startmenu('member');
+if ($ok ==1){
+ print $string;
+} else {
+ my $valid=checkdigit(\%env,$data{"cardnumber_institution"});
+ if ($valid != 1){
+ print "Invalid cardnumber";
+ } else {
+
+ my @inputs;
+ my $i=0;
+ while (my ($key, $value) = each %data) {
+ $value=~ s/\"/%22/g;
+ $inputs[$i]=["hidden","$key","$value"];
+ $i++;
+ }
+ $inputs[$i]=["submit","submit","submit"];
+ print mkformnotable("/cgi-bin/koha/insertidata.pl",@inputs);
+ }
+}
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to print confirmation screen, then if accepted calls itself to insert data
+
+use strict;
+use C4::Output;
+use C4::Input;
+use CGI;
+use Date::Manip;
+
+my %env;
+my $input = new CGI;
+#get varibale that tells us whether to show confirmation page
+#or insert data
+my $insert=$input->param('insert');
+print $input->header;
+#get rest of data
+my %data;
+my @names=$input->param;
+foreach my $key (@names){
+ $data{$key}=$input->param($key);
+}
+my $ok=0;
+
+my $string="The following compulsary fields have been left blank. Please push the back button
+and try again<p>";
+for (my $i=0;$i<3;$i++){
+ my $number=$data{"cardnumber_child_$i"};
+ my $firstname=$data{"firstname_child_$i"};
+ my $surname=$data{"surname_child_$i"};
+ my $dob=$data{"dateofbirth_child_$i"};
+ my $sex=$data{"sex_child_$i"};
+ if ($number eq ''){
+ if ($i == 0){
+ $string.=" Cardnumber<br>";
+ $ok=1;
+ }
+ } else {
+ if ($firstname eq ''){
+ $string.=" Given Names<br>";
+ $ok=1;
+ }
+ if ($surname eq ''){
+ $string.=" Surname<br>";
+ $ok=1;
+ }
+ if ($dob eq ''){
+ $string.=" Date Of Birth<br>";
+ $ok=1;
+ }
+ if ($sex eq ''){
+ $string.=" Gender <br>";
+ $ok=1;
+ }
+ my $valid=checkdigit(\%env,$data{"cardnumber_child_$i"});
+ if ($valid != 1){
+ $ok=1;
+ $string.=" Invalid Cardnumber $number<br>";
+ }
+ }
+}
+
+print startpage();
+print startmenu('member');
+
+if ($ok == 0){
+ print mkheadr(1,'Confirm Record');
+ my $main="#99cc33";
+ my $image="/images/background-mem.gif";
+ for (my $i=0;$i<3;$i++){
+ if ($data{"cardnumber_child_$i"} ne ''){
+ print mktablehdr;
+ print mktablerow(2,$main,bold('NEW MEMBER'),"",$image);
+ my $name=$data{"firstname_child_$i"}.$data{"surname_child_$i"};
+ print mktablerow(2,'white',bold('Name'),$name);
+ print mktablerow(2,$main,bold('MEMBERSHIP DETAILS'),"",$image);
+ print mktablerow(2,'white',bold('Membership Number'),$data{"bornumber_child_$i"});
+ print mktablerow(2,'white',bold('Date of Birth'),$data{"dateofbirth_child_$i"});
+ my $sex;
+ if ($data{"sex_child_$i"} eq 'M'){
+ $sex="Male";
+ } else {
+ $sex="Female";
+ }
+ print mktablerow(2,'white',bold('Sex'),$sex);
+ print mktablerow(2,'white',bold('School'),$data{"school_child_$i"});
+ print mktablerow(2,'white',bold('General Notes'),$data{"altnotes_child_$i"});
+
+ print mktableft;
+ print "<p>";
+ }
+ }
+ my $i=0;
+ my @inputs;
+ while (my ($key, $value) = each %data) {
+ $value=~ s/\"/%22/g;
+ $inputs[$i]=["hidden","$key","$value"];
+ $i++;
+ }
+ $inputs[$i]=["submit","submit","submit"];
+ print mkformnotable("/cgi-bin/koha/insertjdata.pl",@inputs);
+
+} else {
+
+
+#print $input->dump;
+print $string;
+}
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to print confirmation screen, then if accepted calls itself to insert data
+
+use strict;
+use C4::Output;
+use C4::Input;
+use CGI;
+use Date::Manip;
+
+my %env;
+my $input = new CGI;
+#get varibale that tells us whether to show confirmation page
+#or insert data
+my $insert=$input->param('insert');
+
+#get rest of data
+my %data;
+my @names=$input->param;
+foreach my $key (@names){
+ $data{$key}=$input->param($key);
+}
+print $input->header;
+print startpage();
+print startmenu('member');
+my $main="#99cc33";
+my $image="/images/background-mem.gif";
+if ($insert eq ''){
+ my $ok=0;
+ #check that all compulsary fields are entered
+ my $string="The following compulsary fields have been left blank. Please push the back button
+ and try again<p>";
+ if ($data{'cardnumber'} eq ''){
+
+ $string.=" Cardnumber<br>";
+ $ok=1;
+ } else {
+ #check cardnumber is valid
+ my $valid=checkdigit(\%env,$data{'cardnumber'});
+ if ($valid != 1){
+ $ok=1;
+ $string.=" Invalid Cardnumber<br>";
+ }
+ }
+ if ($data{'sex'} eq ''){
+ $string.=" Gender <br>";
+ $ok=1;
+ }
+ if ($data{'firstname'} eq ''){
+ $string.=" Given Names<br>";
+ $ok=1;
+ }
+ if ($data{'surname'} eq ''){
+ $string.=" Surname<br>";
+ $ok=1;
+ }
+ if ($data{'address'} eq ''){
+ $string.=" Postal Street Address<br>";
+ $ok=1;
+ }
+ if ($data{'city'} eq ''){
+ $string.=" Postal City<br>";
+ $ok=1;
+ }
+ if ($data{'contactname'} eq ''){
+ $string.=" Alternate Contact<br>";
+ $ok=1;
+ }
+ #we are printing confirmation page
+ print mkheadr(1,'Confirm Record');
+ if ($ok ==0){
+ print mktablehdr;
+ print mktablerow(2,$main,bold('NEW MEMBER'),"",$image);
+ my $name=$data{'title'}." ";
+ if ($data{'othernames'} ne ''){
+ $name.=$data{'othernames'}." ";
+ } else {
+ $name.=$data{'firstname'}." ";
+ }
+ $name.="$data{'surname'} ( $data{'firstname'}, $data{'initials'})";
+ print mktablerow(2,'white',bold('Name'),$name);
+ print mktablerow(2,$main,bold('MEMBERSHIP DETAILS'),"",$image);
+ print mktablerow(2,'white',bold('Membership Number'),$data{'borrowernumber'});
+ print mktablerow(2,'white',bold('Cardnumber'),$data{'cardnumber'});
+ print mktablerow(2,'white',bold('Membership Category'),$data{'categorycode'});
+ print mktablerow(2,'white',bold('Area'),$data{'area'});
+ print mktablerow(2,'white',bold('Fee'),$data{'fee'});
+ if ($data{'joining'} eq ''){
+ $data{'joining'}=ParseDate('today');
+ $data{'joining'}=&UnixDate($data{'joining'},'%Y-%m-%d');
+ }
+ print mktablerow(2,'white',bold('Joining Date'),$data{'joining'});
+ if ($data{'expiry'} eq ''){
+ $data{'expiry'}=ParseDate('in 1 year');
+ $data{'expiry'}=&UnixDate($data{'expiry'},'%Y-%m-%d');
+ }
+ print mktablerow(2,'white',bold('Expiry Date'),$data{'expiry'});
+ print mktablerow(2,'white',bold('Joining Branch'),$data{'joinbranch'});
+ print mktablerow(2,$main,bold('PERSONAL DETAILS'),"",$image);
+ my $ethnic=$data{'ethnicity'}." ".$data{'ethnicnotes'};
+ print mktablerow(2,'white',bold('Ethnicity'),$ethnic);
+ $data{'dateofbirth'}=ParseDate($data{'dateofbirth'});
+ $data{'dateofbirth'}=UnixDate($data{'dateofbirth'},'%Y-%m-%d');
+ print mktablerow(2,'white',bold('Date of Birth'),$data{'dateofbirth'});
+ my $sex;
+ if ($data{'sex'} eq 'M'){
+ $sex="Male";
+ } else {
+ $sex="Female";
+ }
+ print mktablerow(2,'white',bold('Sex'),$sex);
+ print mktablerow(2,$main,bold('MEMBER ADDRESS'),"",$image);
+ my $postal=$data{'address'}."<br>".$data{'city'};
+ my $home;
+ if ($data{'streetaddress'} ne ''){
+ $home=$data{'streetaddress'}."<br>".$data{'streetcity'};
+ } else {
+ $home=$postal;
+ }
+ print mktablerow(2,'white',bold('Postal Address'),$postal);
+ print mktablerow(2,'white',bold('Home Address'),$home);
+ print mktablerow(2,$main,bold('MEMBER CONTACT DETAILS'),"",$image);
+ print mktablerow(2,'white',bold('Phone (Home)'),$data{'phone'});
+ print mktablerow(2,'white',bold('Phone (Daytime)'),$data{'phoneday'});
+ print mktablerow(2,'white',bold('Fax'),$data{'faxnumber'});
+ print mktablerow(2,'white',bold('Email'),$data{'emailaddress'});
+ print mktablerow(2,$main,bold('ALTERNATIVE CONTACT DETAILS'),"",$image);
+ print mktablerow(2,'white',bold('Name'),$data{'contactname'});
+ print mktablerow(2,'white',bold('Phone'),$data{'altphone'});
+ print mktablerow(2,'white',bold('Relationship'),$data{'altrelationship'});
+ print mktablerow(2,'white',bold('Notes'),$data{'altnotes'});
+ print mktablerow(2,$main,bold('Notes'),"",$image);
+ print mktablerow(2,'white',bold('General Notes'),$data{'borrowernotes'});
+
+ print mktableft;
+ #set up form to post data thru for modification or insertion
+ my $i=0;
+ my @inputs;
+ while (my ($key, $value) = each %data) {
+ $value=~ s/\"/%22/g;
+ $inputs[$i]=["hidden","$key","$value"];
+ $i++;
+ }
+ $inputs[$i]=["submit","submit","submit"];
+ print mkformnotable("/cgi-bin/koha/insertdata.pl",@inputs);
+ } else {
+ print $string;
+ }
+}
+#print $input->dump;
+
+print mktablehdr;
+
+print mktableft;
+print endmenu('member');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+#script to provide intranet (librarian) advanced search facility
+#modified 9/11/1999 by chris@katipo.co.nz
+#adding an extra comment to play with CVS (Si, 19/11/99)
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+
+my $env;
+my $input = new CGI;
+print $input->header;
+#print $input->Dump;
+my $blah;
+my %search;
+#build hash of users input
+
+
+my $keyword=validateinp($input->param('keyword'));
+#my $keyword=$input->param('keyword');
+#$keyword=~ s/'/\'/g;
+$search{'keyword'}=$keyword;
+
+my @results;
+my $offset=$input->param('offset');
+if ($offset eq ''){
+ $offset=0;
+}
+my $num=$input->param('num');
+if ($num eq ''){
+ $num=10;
+}
+print startpage();
+print startmenu('opac');
+print mkheadr(1,"Opac Search Results for $keyword");
+print center();
+my $count;
+my @results;
+if ($search{'keyword'} ne ''){
+ ($count,@results)=&OpacSearch(\$blah,'loose',\%search,$num,$offset);
+}
+#print "You searched on <b>$keyword</b>";
+
+print " $count results found";
+my $offset2=$num+$offset;
+my $disp=$offset+1;
+print ", Results $disp to $offset2 displayed";
+print mktablehdr;
+
+print mktablerow(4,'#99cccc','<b>TITLE</b>','<b>AUTHOR</b>','<b>COUNT</b>',bold('BRANCH'));
+
+my $count2=@results;
+my $i=0;
+my $colour=1;
+while ($i < $count2){
+ my @stuff=split('\t',$results[$i]);
+ $stuff[1]=~ s/\`/\'/g;
+ my $title2=$stuff[1];
+ $title2=~ s/ /%20/g;
+
+ $stuff[1]=mklink("/cgi-bin/koha/detail.pl?bib=$stuff[2]&title=$title2&type=opac",$stuff[1]);
+ my $word=$stuff[0];
+ $word=~ s/ //g;
+ $word=~ s/ /%20/g;
+ $word=~ s/\,/\,%20/g;
+ $word=~ s/\n//g;
+ my $url="/cgi-bin/koha/search.pl?author=$word&type=opac";
+ $stuff[0]=mklink($url,$stuff[0]);
+ my ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit)=itemcount($env,$stuff[2]);
+ $stuff[3]=$count;
+ if ($nacount > 0){
+ $stuff[4]=$stuff[4]."On Loan";
+ if ($nacount >1 ){
+ $stuff[4]=$stuff[4]." ($nacount)";
+ }
+ $stuff[4].=" ";
+ }
+ if ($lcount > 0){
+ $stuff[4]=$stuff[4]."Levin";
+ if ($lcount >1 ){
+ $stuff[4]=$stuff[4]." ($lcount)";
+ }
+ $stuff[4].=" ";
+ }
+ if ($fcount > 0){
+ $stuff[4]=$stuff[4]."Foxton";
+ if ($fcount >1 ){
+ $stuff[4]=$stuff[4]." ($fcount)";
+ }
+ $stuff[4].=" ";
+ }
+ if ($scount > 0){
+ $stuff[4]=$stuff[4]."Shannon";
+ if ($scount >1 ){
+ $stuff[4]=$stuff[4]." ($scount)";
+ }
+ $stuff[4].=" ";
+ }
+ if ($mending > 0){
+ $stuff[4]=$stuff[4]."Mending";
+ if ($mending >1 ){
+ $stuff[4]=$stuff[4]." ($mending)";
+ }
+ $stuff[4].=" ";
+ }
+ if ($transit > 0){
+ $stuff[4]=$stuff[4]."In Transit";
+ if ($transit >1 ){
+ $stuff[4]=$stuff[4]." ($transit)";
+ }
+ $stuff[4].=" ";
+ }
+ if ($colour == 1){
+ print mktablerow(4,'#efe5ef',$stuff[1],$stuff[0],$stuff[3],$stuff[4]);
+ $colour=0;
+ } else{
+ print mktablerow(4,'white',$stuff[1],$stuff[0],$stuff[3],$stuff[4]);
+ $colour=1;
+ }
+ $i++;
+}
+$offset=$num+$offset;
+if ($offset < $count){
+ $keyword=~ s/ /%20/g;
+ my $search="num=$num&offset=$offset&keyword=$keyword";
+ my $stuff=mklink("/cgi-bin/koha/opac-search.pl?$search",'Next Results');
+# print $stuff;
+ print "<tr valign=top bgcolor=#99cccc><td colspan=4>$stuff
+ </td></tr>";
+} else {
+ print mktablerow(4,'#99cccc',' ',' ',' ',' ');
+}
+print mktableft();
+
+
+print endcenter();
+print endmenu('opac');
+print endpage();
+
+
+sub validateinp {
+ my ($input)=@_;
+ $input=~ s/\<[a-z]+\>//gi;
+ $input=~ s/\<\/[a-z]+\>//gi;
+ $input=~ s/\<//g;
+ $input=~ s/\>//g;
+ $input=~ s/%//g;
+ return($input);
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to display info about acquisitions
+#written by chris@katipo.co.nz 31/01/2000
+
+use C4::Acquisitions;
+use C4::Output;
+use CGI;
+my $input=new CGI;
+print $input->header();
+my $id=$input->param('id');
+my ($count,$order)=breakdown($id);
+print startpage;
+print mktablehdr;
+#print $id;
+for (my$i=0;$i<$count;$i++){
+print mktablerow(5,'white',"<b>Ordernumber:</b>$order->[$i]->{'ordernumber'}",
+"<b>Line umber</b>:$order->[$i]->{'linenumber'}","<b>Branch Code:</b>$order->[$i]->{'branchcode'}",
+"<b>Bookfundid</b>:$order->[$i]->{'bookfundid'}","<b>Allocation:</b>$order->[$i]->{'allocation'}");
+}
+print mktableft;
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#wrriten 11/1/2000 by chris@katipo.oc.nz
+#part of the koha library system, script to facilitate paying off fines
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+use C4::Accounts2;
+my $input=new CGI;
+
+
+my $bornum=$input->param('bornum');
+if ($bornum eq ''){
+ $bornum=$input->param('bornum0');
+}
+#get borrower details
+my $data=borrdata('',$bornum);
+my $user=$input->remote_user;
+
+#get account details
+my %bor;
+$bor{'borrowernumber'}=$bornum;
+
+
+my @names=$input->param;
+my %inp;
+my $check=0;
+for (my $i=0;$i<@names;$i++){
+ my$temp=$input->param($names[$i]);
+ if ($temp eq 'wo'){
+ $inp{$names[$i]}=$temp;
+ $check=1;
+ }
+ if ($temp eq 'yes'){
+ my $amount=$input->param($names[$i+4]);
+ my $bornum=$input->param($names[$i+5]);
+ my $accountno=$input->param($names[$i+6]);
+ makepayment($bornum,$accountno,$amount,$user);
+ $check=2;
+ }
+}
+my %env;
+my $total=$input->param('total');
+if ($check ==0){
+ if ($total ne ''){
+ recordpayment(\%env,$bornum,$total);
+ }
+my ($numaccts,$accts,$total)=getboracctrecord('',\%bor);
+print $input->header;
+print startpage();
+print startmenu('member');
+print <<printend
+<FONT SIZE=6><em>Pay Fines for $data->{'firstname'} $data->{'surname'}</em></FONT><P>
+<center>
+<p>
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=4><B>FINES & CHARGES</TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=4><B>AMOUNT OWING</TD>
+</TR>
+<form action=/cgi-bin/koha/pay.pl method=post>
+<input type=hidden name=bornum value=$bornum>
+printend
+;
+for (my $i=0;$i<$numaccts;$i++){
+if ($accts->[$i]{'amountoutstanding'} > 0){
+$accts->[$i]{'amount'}+=0.00;
+$accts->[$i]{'amountoutstanding'}+=0.00;
+print <<printend
+<tr VALIGN=TOP >
+<TD><input type=radio name=payfine$i value=no checked>Unpaid
+<input type=radio name=payfine$i value=yes>Pay
+<input type=radio name=payfine$i value=wo>Writeoff
+<input type=hidden name=itemnumber$i value=$accts->[$i]{'itemnumber'}>
+<input type=hidden name=accounttype$i value=$accts->[$i]{'accounttype'}>
+<input type=hidden name=amount$i value=$accts->[$i]{'amount'}>
+<input type=hidden name=out$i value=$accts->[$i]{'amountoutstanding'}>
+<input type=hidden name=bornum$i value=$bornum>
+<input type=hidden name=accountno$i value=$accts->[$i]{'accountno'}>
+</td>
+<TD>$accts->[$i]{'description'} $accts->[$i]{'title'}</td>
+<TD>$accts->[$i]{'accounttype'}</td>
+<td>$accts->[$i]{'amount'}</td>
+<TD>$accts->[$i]{'amountoutstanding'}</td>
+
+</tr>
+printend
+;
+}
+}
+print <<printend
+<tr VALIGN=TOP >
+<TD></td>
+<TD colspan=2><b>Total Due</b></td>
+
+<TD><b>$total</b></td>
+
+</tr>
+
+
+
+<tr VALIGN=TOP >
+<TD></td>
+<TD colspan=3><b>AMOUNT PAID</b></td>
+<TD><input type=text name=total value="" SIZE=7></td>
+</tr>
+<tr VALIGN=TOP >
+<TD colspan=5 align=right>
+<INPUT TYPE="image" name="submit" VALUE="pay" height=42 WIDTH=187 BORDER=0 src="/images/pay-fines.gif"></td>
+</tr>
+</form>
+</table>
+
+
+
+
+
+
+<br clear=all>
+<p> </p>
+
+printend
+;
+print endmenu('member');
+print endpage();
+
+} else {
+ my $quety=$input->query_string;
+ print $input->redirect("/cgi-bin/koha/sec/writeoff.pl?$quety");
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to place reserves/requests
+#writen 2/1/00 by chris@katipo.oc.nz
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Reserves2;
+
+my $input = new CGI;
+#print $input->header;
+
+my @bibitems=$input->param('biblioitem');
+my @reqbib=$input->param('reqbib');
+my $biblio=$input->param('biblio');
+my $borrower=$input->param('member');
+my $notes=$input->param('notes');
+my $branch=$input->param('pickup');
+my @rank=$input->param('rank-request');
+my $type=$input->param('type');
+my $title=$input->param('title');
+my $bornum=borrdata($borrower,'');
+if ($type eq 'str8' && $bornum ne ''){
+my $count=@bibitems;
+@bibitems=sort @bibitems;
+my $i2=1;
+my @realbi;
+$realbi[0]=$bibitems[0];
+for (my $i=1;$i<$count;$i++){
+ my $i3=$i2-1;
+ if ($realbi[$i3] ne $bibitems[$i]){
+ $realbi[$i2]=$bibitems[$i];
+ $i2++;
+ }
+}
+#print $input->dump;
+my $env;
+
+my $const;
+if ($input->param('request') eq 'any'){
+ $const='a';
+ CreateReserve(\$env,$branch,$bornum->{'borrowernumber'},$biblio,$const,\@realbi,$rank[0],$notes,$title);
+} elsif ($reqbib[0] ne ''){
+ $const='o';
+ CreateReserve(\$env,$branch,$bornum->{'borrowernumber'},$biblio,$const,\@reqbib,$rank[0],$notes,$title);
+} else {
+ CreateReserve(\$env,$branch,$bornum->{'borrowernumber'},$biblio,'a',\@realbi,$rank[0],$notes,$title);
+}
+#print @realbi;
+
+print $input->redirect("request.pl?bib=$biblio");
+} elsif ($bornum eq ''){
+ print $input->header();
+ print "Invalid card number please try again";
+ print $input->dump;
+}
--- /dev/null
+#!/usr/bin/perl
+
+#written 27/01/2000
+#script to display borrowers reading record
+
+
+use strict;
+use C4::Output;
+use CGI;
+use C4::Search;
+my $input=new CGI;
+
+
+my $bornum=$input->param('bornum');
+#get borrower details
+my $data=borrdata('',$bornum);
+my ($count,$issues)=allissues($bornum);
+
+
+print $input->header;
+print startpage();
+print startmenu('member');
+#print $count;
+print mkheadr(3,"$data->{'title'} $data->{'initials'} $data->{'surname'}");
+print mktablehdr();
+print mktablerow(4,'white',bold('TITLE'),bold('AUTHOR'),bold('DATE'));
+for (my $i=0;$i<$count;$i++){
+ print mktablerow(3,'white',$issues->[$i]->{'title'},$issues->[$i]->{'author'},$issues->[$i]->{'returndate'});
+}
+print mktableft();
+print endmenu('member');
+print endpage();
+
--- /dev/null
+#!/usr/bin/perl
+
+#written 18/1/2000 by chris@katipo.co.nz
+#script to renew items from the web
+
+use CGI;
+use C4::Circulation::Renewals2;
+#get input
+my $input= new CGI;
+#print $input->header;
+
+#print $input->dump;
+
+my @names=$input->param();
+my $count=@names;
+my %data;
+
+for (my $i=0;$i<$count;$i++){
+ if ($names[$i] =~ /renew/){
+ my $temp=$names[$i];
+ $temp=~ s/renew_item_//;
+ $data{$temp}=$input->param($names[$i]);
+ }
+}
+my %env;
+my $bornum=$input->param("bornum");
+while ( my ($key, $value) = each %data) {
+ # print "$key = $value\n";
+ if ($value eq 'y'){
+ #means we want to renew this item
+ #check its status
+ my $status=renewstatus(\%env,$bornum,$key);
+ if ($status == 1){
+ renewbook(\%env,$bornum,$key);
+ }
+ }
+}
+
+print $input->redirect("/cgi-bin/koha/moremember.pl?bornum=$bornum");
--- /dev/null
+#!/usr/bin/perl
+
+#script to display reports
+#written 8/11/99
+
+use strict;
+use CGI;
+use C4::Output;
+use C4::Stats;
+use C4::Stock;
+
+my $input = new CGI;
+print $input->header;
+my $type=$input->param('type');
+print startpage();
+print startmenu('issue');
+my @data;
+if ($type eq 'search'){
+ @data=statsreport('search','something');
+}
+if ($type eq 'issue'){
+ @data=statsreport('issue','today');
+}
+if ($type eq 'stock'){
+ @data=stockreport();
+}
+
+print mkheadr(1,"$type reports");
+print @data;
+
+print endmenu('issue');
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#script to place reserves/requests
+#writen 2/1/00 by chris@katipo.oc.nz
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Reserves2;
+use C4::Acquisitions;
+my $input = new CGI;
+print $input->header;
+
+
+#setup colours
+print startpage();
+print startmenu();
+my $blah;
+my $bib=$input->param('bib');
+my $dat=bibdata($bib);
+my ($count,$reserves)=FindReserves($bib);
+#print $count;
+#print $input->dump;
+
+
+print <<printend
+<form action="placerequest.pl" method=post>
+<INPUT TYPE="image" name="submit" VALUE="request" height=42 WIDTH=187 BORDER=0 src="/images/place-request.gif" align=right >
+<input type=hidden name=biblio value=$bib>
+<input type=hidden name=type value=str8>
+<input type=hidden name=title value="$dat->{'title'}">
+<FONT SIZE=6><em>Requesting: <a href=/cgi-bin/koha/detail.pl?bib=$bib>$dat->{'title'}</a> ($dat->{'author'})</em></FONT><P>
+<p>
+
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left >
+
+<!----------------BIBLIO RESERVE TABLE-------------->
+
+
+
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+<TR VALIGN=TOP>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Rank</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Member Number</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Notes</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Date</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Pickup</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Request</b></TD>
+</TR>
+<tr VALIGN=TOP >
+<TD><select name=rank-request>
+printend
+;
+$count++;
+my $i;
+for ($i=1;$i<$count;$i++){
+ print "<option value=$i>$i\n";
+}
+print "<option value=$i selected>$i\n";
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
+$year=$year+1900;
+$mon++;
+my $date="$mday/$mon/$year";
+print <<printend
+</select>
+</td>
+<TD><input type=text size=10 name=member></td>
+<TD><input type=text size=20 name=notes></td>
+<TD>$date</td>
+<TD><select name=pickup>
+printend
+;
+my ($count2,@branches)=branches;
+for (my $i=0;$i<$count2;$i++){
+ print "<option value=$branches[$i]->{'branchcode'}";
+ print ">$branches[$i]->{'branchname'}";
+}
+print <<printend
+</select>
+</td>
+<td><input type=checkbox name=request value=any>Next Available, <br>(or choose from list below)</td>
+</tr>
+
+
+</table>
+</p>
+
+
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+<TR VALIGN=TOP>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Request</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Item Type</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Classification</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Volume</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>ISBN</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Copyright</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Pubdate</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Copies</b></TD>
+</TR>
+printend
+;
+my $blah;
+my ($count2,@data)=bibitems($bib);
+for ($i=0;$i<$count2;$i++){
+ my @barcodes=barcodes($data[$i]->{'biblioitemnumber'});
+ if ($data[$i]->{'dewey'} == 0){
+ $data[$i]->{'dewey'}="";
+ }
+ $data[$i]->{'dewey'}=~ s/\.0000$//;
+ $data[$i]->{'dewey'}=~ s/00$//;
+ my $class="$data[$i]->{'classification'}$data[$i]->{'dewey'}$data[$i]->{'subclass'}";
+ print "<tr VALIGN=TOP >
+ <TD><input type=checkbox name=reqbib value=$data[$i]->{'biblioitemnumber'}>
+ <input type=hidden name=biblioitem value=$data[$i]->{'biblioitemnumber'}>
+ </td>
+ <TD>$data[$i]->{'description'}</td>
+ <TD>$class</td>
+ <td>$data[$i]->{'volumeddesc'}</td>
+ <td>$data[$i]->{'isbn'}</td>
+ <td>$dat->{'copyrightdate'}</td>
+ <td>$data[$i]->{'publicationyear'}</td>
+ <td>@barcodes</td>
+ </tr>";
+}
+print <<printend
+</table>
+</p>
+</form>
+<p> </p>
+<!-----------MODIFY EXISTING REQUESTS----------------->
+
+<TABLE CELLSPACING=0 CELLPADDING=5 border=1 >
+
+<TR VALIGN=TOP>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif" colspan=7><B>MODIFY EXISTING REQUESTS </b></TD>
+</TR>
+<form action=modrequest.pl method=post>
+<TR VALIGN=TOP>
+
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Rank</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Member</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Notes</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Date</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Pickup</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Request</b></TD>
+<td bgcolor="99cc33" background="/images/background-mem.gif"><B>Change To</b></TD>
+</TR>
+printend
+;
+$count--;
+
+for ($i=0;$i<$count;$i++){
+print "<input type=hidden name=borrower value=$reserves->[$i]{'borrowernumber'}>";
+print "<input type=hidden name=biblio value=$reserves->[$i]{'biblionumber'}>";
+#my $bor=$reserves->[$i]{'firstname'}."%20".$reserves->[$i]{'surname'};
+#$bor=~ s/ /%20/g;
+my $bor=$reserves->[$i]{'borrowernumber'};
+my @temp=split('-',$reserves->[$i]{'reservedate'});
+$date="$temp[2]/$temp[1]/$temp[0]";
+my $type=$reserves->[$i]{'constrainttype'};
+#print "test";
+if ($type eq 'a'){
+ $type='Next Available';
+} elsif ($type eq 'o'){
+# print "test";
+ my $res=getreservetitle($reserves->[$i]{'biblionumber'},$reserves->[$i]{'borrowernumber'},$reserves->[$i]{'reservedate'},$reserves->[$i]{'timestamp'});
+ $type="This type only $res->{'volumeddesc'} $res->{'itemtype'}";
+# my @data=ItemInfo(\$blah,$reserves->[$i]{'borrowernumber'});
+
+}
+print "<tr VALIGN=TOP >
+<TD><select name=rank-request>
+";
+for (my $i2=1;$i2<=$count;$i2++){
+ print "<option value=$i2";
+ if ($reserves->[$i]{'priority'} eq $i2){
+ print " selected";
+ }
+ print">$i2";
+}
+print "<option value=del>Del";
+print "</select>
+</td>
+<TD><a href=/cgi-bin/koha/moremember.pl?bornum=$bor>$reserves->[$i]{'firstname'} $reserves->[$i]{'surname'}</a></td>
+<td>$reserves->[$i]{'reservenotes'}</td>
+<TD>$date</td>
+<TD><select name=pickup>
+";
+my ($count2,@branches)=branches;
+for (my $i2=0;$i2<$count2;$i2++){
+ print "<option value=$branches[$i2]->{'branchcode'}";
+ if ($reserves->[$i]{'branchcode'} eq $branches[$i2]->{'branchcode'}){
+ print " Selected";
+ }
+ print ">$branches[$i2]->{'branchname'}\n";
+}
+print "
+</select>
+</td>
+<TD>$type</td>
+<TD><select name=itemtype>
+<option value=next>Next Available
+<option value=change>Change Selection
+<option value=nc >No Change
+</select>
+</td>
+</tr>
+";
+}
+print <<printend
+
+
+<tr VALIGN=TOP >
+
+<TD colspan=6 align=right>
+Delete a request by selecting "del" from the rank list.
+
+<INPUT TYPE="image" name="submit" VALUE="request" height=42 WIDTH=64 BORDER=0 src="/images/ok.gif"></td>
+
+
+</tr>
+
+
+</table>
+<P>
+
+<br>
+
+
+
+
+</form>
+printend
+;
+
+print endmenu();
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+#written 26/4/2000
+#script to display reports
+
+use C4::Stats;
+use strict;
+use Date::Manip;
+use CGI;
+use C4::Output;
+
+my $input=new CGI;
+my $time=$input->param('time');
+print $input->header;
+
+print startpage;
+print startmenu('report');
+print center;
+print mktablehdr();
+my ($count,$data)=unfilledreserves();
+print $count;
+for (my $i=0;$i<$count;$i++){
+ print mktablerow(4,'white',"$data->[$i]->{'surname'}\, $data->[$i]->{'firstname'}",$data->[$i]->{'reservedate'},$data->[$i]->{'title'},"$data->[$i]->{'classification'}$data->[$i]->{'dewey'}");
+}
+print mktableft();
+print endmenu('report');
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#written 26/4/2000
+#script to display reports
+
+use C4::Stats;
+use strict;
+use CGI;
+use C4::Output;
+
+my $input=new CGI;
+
+#print $input->header;
+
+#print startpage;
+#print startmenu('report');
+#print center;
+#print mktablehdr();
+my ($count,$data)=unfilledreserves();
+#print $count;
+for (my $i=0;$i<$count;$i++){
+# print mktablerow(4,'white',"$data->[$i]->{'surname'}\, $data->[$i]->{'firstname'}",$data->[$i]->{'reservedate'},$data->[$i]->{'title'},"$data->[$i]->{'classification'}$data->[$i]->{'dewey'}");
+ print "$data->[$i]->{'surname'}\'$data->[$i]->{'firstname'}\t$data->[$i]->{'reservedate'}\t$data->[$i]->{'title'}\t$data->[$i]->{'classification'}$data->[$i]->{'dewey'}$data->[$i]->{'subclass'}\n";
+}
+#print mktableft();
+#print endmenu('report');
+#print endpage;
--- /dev/null
+#!/usr/bin/perl
+#script to provide intranet (librarian) advanced search facility
+#modified 9/11/1999 by chris@katipo.co.nz
+#adding an extra comment to play with CVS (Si, 19/11/99)
+#modified 29/12/99 by chris@katipo.co.nz to be usavle by opac as well
+#modified by chris 10/11/00 to fix dewey search
+
+use strict;
+use C4::Search;
+use CGI;
+use C4::Output;
+
+my $env;
+my $input = new CGI;
+print $input->header;
+#print $input->dump;
+#whether it is called from the opac of the intranet
+my $type=$input->param('type');
+if ($type eq ''){
+ $type = 'intra';
+}
+my $ttype=$input->param('ttype');
+#setup colours
+my $main;
+my $secondary;
+if ($type eq 'opac'){
+ $main='#99cccc';
+ $secondary='#efe5ef';
+} else {
+ $main='#cccc99';
+ $secondary='#ffffcc';
+}
+
+#print $input->dump;
+my $blah;
+my %search;
+#build hash of users input
+my $title=validate($input->param('title'));
+$search{'title'}=$title;
+my $keyword=validate($input->param('keyword'));
+$search{'keyword'}=$keyword;
+$search{'front'}=validate($input->param('front'));
+my $author=validate($input->param('author'));
+$search{'author'}=$author;
+my $subject=validate($input->param('subject'));
+$search{'subject'}=$subject;
+my $itemnumber=validate($input->param('item'));
+$search{'item'}=$itemnumber;
+my $isbn=validate($input->param('isbn'));
+$search{'isbn'}=$isbn;
+my $datebefore=validate($input->param('date-before'));
+$search{'date-before'};
+my $class=$input->param('class');
+$search{'class'}=$class;
+$search{'ttype'}=$ttype;
+my $dewey=validate($input->param('dewey'));
+$search{'dewey'}=$dewey;
+my @results;
+my $offset=$input->param('offset');
+if ($offset eq ''){
+ $offset=0;
+}
+my $num=$input->param('num');
+if ($num eq ''){
+ $num=10;
+}
+print startpage();
+print startmenu($type);
+#print $search{'ttype'};
+if ($type ne 'opac'){
+ print mkheadr(1,'Catalogue Search Results');
+} else {
+ print mkheadr(1,'Opac Search Results');
+}
+print center();
+my $count;
+my @results;
+if ($itemnumber ne '' || $isbn ne ''){
+ ($count,@results)=&CatSearch(\$blah,'precise',\%search,$num,$offset);
+} else {
+ if ($subject ne ''){
+ ($count,@results)=&CatSearch(\$blah,'subject',\%search,$num,$offset);
+ } else {
+ if ($keyword ne ''){
+# print "hey";
+ ($count,@results)=&KeywordSearch(\$blah,'intra',\%search,$num,$offset);
+ } elsif ($search{'front'} ne '') {
+ ($count,@results)&FrontSearch(\$blah,'intra',\%search,$num,$offset);
+# print "hey";
+ }elsif ($title ne '' || $author ne '' || $dewey ne '' || $class ne '') {
+ ($count,@results)=&CatSearch(\$blah,'loose',\%search,$num,$offset);
+# print "hey";
+ }
+ }
+}
+print "You searched on ";
+while ( my ($key, $value) = each %search) {
+ if ($value ne '' && $key ne 'ttype'){
+ $value=~ s/\\//g;
+ print bold("$key $value,");
+ }
+}
+print " $count results found";
+my $offset2=$num+$offset;
+my $dispnum=$offset+1;
+print "<br> Results $dispnum to $offset2 displayed";
+print mktablehdr;
+if ($type ne 'opac'){
+ if ($subject ne ''){
+ print mktablerow(1,$main,'<b>SUBJECT</b>','/images/background-mem.gif');
+ } else {
+ print mktablerow(6,$main,'<b>TITLE</b>','<b>AUTHOR</b>',bold('©'),'<b>COUNT</b>',bold('LOCATION'),'','/images/background-mem.gif');
+ }
+} else {
+ if ($subject ne ''){
+ print mktablerow(6,$main,'<b>SUBJECT</b>',' ',' ');
+ } else {
+ print mktablerow(6,$main,'<b>TITLE</b>','<b>AUTHOR</b>',bold('©'),'<b>COUNT</b>',bold('BRANCH'),'');
+ }
+}
+my $count2=@results;
+if ($keyword ne '' && $offset > 0){
+ $count2=$count-$offset;
+ if ($count2 > 10){
+ $count2=10;
+ }
+}
+#print $count2;
+my $i=0;
+my $colour=1;
+while ($i < $count2){
+# print $results[$i]."\n";
+ my @stuff=split('\t',$results[$i]);
+ $stuff[1]=~ s/\`/\\\'/g;
+ my $title2=$stuff[1];
+ $title2=~ s/ /%20/g;
+ if ($subject eq ''){
+# print $stuff[0];
+ $stuff[1]=mklink("/cgi-bin/koha/detail.pl?type=$type&bib=$stuff[2]&title=$title2",$stuff[1]);
+ my $word=$stuff[0];
+# print $word;
+ $word=~ s/([a-z]) +([a-z])/$1%20$2/ig;
+ $word=~ s/ //g;
+ $word=~ s/ /%20/g;
+ $word=~ s/\,/\,%20/g;
+ $word=~ s/\n//g;
+ my $url="/cgi-bin/koha/search.pl?author=$word&type=$type";
+ $stuff[0]=mklink($url,$stuff[0]);
+ my ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount)=itemcount($env,$stuff[2],$type);
+ $stuff[4]=$count;
+ if ($nacount > 0){
+ $stuff[5]=$stuff[5]."On Loan";
+ if ($nacount >1 ){
+ $stuff[5]=$stuff[5]." ($nacount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($lcount > 0){
+ $stuff[5]=$stuff[5]."Levin";
+ if ($lcount >1 ){
+ $stuff[5]=$stuff[5]." ($lcount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($fcount > 0){
+ $stuff[5]=$stuff[5]."Foxton";
+ if ($fcount >1 ){
+ $stuff[5]=$stuff[5]." ($fcount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($scount > 0){
+ $stuff[5]=$stuff[5]."Shannon";
+ if ($scount >1 ){
+ $stuff[5]=$stuff[5]." ($scount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($lostcount > 0){
+ $stuff[5]=$stuff[5]."Lost";
+ if ($lostcount >1 ){
+ $stuff[5]=$stuff[5]." ($lostcount)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($mending > 0){
+ $stuff[5]=$stuff[5]."Mending";
+ if ($mending >1 ){
+ $stuff[5]=$stuff[5]." ($mending)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($transit > 0){
+ $stuff[5]=$stuff[5]."In Transiit";
+ if ($transit >1 ){
+ $stuff[5]=$stuff[5]." ($transit)";
+ }
+ $stuff[5].=" ";
+ }
+ if ($ocount > 0){
+ $stuff[5]=$stuff[5]."On Order";
+ if ($ocount >1 ){
+ $stuff[5]=$stuff[5]." ($ocount)";
+ }
+ $stuff[5].=" ";
+ }
+
+ if ($type ne 'opac'){
+ $stuff[6]=mklink("/cgi-bin/koha/request.pl?bib=$stuff[2]","Request");
+ }
+ } else {
+ my $word=$stuff[1];
+ $word=~ s/ /%20/g;
+
+ $stuff[1]=mklink("/cgi-bin/koha/subjectsearch.pl?subject=$word&type=$type",$stuff[1]);
+
+ }
+
+ if ($colour == 1){
+ print mktablerow(6,$secondary,$stuff[1],$stuff[0],$stuff[3],$stuff[4],$stuff[5],$stuff[6]);
+ $colour=0;
+ } else{
+ print mktablerow(6,'white',$stuff[1],$stuff[0],$stuff[3],$stuff[4],$stuff[5],$stuff[6]);
+ $colour=1;
+ }
+ $i++;
+}
+$offset=$num+$offset;
+if ($type ne 'opac'){
+ print mktablerow(6,$main,' ',' ',' ',' ','','','/images/background-mem.gif');
+} else {
+ print mktablerow(6,$main,' ',' ',' ',' ','','');
+}
+print mktableft();
+my $search;
+
+ $search="num=$num&offset=$offset&type=$type";
+ if ($subject ne ''){
+ $subject=~ s/ /%20/g;
+ $search=$search."&subject=$subject";
+ }
+ if ($title ne ''){
+ $title=~ s/ /%20/g;
+ $search=$search."&title=$title";
+ }
+ if ($author ne ''){
+ $author=~ s/ /%20/g;
+ $search=$search."&author=$author";
+ }
+ if ($keyword ne ''){
+ $keyword=~ s/ /%20/g;
+ $search=$search."&keyword=$keyword";
+ }
+ if ($class ne ''){
+ $keyword=~ s/ /%20/g;
+ $search=$search."&class=$class";
+ }
+ if ($dewey ne ''){
+ $search=$search."&dewey=$dewey";
+ }
+ $search.="&ttype=$ttype";
+if ($offset < $count){
+ my $stuff=mklink("/cgi-bin/koha/search.pl?$search",'Next');
+ print $stuff;
+}
+print "<br>";
+my $pages=$count/10;
+$pages++;
+for (my $i=1;$i<$pages;$i++){
+ my $temp=$i*10;
+ $temp=$temp-10;
+ $search=~ s/offset=[0-9]+/offset=$temp/;
+ my $stuff=mklink("/cgi-bin/koha/search.pl?$search",$i);
+ print "$stuff ";
+}
+
+print endcenter();
+print endmenu($type);
+print endpage();
+
+
+sub validate {
+ my ($input)=@_;
+ $input=~ s/\<[a-z]+\>//gi;
+ $input=~ s/\<\/[a-z]+\>//gi;
+ $input=~ s/\<//g;
+ $input=~ s/\>//g;
+ $input=~ s/^%//g;
+ return($input);
+}
--- /dev/null
+#!/usr/bin/perl
+
+#written 11/1/2000 by chris@katipo.co.nz
+#script to write off accounts
+
+use strict;
+use CGI;
+use C4::Database;
+my $input=new CGI;
+
+#print $input->header;
+#print $input->dump;
+
+my%inp;
+
+my @name=$input->param;
+for (my $i=0;$i<@name;$i++){
+ my $test=$input->param($name[$i]);
+ if ($test eq 'wo'){
+ my $temp=$name[$i];
+ $temp=~ s/payfine//;
+ $inp{$name[$i]}=$temp;
+ }
+}
+my $bornum;
+while ( my ($key, $value) = each %inp){
+# print $key,$value;
+ my $accounttype=$input->param("accounttype$value");
+ $bornum=$input->param("bornum$value");
+ my $itemno=$input->param("itemnumber$value");
+ my $amount=$input->param("amount$value");
+ if ($accounttype eq 'Res'){
+ my $accountno=$input->param("accountno$value");
+ writeoff($bornum,$accountno,$itemno,$accounttype,$amount);
+ } else {
+ writeoff($bornum,'',$itemno,$accounttype,$amount);
+ }
+}
+#print $input->header;
+$bornum=$input->param('bornum');
+print $input->redirect("/cgi-bin/koha/pay.pl?bornum=$bornum");
+
+#needs to be shifted to a module when time permits
+sub writeoff{
+ my ($bornum,$accountnum,$itemnum,$accounttype,$amount)=@_;
+ my $dbh=C4Connect;
+ my $query="Update accountlines set amountoutstanding=0 where ";
+ if ($accounttype eq 'Res'){
+ $query.="accounttype='Res' and accountno='$accountnum' and borrowernumber='$bornum'";
+ } else {
+ $query.="accounttype='$accounttype' and itemnumber='$itemnum' and borrowernumber='$bornum'";
+ }
+ my $sth=$dbh->prepare($query);
+# print $query;
+ $sth->execute;
+ $sth->finish;
+ $query="select max(accountno) from accountlines";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $account=$sth->fetchrow_hashref;
+ $sth->finish;
+ $account->{'max(accountno)'}++;
+ $query="insert into accountlines (borrowernumber,accountno,itemnumber,date,amount,description,accounttype)
+ values ('$bornum','$account->{'max(accountno)'}','$itemnum',now(),'$amount','Writeoff','W')";
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+# print $query;
+ $dbh->disconnect;
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to show list of budgets and bookfunds
+#written 4/2/00 by chris@katipo.co.nz
+#called as an include by the acquisitions index page
+
+use C4::Acquisitions;
+#use CGI;
+#my $inp=new CGI;
+#print $inp->header;
+my ($count,@results)=bookfunds;
+
+open (FILE,'>/usr/local/www/hdl/htdocs/includes/budgets.inc') || die "Cant open file";
+print FILE <<printend
+
+<TABLE width="40%" cellspacing=0 cellpadding=5 border=1 >
+<FORM ACTION="/cgi-bin/koha/search.pl">
+<TR VALIGN=TOP>
+<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2><b>BUDGETS AND BOOKFUNDS</b></TD></TR>
+<TR VALIGN=TOP>
+<TD colspan=2><table>
+
+
+<tr><td>
+<b>Budgets</B></TD> <TD><b>Total</B></TD> <TD><b>Spent</B></TD><TD><b>Comtd</B></TD><TD><b>Avail</B></TD></TR>
+printend
+;
+my $total=0;
+my $totspent=0;
+my $totcomtd=0;
+my $totavail=0;
+for (my $i=0;$i<$count;$i++){
+ my ($spent,$comtd)=bookfundbreakdown($results[$i]->{'bookfundid'});
+ my $avail=$results[$i]->{'budgetamount'}-($spent+$comtd);
+ print FILE <<EOP
+<tr><td>
+$results[$i]->{'bookfundname'} </TD>
+<TD>$results[$i]->{'budgetamount'}</TD> <TD>
+EOP
+;
+printf FILE ("%.2f", $spent);
+print FILE "</TD><TD>";
+printf FILE ("%.2f",$comtd);
+print FILE "</TD><TD>";
+printf FILE ("%.2f",$avail);
+print FILE "</TD></TR>";
+ $total+=$results[$i]->{'budgetamount'};
+ $totspent+=$spent;
+ $totcomtd+=$comtd;
+ $totavail+=$avail;
+}
+
+print FILE <<printend
+<tr><td colspan=5>
+<hr size=1 noshade></TD></TR>
+
+<tr><td>
+Total </TD> <TD>$total</TD> <TD>
+printend
+;
+printf FILE ("%.2f",$totspent);
+print FILE "</TD><TD>";
+printf FILE ("%.2f",$totcomtd);
+print FILE "</TD><TD>";
+printf FILE ("%.2f",$totavail);
+print FILE "</TD></TR>";
+print FILE <<printend
+</table><br>
+Use your reload button [ctrl + r] to get the most recent figures.
+Committed figures are approximate only, as exchange rates will affect the amount actually paid.
+
+</TD></TR>
+</form>
+</table>
+
+printend
+;
+
+close FILE;
--- /dev/null
+#!/usr/bin/perl
+
+#simple script to provide basic redirection
+#used by members section
+
+use CGI;
+use strict;
+
+my $input=new CGI;
+
+my $choice=$input->param('chooseform');
+
+if ($choice eq 'adult'){
+ print $input->redirect("/cgi-bin/koha/memberentry.pl?type=Add");
+}
+
+if ($choice eq 'organisation'){
+ print $input->redirect("/cgi-bin/koha/imemberentry.pl?type=Add");
+}
--- /dev/null
+#!/usr/bin/perl
+
+#written 14/1/2000
+#script to display reports
+
+use C4::Stats;
+use strict;
+use Date::Manip;
+use CGI;
+use C4::Output;
+
+my $input=new CGI;
+my $time=$input->param('time');
+print $input->header;
+
+print startpage;
+print startmenu('report');
+print center;
+
+my $date;
+my $date2;
+if ($time eq 'yesterday'){
+ $date=ParseDate('yesterday');
+ $date2=ParseDate('today');
+}
+if ($time eq 'today'){
+ $date=ParseDate('today');
+ $date2=ParseDate('tomorrow');
+}
+if ($time eq 'daybefore'){
+ $date=ParseDate('2 days ago');
+ $date2=ParseDate('yesterday');
+}
+if ($time=~ /\//){
+ $date=ParseDate($time);
+ $date2=ParseDateDelta('+ 1 day');
+ $date2=DateCalc($date,$date2);
+}
+$date=UnixDate($date,'%Y-%m-%d');
+$date2=UnixDate($date2,'%Y-%m-%d');
+my @payments=TotalPaid($date);
+my $count=@payments;
+my $total=0;
+my %levin;
+my %foxton;
+my %shannon;
+my $oldtime;
+#my $totalc=0;
+#my $totalcf=0;
+print mktablehdr;
+print mktablerow(5,'#99cc33',bold('Name'),bold('Type'),bold('Date/time'),bold('Amount'), bold('Branch'),'/images/background-mem.gif');
+for (my $i=0;$i<$count;$i++){
+ my $hour=substr($payments[$i]{'timestamp'},8,2);
+ my $min=substr($payments[$i]{'timestamp'},10,2);
+ my $sec=substr($payments[$i]{'timestamp'},12,2);
+ my $time="$hour:$min:$sec";
+ $payments[$i]{'amount'}*=-1;
+ $total+=$payments[$i]{'amount'};
+ my @charges=getcharges($payments[$i]{'borrowernumber'},$payments[$i]{'timestamp'});
+ my $count=@charges;
+ my $temptotalf=0;
+ my $temptotalr=0;
+ my $temptotalres=0;
+ my $temptotalren=0;
+ for (my $i2=0;$i2<$count;$i2++){
+ if ($charges[$i2]->{'amountoutstanding'} != $oldtime){
+ print mktablerow(6,'red',$charges[$i2]->{'description'},$charges[$i2]->{'accounttype'},'',
+ $charges[$i2]->{'amount'},$charges[$i2]->{'amountoutstanding'});
+ if ($charges[$i2]->{'accounttype'} eq 'Rent'){
+ $temptotalr+=$charges[$i2]->{'amount'}-$charges[$i2]->{'amountoutstanding'};
+ }
+ if ($charges[$i2]->{'accounttype'} eq 'F' || $charges[$i2]->{'accounttype'} eq 'FU'){
+ $temptotalf+=$charges[$i2]->{'amount'}-$charges[$i2]->{'amountoutstanding'};
+ }
+ if ($charges[$i2]->{'accounttype'} eq 'Res'){
+ $temptotalres+=$charges[$i2]->{'amount'}-$charges[$i2]->{'amountoutstanding'};
+ }
+ if ($charges[$i2]->{'accounttype'} eq 'R'){
+ $temptotalren+=$charges[$i2]->{'amount'}-$charges[$i2]->{'amountoutstanding'};
+ }
+ }
+ }
+ my $time2="$payments[$i]{'date'} $time";
+ my $branch=Getpaidbranch($time2);
+ if ($branch eq 'C'){
+ $levin{'total'}+=$payments[$i]{'amount'};
+ $levin{'totalr'}+=$temptotalr;
+ $levin{'totalres'}+=$temptotalres;
+ $levin{'totalf'}+=$temptotalf;
+ $levin{'totalren'}+=$temptotalren;
+ }
+ if ($branch eq 'F'){
+ $foxton{'total'}+=$payments[$i]{'amount'};
+ $foxton{'totalr'}+=$temptotalr;
+ $foxton{'totalres'}+=$temptotalres;
+ $foxton{'totalf'}+=$temptotalf;
+ $foxton{'totalren'}+=$temptotalren;
+ }
+ if ($branch eq 'S'){
+ $shannon{'total'}+=$payments[$i]{'amount'};
+ $shannon{'totalr'}+=$temptotalr;
+ $shannon{'totalres'}+=$temptotalres;
+ $shannon{'totalf'}+=$temptotalf;
+ $shannon{'totalren'}+=$temptotalren;
+ }
+ print mktablerow(6,'white',"$payments[$i]{'firstname'} <b>$payments[$i]{'surname'}</b>"
+ ,$payments[$i]{'accounttype'},"$payments[$i]{'date'} $time",$payments[$i]{'amount'}
+ ,$branch);
+ $oldtime=$payments[$i]{'timestamp'};
+}
+print mktableft;
+print endcenter;
+print "<p><b>$total</b>";
+#print "<b
+print mktablehdr;
+$levin{'issues'}=Count('issue','C',$date,$date2);
+$foxton{'issues'}=Count('issue','F',$date,$date2);
+$shannon{'issues'}=Count('issue','S',$date,$date2);
+$levin{'returns'}=Count('return','C',$date,$date2);
+$foxton{'returns'}=Count('return','F',$date,$date2);
+$shannon{'returns'}=Count('return','S',$date,$date2);
+print mktablerow(9,'white',"<b>Levin</b>","Fines $levin{'totalf'}","Rental Charges $levin{'totalr'}",
+"Reserve Charges $levin{'totalres'}","Renewal Charges $levin{'totalren'}","Total $levin{'total'}",
+"Issues $levin{'issues'}","Renewals $levin{'renewals'}","Returns $levin{'returns'}");
+print mktablerow(9,'white',"<b>foxton</b>","Fines $foxton{'totalf'}","Rental Charges $foxton{'totalr'}","Reserve Charges $foxton{'totalres'}","Renewal Charges $foxton{'totalren'}","Total $foxton{'total'}",
+"Issues $foxton{'issues'}","Renewals $foxton{'renewals'}","Returns $foxton{'returns'}");
+print mktablerow(9,'white',"<b>shannon</b>","Fines $shannon{'totalf'}","Rental Charges $shannon{'totalr'}","Reserve Charges $shannon{'totalres'}","Renewal Charges $shannon{'totalren'}","Total $shannon{'total'}",
+"Issues $shannon{'issues'}","Renewals $shannon{'renewals'}","Returns $shannon{'returns'}");
+print mktableft;
+
+
+print endmenu('report');
+print endpage;
--- /dev/null
+#!/usr/bin/perl
+
+#written 14/1/2000
+#script to display reports
+
+use C4::Stats;
+use strict;
+use Date::Manip;
+use CGI;
+use C4::Output;
+use DBI;
+use C4::Database;
+
+my $input=new CGI;
+my $time=$input->param('time');
+print $input->header;
+
+print startpage;
+print startmenu('report');
+print center;
+
+my $date;
+my $date2;
+if ($time eq 'yesterday'){
+ $date=ParseDate('yesterday');
+ $date2=ParseDate('today');
+}
+if ($time eq 'today'){
+ $date=ParseDate('today');
+ $date2=ParseDate('tomorrow');
+}
+if ($time eq 'daybefore'){
+ $date=ParseDate('2 days ago');
+ $date2=ParseDate('yesterday');
+}
+if ($time=~ /\//){
+ $date=ParseDate($time);
+ $date2=ParseDateDelta('+ 1 day');
+ $date2=DateCalc($date,$date2);
+}
+$date=UnixDate($date,'%Y-%m-%d');
+$date2=UnixDate($date2,'%Y-%m-%d');
+
+my $dbh=C4Connect;
+my $query="select *
+from accountlines,accountoffsets,borrowers where
+accountlines.borrowernumber=accountoffsets.borrowernumber and
+(accountlines.accountno=accountoffsets.accountno or accountlines.accountno
+=accountoffsets.offsetaccount) and accountlines.timestamp >=20000621000000
+and borrowers.borrowernumber=accountlines.borrowernumber
+group by accountlines.borrowernumber,accountlines.accountno";
+my $sth=$dbh->prepare($query);
+$sth->execute;
+
+
+
+print mktablehdr;
+while (my $data=$sth->fetchrow_hashref){
+ print "<TR><Td>$data->{'surname'}</td><td>$data->{'description'}</td><td>$data->{'amount'}
+ </td>";
+ if ($data->{'accountype'}='Pay'){
+ my $branch=Getpaidbranch($data->{'timestamp'});
+ print "<td>$branch</td>";
+ }
+ print "</tr>";
+
+}
+
+
+print mktableft;
+print endcenter;
+#print "<p><b>$total</b>";
+
+
+
+print endmenu('report');
+print endpage;
+$sth->finish;
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+#script to display detailed information
+#written 8/11/99
+
+use strict;
+#use DBI;
+use C4::Search;
+use CGI;
+use C4::Output;
+
+my $input = new CGI;
+print $input->header;
+my $type=$input->param('type');
+print startpage();
+print startmenu($type);
+my $blah;
+my $env;
+my $subject=$input->param('subject');
+#my $title=$input->param('title');
+
+my $main;
+my $secondary;
+if ($type eq 'opac'){
+ $main='#99cccc';
+ $secondary='#efe5ef';
+} else {
+ $main='#99cc33';
+ $secondary='#ffffcc';
+}
+
+my @items=subsearch(\$blah,$subject);
+#print @items;
+my $count=@items;
+my $i=0;
+print center();
+print mktablehdr;
+if ($type ne 'opac'){
+ print mktablerow(5,$main,bold('TITLE'),bold('AUTHOR'),bold('COUNT'),bold('LOCATION'),' ',"/images/background-mem.gif");
+} else {
+ print mktablerow(5,$main,bold('TITLE'),bold('AUTHOR'),bold('COUNT'),bold('BRANCH'),' ');
+}
+my $colour=1;
+while ($i < $count){
+ my @results=split('\t',$items[$i]);
+ $results[0]=mklink("/cgi-bin/koha/detail.pl?bib=$results[2]&type=$type",$results[0]);
+ my $word=$results[1];
+ $word=~ s/ //g;
+ $word=~ s/\,/\,%20/;
+ $results[1]=mklink("/cgi-bin/koha/search.pl?author=$word&type=$type",$results[1]);
+ my ($count,$lcount,$nacount,$fcount,$scount)=itemcount($env,$results[2]);
+ $results[3]=$count;
+ if ($nacount > 0){
+ $results[4]=$results[4]."On Loan";
+ if ($nacount > 1){
+ $results[4].=" $nacount";
+ }
+ $results[4].=" ";
+ }
+ if ($lcount > 0){
+ $results[4]=$results[4]." Levin";
+ if ($lcount > 1){
+ $results[4].=" $lcount";
+ }
+ $results[4].=" ";
+ }
+ if ($fcount > 0){
+ $results[4]=$results[4]." Foxton";
+ if ($fcount > 1){
+ $results[4].=" $fcount";
+ }
+ $results[4].=" ";
+ }
+ if ($scount > 0){
+ $results[4]=$results[4]." Shannon";
+ if ($scount > 1){
+ $results[4].=" $scount";
+ }
+ $results[4].=" ";
+ }
+ if ($type ne 'opac'){
+ $results[6]=mklink("/cgi-bin/koha/request.pl?bib=$results[2]","Request");
+ }
+ if ($colour == 1){
+ print mktablerow(5,$secondary,$results[0],$results[1],$results[3],$results[4],$results[6]);
+ $colour=0;
+ } else{
+ print mktablerow(5,'white',$results[0],$results[1],$results[3],$results[4],$results[6]);
+ $colour=1;
+ }
+ $i++;
+}
+print endcenter();
+print mktableft();
+print endmenu($type);
+print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+use DBI;
+use C4::Database;
+use C4::Circulation::Issues;
+use C4::Circulation::Main;
+use C4::InterfaceCDK;
+use C4::Circulation::Borrower;
+
+# my @args=('issuewrapper.pl',"$env{'branchcode'}","$env{'usercode'}","$env{'telnet'}","$env{'queue'}","$env{'printtype'}");
+my %env = (
+ branchcode => $ARGV[0], usercode => $ARGV[1], proccode => "lgon", borrowernumber => "",
+ logintime => "", lasttime => $ARGV[6], tempuser => "", debug => "9",
+ telnet => $ARGV[2], queue => $ARGV[3], printtype => $ARGV[4], brdata => $ARGV[5], bcard=>$ARGV[7]
+ );
+my ($env) = \%env;
+
+startint();
+ helptext('');
+my $done;
+my ($items,$items2,$amountdue);
+my $itemsdet;
+$env->{'sysarea'} = "Issues";
+$done = "Issues";
+my $i=0;
+my $dbh=&C4Connect;
+ my ($bornum,$issuesallowed,$borrower,$reason,$amountdue) = C4::Circulation::Borrower::findborrower($env,$dbh);
+# my $time=localtime(time);
+# open (FILE,">>/tmp/$<_$ARGV[6]");
+# print FILE "borrower found $bornum";
+# close FILE;
+ $env->{'loanlength'}="";
+ if ($reason ne "") {
+ $done = $reason;
+ } elsif ($env->{'IssuesAllowed'} eq '0') {
+ error_msg($env,"No Issues Allowed =$env->{'IssuesAllowed'}");
+ } else {
+ $env->{'bornum'} = $bornum;
+ $env->{'bcard'} = $borrower->{'cardnumber'};
+ ($items,$items2)=C4::Circulation::Main::pastitems($env,$bornum,$dbh); #from Circulation.pm
+ $done = "No";
+ my $it2p=0;
+ while ($done eq 'No'){
+ ($done,$items2,$it2p,$amountdue,$itemsdet) = C4::Circulation::Issues::processitems($env,$bornum,$borrower,$items,$items2,$it2p,$amountdue,$itemsdet);
+ }
+
+ }
+ if ($done ne 'Issues'){
+ $dbh->disconnect;
+ die "test";
+ }
+$dbh->disconnect;
--- /dev/null
+#!/usr/bin/perl
+
+#my @args=('issuewrapper.pl',"$env{'branchcode'}","$env{'usercode'}","$env{'telnet'}","$env{'queue'}","$env{'printtype'}");
+
+$done = "Issues";
+my $i=0;
+while ($done eq "Issues") {
+ my @args=('startint.pl',@ARGV);
+ eval{system(@args)};
+ $exit_value = $? >> 8;
+ if ($exit_value){
+ $done=$exit_value;
+ }
+
+}
--- /dev/null
+#!/usr/bin/perl
+
+use DBI;
+use C4::Database;
+use C4::Accounts;
+use C4::InterfaceCDK;
+use C4::Circulation::Main;
+use C4::Format;
+use C4::Scan;
+use C4::Stats;
+use C4::Search;
+use C4::Print;
+use C4::Circulation::Returns;
+
+
+my %env = (
+branchcode => $ARGV[0], usercode => $ARGV[1], proccode => "lgon", borrowernumber => "",
+logintime => "", lasttime => "", tempuser => "", debug => "9",
+telnet => $ARGV[2], queue => $ARGV[3], printtype => $ARGV[4], brdata => $ARGV[5]
+);
+my $env=\%env;
+
+
+my $dbh=&C4Connect;
+my @items;
+@items[0]=" "x50;
+my $reason;
+my $item;
+my $reason;
+my $borrower;
+my $itemno;
+my $itemrec;
+my $bornum;
+my $amt_owing;
+my $odues;
+my $issues;
+my $resp;
+startint();
+until ($reason ne "") {
+ ($reason,$item) = returnwindow($env,"Enter Returns",$item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
+ if ($reason eq "") {
+ $resp = "";
+ ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) = C4::Circulation::Returns::checkissue($env,$dbh,$item);
+ if ($bornum ne "") {
+ ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
+ } else {
+ $issues = "";
+ $odues = "";
+ $amt_owing = "";
+ }
+ if ($resp ne "") {
+ if ($itemno ne "" ) {
+ my $item = itemnodata($env,$dbh,$itemno);
+ my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
+ unshift @items,$fmtitem;
+ if ($items[20] > "") {
+ pop @items;
+ }
+ }
+ }
+ }
+}
+die;
+$dbh->disconnect;
+
+
--- /dev/null
+#!/usr/bin/perl
+
+#my @args=('issuewrapper.pl',"$env{'branchcode'}","$env{'usercode'}","$env{'telnet'}","$env{'queue'}","$env{'printtype'}");
+
+$done = "Issues";
+my $i=0;
+my $bcard;
+while ($done eq "Issues") {
+ my @args=('borrwraper.pl',@ARGV,$bcard);
+ my $time=localtime(time);
+ open (FILE,">>/tmp/$<_$ARGV[6]");
+ print FILE "new borrower $time\n";
+ close FILE;
+ eval{$bcard=system(@args)};
+ $exit_value = $? >> 8;
+ if ($exit_value){
+ $done=$exit_value;
+ }
+
+}
--- /dev/null
+#!/usr/bin/perl
+
+$done = "returns";
+my $i=0;
+while ($done eq "returns") {
+ my @args=('doreturns.pl',@ARGV);
+ eval{system(@args)};
+ $exit_value = $? >> 8;
+ if ($exit_value){
+ $done=$exit_value;
+ }
+
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+#use C4::Security;
+#use C4::Database;
+use C4::Circulation::Main;
+#use C4::Circulation::Issues;
+#use C4::Circulation::Returns;
+#use C4::Circulation::Renewals;
+#use C4::Circulation::Borrower;
+#use C4::Reserves;
+use C4::InterfaceCDK;
+#use C4::Security;
+
+
+# set up environment array
+# branchcode - logged on branch
+# usercode - current user
+# proccode - current or last procedure
+# borrowernumber - current or last borrowernumber
+# logintime - time logged on
+# lasttime - lastime security checked
+# tempuser - temporary user
+my %env = (
+ branchcode => "", usercode => "", proccode => "lgon", borrowernumber => "",
+ logintime => "", lasttime => "", tempuser => "", debug => "9"
+ );
+
+$env{'branchcode'} = "C";
+$env{'usercode'} = `whoami`;
+$env{'telnet'} = "Y";
+
+
+#start interface
+&startint(\%env,'Circulation');
+getbranch(\%env);
+getprinter(\%env);
+my $donext = 'Circ';
+my $reason;
+my $data;
+while ($donext ne 'Quit') {
+ if ($donext eq "Circ") {
+ ($reason,$data) = menu(\%env,'console','Circulation',
+ ('Issues','Returns','Select Branch','Select Printer'));
+ } else {
+ $data = $donext;
+ }
+ if ($data eq 'Issues') {
+ my @args=('issuewrapper.pl',"$env{'branchcode'}","$env{'usercode'}","$env{'telnet'}","$env{'queue'}","$env{'printtype'}","$env{'brdata'}","$env{'lasttime'}");
+ open (FILE,">>/tmp/$<_$$");
+ my $time=localtime(time);
+ print FILE "Start issues $time \n";
+ close FILE;
+ system(@args);
+ } elsif ($data eq 'Returns') {
+ my @args=('returnswrapper.pl',"$env{'branchcode'}","$env{'usercode'}","$env{'telnet'}","$env{'queue'}","$env{'printtype'}","$env{'brdata'}");
+ open (FILE,">>/tmp/$<_$$");
+ my $time=localtime(time);
+ print FILE "Start returns $time \n";
+ close FILE;
+ system(@args);
+# $donext=Returns(\%env); #C4::Circulation::Returns
+ } elsif ($data eq 'Select Branch') {
+ getbranch(\%env);
+ } elsif ($data eq 'Select Printer') {
+ getprinter(\%env);
+# } elsif ($data eq 'Borrower Enquiries') {
+ # $donext=Borenq($env); #C4::Circulation::Borrower - conversion
+# } elsif ($data eq 'Reserves'){
+# $donext=EnterReserves(\%env); #C4::Reserves
+ } elsif ($data eq 'Quit') {
+ $donext = $data;
+ &endint(\%env);
+ die;
+ }
+}
+ &endint(\%env);
+ die;
--- /dev/null
+#!/usr/bin/perl
+#
+# written 31/5/00 by chris@katipo.co.nz to make a way to fix account mistakes
+#
+
+use strict;
+use C4::Database;
+use CGI;
+use C4::Accounts2;
+
+my $input=new CGI;
+
+#print $input->header();
+#print $input->dump;
+
+my $bornum=$input->param('bornum');
+
+my @name=$input->param;
+
+foreach my $key (@name){
+ if ($key ne 'bornum'){
+ my $temp=$input->param($key);
+
+# print $temp,$key;
+ if ($temp ne ''){
+ fixaccounts($bornum,$key,$temp);
+
+ }
+ }
+}
+
+print $input->redirect("boraccount.pl?bornum=$bornum");
--- /dev/null
+#!/usr/bin/perl
+
+use C4::Database;
+use CGI;
+use strict;
+use C4::Acquisitions;
+use C4::Output;
+use C4::Search;
+
+my $input= new CGI;
+#print $input->header;
+#print $input->dump;
+
+
+my $bibitemnum=checkinp($input->param('bibitemnum'));
+my $bibnum=checkinp($input->param('bibnum'));
+my $itemtype=checkinp($input->param('Item'));
+my $isbn=checkinp($input->param('ISBN'));
+my $publishercode=checkinp($input->param('Publisher'));
+my $publicationdate=checkinp($input->param('Publication'));
+my $class=checkinp($input->param('Class'));
+my $classification;
+my $dewey;
+my $subclass;
+if ($itemtype ne 'NF'){
+ $classification=$class;
+}
+if ($class =~/[0-9]+/){
+# print $class;
+ $dewey= $class;
+ $dewey=~ s/[a-z]+//gi;
+ my @temp;
+ if ($class =~ /\./){
+ @temp=split(/[0-9]+\.[0-9]+/,$class);
+ } else {
+ @temp=split(/[0-9]+/,$class);
+ }
+ $classification=$temp[0];
+ $subclass=$temp[1];
+# print $classification,$dewey,$subclass;
+}else{
+ $dewey='';
+}
+my $illus=checkinp($input->param('Illustrations'));
+my $pages=checkinp($input->param('Pages'));
+my $volumeddesc=checkinp($input->param('Volume'));
+my $notes=checkinp($input->param('Notes'));
+my $size=checkinp($input->param('Size'));
+my $place=checkinp($input->param('Place'));
+my (@items)=itemissues($bibitemnum);
+#print @items;
+my $count=@items;
+#print $count;
+my @barcodes;
+
+
+my $existing=$input->param('existing');
+if ($existing eq 'YES'){
+# print "yes";
+ my $group=$input->param('existinggroup');
+ #go thru items assing selected ones to group
+ for (my $i=0;$i<$count;$i++){
+ my $temp="check_group_".$items[$i]->{'barcode'};
+ my $barcode=$input->param($temp);
+ if ($barcode ne ''){
+ moditem($items[$i]->{'notforloan'},$items[$i]->{'itemnumber'},$group);
+# print "modify $items[$i]->{'itemnumber'} $group";
+ }
+ }
+ $bibitemnum=$group;
+} else {
+ my $flag;
+ my $flag2;
+ for (my $i=0;$i<$count;$i++){
+ my $temp="check_group_".$items[$i]->{'barcode'};
+ $barcodes[$i]=$input->param($temp);
+ if ($barcodes[$i] eq ''){
+ $flag="notall";
+ } else {
+ $flag2="leastone";
+ }
+ }
+ my $loan;
+ if ($flag eq 'notall' && $flag2 eq 'leastone'){
+ $bibitemnum=newbiblioitem($bibnum,$itemtype,$volumeddesc,$classification);
+ modbibitem($bibitemnum,$itemtype,$isbn,$publishercode,$publicationdate,$classification,$dewey,$subclass,$illus,$pages,$volumeddesc,$notes,$size,$place);
+ if ($itemtype =~ /REF/){
+ $loan=1;
+ } else {
+ $loan=0;
+ }
+ for (my $i=0;$i<$count;$i++){
+ if ($barcodes[$i] ne ''){
+ moditem($loan,$items[$i]->{'itemnumber'},$bibitemnum);
+ }
+ }
+
+ } elsif ($flag2 eq 'leastone') {
+ modbibitem($bibitemnum,$itemtype,$isbn,$publishercode,$publicationdate,$classification,$dewey,$subclass,$illus,$pages,$volumeddesc,$notes,$size,$place);
+ if ($itemtype =~ /REF/){
+ $loan=1;
+ } else {
+ $loan=0;
+ }
+ for (my $i=0;$i<$count;$i++){
+ if ($barcodes[$i] ne ''){
+ moditem($loan,$items[$i]->{'itemnumber'},$bibitemnum);
+ }
+ }
+
+ }
+}
+print $input->redirect("moredetail.pl?type=intra&bib=$bibnum&bi=$bibitemnum");
+
+
+sub checkinp{
+ my ($inp)=@_;
+ $inp=~ s/\'/\\\'/g;
+ $inp=~ s/\"/\\\"/g;
+ return($inp);
+}
--- /dev/null
+#!/usr/bin/perl
+
+use C4::Database;
+use CGI;
+use strict;
+use C4::Acquisitions;
+use C4::Output;
+
+my $input= new CGI;
+#print $input->header;
+#print $input->dump;
+
+
+my $title=checkinp($input->param('Title'));
+my $author=checkinp($input->param('Author'));
+my $bibnum=checkinp($input->param('bibnum'));
+my $copyright=checkinp($input->param('Copyright'));
+my $seriestitle=checkinp($input->param('Series'));
+my $serial=checkinp($input->param('Serial'));
+my $unititle=checkinp($input->param('Unititle'));
+my $notes=checkinp($input->param('Notes'));
+
+modbiblio($bibnum,$title,$author,$copyright,$seriestitle,$serial,$unititle,$notes);
+
+my $subtitle=checkinp($input->param('Subtitle'));
+modsubtitle($bibnum,$subtitle);
+
+my $subject=checkinp($input->param('Subject'));
+$subject=uc $subject;
+my @sub=split(/\|/,$subject);
+#print @sub;
+#
+
+my $addauthor=checkinp($input->param('Additional'));
+modaddauthor($bibnum,$addauthor);
+my $count1=@sub;
+
+for (my $i=0; $i<$count1; $i++){
+ $sub[$i]=~ s/ +$//;
+}
+
+#print $input->header;
+my $force=$input->param('Force');
+my $error=modsubject($bibnum,$force,@sub);
+
+if ($error ne ''){
+ print $input->header;
+ print startpage();
+ print startmenu();
+ print $error;
+ my @subs=split('\n',$error);
+ print "<p> Click submit to force the subject";
+ my @names=$input->param;
+ my %data;
+ my $count=@names;
+ for (my $i=0;$i<$count;$i++){
+ if ($names[$i] ne 'Force'){
+ my $value=$input->param("$names[$i]");
+ $data{$names[$i]}="hidden\t$value\t$i";
+ }
+ }
+ $data{"Force"}="hidden\t$subs[0]\t$count";
+ print mkform3('updatebiblio.pl',%data);
+ print endmenu();
+ print endpage();
+} else {
+ print $input->redirect("detail.pl?type=intra&bib=$bibnum");
+}
+
+sub checkinp{
+ my ($inp)=@_;
+ $inp=~ s/\'/\\\'/g;
+ $inp=~ s/\"/\\\"/g;
+ return($inp);
+}
--- /dev/null
+#!/usr/bin/perl
+
+#script to update charges for overdue in database
+#updates categoryitem
+# is called by charges.pl
+# written 1/1/2000 by chris@katipo.co.nz
+
+use strict;
+use CGI;
+use C4::Output;
+use C4::Database;
+
+my $input = new CGI;
+#print $input->header;
+#print startpage();
+#print startmenu('issue');
+
+
+my $dbh=C4Connect;
+#print $input->dump;
+my @names=$input->param();
+
+foreach my $key (@names){
+
+ my $bor=substr($key,0,1);
+ my $cat=$key;
+ $cat =~ s/[A-Z]//i;
+ my $data=$input->param($key);
+ my @dat=split(',',$data);
+# print "$bor $cat $dat[0] $dat[1] $dat[2] <br> ";
+ my $sth=$dbh->prepare("Update categoryitem set fine=$dat[0],startcharge=$dat[1],chargeperiod=$dat[2] where
+ categorycode='$bor' and itemtype='$cat'");
+ $sth->execute;
+ $sth->finish;
+}
+$dbh->disconnect;
+print $input->redirect("/cgi-bin/koha/charges.pl");
+#print endmenu('issue');
+#print endpage();
--- /dev/null
+#!/usr/bin/perl
+
+use C4::Database;
+use CGI;
+use strict;
+use C4::Acquisitions;
+use C4::Output;
+
+my $input= new CGI;
+#print $input->header;
+#print $input->dump;
+
+
+#my $title=checkinp($input->param('Title'));
+#my $author=checkinp($input->param('Author'));
+my $bibnum=checkinp($input->param('bibnum'));
+my $itemnum=checkinp($input->param('itemnumber'));
+my $copyright=checkinp($input->param('Copyright'));
+my $seriestitle=checkinp($input->param('Series'));
+my $serial=checkinp($input->param('Serial'));
+my $unititle=checkinp($input->param('Unititle'));
+my $notes=checkinp($input->param('ItemNotes'));
+
+#need to do barcode check
+my $barcode=$input->param('Barcode');
+#modbiblio($bibnum,$title,$author,$copyright,$seriestitle,$serial,$unititle,$notes);
+
+my $bibitemnum=checkinp($input->param('bibitemnum'));
+#my $olditemtype
+my $itemtype=checkinp($input->param('Item'));
+my $isbn=checkinp($input->param('ISBN'));
+my $publishercode=checkinp($input->param('Publisher'));
+my $publicationdate=checkinp($input->param('Publication'));
+my $class=checkinp($input->param('Class'));
+my $homebranch=checkinp($input->param('Home'));
+my $lost=$input->param('Lost');
+my $wthdrawn=$input->param('withdrawn');
+my $classification;
+my $dewey;
+my $subclass;
+if ($itemtype ne 'NF'){
+ $classification=$class;
+}
+if ($class =~/[0-9]+/){
+# print $class;
+ $dewey= $class;
+ $dewey=~ s/[a-z]+//gi;
+ my @temp;
+ if ($class =~ /\./){
+ @temp=split(/[0-9]+\.[0-9]+/,$class);
+ } else {
+ @temp=split(/[0-9]+/,$class);
+ }
+ $classification=$temp[0];
+ $subclass=$temp[1];
+# print $classification,$dewey,$subclass;
+}else{
+ $dewey='';
+}
+my $illus=checkinp($input->param('Illustrations'));
+my $pages=checkinp($input->param('Pages'));
+my $volumeddesc=checkinp($input->param('Volume'));
+
+#have to check how many items are attached to this bibitem, if one, just change it,
+#if more than one, we must create a new one.
+#my $number=countitems($bibitemnum);
+#if ($number > 1){
+# print $number;
+ #check if bibitemneeds modifying
+# my $needsmod=needsmod($bibitemnum,$itemtype);
+# if ($needsmod != 1){
+# $bibitemnum=newbiblioitem($bibnum,$itemtype,$volumeddesc,$classification);
+# }
+#}
+#modbibitem($bibitemnum,$itemtype,$isbn,$publishercode,$publicationdate,$classification,$dewey,$subclass,$illus,$pages,$volumeddesc);
+moditem('loan',$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn);
+
+print $input->redirect("moredetail.pl?type=intra&bib=$bibnum&bi=$bibitemnum");
+#print $bibitemnum;
+
+sub checkinp{
+ my ($inp)=@_;
+ $inp=~ s/\'/\\\'/g;
+ $inp=~ s/\"/\\\"/g;
+ return($inp);
+}
projects / koha_gimpoz / commitdiff