[interchange-cvs] interchange - heins modified lib/Vend/Accounting/SQL_Ledger.pm

interchange-core@icdevgroup.org interchange-core@icdevgroup.org
Sat Jul 20 21:11:00 2002


User:      heins
Date:      2002-07-21 01:10:47 GMT
Modified:  lib/Vend/Accounting SQL_Ledger.pm
Log:
* Add routine to transfer parts from Interchange to SQL-Ledger.

Revision  Changes    Path
1.5       +278 -17   interchange/lib/Vend/Accounting/SQL_Ledger.pm


rev 1.5, prev_rev 1.4
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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- SQL_Ledger.pm	7 Jul 2002 21:07:57 -0000	1.4
+++ SQL_Ledger.pm	21 Jul 2002 01:10:47 -0000	1.5
@@ -26,6 +26,23 @@
 use Vend::Util;
 use Vend::Accounting;
 use Text::ParseWords;
+use vars qw/$Have_AR $Have_IC $Have_IS/;
+eval {
+	require SL::GL;
+	require SL::AR;
+	$Have_AR =3D 1;
+};
+
+eval {
+	require SL::IC;
+	$Have_IC =3D 1;
+};
+
+
+eval {
+	require SL::IS;
+	$Have_IS =3D 1;
+};
=20
 use vars qw/$VERSION @ISA/;
 @ISA =3D qw/ Vend::Accounting /;
@@ -226,10 +243,37 @@
=20
 	$cart ||=3D $Vend::Items;
=20
+	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 @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};
+	if($Vend::Cfg->{Levies}) {
+		$Tag->levies(1);
+		my $lcart =3D $::Levies;
+		for my $levy (@$lcart) {
+			my $pid =3D $levy->{part_number};
+			$pid ||=3D uc($levy->{group} || $levy->{type});
+			my $lresult =3D {
+						code =3D> $pid,
+						description =3D> $levy->{description},
+						mv_price =3D> $levy->{cost},
+			};
+#::logDebug("levy result=3D" . ::uneval($lresult));
+			push @charges, $lresult;
+		}
+	}
+	else {
+		my $salestax =3D $opt->{salestax};
+		my $salestax_desc =3D $opt->{salestax_desc} || $cfg->{salestax_desc};
+		my $salestax_part =3D $opt->{salestax_part} || $cfg->{salestax_part};
 	$salestax_part ||=3D 'SALESTAX';
 	if(not length $salestax) {
 		$salestax =3D $Tag->salestax( { noformat =3D> 1 } );
@@ -243,7 +287,7 @@
=20
 	if($::Values->{mv_handling}) {
 		my @handling =3D split /\0+/, $::Values->{mv_handling};
-		my $part	=3D delete ($opt->{handling_part})
+			my $part	=3D $opt->{handling_part}
 					|| $cfg->{handling_part}
 					|| 'HANDLING';
 		for (@handling) {
@@ -257,9 +301,9 @@
 		}
 	}
=20
-	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};
+		my $shipping =3D $opt->{shipping};
+		my $shipping_desc =3D $opt->{shipping_desc};
+		my $shipping_part =3D $opt->{shipping_part} || $cfg->{shipping_part};
 	$shipping_part ||=3D 'SHIPPING';
 	if(not length $shipping) {
 		$shipping =3D $Tag->shipping( { noformat =3D> 1 } );
@@ -270,16 +314,7 @@
 					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);
+	}
=20
 	my @oe;
=20
@@ -423,6 +458,232 @@
     return 1;
 }
