[interchange-cvs] interchange - heins modified lib/Vend/Accounting/SQL_Ledger.pm
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Sun Jul 28 01:16:02 2002
User: heins
Date: 2002-07-28 05:15:28 GMT
Modified: lib/Vend/Accounting SQL_Ledger.pm
Log:
* Really starting to get somewhere with this stuff.
[accounting
order_number=3D"[value mv_order_number]"
do_invoice=3D"[scratch do_invoice]"
do_payment=3D"[scratch realtime]"
]
This now creates the order for SQL-Ledger. If passed the
do_invoice parameter, it will also create an invoice.
If passed do_payment, it will do the payment -- ala receiving
money via electronic payment system with auto-settle.
We are creating a pseudo-form object and using the SQL-Ledger
libraries minus the CGI stuff. This should provide building
blocks for other functions like shipping and charging the
order from the UI.
Configuration is read from the Accounting repository, and
you can point to a SQL-Ledger user.conf file if desired.
Revision Changes Path
1.6 +995 -26 interchange/lib/Vend/Accounting/SQL_Ledger.pm
rev 1.6, prev_rev 1.5
Index: SQL_Ledger.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /anon_cvs/repository/interchange/lib/Vend/Accounting/SQL_Ledger.p=
m,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- SQL_Ledger.pm 21 Jul 2002 01:10:47 -0000 1.5
+++ SQL_Ledger.pm 28 Jul 2002 05:15:28 -0000 1.6
@@ -77,6 +77,45 @@
return $self;
}
=20
+sub myconfig {
+ my $self =3D shift;
+ return $self->{_myconfig} if $self->{_myconfig};
+
+ my @keys =3D qw(
+ acs address admin businessnumber charset company countrycode currency
+ dateformat dbconnect dbdriver dbhost dbname dboptions dbpasswd dbport
+ dbuser email fax name numberformat password printer shippingpoint sid
+ signature stylesheet tel templates
+ );
+
+ my $cfg =3D $self->{Config};
+ if($cfg->{myconfig_file}) {
+ no strict;
+ my $string =3D readfile($cfg->{myconfig_file});
+ $string =3D~ s/.*%myconfig\s*=3D\s*\(/{/s;
+ $string =3D~ s/\);\s*$/}/s;
+ $self->{_myconfig} =3D Vend::Interpolate::tag_calc($string);
+ if(! $self->{_myconfig}) {
+ die errmsg(
+ "operation '%s' failed: %s",
+ "myconfig_file $cfg->{myconfig_file}",
+ $Vend::Session->{last_error},
+ );
+ }
+ }
+ elsif ($cfg->{myconfig_string}) {
+ $self->{_myconfig} =3D get_option_hash($cfg->{myconfig_string});
+ }
+ else {
+ my $confhash =3D {};
+ for (@keys) {
+ $confhash->{$_} =3D $cfg->{$_};
+ }
+ $self->{_myconfig} =3D $confhash;
+ }
+ return $self->{_myconfig};
+}
+
# ------------------ START OF THE LIBRARY ------------
=20
my %Def_filter =3D (
@@ -198,20 +237,113 @@
return $record;
}
=20
-sub save_customer_data {
+sub save_transactions_list {
+ my ($self, $opt) =3D @_;
+ use vars qw($Tag);
+
+ my $ary =3D $opt->{transaction_array};
+
+ if(! $ary) {
+ my $tab =3D $opt->{transactions_table} || 'transactions';
+ my $db =3D ::database_exists_ref($tab)
+ or die errmsg("bad %s table '%s'", 'transactions', $tab);
+ my $q =3D $opt->{sql} || "select * from $tab";
+ $ary =3D $db->query( { sql =3D> $q, hashref =3D> 1 } );
+ }
+
+ die errmsg("No transactions array sent!")
+ unless ref($ary) eq 'ARRAY';
+
+ my $prof =3D $self->{userdb_profile} || 'default';
+ my $ucfg =3D $Vend::Cfg->{UserDB_repository}{$prof} || {};
+=09
+ my $tab =3D $opt->{orderline_table} || 'orderline';
+ my $db =3D ::database_exists_ref($tab)
+ or die errmsg("bad %s table '%s'", 'orderline', $tab);
+
+ my $count;
+ for(@$ary) {
+ my $rec =3D $_;
+ my $id =3D $rec->{username};
+ $id =3D~ s/\s+$//;
+ if($id !~ /^\d+$/) {
+ $id =3D $Tag->counter( { sql =3D> $ucfg->{sql_counter} || 'customer::id=
'});
+ my $msg =3D errmsg(
+ "assigned arbitrary customer number %s to user %s",
+ $id,
+ $rec->{username},
+ );
+ logError($msg);
+#::logDebug($msg);
+ }
+#::logDebug("passing rec=3D" . ::uneval($rec));
+ $self->save_customer_data($id, $rec);
+ my $on =3D $rec->{order_number};
+ my $query =3D "select * from $tab where order_number =3D '$on'";
+ my $oary =3D $db->query( { sql =3D> $query, hashref =3D> 1 } );
+ my @cart;
+ foreach my $item (@$oary) {
+ my $price =3D $item->{price};
+ my $quan =3D $item->{quantity}
+ or next;
+ next if $quan <=3D 0;
+ if ($item->{subtotal} <=3D 0) {
+ $item->{subtotal} =3D $quan * $price;
+ }
+
+ my $psubt =3D round_to_frac_digits($quan * $price);
+ my $asubt =3D round_to_frac_digits($item->{subtotal});
+ if($asubt !=3D $psubt) {
+ $price =3D $item->{subtotal} / $quan;
+ }
+ my $ip =3D $item->{code};
+ $ip =3D~ s/.*-//;
+ $ip--;
+ push @cart, {
+ code =3D> $item->{sku},
+ quantity =3D> $quan,
+ description =3D> $item->{description},
+ mv_price =3D> $price,
+ mv_ip =3D> $ip,
+ };
+ }
+
+ my $obj =3D new Vend::Accounting::SQL_Ledger;
+ my $notes =3D $rec->{gift_note};
+ $notes =3D $notes ? "$notes\n" : "";
+ $notes .=3D 'Added automatically by IC';
+ my $o =3D {
+ order_number =3D> $on,
+ cart =3D> \@cart,
+ order_date =3D> $rec->{order_date},
+ notes =3D> $rec->{gift_note},
+ salestax =3D> $rec->{salestax} || 0,
+ shipping =3D> $rec->{shipping} || 0,
+ handling =3D> $rec->{handling} || 0,
+ total_cost =3D> $rec->{total_cost} || 0,
+ };
+#::logDebug("Getting ready to create order entry: " . ::uneval($o));
+ $obj->create_order_entry($o);
+ $count++;
+ }
+ return $count;
+}
=20
+sub save_customer_data {
my ($self, $userid, $hashdata) =3D @_;
=20
my $result;
+ my $record =3D $self->map_data('customer', $hashdata);
=20
- my $record =3D $self->map_data('customer');
$userid =3D~ s/\D+//g;
$record->{id} =3D $userid;
+
my $tab =3D $self->{Config}{customer_table} || 'customer';
=20
my $db =3D ::database_exists_ref($tab)
or die errmsg("Customer table database '%s' inaccessible.", $tab);
- return $db->set_slice($userid, $record);
+ my $status =3D $db->set_slice($userid, $record);
+ return $status;
}
=20
sub assign_customer_number {
@@ -227,7 +359,7 @@
sub create_order_entry {
=20
## For syntax check
- # use vars qw($Tag);
+ use vars qw($Tag);
=20
my $self =3D shift;
my $opt =3D shift;
@@ -235,11 +367,21 @@
my $cfg =3D $self->{Config} || {};
=20
my $cart =3D delete $opt->{cart};
+ my $no_levies;
=20
## Allow a cart name, a cart reference, or default to current cart
if($cart and ! ref($cart)) {
$cart =3D $Vend::Session->{carts}{$cart};
}
+ elsif($cart
+ and defined $opt->{salestax}=20
+ and defined $opt->{shipping}=20
+ and defined $opt->{handling}=20
+ )
+ {
+ ## Must be passed order batch
+ $no_levies =3D 1;
+ }
=20
$cart ||=3D $Vend::Items;
=20
@@ -255,9 +397,11 @@
=20
=20
my @charges;
+#::logDebug("Levies=3D" . ::uneval($Vend::Cfg->{Levies}));
if($Vend::Cfg->{Levies}) {
$Tag->levies(1);
my $lcart =3D $::Levies;
+#::logDebug("levy cart=3D" . ::uneval($lcart));
for my $levy (@$lcart) {
my $pid =3D $levy->{part_number};
$pid ||=3D uc($levy->{group} || $levy->{type});
@@ -283,7 +427,8 @@
code =3D> $salestax_part,
description =3D> $salestax_desc,
mv_price =3D> $salestax,
- };
+ }
+ if $salestax > 0 || $cfg->{add_zero_salestax};
=20
if($::Values->{mv_handling}) {
my @handling =3D split /\0+/, $::Values->{mv_handling};
@@ -293,6 +438,7 @@
for (@handling) {
my $desc =3D $Tag->shipping_desc($_);
my $cost =3D $Tag->shipping( { mode =3D> $_, noformat =3D> 1 });
+ next unless $cost > 0 || $cfg->{add_zero_handling};
push @charges, {
code =3D> $part,
description =3D> $desc,
@@ -313,7 +459,8 @@
code =3D> $shipping_part,
description =3D> $shipping_desc,
mv_price =3D> $shipping,
- };
+ }
+ if $shipping > 0 || $cfg->{add_zero_shipping};
}
=20
my @oe;
@@ -323,9 +470,53 @@
(trans_id, parts_id, description, qty, sellprice, discount)
VALUES (?, ?, ?, ?, ?, ?)
};
+=09
my $ol_sth =3D $dbh->prepare($olq)
or die errmsg("Prepare '%s' failed.", $olq, $tab);
=20
+=3Dhead2 parts table
+
+CREATE TABLE "parts" (
+ "id" integer DEFAULT nextval('id'::text),
+ "partnumber" text,
+ "description" text,
+ "bin" text,
+ "unit" character varying(5),
+ "listprice" double precision,
+ "sellprice" double precision,
+ "lastcost" double precision,
+ "priceupdate" date DEFAULT date('now'::text),
+ "weight" real,
+ "onhand" real DEFAULT 0,
+ "notes" text,
+ "makemodel" boolean DEFAULT 'f',
+ "assembly" boolean DEFAULT 'f',
+ "alternate" boolean DEFAULT 'f',
+ "rop" real,
+ "inventory_accno_id" integer,
+ "income_accno_id" integer,
+ "expense_accno_id" integer,
+ "obsolete" boolean DEFAULT 'f'
+);
+
+=3Dcut
+
+ my $plq =3D q{SELECT id,
+ partnumber,
+ description,
+ bin,
+ unit,
+ listprice,
+ assembly,
+ inventory_accno_id,
+ income_accno_id,
+ expense_accno_id
+ FROM parts
+ WHERE id =3D ?};
+=09
+ my $pl_sth =3D $dbh->prepare($plq)
+ or die errmsg("Prepare '%s' failed.", $plq, 'parts');
+
my @items;
foreach my $item (@$cart) {
my $code =3D $item->{code};
@@ -406,6 +597,7 @@
#(trans_id, parts_id, description, qty, sellprice, discount)
=20
for my $c (@charges) {
+#::logDebug("doing item $c->{code}");
$sth->execute($c->{code})
or die errmsg("Statement '%s' failed.", $cq);
my ($pid) =3D $sth->fetchrow_array;
@@ -414,48 +606,131 @@
=20
my ($tid) =3D $Tag->counter({ sql =3D> "$tab:id" });
=20
+ my $res =3D {}; # Repository for result array
+
+ my @t =3D localtime();
+ $res->{invdate} =3D $opt->{order_date} || POSIX::strftime('%Y-%m-%d', @t);
+ $res->{duedate} =3D $opt->{req_date} || POSIX::strftime('%Y-%m-%d', @t);
+
+=3Dhead2 oe table
+
+CREATE TABLE "oe" (
+ "id" integer DEFAULT nextval('id'::text),
+ "ordnumber" text,
+ "transdate" date DEFAULT date('now'::text),
+ "vendor_id" integer,
+ "customer_id" integer,
+ "amount" double precision,
+ "netamount" double precision,
+ "reqdate" date,
+ "taxincluded" boolean,
+ "shippingpoint" text,
+ "notes" text,
+ "curr" character(3)
+);
+
+=3Dcut
+
my $tq =3D q{
INSERT INTO oe VALUES (
?,
?,
- date('now'::text),
- 0,
?,
?,
?,
- date('now'::text),
- 'f',
- '',
+ ?,
+ ?,
+ ?,
+ ?,
+ ?,
?,
?)
};
=20
- my $total =3D $Tag->total_cost({ noformat =3D> 1 });
+ $opt->{total_cost} ||=3D $Tag->total_cost({ noformat =3D> 1 });
=20
my $tsth =3D $dbh->prepare($tq)
or die errmsg("Statement '%s' failed.", $tq);
=20
- my $customer_id =3D $opt->{customer_id} || $Vend::Session->{username};
- $customer_id =3D~ s/\D+//g;
+ $opt->{customer_id} ||=3D $Vend::Session->{username};
+ $opt->{customer_id} =3D~ s/\D+//g;
+
+ $res->{orderid} =3D $tid;
+ $res->{ordnumber} =3D $opt->{order_number} ||=3D $::Values->{mv_order_num=
ber},
+ $res->{vendor_id} =3D 0; # This is not a PO
+ $res->{customer_id} =3D $opt->{customer_id};
+ $res->{taxincluded} =3D $opt->{taxincluded} ? 't' : 'f',
+ $res->{shippingpoint} =3D $opt->{shippingpoint};
+ $res->{notes} =3D $opt->{notes} || $::Values->{gift_note},
+ $res->{currency} =3D $opt->{currency_code} || $cfg->{currency_code} ||=
'USD';
+
my @vals =3D (
- $tid,
- $opt->{order_number} || $::Values->{mv_order_number},
- $customer_id,
- $total,
- $total,
- $opt->{notes} || $::Values->{gift_note},
- $cfg->{currency_code} || 'usd',
+ $res->{orderid},
+ $res->{ordnumber},
+ $res->{invdate},
+ $res->{vendor_id},
+ $res->{customer_id},
+ $opt->{total_cost},
+ $opt->{netamount} || $opt->{total_cost},
+ $res->{duedate},
+ $res->{taxincluded} ? 't' : 'f',
+ $res->{shippingpoint} || '',
+ $res->{notes},
+ $res->{currency},
);
=20=09
+#::logDebug("ready to execute tquery=3D$tq with values=3D" . ::uneval(\@va=
ls));
$tsth->execute(@vals)=20
or die errmsg("Statement '%s' failed.", $tq);
=20
- for(@items) {
- $ol_sth->execute($tid, @$_);
+ my $idx =3D 1;
+ my $acq =3D qq{SELECT accno from chart where id =3D ?};
+ my $asth =3D $dbh->prepare($acq)
+ or die errmsg("Prepare '%s' failed.", $acq);
+
+ for my $line (@items) {
+ $ol_sth->execute($tid, @$line);
+ my ($newpid, $desc, $qty, $price, $discount) =3D @$line;
+
+ $pl_sth->execute($newpid);
+ my $href =3D $pl_sth->fetchrow_hashref()
+ or die errmsg("Failed to retrieve part: %s", $DBI::errstr);
+ for(qw/ assembly bin description listprice partnumber unit /) {
+ $res->{$_ . "_$idx"} =3D defined $href->{$_} ? $href->{$_} : '';
+ }
+ for(qw/ expense_accno inventory_accno income_accno /) {
+ my $id =3D $href->{$_ . "_id"} || 0;
+ my $acc;
+ if($id > 0) {
+ $asth->execute($id);
+ my $ary;
+ $ary =3D $asth->fetchrow_arrayref
+ and $acc =3D $ary->[0];
+ }
+ $res->{$_ . "_$idx"} =3D $acc || 0;
+ }
+
+ ## Shows order: push @items, [$newpid, $desc, $qty, $price, $discount];
+ $res->{"id_$idx"} =3D $newpid;
+ $res->{"sellprice_$idx"} =3D $price;
+ $res->{"qty_$idx"} =3D $qty;
+ $res->{"discount_$idx"} =3D $discount;
+
+ $idx++;
}
=20=09=09
-#::logDebug("past accounting, ready to return 1");
- return 1;
+ $res->{rowcount} =3D $idx;
+#::logDebug("past accounting, ready to return res=3D" . ::uneval($res));
+
+ if($opt->{do_payment}) {
+ $res->{paid_1} =3D $opt->{total_cost};
+ }
+
+ if($opt->{do_invoice}) {
+ $res =3D $self->post_invoice($res);
+ }
+
+ return $res;
}
=20
my @all_part_fields =3D qw/
@@ -692,8 +967,702 @@
return $string;
}
=20
-return 1;
+sub post_invoice {
+
+ my ($self, $opt) =3D @_;
+
+ my $form =3D Form->new($opt);
+ my $myconfig =3D $self->myconfig();
+ my $cfg =3D $self->{Config};
+
+#::logDebug("have myconfig=3D" . ::uneval($myconfig));
+ $form->{AR} ||=3D $cfg->{default_ar} || 1200;
+ $form->{AR_paid} ||=3D $cfg->{default_ar_paid} || 1060;
+ $form->{fxgain_accno} ||=3D $cfg->{default_fxgain_accno}|| 4450;
+ $form->{fxloss_accno} ||=3D $cfg->{default_fxloss_accno}|| 5810;
+ $form->{invnumber} ||=3D $Tag->counter( {
+ sql =3D> $cfg->{inv_counter} || $cfg->{counter},
+ });
+
+ if($form->{paid_1} > 0) {
+ $form->{paidaccounts} =3D 1;
+ $form->{AR_paid_1} =3D $form->{AR_paid};
+ $form->{datepaid_1} =3D $form->{invdate};
+ }
+ else {
+ $form->{paid_1} =3D 0;
+ $form->{paid} =3D 0;
+ }
+
+ IS->customer_details($myconfig, $form);
+
+ foreach my $key (qw(name addr1 addr2 addr3 addr4)) {
+ unless ($form->{"shipto$key"}) {
+ $form->{"shipto$key"} =3D defined $form->{$key} ? $form->{$key} : '';
+ }
+ $form->{"shipto$key"} =3D~ s/"/"/g;
+ }
+
+#::logDebug("customer details back, form set up=3D" . ::uneval($form));
+ my $status =3D IS->post_invoice($myconfig, $form);
+#::logDebug("post_status=3D$status, form now=3D" . ::uneval($form));
+ return $form;
+}
+
+package Form;
+
+use DBI;
+use Vend::Util;
+
+no strict 'subs';
+
+sub new {
+ my $type =3D shift;
+ my $opt =3D shift;
+=20=20=20=20
+ my $self =3D {};
+
+ if(! ref($opt) eq 'HASH') {
+ $opt =3D { $opt, @_ };
+ }
+
+ while (my ($k, $v) =3D each %$opt) {
+ $self->{$k} =3D $v;
+ }
+
+ $self->{action} =3D lc $self->{action};
+ $self->{action} =3D~ s/( |-|,)/_/g;
+
+ $self->{version} =3D $Vend::Accounting::SQL_Ledger::VERSION;
+
+ bless $self, $type;
+}
+
+
+sub debug {
+ my $self =3D shift;
+=20=20
+ foreach my $key (sort keys %{$self}) {
+ logDebug("$key =3D $self->{$key}\n");
+ }
+}=20
+
+=20=20
+sub escape {
+ shift;
+ return hexify(shift);
+}
+
+
+sub unescape {
+ shift;
+ return unhexify(shift);
+}
+
+sub error {
+ my ($self, $msg) =3D @_;
+
+ $msg =3D errmsg($msg, @_);
+
+ if ($self->{error_function}) {
+ $self->{error_function}->($msg);
+ }
+ else {
+ die errmsg("SQL-Ledger error: %s\n", $msg);
+ }
+}
+
+
+sub dberror {
+ my ($self, $msg) =3D @_;
+
+ $self->error("$msg\n".$DBI::errstr);
+=20=20
+}
+
+
+sub isblank {
+ my ($self, $name, $msg) =3D @_;
+
+ if ($self->{$name} =3D~ /^\s*$/) {
+ $self->error($msg);
+ }
+}
+=20=20
+
+sub header {
+ return;
+}
+
+
+sub redirect {
+}
+
+
+sub isposted {
+ my ($self, $rc) =3D @_;
+
+ if ($rc) {
+ $self->redirect;
+ }
+
+ $rc;
+=20=20
+}
+
+
+sub isdeleted {
+ my ($self, $rc) =3D @_;
+
+ if ($rc) {
+ $self->redirect;
+ }
+
+ $rc;
+=20=20
+}
+
+
+sub sort_columns {
+ my ($self, @columns) =3D @_;
+
+ @columns =3D grep !/^$self->{sort}$/, @columns;
+ splice @columns, 0, 0, $self->{sort};
+
+ @columns;
+=20=20
+}
+
+
+sub format_amount {
+ my ($self, $myconfig, $amount, $places, $dash) =3D @_;
+
+ if (defined $places) {
+ $amount =3D $self->round_amount($amount, $places) if ($places >=3D 0);
+ }
+
+ # is the amount negative
+ my $negative =3D ($amount < 0);
+=20=20
+ if ($amount !=3D 0) {
+ if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.0=
0')) {
+ my ($whole, $dec) =3D split /\./, "$amount";
+ $whole =3D~ s/-//;
+ $amount =3D join '', reverse split //, $whole;
+=20=20=20=20=20=20
+ if ($myconfig->{numberformat} eq '1,000.00') {
+ $amount =3D~ s/\d{3,}?/$&,/g;
+ $amount =3D~ s/,$//;
+ $amount =3D join '', reverse split //, $amount;
+ $amount .=3D "\.$dec" if $dec;
+ }
+=20=20=20=20=20=20
+ if ($myconfig->{numberformat} eq '1.000,00') {
+ $amount =3D~ s/\d{3,}?/$&./g;
+ $amount =3D~ s/\.$//;
+ $amount =3D join '', reverse split //, $amount;
+ $amount .=3D ",$dec" if $dec;
+ }
+=20=20=20=20=20=20
+ if ($myconfig->{numberformat} eq '1000,00') {
+ $amount =3D "$whole";
+ $amount .=3D ",$dec" if $dec;
+ }
+
+ if ($dash =3D~ /-/) {
+ $amount =3D ($negative) ? "($amount)" : "$amount";
+ } elsif ($dash =3D~ /DRCR/) {
+ $amount =3D ($negative) ? "$amount DR" : "$amount CR";
+ } else {
+ $amount =3D ($negative) ? "-$amount" : "$amount";
+ }
+ }
+ } else {
+ $amount =3D ($dash) ? "$dash" : "";
+ }
+
+ $amount;
+
+}
+
+
+sub parse_amount {
+ my ($self, $myconfig, $amount) =3D @_;
+
+ $amount =3D 0 if ! defined $amount;
+
+ if (($myconfig->{numberformat} eq '1.000,00') ||
+ ($myconfig->{numberformat} eq '1000,00')) {
+ $amount =3D~ s/\.//g;
+ $amount =3D~ s/,/\./;
+ }
+
+ $amount =3D~ s/,//g;
+=20=20
+ return ($amount * 1);
+
+}
+
+
+sub round_amount {
+ my ($self, $amount, $places) =3D @_;
+
+ # compensate for perl bug, add 1/10^$places+2
+ sprintf("%.${places}f", $amount + (1 / (10 ** ($places + 2))) * (($amoun=
t > 0) ? 1 : -1));
+
+}
+
+
+sub parse_template {
+ return 1;
+}
+
+
+sub format_string {
+ my ($self, @fields) =3D @_;
+
+ my $format =3D $self->{format};
+ if ($self->{format} =3D~ /(postscript|pdf)/) {
+ $format =3D 'tex';
+ }
+=20=20
+ # order matters!!!
+ my %umlaute =3D ( 'order' =3D> { 'html' =3D> [ '&', '<', '>', quotemeta(=
'\n'), '=0D',
+ '=E4', '=F6', '=FC',
+ '=C4', '=D6', '=DC',
+ '=DF' ],
+ 'tex' =3D> [ '&', quotemeta('\n'), '=0D',
+ '=E4', '=F6', '=FC',
+ '=C4', '=D6', '=DC',
+ '=DF', '\$', '%' ] },
+ 'html' =3D> {
+ '&' =3D> '&', '<' =3D> '<', '>' =3D> '>', quotem=
eta('\n') =3D> '<br>', '=0D' =3D> '<br>',
+ '=E4' =3D> 'ä', '=F6' =3D> 'ö', '=FC' =3D> '&uum=
l;',
+ '=C4' =3D> 'Ä', '=D6' =3D> 'Ö', '=DC' =3D> 'Ü',
+ '=DF' =3D> 'ß',
+ '\x84' =3D> 'ä', '\x94' =3D> 'ö', '\x81' =3D> 'ü',
+ '\x8e' =3D> 'Ä', '\x99' =3D> 'Ö', '\x9a' =3D> 'Ü',
+ '\xe1' =3D> 'ß'
+ },
+ 'tex' =3D> {
+ '=E4' =3D> '\"a', '=F6' =3D> '\"o', '=FC' =3D> '\"u',
+ '=C4' =3D> '\"A', '=D6' =3D> '\"O', '=DC' =3D> '\"U',
+ '=DF' =3D> '{\ss}',
+ '\x84' =3D> '\"a', '\x94' =3D> '\"o', '\x81' =3D> '\"u',
+ '\x8e' =3D> '\"A', '\x99' =3D> '\"O', '\x9a' =3D> '\"U',
+ '\xe1' =3D> '{\ss}',
+ '&' =3D> '\&', '\$' =3D> '\$', '%' =3D> '\%',
+ quotemeta('\n') =3D> '\newline ', '=0D' =3D> '\newline '
+ }
+ );
+
+ foreach my $key (@{ $umlaute{order}{$format} }) {
+ map { $self->{$_} =3D~ s/$key/$umlaute{$format}{$key}/g; } @fields;
+ }
+
+}
+
+# Database routines used throughout
+
+sub dbconnect {
+ my ($self, $myconfig) =3D @_;
+
+ # connect to database
+ my $dbh =3D DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $m=
yconfig->{dbpasswd}) or $self->dberror;
+
+ $dbh->trace($Global::DataTrace, $Global::DebugFile)
+ if $Global::DataTrace and $Global::DebugFile;
+
+ # set db options
+ if ($myconfig->{dboptions}) {
+ $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptio=
ns});
+ }
+
+ $dbh;
+
+}
+
+
+sub dbconnect_noauto {
+ my ($self, $myconfig) =3D @_;
+
+ # connect to database
+ my $dbh =3D DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $m=
yconfig->{dbpasswd}, {AutoCommit =3D> 0}) or $self->dberror;
+
+ $dbh->trace($Global::DataTrace, $Global::DebugFile)
+ if $Global::DataTrace and $Global::DebugFile;
+
+ # set db options
+ if ($myconfig->{dboptions}) {
+ $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptio=
ns});
+ }
+
+ $dbh;
+
+}
+
+
+sub update_balance {
+ my ($self, $dbh, $table, $field, $where, $value) =3D @_;
+
+ # if we have a value, go do it
+ if ($value !=3D 0) {
+ # retrieve balance from table
+ my $query =3D "SELECT $field FROM $table WHERE $where";
+ my $sth =3D $dbh->prepare($query);
+
+ $sth->execute || $self->dberror($query);
+ my ($balance) =3D $sth->fetchrow_array;
+ $sth->finish;
+
+ $balance +=3D $value;
+ # update balance
+ $query =3D "UPDATE $table SET $field =3D $balance WHERE $where";
+ $dbh->do($query) || $self->dberror($query);
+ }
+}
+
+
+
+sub update_exchangerate {
+ my ($self, $dbh, $curr, $transdate, $buy, $sell) =3D @_;
+
+ # some sanity check for currency
+ return if ($curr eq '');
+
+ my $query =3D qq|SELECT curr FROM exchangerate
+ WHERE curr =3D '$curr'
+ AND transdate =3D '$transdate'|;
+ my $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+=20=20
+ my $set;
+ if ($buy !=3D 0 && $sell !=3D 0) {
+ $set =3D "buy =3D $buy, sell =3D $sell";
+ } elsif ($buy !=3D 0) {
+ $set =3D "buy =3D $buy";
+ } elsif ($sell !=3D 0) {
+ $set =3D "sell =3D $sell";
+ }
+=20=20
+ if ($sth->fetchrow_array) {
+ $query =3D qq|UPDATE exchangerate
+ SET $set
+ WHERE curr =3D '$curr'
+ AND transdate =3D '$transdate'|;
+ } else {
+ $query =3D qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
+ VALUES ('$curr', $buy, $sell, '$transdate')|;
+ }
+ $sth->finish;
+ $dbh->do($query) || $self->dberror($query);
+=20=20
+}
+
+
+sub get_exchangerate {
+ my ($self, $dbh, $curr, $transdate, $fld) =3D @_;
+=20=20
+ my $query =3D qq|SELECT $fld FROM exchangerate
+ WHERE curr =3D '$curr'
+ AND transdate =3D '$transdate'|;
+ my $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ my ($exchangerate) =3D $sth->fetchrow_array;
+ $sth->finish;
+
+ ($exchangerate) ? $exchangerate : 1;
+
+}
+
+
+# the selection sub is used in the AR, AP and IS module
+#
+sub all_vc {
+ my ($self, $myconfig, $table) =3D @_;
+
+ # create array for vendor or customer
+ my $dbh =3D $self->dbconnect($myconfig);
+
+ my $query;
+ my $sth;
+=20=20
+ unless ($self->{"${table}_id"}) {
+ my $arap =3D ($table eq 'customer') ? "ar" : "ap";
+ $arap =3D 'oe' if ($self->{type} =3D~ /_order/);
+
+ $query =3D qq|SELECT ${table}_id FROM $arap
+ WHERE oid =3D (SELECT max(oid) FROM $arap
+ WHERE ${table}_id > 0)|;
+ $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ unless (($self->{"${table}_id"}) =3D $sth->fetchrow_array) {
+ $self->{"${table}_id"} =3D 0;
+ }
+ $sth->finish;
+ }
+=20=20
+ $query =3D qq|SELECT id, name
+ FROM $table
+ ORDER BY name|;
+ $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ my $ref =3D $sth->fetchrow_hashref(NAME_lc);
+ push @{ $self->{"all_$table"} }, $ref;
+
+ while (my $ref =3D $sth->fetchrow_hashref(NAME_lc)) {
+ push @{ $self->{"all_$table"} }, $ref;
+ }
+
+ $sth->finish;
+ $dbh->disconnect;
+
+}
+
+
+sub create_links {
+ my ($self, $module, $myconfig, $table) =3D @_;
+
+ # get all the customers or vendors
+ &all_vc($self, $myconfig, $table);
+
+ my %xkeyref =3D ();
+=20=20
+ my $dbh =3D $self->dbconnect($myconfig);
+ # now get the account numbers
+ my $query =3D qq|SELECT accno, description, link
+ FROM chart
+ WHERE link LIKE '%$module%'
+ ORDER BY accno|;
+ my $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ while (my $ref =3D $sth->fetchrow_hashref(NAME_lc)) {
+=20=20=20=20
+ foreach my $key (split(/:/, $ref->{link})) {
+ if ($key =3D~ /$module/) {
+ # cross reference for keys
+ $xkeyref{$ref->{accno}} =3D $key;
+=09
+ push @{ $self->{"${module}_links"}{$key} }, { accno =3D> $ref->{accno},
+ description =3D> $ref->{description=
} };
+ }
+ }
+ }
+ $sth->finish;
+=20=20
+=20
+ if ($self->{id}) {
+ my $arap =3D ($table eq 'customer') ? 'ar' : 'ap';
+=20=20=20=20
+ $query =3D qq|SELECT invnumber, transdate, ${table}_id, datepaid, dued=
ate,
+ ordnumber, taxincluded, curr AS currency
+ FROM $arap
+ WHERE id =3D $self->{id}|;
+ $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+=20=20=20=20
+ my $ref =3D $sth->fetchrow_hashref(NAME_lc);
+ foreach my $key (keys %$ref) {
+ $self->{$key} =3D $ref->{$key};
+ }
+ $sth->finish;
+
+ # get amounts from individual entries
+ $query =3D qq|SELECT accno, description, source, amount, transdate, cl=
eared
+ FROM acc_trans, chart
+ WHERE chart.id =3D acc_trans.chart_id
+ AND trans_id =3D $self->{id}
+ AND fx_transaction =3D '0'
+ ORDER BY transdate|;
+ $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+
+ my $fld =3D ($module eq 'AR') ? 'buy' : 'sell';
+ # get exchangerate for currency
+ $self->{exchangerate} =3D $self->get_exchangerate($dbh, $self->{curren=
cy}, $self->{transdate}, $fld);
+=20=20=20=20
+ # store amounts in {acc_trans}{$key} for multiple accounts
+ while (my $ref =3D $sth->fetchrow_hashref(NAME_lc)) {
+ $ref->{exchangerate} =3D $self->get_exchangerate($dbh, $self->{curre=
ncy}, $ref->{transdate}, $fld);
+
+ push @{ $self->{acc_trans}{$xkeyref{$ref->{accno}}} }, $ref;
+ }
+
+ $sth->finish;
+
+ $query =3D qq|SELECT d.curr AS currencies,
+ (SELECT c.accno FROM chart c
+ WHERE d.fxgain_accno_id =3D c.id) AS fxgain_accno,
+ (SELECT c.accno FROM chart c
+ WHERE d.fxloss_accno_id =3D c.id) AS fxloss_accno
+ FROM defaults d|;
+ $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ $ref =3D $sth->fetchrow_hashref(NAME_lc);
+ map { $self->{$_} =3D $ref->{$_} } keys %$ref;
+ $sth->finish;
+
+ } else {
+ # get date
+ $query =3D qq|SELECT current_date AS transdate, current_date + 30 AS d=
uedate,
+ d.curr AS currencies,
+ (SELECT c.accno FROM chart c
+ WHERE d.fxgain_accno_id =3D c.id) AS fxgain_accno,
+ (SELECT c.accno FROM chart c
+ WHERE d.fxloss_accno_id =3D c.id) AS fxloss_accno
+ FROM defaults d|;
+ $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ my $ref =3D $sth->fetchrow_hashref(NAME_lc);
+ map { $self->{$_} =3D $ref->{$_} } keys %$ref;
+ $sth->finish;
+ }
+
+ $dbh->disconnect;
+
+}
+
+
+sub current_date {
+ my ($self, $myconfig, $thisdate, $days) =3D @_;
+=20=20
+ my $dbh =3D $self->dbconnect($myconfig);
+ my $query =3D qq|SELECT current_date AS thisdate
+ FROM defaults|;
+
+ $days *=3D 1;
+ if ($thisdate) {
+ $query =3D qq|SELECT date '$thisdate' + $days AS thisdate
+ FROM defaults|;
+ }
+=20=20
+ my $sth =3D $dbh->prepare($query);
+ $sth->execute || $self->dberror($query);
+
+ ($thisdate) =3D $sth->fetchrow_array;
+ $sth->finish;
+
+ $dbh->disconnect;
+
+ $thisdate;
+
+}
+
+
+sub like {
+ my ($self, $string) =3D @_;
+=20=20
+ unless ($string =3D~ /%/) {
+ $string =3D "%$string%";
+ }
+
+ $string;
+=20=20
+}
+
+
+package Locale;
+
+
+sub new {
+ my ($type, $country, $NLS_file) =3D @_;
+ my $self =3D {};
+
+ if ($country && -d "locale/$country") {
+ $self->{countrycode} =3D $country;
+ eval { require "locale/$country/$NLS_file"; };
+ }
+
+ $self->{NLS_file} =3D $NLS_file;
+=20=20
+ push @{ $self->{LONG_MONTH} }, ("January", "February", "March", "April",=
"May ", "June", "July", "August", "September", "October", "November", "Dec=
ember");
+ push @{ $self->{SHORT_MONTH} }, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep =
Oct Nov Dec));
+=20=20
+ bless $self, $type;
+
+}
+
+
+sub text {
+ my ($self, $text) =3D @_;
+=20=20
+ return (exists $self->{texts}{$text}) ? $self->{texts}{$text} : $text;
+=20=20
+}
+
+
+sub findsub {
+ my ($self, $text) =3D @_;
+
+ if (exists $self->{subs}{$text}) {
+ $text =3D $self->{subs}{$text};
+ } else {
+ if ($self->{countrycode} && $self->{NLS_file}) {
+ Form->error("$text not defined in locale/$self->{countrycode}/$self-=
>{NLS_file}");
+ }
+ }
+
+ $text;
+
+}
+
+
+sub date {
+ my ($self, $myconfig, $date, $longformat) =3D @_;
+
+ my $longdate =3D "";
+ my $longmonth =3D ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
+
+ my $spc;
+ if ($date) {
+ # get separator
+ $spc =3D $myconfig->{dateformat};
+ $spc =3D~ s/\w//g;
+ $spc =3D substr($spc, 1, 1);
+
+ if ($spc eq '.') {
+ $spc =3D '\.';
+ }
+ if ($spc eq '/') {
+ $spc =3D '\/';
+ }
+
+ my ($yy, $mm, $dd);
+ if ($myconfig->{dateformat} =3D~ /^yy/) {
+ ($yy, $mm, $dd) =3D split /$spc/, $date;
+ }
+ if ($myconfig->{dateformat} =3D~ /^mm/) {
+ ($mm, $dd, $yy) =3D split /$spc/, $date;
+ }
+ if ($myconfig->{dateformat} =3D~ /^dd/) {
+ ($dd, $mm, $yy) =3D split /$spc/, $date;
+ }
+=20=20=20=20
+ $dd *=3D 1;
+ $mm--;
+ $yy =3D ($yy < 70) ? $yy + 2000 : $yy;
+ $yy =3D ($yy >=3D 70 && $yy <=3D 99) ? $yy + 1900 : $yy;
+
+ if ($myconfig->{dateformat} =3D~ /^dd/) {
+ $longdate =3D "$dd. ".&text($self, $self->{$longmonth}[$mm])." $yy";
+ } else {
+ $longdate =3D &text($self, $self->{$longmonth}[$mm])." $dd, $yy";
+ }
+
+ }
+
+ $longdate;
+
+}
=20
+1;
=20
=3Dhead
=20