[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