=20
+my @all_part_fields =3D qw/
+			partnumber
+			description
+			bin
+			unit
+			listprice
+			sellprice
+			weight
+			onhand
+			notes
+			inventory_accno_id
+			income_accno_id
+			expense_accno_id
+			obsolete
+/;
+my @update_part_fields =3D qw/
+			partnumber
+			description
+			unit
+			listprice
+			weight
+			obsolete
+/;
+
+my %query =3D (
+	find   =3D> 'SELECT id FROM parts WHERE partnumber =3D ?',
+	insert =3D> 'INSERT INTO parts ( $ALLFIELDS$ ) VALUES ( $ALLVALUES$ )',
+	update =3D> 'UPDATE parts set $UPDATEFIELDS$ WHERE id =3D ?',
+);
+
+my %default_source =3D (qw/
+	listprice	products:price
+	sellprice	products:price
+	partnumber	products:sku
+	weight		products:weight
+	onhand		inventory:quantity
+	obsolete	products:inactive
+	description	products:description
+/);
+
+my %default_value =3D (
+	unit	=3D> 'ea',
+	weight	=3D> 0,
+	onhand	=3D> 0,
+	notes	=3D> 'Added from Interchange',
+	inventory_accno_id	=3D> 1520,
+	expense_accno_id	=3D> 5020,
+	income_accno_id	=3D> 4020,
+);
+
+use vars qw/%value_filter %value_indirect/;
+
+%value_filter =3D (
+	obsolete =3D> sub { my $val =3D shift; return $val =3D~ /1/ ? 't' : 'f'; =
},
+	inventory_accno_id	=3D> sub { my $val =3D shift; return $val || shift || =
0 },
+	expense_accno_id	=3D> sub { my $val =3D shift; return $val || shift || 0 =
},
+	income_accno_id		=3D> sub { my $val =3D shift; return $val || shift || 0 =
},
+	weight		=3D> sub { my $val =3D shift; return $val || shift || 0 },
+);
+
+
+%value_indirect =3D (
+	inventory_accno_id	=3D> 'select id from chart where accno =3D ?',
+	expense_accno_id	=3D>  'select id from chart where accno =3D ?',
+	income_accno_id		=3D>  'select id from chart where accno =3D ?',
+);
+
+
+sub parts_update {
+	my ($self, $opt) =3D @_;
+	my $cfg =3D $self->{Config};
+	my $atab =3D $cfg->{link_table}
+		or die errmsg("missing accounting link_table: %s", 'definition');
+	my $adb =3D ::database_exists_ref($atab)
+		or die errmsg("missing accounting link_table: %s", 'table');
+	my $dbh =3D $adb->dbh()
+		or die errmsg("missing accounting link_table: %s", 'handle');
+
+
+	my %source  =3D %default_source;
+	my %default =3D %default_value;
+	for(@all_part_fields) {
+		my $src =3D $cfg->{"parts_source_$_"};
+		if(defined $src) {
+			$source{$_} =3D $src;
+		}
+		my $def =3D $cfg->{"parts_default_$_"};
+		if(defined $def) {
+			$default{$_} =3D $def;
+		}
+	}
+	my @fields =3D grep defined $source{$_} || defined $default{$_}, @all_par=
t_fields;
+	my $fstring =3D join ", ", @fields;
+
+	my @ufields;
+	if($cfg->{update_fields}) {
+		@ufields =3D grep /\S/, split /[\s,\0]+/, $cfg->{update_fields};
+	}
+	else {
+		@ufields =3D @update_part_fields;
+	}
+
+	my @vph;
+	my @uph;
+
+	push(@vph, '?') for @fields;
+	for(@ufields) {
+		push @uph, "$_ =3D ?";
+	}
+
+	my $partskey =3D $cfg->{parts_key} || 'sku';
+
+	my %dbo;
+	my %rowfunc;
+	my %row;
+
+	my $colsub =3D sub {
+		my ($name) =3D @_;
+		my $src =3D $source{$name};
+		my $val;
+		my ($st, $sc) =3D split /:/, ($src || '');
+		if($sc and defined $row{$st}) {
+			$val =3D defined $row{$st}{$sc} ? $row{$st}{$sc} : $default{$name};
+		}
+		else {
+			$val =3D $default{$name};
+		}
+
+		$val =3D '' if ! defined $val;
+		my $filt =3D $value_filter{$name} || '';
+		my $indir =3D $value_indirect{$name} || '';
+#::logDebug("$name=3D'$val' filter=3D$filt indir=3D$indir");
+		if($indir) {
+			my $sth =3D $dbh->prepare($indir);
+			$sth->execute($val);
+			$val =3D ($sth->fetchrow_array)[0];
+		}
+
+		if($filt) {
+			$val =3D $filt->($val, $default{$name});
+		}
+#::logDebug("$name=3D'$val'");
+		return $val;
+	};
+
+	for (values %source) {
+		my ($t,$c) =3D split /:/, $_;
+		if(! $t) {
+			$rowfunc{""} ||=3D sub { return Vend::Data::product_row_hash(shift) };
+		}
+		else {
+			my $d =3D $dbo{$t} ||=3D ::database_exists_ref($t);
+			$rowfunc{$t} ||=3D sub { return $d->row_hash(shift) };
+		}
+	}
+
+	my $qst =3D $dbh->prepare('select id from parts where partnumber =3D ?')
+		or die errmsg("accounting statement handle: %s", 'part check');
+
+	my $upq =3D $query{update};
+	$upq =3D~ s/\$UPDATEFIELDS\$/join ", ", @uph/e;
+#::logDebug("update query is: $upq");
+	my $qup =3D $dbh->prepare($upq)
+		or die errmsg("accounting statement prepare: %s", 'update query');
+
+	my $inq =3D $query{insert};
+	$inq =3D~ s/\$ALLFIELDS\$/join ", ", @fields/e;
+	$inq =3D~ s/\$ALLVALUES\$/join ",", @vph/e;
+#::logDebug("insert query is: $inq");
+	my $qin =3D $dbh->prepare($inq)
+		or die errmsg("accounting statement prepare: %s", 'update query');
+
+	my @parts;
+
+	my $source_tables =3D $cfg->{parts_tables} || 'products';
+
+	if($opt->{skus}) {
+		@parts =3D grep /\S/, split /[\s,\0]+/, $opt->{skus};
+	}
+	else {
+		my @tabs =3D grep /\S/, split /[\s,\0]+/, $source_tables;
+		for(@tabs) {
+			 my $q =3D "select $partskey from $_";
+			 my $db =3D ::database_exists_ref($_)
+			 	or next;
+			 my $ary =3D $db->query($q) || [];
+			 for(@$ary) {
+			 	push @parts, $_->[0];
+			 }
+		}
+	}
+=09
+	my $updated =3D 0;
+
+	foreach my $p (@parts) {
+#::logDebug("Doing part $p");
+		%row =3D ();
+		for(keys %rowfunc) {
+			$row{$_} =3D $rowfunc{$_}->($p);
+		}
+		my $pid;
+		if($qst->execute($p)) {
+			$pid =3D ($qst->fetchrow_array)[0];
+		}
+=09=09
+		if($pid) {
+			my @v;
+			for(@ufields) {
+				push @v, $colsub->($_);
+			}
+			push @v, $pid;
+			$qup->execute(@v);
+			$updated++;
+		}
+		else {
+			my @v;
+			for(@fields) {
+				push @v, $colsub->($_);=20
+			}
+			$qin->execute(@v);
+			$updated++;
+		}
+	}
+
+	return $updated;
+}
=20
 sub enter_payment {
     my ($self, $string) =3D @_;