[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 @_;