[interchange-cvs] interchange - heins modified 2 files
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Sat Jul 6 23:59:01 2002
User: heins
Date: 2002-07-07 03:58:43 GMT
Modified: lib/Vend/Accounting SQL_Ledger.pm
Added: code/SystemTag accounting.coretag
Log:
* Update Vend::Accounting::SQL_Ledger to use a direct database
link instead of a CGI link. This should be a much more reliable
method -- even allows commits/rollbacks if the order process
fails.
* Add [accounting ] tag to interface to accounting modules.
Revision Changes Path
1.3 +552 -283 interchange/lib/Vend/Accounting/SQL_Ledger.pm
rev 1.3, prev_rev 1.2
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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- SQL_Ledger.pm 28 Jun 2002 18:52:45 -0000 1.2
+++ SQL_Ledger.pm 7 Jul 2002 03:58:43 -0000 1.3
@@ -23,34 +23,14 @@
=20
use strict;
use warnings;
-use HTML::TokeParser;
use Vend::Util;
use Vend::Accounting;
+use Text::ParseWords;
=20
use vars qw/$VERSION @ISA/;
@ISA =3D qw/ Vend::Accounting /;
=20
-# HARD-CODED GLOBALS.
-# >>>>> Here are some globals that you might want to adjust <<<<<<
-
- # The current SQL-Ledger install directory
- our $SL_DIR =3D '/usr/local/sql-ledger/';=20
-
- # The SQL-Ledger path to use for transactions
- #our $SL_PATH =3D Vend::Util::escape_chars_url('bin/mozilla');=20
- our $SL_PATH =3D 'bin/mozilla';=20
-
- # The SQL-Ledger user-id to use for transactions
- our $SL_USER =3D 'mike';=20
-
- # The SQL-Ledger password to use for transactions
- our $SL_PASS =3D 'flange';=20
-
- # The SQL-Ledger service item name to use for transactions
- our $SL_ITEM_NAME =3D 'test-service';=20
-
- # The SQL-Ledger service item id to use for transactions
- our $SL_ITEM_ID =3D '10073';=20
+my $Tag =3D new Vend::Tags;
=20
sub new {
my $class =3D shift;
@@ -63,14 +43,18 @@
=20
my $self =3D new Vend::Accounting;
=20
- $self->{Config} =3D {};
+ my $cfg =3D $self->{Config} =3D {};
while (my ($k, $v) =3D each %{$Vend::Cfg->{Accounting}}) {
- $self->{Config}{$k} =3D $v;
+ $cfg->{$k} =3D $v;
}
while (my ($k, $v) =3D each %$opt) {
- $self->{Config}{$k} =3D $v;
+ $cfg->{$k} =3D $v;
}
=20
+ if(! $cfg->{counter}) {
+ my $tab =3D $cfg->{link_table} || 'customer';
+ $cfg->{counter} =3D "$tab:id";
+ }
bless $self, $class;
#::logDebug("Accounting self=3D" . ::uneval($self) );
return $self;
@@ -78,229 +62,144 @@
=20
# ------------------ START OF THE LIBRARY ------------
=20
-sub push_parms {
- my($k, $v, $ary) =3D @_;
- if( ref($v) eq 'ARRAY') {
- my $ary =3D $v;
- for(@$ary) {
- push @$ary, "$k=3D" . Vend::Util::escape_chars_url($_);
- }
- return;
- }
- $v =3D Vend::Util::escape_chars_url($v);
- push @$ary, "$k=3D$v";
- return;
-}
-
-sub split_name_value_pairs {
-
- my $htmlstring =3D shift;
- my $obj =3D HTML::TokeParser->new(doc =3D> "$htmlstring");
- my ($token, $urlstring, $pair, @pairs, $name, $value, $data, %data);
+my %Def_filter =3D (
=20
- while ($token =3D $obj->get_tag("a")) {
+);
=20
- $urlstring =3D $token->[1]{href};
+my %Def_map =3D (
=20
- #Split the name-value pairs
- @pairs =3D split(/&/, $urlstring);
-
- #Loop through each pair
- foreach $pair (@pairs) {
-
- #Create a Name/Value pair set
- ($name, $value) =3D split(/=3D/, $pair);
-
- #Assign the value to an associative array using the name as its hash
- $data{$name} =3D Vend::Util::unescape_full($value);
- }
- }
- return %data;
-}
-
-sub call_sl_script {
- my ($sname, $opt) =3D @_;
- my $dir =3D $Vend::Cfg->{SQL_Ledger}{dir} || $SL_DIR;
- $dir =3D~ s:/+$::;
- my $cmd =3D "$dir/$sname";
- local($ENV{PERL5LIB});
- $ENV{PERL5LIB} =3D $dir;
-# if($opt->{path} !~ m:^/:) {
-# $opt->{path} =3D "$dir/$opt->{path}";
-# }
- if(! -f $cmd) {
- logError(
- "SQL-Ledger script '%s' does not exist in SL_DIR '%s'",
- $sname,
- $dir,
- );
- return undef;
- }
-
- # Build the option string. Keys beginning with sl_* override other
- # passed parameters, meaning that even if the function parameter
- # is needed in a standard opt string a 'function' parameter can
- # be passed with sl_function=3Dsomething.
-
- my @parms;
- my @override;
-
- for my $k (keys %$opt) {
- if($k =3D~ /^sl_/) {
- push @override, $_;
- next;
- }
-
- my $v =3D $opt->{$k};
- push_parms($k, $v, \@parms);
+customer =3D> <<EOF,
+ name "{company?}{b_company?b_company:company}{/company?}{co=
mpany:}{b_address1?b_lname:lname}{/company:}"
+ addr1 {b_address1?b_address1:address1}
+ addr2 {b_address1?b_address2:address2}
+ addr3 "{b_address1?}{b_city}, {b_state} {b_zip}{/b_address1=
?}{b_address1:}{city}, {state} {zip}{/b_address1:}"
+ addr4 "{b_address1?}{b_country}--{country:name:{b_country}}{=
/b_address1?}{b_address1:}{country}--{country:name:{country}}{/b_address1:}"
+ contact "{b_fname|{fname}} {b_lname|{lname}}"
+ phone "{b_phone|{phone_day}}"
+ email email
+ shiptoname "{company?}{company}{/company?}{company:}{lname}{/comp=
any:}"
+ shiptoaddr1 address1
+ shiptoaddr2 address2
+ shiptoaddr3 "{city}, {state} {zip}"
+ shiptoaddr4 "{country} - {country:name:{country}}"
+ shiptocontact "{fname} {lname}"
+ shiptophone phone_day
+ shiptofax fax
+ shiptoemail email
+EOF
+
+ oe =3D> q(
+ ordnumber order_number
+ vendor_id vendor_id
+ customer_id username
+ amount total_cost
+ reqdate require_date
+ curr currency_code
+ ),
+
+);
+
+my %Include_map =3D (
+ customer =3D> [qw/
+ name
+ addr1
+ addr2
+ addr3
+ addr4
+ contact
+ phone
+ email
+ shiptoname
+ shiptoaddr1
+ shiptoaddr2
+ shiptoaddr3
+ shiptoaddr4
+ shiptocontact
+ shiptophone
+ shiptofax
+ shiptoemail
+ /],
+ oe =3D> [qw/
+ ordnumber
+ transdate
+ vendor_id
+ customer_id=20
+ amount
+ netamount
+ reqdate
+ taxincluded
+ shippingpoint
+ notes
+ curr
+ /],
+ );
+
+sub map_data {
+ my ($s, $type, $ref, $record) =3D @_;
+ $record ||=3D {};
+ $ref ||=3D $::Values;
+
+ my $keys =3D $s->{Config}{"include_$type"} || $Include_map{$type};
+ my $map =3D $s->{Config}{"map_$type"} || $Def_map{$type};
+ my $filt =3D $s->{Config}{"filter_$type"} || $Def_filter{$type};
+ $map =3D~ s/\r?\n/ /g;
+ $map =3D~ s/^\s+//;
+ $map =3D~ s/\s+$//;
+ my %map =3D Text::ParseWords::shellwords($map);
+ my %filt;
+ %filt =3D Text::ParseWords::shellwords($filt) if $filt;
+
+ my @keys;
+ if(ref($keys)) {
+ @keys =3D @$keys;
}
-
- for my $k (@override) {
- my $v =3D $opt->{$k};
- push_parms($k, $v, \@parms);
- }
-
- my $arg =3D join "&", @parms;
- logDebug("calling $cmd with arg=3D$arg");
- my $result =3D `$cmd "$arg"`;
- chomp($result);
- if($? !=3D 0) {
- my $err =3D $? >> 8;
- logError(
- "SQL-Ledger error status '%s' returned on call to '%s': %s",
- $err,
- $sname,
- $!,
- );
+ else {
+ $keys =3D~ s/^\s+//;
+ $keys =3D~ s/\s+$//;
+ @keys =3D split /[\s,\0]+/, $keys;
}
- return $result;
-}
-
-sub hash_line_params {
- my $body =3D shift
- or return undef;
- my $o;
- if($body =3D~ /=3D/) {
- $o =3D {};
- $body =3D~ s/^\s+//;
- $body =3D~ s/\s+$//;
- $body =3D~ s/^\s+//mg;
- $body =3D~ s/\s+$//mg;
- my @in =3D grep /=3D/, split /\n/, $body;
- for(@in) {
- my ($k, $v) =3D split /\s*=3D\s*/, $_;
-
- if($o->{$k}) {
- my $val =3D delete $o->{$k};
- if ( ref($val) eq 'ARRAY' ) {
- push @$val, $v;
- }
- else {
- $val =3D [ $val ];
- }
- $v =3D $val;
- }
=20
- $o->{$k} =3D $v;
+ for my $k (@keys) {
+ my $filt =3D $filt{$k};
+ my $v =3D $map{$k};
+ $filt =3D 'strip mac' unless defined $filt;
+ my $val;
+ if($v =3D~ /^(\w+)\:(\w+)$/) {
+ $val =3D length($ref->{$1}) ? $ref->{$1} : $ref->{$2};=09
}
+ elsif ( $v =3D~ /{/) {
+ $val =3D Vend::Interpolate::tag_attr_list($v, $ref);
+ }
+ elsif(length($v)) {
+ $val =3D $ref->{$v};
+ }
+ else {
+ $val =3D $ref->{$k};
+ }
+ $record->{$k} =3D Vend::Interpolate::filter_value($filt, $val);
}
- return $o;
-}
-
-sub assign_customer_number {
-
- my ($self, $opt) =3D @_;
- my $result;
-
- my $call =3D {
- path =3D> $self->{Config}{path} || $SL_PATH,
- login =3D> $self->{Config}{login} || $SL_USER,
- password =3D> $self->{Config}{password} || $SL_PASS,
- };
-
- $call->{action} =3D "Save Customer";
- $call->{db} =3D "customer";
- $call->{name} =3D $opt->{username} || $::Values->{email};
- $call->{contact} =3D $opt->{email} || $::Values->{email};
- $call->{email} =3D $opt->{email} || $::Values->{email};
-
- call_sl_script('ct.pl', $call);
-
- $call->{action} =3D "Search for Customer";
- $call->{l_contact} =3D "Y";
- $call->{l_name} =3D "Y";
-
- $result =3D call_sl_script('ct.pl', $call);
- logDebug("call_sl_script result was: $result");
-
- my %data =3D split_name_value_pairs($result);
-
- my $datastuff =3D ::uneval(\@_);
- logDebug("This is a assign_customer_number test(result '$data{id}') ... $=
datastuff");
-
- return $data{id};
+ return $record;
}
=20
sub save_customer_data {
=20
my ($self, $userid, $hashdata) =3D @_;
=20
- my $datastuff =3D uneval(\$self);
-#::logDebug( "This is a save_customer_data self... $datastuff");
- $datastuff =3D uneval($hashdata);
-#::logDebug("This is a save_customer_data fnv... $datastuff");
- $datastuff =3D uneval(\$userid);
-#::logDebug("This is a save_customer_data userid .. $datastuff");
- `echo "This is a save_customer_data userid... $datastuff" >> testlog.txt`;
-
my $result;
=20
- my %fnv =3D %$hashdata;
- my $name;
-
- my $call =3D {
- path =3D> $self->{Config}{path} || $SL_PATH,
- login =3D> $self->{Config}{login} || $SL_USER,
- password =3D> $self->{Config}{password} || $SL_PASS,
- };
-
-
- $call->{action} =3D "Save Customer";
- $call->{db} =3D "customer";
- $call->{id} =3D $userid;
- $call->{name} =3D $fnv{company} || "$fnv{lname}, $fnv{fname}";
- $call->{addr1} =3D $fnv{b_address1} || $fnv{address1};
- $call->{addr2} =3D $fnv{b_address2} || $fnv{address2};
- $call->{addr3} =3D $fnv{b_address3} || $fnv{address3};
- if($fnv{b_city}) {
- $call->{addr4} =3D "$fnv{b_city}, $fnv{b_state} $fnv{b_zip} $fnv{b_count=
ry}";
- }
- else {
- $call->{addr4} =3D "$fnv{city}, $fnv{state} $fnv{zip} $fnv{country}";
- }
- if($fnv{b_lname}) {
- $call->{contact} =3D "$fnv{b_lname}, $fnv{b_fname}";
- }
- else {
- $call->{contact} =3D "$fnv{lname}, $fnv{fname}";
- }
- $call->{phone} =3D $fnv{phone_night} || $fnv{phone_day};
- $call->{fax} =3D $fnv{fax};
- $call->{email} =3D $fnv{email};
- $call->{shiptoname} =3D $fnv{company} || "$fnv{lname}, $fnv{fname}";
- $call->{shiptoaddr1} =3D $fnv{address1};
- $call->{shiptoaddr2} =3D $fnv{address2};
- $call->{shiptoaddr3} =3D $fnv{address3};
- $call->{shiptoaddr4} =3D "$fnv{city} $fnv{state} $fnv{zip} $fnv{countr=
y}";
- $call->{shiptocontact} =3D "$fnv{lname}, $fnv{fname}";
- $call->{shiptophone} =3D $fnv{phone_day};
- $call->{shiptofax} =3D $fnv{fax};
- $call->{shiptoemail} =3D $fnv{email};
- $call->{creditlimit} =3D $fnv{credit_limit};
-
- $result =3D call_sl_script('ct.pl', $call);
+ my $record =3D $self->map_data('customer');
+ $userid =3D~ s/\D+//g;
+ $record->{id} =3D $userid;
+ my $tab =3D $self->{Config}{customer_table} || 'customer';
+
+ my $db =3D ::database_exists_ref($tab)
+ or die errmsg("Customer table database '%s' inaccessible.", $tab);
+ return $db->set_slice($userid, $record);
+}
=20
- return 1;
+sub assign_customer_number {
+ my $s =3D shift || { Config =3D> { counter =3D> 'customer:id' } };
+ return $Tag->counter( { sql =3D> $s->{Config}{counter} } );
}
=20
sub create_vendor_purchase_order {
@@ -308,66 +207,215 @@
return $string;
}
=20
-
sub create_order_entry {
=20
- my $self =3D shift;
- my $order =3D shift;
+ ## For syntax check
+ # use vars qw($Tag);
=20
- unless(ref $order) {
- my $ary =3D { $order, @_ };
- $order =3D $ary;
- }
+ my $self =3D shift;
+ my $opt =3D shift;
=20
- my $result;
+ my $cfg =3D $self->{Config} || {};
=20
- my $lineitem;
-=20=20=20=20
- my $call =3D {
- path =3D> $self->{Config}{path} || $SL_PATH,
- login =3D> $self->{Config}{login} || $SL_USER,
- password =3D> $self->{Config}{password} || $SL_PASS,
- };
-
-
- $call->{action} =3D "Save Order";
- $call->{type} =3D "sales_order";
-
- $call->{new_form} =3D "1";
- $call->{vc} =3D "customer";
- $call->{title} =3D "Add Sales Order";
-
- $call->{customer_id} =3D $order->{username};
- $call->{discount} =3D "0";
- $call->{customer} =3D $order->{compuser};
- $call->{ordnumber} =3D $order->{orderno};
- $call->{shippingpoint} =3D $order->{shipping};
- $call->{currency} =3D "USD";
- $call->{orddate} =3D $order->{date};
- $call->{reqdate} =3D $order->{date};
-
- $lineitem =3D 1;
-
- for ( my $ln =3D 1; $ln <=3D $order->{lineitems}; $ln++ ) {
-
- my $ref =3D $order->{orderitem}{$ln};
- $call->{"qty_$ln"} =3D $ref->{quantity};
- $call->{"unit_$ln"} =3D $ref->{uom} || 'each';
- $call->{"partnumber_$ln"} =3D $ref->{part_number} || $SL_ITEM_NAM=
E;
- $call->{"description_$ln"} =3D $ref->{description};
- $call->{"sellprice_$ln"} =3D $ref->{price};
- $call->{"id_$ln"} =3D $ref->{part_id} || $SL_ITEM_ID;
- $call->{"income_accno_$ln"} =3D $ref->{income_accno} || '4020';
- $call->{"expense_accno_$ln"} =3D $ref->{expense_accno} || '5020';
- $call->{"listprice_$ln"} =3D $ref->{price};
- $call->{"assembly_$ln"} =3D 0;
- }
+ my $cart =3D delete $opt->{cart};
=20
- $call->{notes} =3D $order->{notes} || "Notes";
- $call->{rowcount} =3D $order->{lineitem};
+ ## Allow a cart name, a cart reference, or default to current cart
+ if($cart and ! ref($cart)) {
+ $cart =3D $Vend::Session->{carts}{$cart};
+ }
+
+ $cart ||=3D $Vend::Items;
+
+ my @charges;
+ my $salestax =3D delete $opt->{salestax};
+ my $salestax_desc =3D delete($opt->{salestax_desc}) || $cfg->{salestax_de=
sc};
+ my $salestax_part =3D delete($opt->{salestax_part}) || $cfg->{salestax_pa=
rt};
+ $salestax_part ||=3D 'SALESTAX';
+ if(not length $salestax) {
+ $salestax =3D $Tag->salestax( { noformat =3D> 1 } );
+ }
+ $salestax_desc ||=3D "$::Values->{state} Sales Tax";
+ push @charges, {
+ code =3D> $salestax_part,
+ description =3D> $salestax_desc,
+ mv_price =3D> $salestax,
+ };
+
+ if($::Values->{mv_handling}) {
+ my @handling =3D split /\0+/, $::Values->{mv_handling};
+ my $part =3D delete ($opt->{handling_part})
+ || $cfg->{handling_part}
+ || 'HANDLING';
+ for (@handling) {
+ my $desc =3D $Tag->shipping_desc($_);
+ my $cost =3D $Tag->shipping( { mode =3D> $_, noformat =3D> 1 });
+ push @charges, {
+ code =3D> $part,
+ description =3D> $desc,
+ mv_price =3D> $cost,
+ };
+ }
+ }
=20
- $result =3D call_sl_script('oe.pl', $call);
+ my $shipping =3D delete $opt->{shipping};
+ my $shipping_desc =3D delete($opt->{shipping_desc});
+ my $shipping_part =3D delete($opt->{shipping_part}) || $cfg->{shipping_pa=
rt};
+ $shipping_part ||=3D 'SHIPPING';
+ if(not length $shipping) {
+ $shipping =3D $Tag->shipping( { noformat =3D> 1 } );
+ }
+ $shipping_desc ||=3D $Tag->shipping_desc();
+ push @charges, {
+ code =3D> $shipping_part,
+ description =3D> $shipping_desc,
+ mv_price =3D> $shipping,
+ };
+
+ my $tab =3D $cfg->{link_table} || 'customer';
+ my $db =3D ::database_exists_ref($tab)
+ or die errmsg("No database '%s' for SQL-Ledger link!J", $tab);
+ my $dbh =3D $db->dbh()
+ or die errmsg("No database handle for table '%s'.", $tab);
+
+ my $cq =3D 'select id from parts where partnumber =3D ?';
+ my $sth =3D $dbh->prepare('select id from parts where partnumber =3D ?')
+ or die errmsg("Prepare '%s' failed.", $cq);
+
+ my @oe;
+
+ my $olq =3D q{
+ INSERT INTO orderitems=20
+ (trans_id, parts_id, description, qty, sellprice, discount)
+ VALUES (?, ?, ?, ?, ?, ?)
+ };
+ my $ol_sth =3D $dbh->prepare($olq)
+ or die errmsg("Prepare '%s' failed.", $olq, $tab);
+
+ my @items;
+ foreach my $item (@$cart) {
+ my $code =3D $item->{code};
+ my $desc =3D $item->{description} || Vend::Data::item_description($item);
+ my $price =3D Vend::Data::item_price($item);
+ my $qty =3D $item->{quantity};
+ my $sub =3D $qty * $price;
+ my $discsub =3D Vend::Interpolate::discount_price($item, $sub, $qty);
+ my $discount =3D 0;
+ if($discsub !=3D $sub) {
+ $discount =3D 100 * (1 - $discsub / $sub);
+ }
+ $sth->execute($code)
+ or die errmsg("Statement '%s' failed for '%s'.", $cq, $code);
+ my ($pid) =3D $sth->fetchrow_array;
+ if(! $pid) {
+ my $iacc =3D $cfg->{inventory_accno_id} || 1520;
+ my $sacc =3D $cfg->{income_accno_id} || 4020;
+ my $eacc =3D $cfg->{expense_accno_id} || 5010;
+ my @add;
+ my $addq =3D <<EOF;
+INSERT INTO parts (
+ partnumber,
+ description,
+ unit,
+ listprice,
+ sellprice,
+ lastcost,
+ weight,
+ notes,
+ rop,
+ inventory_accno_id,
+ income_accno_id,
+ expense_accno_id
+) VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )
+EOF
+ my $sh =3D $dbh->prepare($addq)
+ or die errmsg("Prepare add part '%s' failed.", $addq);
+
+ # partnumber
+ push @add, $code;
+ # description
+ push @add, $desc;
+ # unit
+ push @add, $Tag->field('uom', $code) || 'ea';
+ # listprice
+ push @add, $price;
+ # sellprice
+ push @add, $price;
+ # lastcost
+ push @add, 0;
+ # weight
+ push @add, $Tag->field('weight', $code) || 0;
+ # notes
+ push @add, '';
+ # rop
+ push @add, 0;
+ # inventory_accno_id
+ push @add, $iacc;
+ # income_accno_id
+ push @add, $sacc;
+ # expense_accno_id
+ push @add, $eacc;
+ $sh->execute(@add)=20
+ or die errmsg("Execute add part '%s' failed.", $addq);
+=09=09=09=09
+ }
+ $sth->execute($code)
+ or die errmsg("Statement '%s' failed for '%s'.", $cq, $code);
+ my ($newpid) =3D $sth->fetchrow_array;
+ push @items, [$newpid, $desc, $qty, $price, $discount];
+ }
+
+#(trans_id, parts_id, description, qty, sellprice, discount)
+
+ for my $c (@charges) {
+ $sth->execute($c->{code})
+ or die errmsg("Statement '%s' failed.", $cq);
+ my ($pid) =3D $sth->fetchrow_array;
+ push @items, [$pid, $c->{description}, 1, $c->{mv_price}, 0];=20
+ }
+
+ my ($tid) =3D $Tag->counter({ sql =3D> "$tab:id" });
+
+ my $tq =3D q{
+ INSERT INTO oe VALUES (
+ ?,
+ ?,
+ date('now'::text),
+ 0,
+ ?,
+ ?,
+ ?,
+ date('now'::text),
+ 'f',
+ '',
+ ?,
+ ?)
+ };
+
+ my $total =3D $Tag->total_cost({ noformat =3D> 1 });
+
+ my $tsth =3D $dbh->prepare($tq)
+ or die errmsg("Statement '%s' failed.", $tq);
+
+ my $customer_id =3D $opt->{customer_id} || $Vend::Session->{username};
+ $customer_id =3D~ s/\D+//g;
+ my @vals =3D (
+ $tid,
+ $opt->{order_number} || $::Values->{mv_order_number},
+ $customer_id,
+ $total,
+ $total,
+ $opt->{notes} || $::Values->{gift_note},
+ $cfg->{currency_code} || 'usd',
+ );
+=09
+ $tsth->execute(@vals)=20
+ or die errmsg("Statement '%s' failed.", $tq);
=20
+ for(@items) {
+ $ol_sth->execute($tid, @$_);
+ }
+=09=09
+#::logDebug("past accounting, ready to return 1");
return 1;
}
=20
@@ -383,6 +431,227 @@
=20
=20
=3Dhead
+
+CREATE SEQUENCE "id" start 1 increment 1 maxvalue 2147483647 minvalue 1 c=
ache 1 ;
+
+CREATE TABLE "makemodel" (
+ "id" integer,
+ "parts_id" integer,
+ "name" text
+);
+CREATE TABLE "gl" (
+ "id" integer DEFAULT nextval('id'::text),
+ "source" text,
+ "description" text,
+ "transdate" date DEFAULT date('now'::text)
+);
+
+CREATE TABLE "chart" (
+ "id" integer DEFAULT nextval('id'::text),
+ "accno" integer,
+ "description" text,
+ "charttype" character(1) DEFAULT 'A',
+ "gifi" integer,
+ "category" character(1),
+ "link" text
+);
+
+CREATE TABLE "defaults" (
+ "inventory_accno_id" integer,
+ "income_accno_id" integer,
+ "expense_accno_id" integer,
+ "fxgain_accno_id" integer,
+ "fxloss_accno_id" integer,
+ "invnumber" text,
+ "ordnumber" text,
+ "yearend" character varying(5),
+ "curr" text,
+ "weightunit" character varying(5),
+ "businessnumber" text,
+ "version" character varying(8)
+);
+
+CREATE TABLE "acc_trans" (
+ "trans_id" integer,
+ "chart_id" integer,
+ "amount" double precision,
+ "transdate" date DEFAULT date('now'::text),
+ "source" text,
+ "cleared" boolean DEFAULT 'f',
+ "fx_transaction" boolean DEFAULT 'f'
+);
+
+CREATE TABLE "invoice" (
+ "id" integer DEFAULT nextval('id'::text),
+ "trans_id" integer,
+ "parts_id" integer,
+ "description" text,
+ "qty" real,
+ "allocated" real,
+ "sellprice" double precision,
+ "fxsellprice" double precision,
+ "discount" real,
+ "assemblyitem" boolean DEFAULT 'f'
+);
+
+CREATE TABLE "vendor" (
+ "id" integer DEFAULT nextval('id'::text),
+ "name" character varying(35),
+ "addr1" character varying(35),
+ "addr2" character varying(35),
+ "addr3" character varying(35),
+ "addr4" character varying(35),
+ "contact" character varying(35),
+ "phone" character varying(20),
+ "fax" character varying(20),
+ "email" text,
+ "notes" text,
+ "terms" smallint DEFAULT 0,
+ "taxincluded" boolean
+);
+
+CREATE TABLE "customer" (
+ "id" integer DEFAULT nextval('id'::text),
+ "name" character varying(35),
+ "addr1" character varying(35),
+ "addr2" character varying(35),
+ "addr3" character varying(35),
+ "addr4" character varying(35),
+ "contact" character varying(35),
+ "phone" character varying(20),
+ "fax" character varying(20),
+ "email" text,
+ "notes" text,
+ "discount" real,
+ "taxincluded" boolean,
+ "creditlimit" double precision DEFAULT 0,
+ "terms" smallint DEFAULT 0,
+ "shiptoname" character varying(35),
+ "shiptoaddr1" character varying(35),
+ "shiptoaddr2" character varying(35),
+ "shiptoaddr3" character varying(35),
+ "shiptoaddr4" character varying(35),
+ "shiptocontact" character varying(20),
+ "shiptophone" character varying(20),
+ "shiptofax" character varying(20),
+ "shiptoemail" text
+);
+
+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'
+);
+
+CREATE TABLE "assembly" (
+ "id" integer,
+ "parts_id" integer,
+ "qty" double precision
+);
+
+CREATE TABLE "ar" (
+ "id" integer DEFAULT nextval('id'::text),
+ "invnumber" text,
+ "ordnumber" text,
+ "transdate" date DEFAULT date('now'::text),
+ "customer_id" integer,
+ "taxincluded" boolean,
+ "amount" double precision,
+ "netamount" double precision,
+ "paid" double precision,
+ "datepaid" date,
+ "duedate" date,
+ "invoice" boolean DEFAULT 'f',
+ "shippingpoint" text,
+ "terms" smallint DEFAULT 0,
+ "notes" text,
+ "curr" character(3)
+);
+
+CREATE TABLE "ap" (
+ "id" integer DEFAULT nextval('id'::text),
+ "invnumber" text,
+ "transdate" date DEFAULT date('now'::text),
+ "vendor_id" integer,
+ "taxincluded" boolean,
+ "amount" double precision,
+ "netamount" double precision,
+ "paid" double precision,
+ "datepaid" date,
+ "duedate" date,
+ "invoice" boolean DEFAULT 'f',
+ "ordnumber" text,
+ "curr" character(3)
+);
+
+CREATE TABLE "partstax" (
+ "parts_id" integer,
+ "chart_id" integer
+);
+
+CREATE TABLE "tax" (
+ "chart_id" integer,
+ "rate" double precision,
+ "taxnumber" text
+);
+
+CREATE TABLE "customertax" (
+ "customer_id" integer,
+ "chart_id" integer
+);
+
+CREATE TABLE "vendortax" (
+ "vendor_id" integer,
+ "chart_id" integer
+);
+
+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)
+);
+
+CREATE TABLE "orderitems" (
+ "trans_id" integer,
+ "parts_id" integer,
+ "description" text,
+ "qty" real,
+ "sellprice" double precision,
+ "discount" real
+);
+
+CREATE TABLE "exchangerate" (
+ "curr" character(3),
+ "transdate" date,
+ "buy" double precision,
+ "sell" double precision
+);
=20
SLInterface
=20
1.1 interchange/code/SystemTag/accounting.coretag
rev 1.1, prev_rev 1.0
Index: accounting.coretag
=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
UserTag accounting Order function
UserTag accounting addAttr
UserTag accounting Routine <<EOR
sub {
my ($func, $opt) =3D @_;
die "Accounting not enabled!"
unless $Vend::Cfg->{Accounting};
if(my $sys =3D $opt->{system}) {
my $former =3D $Vend::Cfg->{Accounting};
$Vend::Cfg->{Accounting} =3D $Vend::Cfg->{Accounting_repository}{$sys}
or do {
logError(
"Failed to change accounting system to %s, returning to %s.",
$opt->{system},
$former->{Class},
);
$Vend::Cfg->{Accounting} =3D $former;
return undef;
};
}
my $a =3D $Vend::Cfg->{Accounting}=20
or do {
logError("No accounting system present. Aborting.");
return undef;
};
=09
my $class =3D $a->{Class};
my $self =3D new $class;
unless( $self->can($func) ) {
logError(
"No function '%s' in accounting system %s. Aborting.",
$func,
$class,
);
return undef;
}
return $self->$func($opt);
}
EOR