1#
2# Vend::Accounting::SQL_Ledger
3# $Id: SQL_Ledger.pm,v 1.13 2006-08-16 13:34:09 mheins Exp $
4#
5# SQL-Ledger Accounting Interface for Interchange
6#
7# Copyright (c) 2002 Daniel H. Thompson
8# All rights reserved.
9#
10# This program is free software; you can redistribute it and/or
11# modify it under the terms of the GNU General Public License.
12#
13# However, I do request that this copyright notice remain attached
14# to the file, and that you please attach a note listing any
15# modifications you have made to the package.
16#
17# Copyright (c) 2002 Mike Heins
18# Major changes made by Mike Heins to fit into Vend::Accounting interface
19
20package Vend::Accounting::SQL_Ledger;
21
22# See the bottom of this file for the POD documentation.
23# Search for the string '=head'.
24
25use strict;
26use warnings;
27use Vend::Util;
28use Vend::Accounting;
29use Text::ParseWords;
30use vars qw/$Have_AR $Have_IC $Have_IS/;
31eval {
32	require SL::GL;
33	require SL::AR;
34	$Have_AR = 1;
35};
36
37eval {
38	require SL::IC;
39	$Have_IC = 1;
40};
41
42
43eval {
44	require SL::IS;
45	$Have_IS = 1;
46};
47
48use vars qw/$VERSION @ISA/;
49@ISA = qw/ Vend::Accounting /;
50
51my $Tag = new Vend::Tags;
52
53sub new {
54    my $class = shift;
55	my $opt = shift;
56
57	if($opt and ref($opt) ne 'HASH') {
58		my $tmp = $opt;
59		$opt = { $tmp, @_ };
60	}
61
62	my $self = new Vend::Accounting;
63
64	my $cfg = $self->{Config} = {};
65	while (my ($k, $v) = each %{$Vend::Cfg->{Accounting}}) {
66		$cfg->{$k} = $v;
67	}
68	while (my ($k, $v) = each %$opt) {
69		$cfg->{$k} = $v;
70	}
71
72	if(! $cfg->{counter}) {
73		my $tab = $cfg->{link_table} || 'customer';
74		$cfg->{counter} = "$tab:id";
75	}
76    bless $self, $class;
77#::logDebug("Accounting self=" . uneval($self) );
78	return $self;
79}
80
81sub myconfig {
82	my $self = shift;
83	return $self->{_myconfig} if $self->{_myconfig};
84
85	my @keys = qw(
86		acs address admin businessnumber charset company countrycode currency
87		dateformat dbconnect dbdriver dbhost dbname dboptions dbpasswd dbport
88		dbuser email fax name numberformat password printer shippingpoint sid
89		signature stylesheet tel templates
90	);
91
92	my $cfg = $self->{Config};
93	if($cfg->{myconfig_file}) {
94	  no strict;
95	  my $string =  readfile($cfg->{myconfig_file});
96	  $string =~ s/.*%myconfig\s*=\s*\(/{/s;
97	  $string =~ s/\);\s*$/}/s;
98	  $self->{_myconfig} = Vend::Interpolate::tag_calc($string);
99	  if(! $self->{_myconfig}) {
100	  	die errmsg(
101				"operation '%s' failed: %s",
102				"myconfig_file $cfg->{myconfig_file}",
103				$Vend::Session->{last_error},
104				);
105	  }
106	}
107	elsif ($cfg->{myconfig_string}) {
108		$self->{_myconfig} = get_option_hash($cfg->{myconfig_string});
109	}
110	else {
111		my $confhash = {};
112		for (@keys) {
113			$confhash->{$_} = $cfg->{$_};
114		}
115		$self->{_myconfig} = $confhash;
116	}
117	return $self->{_myconfig};
118}
119
120# ------------------ START OF THE LIBRARY ------------
121
122my %Def_filter = (
123
124);
125
126my %Def_map = (
127
128customer => <<EOF,
129    name            "{company?}{b_company?b_company:company}{/company?}{company:}{b_address1?b_lname:lname}{/company:}"
130    addr1           {b_address1?b_address1:address1}
131    addr2           {b_address1?b_address2:address2}
132    addr3           "{b_address1?}{b_city}, {b_state}  {b_zip}{/b_address1?}{b_address1:}{city}, {state}  {zip}{/b_address1:}"
133    addr4           "{b_address1?}{b_country}--{country:name:{b_country}}{/b_address1?}{b_address1:}{country}--{country:name:{country}}{/b_address1:}"
134    contact         "{b_fname|{fname}} {b_lname|{lname}}"
135    phone           "{b_phone|{phone_day}}"
136    email			email
137    shiptoname      "{company?}{company}{/company?}{company:}{lname}{/company:}"
138    shiptoaddr1     address1
139    shiptoaddr2     address2
140    shiptoaddr3     "{city}, {state}  {zip}"
141    shiptoaddr4     "{country} - {country:name:{country}}"
142    shiptocontact   "{fname} {lname}"
143    shiptophone     phone_day
144    shiptofax       fax
145    shiptoemail     email
146EOF
147
148	oe =>		q(
149					ordnumber	order_number
150					vendor_id   vendor_id
151					customer_id username
152					amount		total_cost
153					reqdate		require_date
154					curr		currency_code
155				),
156
157);
158
159my %Include_map = (
160	customer =>	[qw/
161					name
162					addr1
163					addr2
164					addr3
165					addr4
166					contact
167					phone
168					email
169					shiptoname
170					shiptoaddr1
171					shiptoaddr2
172					shiptoaddr3
173					shiptoaddr4
174					shiptocontact
175					shiptophone
176					shiptofax
177					shiptoemail
178				/],
179	oe =>		[qw/
180					ordnumber
181					transdate
182					vendor_id
183					customer_id
184					amount
185					netamount
186					reqdate
187					taxincluded
188					shippingpoint
189					notes
190					curr
191				/],
192	);
193
194sub map_data {
195	my ($s, $type, $ref, $record) = @_;
196	$record ||= {};
197	$ref    ||= $::Values;
198
199	my $keys = $s->{Config}{"include_$type"}	|| $Include_map{$type};
200	my $map  = $s->{Config}{"map_$type"}		|| $Def_map{$type};
201	my $filt = $s->{Config}{"filter_$type"}		|| $Def_filter{$type};
202	$map =~ s/\r?\n/ /g;
203	$map =~ s/^\s+//;
204	$map =~ s/\s+$//;
205	my %map  = Text::ParseWords::shellwords($map);
206	my %filt;
207	%filt = Text::ParseWords::shellwords($filt) if $filt;
208
209	my @keys;
210	if(ref($keys)) {
211		@keys = @$keys;
212	}
213	else {
214		$keys =~ s/^\s+//;
215		$keys =~ s/\s+$//;
216		@keys = split /[\s,\0]+/, $keys;
217	}
218
219	for my $k (@keys) {
220		my $filt = $filt{$k};
221		my $v = $map{$k};
222		$filt = 'strip mac' unless defined $filt;
223		my $val;
224		if($v =~ /^(\w+)\:(\w+)$/) {
225			$val = length($ref->{$1}) ? $ref->{$1} : $ref->{$2};
226		}
227		elsif ( $v =~ /{/) {
228			$val = Vend::Interpolate::tag_attr_list($v, $ref);
229		}
230		elsif(length($v)) {
231			$val = $ref->{$v};
232		}
233		else {
234			$val = $ref->{$k};
235		}
236		$record->{$k} = Vend::Interpolate::filter_value($filt, $val);
237	}
238	return $record;
239}
240
241sub save_transactions_list {
242	my ($self, $opt) = @_;
243	use vars qw($Tag);
244
245	my $ary = $opt->{transaction_array};
246
247	if(! $ary) {
248		my $tab = $opt->{transactions_table} || 'transactions';
249		my $db = ::database_exists_ref($tab)
250			or die errmsg("bad %s table '%s'", 'transactions', $tab);
251		my $q = $opt->{sql} || "select * from $tab";
252		$ary = $db->query( { sql => $q, hashref => 1 } );
253	}
254
255	die errmsg("No transactions array sent!")
256		unless ref($ary) eq 'ARRAY';
257
258	my $prof = $self->{userdb_profile} || 'default';
259	my $ucfg = $Vend::Cfg->{UserDB_repository}{$prof} || {};
260
261	my $tab = $opt->{orderline_table} || 'orderline';
262	my $db = ::database_exists_ref($tab)
263		or die errmsg("bad %s table '%s'", 'orderline', $tab);
264
265	my $count;
266	for(@$ary) {
267		my $rec = $_;
268		my $id = $rec->{username};
269		$id =~ s/\s+$//;
270		if($id !~ /^\d+$/) {
271			$id = $Tag->counter( { sql => $ucfg->{sql_counter} || 'customer::id'});
272			my $msg = errmsg(
273				"assigned arbitrary customer number %s to user %s",
274				$id,
275				$rec->{username},
276			);
277			logError($msg);
278#::logDebug($msg);
279		}
280#::logDebug("passing rec=" . uneval($rec));
281		$self->save_customer_data($id, $rec);
282		my $on = $rec->{order_number};
283		my $query = "select * from $tab where order_number = '$on'";
284		my $oary = $db->query( { sql => $query, hashref => 1 } );
285		my @cart;
286		foreach my $item (@$oary) {
287			my $price = $item->{price};
288			my $quan = $item->{quantity}
289				or next;
290			next if $quan <= 0;
291			if ($item->{subtotal} <= 0) {
292				$item->{subtotal} = $quan * $price;
293			}
294
295			my $psubt = round_to_frac_digits($quan * $price);
296			my $asubt = round_to_frac_digits($item->{subtotal});
297			if($asubt != $psubt) {
298				$price = $item->{subtotal} / $quan;
299			}
300			my $ip = $item->{code};
301			$ip =~ s/.*-//;
302			$ip--;
303			push @cart, {
304				code => $item->{sku},
305				quantity => $quan,
306				description => $item->{description},
307				mv_price => $price,
308				mv_ip => $ip,
309			};
310		}
311
312		my $obj = new Vend::Accounting::SQL_Ledger;
313		my $notes = $rec->{gift_note};
314		$notes = $notes ? "$notes\n" : "";
315		$notes .= 'Added automatically by IC';
316		my $o = {
317				order_number => $on,
318				cart => \@cart,
319				order_date => $rec->{order_date},
320				notes => $rec->{gift_note},
321				salestax => $rec->{salestax} || 0,
322				shipping => $rec->{shipping} || 0,
323				handling => $rec->{handling} || 0,
324				total_cost => $rec->{total_cost} || 0,
325			};
326#::logDebug("Getting ready to create order entry: " . uneval($o));
327		$obj->create_order_entry($o);
328		$count++;
329	}
330	return $count;
331}
332
333sub save_customer_data {
334    my ($self, $userid, $hashdata) = @_;
335
336    my $result;
337	my $record = $self->map_data('customer', $hashdata);
338
339	$userid =~ s/\D+//g;
340    $record->{id} = $userid;
341
342	my $tab = $self->{Config}{customer_table} || 'customer';
343
344	my $db = ::database_exists_ref($tab)
345		or die errmsg("Customer table database '%s' inaccessible.", $tab);
346	my $status = $db->set_slice($userid, $record);
347	return $status;
348}
349
350sub assign_customer_number {
351	my $s = shift || { Config => { counter => 'customer:id' } };
352	return $Tag->counter( { sql => $s->{Config}{counter} } );
353}
354
355sub create_vendor_purchase_order {
356    my ($self, $string) = @_;
357    return $string;
358}
359
360sub create_order_entry {
361
362	## For syntax check
363	use vars qw($Tag);
364
365    my $self = shift;
366    my $opt = shift;
367
368	my $cfg = $self->{Config} || {};
369
370	my $cart = delete $opt->{cart};
371	my $no_levies;
372
373	## Allow a cart name, a cart reference, or default to current cart
374	if($cart and ! ref($cart)) {
375		$cart = $Vend::Session->{carts}{$cart};
376	}
377	elsif($cart
378			and defined $opt->{salestax}
379			and defined $opt->{shipping}
380			and defined $opt->{handling}
381			)
382	{
383		## Must be passed order batch
384		$no_levies = 1;
385	}
386
387	$cart ||= $Vend::Items;
388
389	my $tab = $cfg->{link_table} || 'customer';
390	my $db = ::database_exists_ref($tab)
391				or die errmsg("No database '%s' for SQL-Ledger link!J", $tab);
392	my $dbh = $db->dbh()
393				or die errmsg("No database handle for table '%s'.", $tab);
394
395	my $cq = 'select id from parts where partnumber = ?';
396	my $sth = $dbh->prepare('select id from parts where partnumber = ?')
397				or die errmsg("Prepare '%s' failed.", $cq);
398
399
400	my @charges;
401#::logDebug("Levies=" . uneval($Vend::Cfg->{Levies}));
402	if($Vend::Cfg->{Levies}) {
403		$Tag->levies(1);
404		my $lcart = $::Levies;
405#::logDebug("levy cart=" . uneval($lcart));
406		for my $levy (@$lcart) {
407			my $pid = $levy->{part_number};
408			$pid ||= uc($levy->{group} || $levy->{type});
409			my $lresult = {
410						code => $pid,
411						description => $levy->{description},
412						mv_price => $levy->{cost},
413			};
414#::logDebug("levy result=" . uneval($lresult));
415			push @charges, $lresult;
416		}
417	}
418	else {
419		my $salestax = $opt->{salestax};
420		my $salestax_desc = $opt->{salestax_desc} || $cfg->{salestax_desc};
421		my $salestax_part = $opt->{salestax_part} || $cfg->{salestax_part};
422	$salestax_part ||= 'SALESTAX';
423	if(not length $salestax) {
424		$salestax = $Tag->salestax( { noformat => 1 } );
425	}
426	$salestax_desc ||= "$::Values->{state} Sales Tax";
427	push @charges, {
428					code => $salestax_part,
429					description => $salestax_desc,
430					mv_price => $salestax,
431					}
432			if $salestax  > 0 || $cfg->{add_zero_salestax};
433
434	if($::Values->{mv_handling}) {
435		my @handling = split /\0+/, $::Values->{mv_handling};
436			my $part	= $opt->{handling_part}
437					|| $cfg->{handling_part}
438					|| 'HANDLING';
439		for (@handling) {
440			my $desc = $Tag->shipping_desc($_);
441			my $cost = $Tag->shipping( { mode => $_, noformat => 1 });
442				next unless $cost > 0 || $cfg->{add_zero_handling};
443			push @charges, {
444							code => $part,
445							description => $desc,
446							mv_price => $cost,
447						};
448		}
449	}
450
451		my $shipping = $opt->{shipping};
452		my $shipping_desc = $opt->{shipping_desc};
453		my $shipping_part = $opt->{shipping_part} || $cfg->{shipping_part};
454	$shipping_part ||= 'SHIPPING';
455	if(not length $shipping) {
456		$shipping = $Tag->shipping( { noformat => 1 } );
457	}
458	$shipping_desc ||= $Tag->shipping_desc();
459	push @charges, {
460					code => $shipping_part,
461					description => $shipping_desc,
462					mv_price => $shipping,
463					}
464			if $shipping > 0 || $cfg->{add_zero_shipping};
465	}
466
467	my @oe;
468
469	my $olq = q{
470				INSERT INTO orderitems
471					   (trans_id, parts_id, description, qty, sellprice, discount)
472						VALUES (?, ?, ?, ?, ?, ?)
473				};
474
475	my $ol_sth = $dbh->prepare($olq)
476		or die errmsg("Prepare '%s' failed.", $olq, $tab);
477
478=head2 parts table
479
480CREATE TABLE "parts" (
481	"id" integer DEFAULT nextval('id'::text),
482	"partnumber" text,
483	"description" text,
484	"bin" text,
485	"unit" character varying(5),
486	"listprice" double precision,
487	"sellprice" double precision,
488	"lastcost" double precision,
489	"priceupdate" date DEFAULT date('now'::text),
490	"weight" real,
491	"onhand" real DEFAULT 0,
492	"notes" text,
493	"makemodel" boolean DEFAULT 'f',
494	"assembly" boolean DEFAULT 'f',
495	"alternate" boolean DEFAULT 'f',
496	"rop" real,
497	"inventory_accno_id" integer,
498	"income_accno_id" integer,
499	"expense_accno_id" integer,
500	"obsolete" boolean DEFAULT 'f'
501);
502
503=cut
504
505	my $plq = q{SELECT	id,
506						partnumber,
507						description,
508						bin,
509						unit,
510						listprice,
511						assembly,
512						inventory_accno_id,
513						income_accno_id,
514						expense_accno_id
515				FROM parts
516				WHERE id = ?};
517
518	my $pl_sth = $dbh->prepare($plq)
519		or die errmsg("Prepare '%s' failed.", $plq, 'parts');
520
521	my @items;
522	foreach my $item (@$cart) {
523		my $code = $item->{code};
524		my $desc = $item->{description} || Vend::Data::item_description($item);
525		my $price = Vend::Data::item_price($item);
526		my $qty = $item->{quantity};
527		my $sub = $qty * $price;
528		my $discsub = Vend::Interpolate::discount_price($item, $sub, $qty);
529		my $discount = 0;
530		if($discsub != $sub) {
531			$discount = 100 * (1 - $discsub / $sub);
532		}
533		$sth->execute($code)
534			or die errmsg("Statement '%s' failed for '%s'.", $cq, $code);
535		my ($pid) = $sth->fetchrow_array;
536		if(! $pid) {
537			my $iacc = $cfg->{inventory_accno_id}	|| 1520;
538			my $sacc = $cfg->{income_accno_id}		|| 4020;
539			my $eacc = $cfg->{expense_accno_id}		|| 5010;
540			my @add;
541			my $addq = <<EOF;
542INSERT INTO parts (
543	partnumber,
544	description,
545	unit,
546	listprice,
547	sellprice,
548	lastcost,
549	weight,
550	notes,
551	rop,
552	inventory_accno_id,
553	income_accno_id,
554	expense_accno_id
555) VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?,
556			(select c.id from chart c where c.accno = ?),
557			(select c.id from chart c where c.accno = ?),
558			(select c.id from chart c where c.accno = ?)
559			)
560EOF
561			my $sh = $dbh->prepare($addq)
562				or die errmsg("Prepare add part '%s' failed.", $addq);
563
564			# partnumber
565			push @add, $code;
566			# description
567			push @add, $desc;
568			# unit
569			push @add, $Tag->field('uom', $code) || 'ea';
570			# listprice
571			push @add, $price;
572			# sellprice
573			push @add, $price;
574			# lastcost
575			push @add, 0;
576			# weight
577			push @add, $Tag->field('weight', $code) || 0;
578			# notes
579			push @add, '';
580			# rop
581			push @add, 0;
582			# inventory_accno_id
583			push @add, $iacc;
584			# income_accno_id
585			push @add, $sacc;
586			# expense_accno_id
587			push @add, $eacc;
588			$sh->execute(@add)
589				or die errmsg("Execute add part '%s' failed.", $addq);
590
591		}
592		$sth->execute($code)
593			or die errmsg("Statement '%s' failed for '%s'.", $cq, $code);
594		my ($newpid) = $sth->fetchrow_array;
595		push @items, [$newpid, $desc, $qty, $price, $discount];
596	}
597
598#(trans_id, parts_id, description, qty, sellprice, discount)
599
600	for my $c (@charges) {
601#::logDebug("doing item $c->{code}");
602		$sth->execute($c->{code})
603			or die errmsg("Statement '%s' failed.", $cq);
604		my ($pid) = $sth->fetchrow_array;
605		push @items, [$pid, $c->{description}, 1, $c->{mv_price}, 0];
606	}
607
608	my ($tid) = $Tag->counter({ sql => "$tab:id" });
609
610	my $res = {}; # Repository for result array
611
612	my @t = localtime();
613	$res->{invdate} = $opt->{order_date} || POSIX::strftime('%Y-%m-%d', @t);
614	$res->{duedate} = $opt->{req_date}   || POSIX::strftime('%Y-%m-%d', @t);
615
616=head2 oe table
617
618CREATE TABLE "oe" (
619	"id" integer DEFAULT nextval('id'::text),
620	"ordnumber" text,
621	"transdate" date DEFAULT date('now'::text),
622	"vendor_id" integer,
623	"customer_id" integer,
624	"amount" double precision,
625	"netamount" double precision,
626	"reqdate" date,
627	"taxincluded" boolean,
628	"shippingpoint" text,
629	"notes" text,
630	"curr" character(3)
631);
632
633=cut
634
635	my $tq = q{
636		INSERT INTO oe VALUES (
637			?,
638			?,
639			?,
640			?,
641			?,
642			?,
643			?,
644			?,
645			?,
646			?,
647			?,
648			?)
649		};
650
651	$opt->{total_cost} ||= $Tag->total_cost({ noformat => 1 });
652
653	my $tsth = $dbh->prepare($tq)
654		or die errmsg("Statement '%s' failed.", $tq);
655
656	$opt->{customer_id} ||= $Vend::Session->{username};
657	$opt->{customer_id} =~ s/\D+//g;
658
659	$res->{orderid}		= $tid;
660	$res->{ordnumber}	= $opt->{order_number} ||= $::Values->{mv_order_number},
661	$res->{vendor_id} = 0; # This is not a PO
662	$res->{customer_id} = $opt->{customer_id};
663	$res->{taxincluded} = $opt->{taxincluded} ? 't' : 'f',
664	$res->{shippingpoint} = $opt->{shippingpoint};
665	$res->{notes}    	= $opt->{notes} || $::Values->{gift_note},
666	$res->{currency}    = $opt->{currency_code} || $cfg->{currency_code} || 'USD';
667
668	my @vals = (
669				$res->{orderid},
670				$res->{ordnumber},
671				$res->{invdate},
672				$res->{vendor_id},
673				$res->{customer_id},
674				$opt->{total_cost},
675				$opt->{netamount} || $opt->{total_cost},
676				$res->{duedate},
677				$res->{taxincluded} ? 't' : 'f',
678				$res->{shippingpoint} || '',
679				$res->{notes},
680				$res->{currency},
681				);
682
683#::logDebug("ready to execute tquery=$tq with values=" . uneval(\@vals));
684	$tsth->execute(@vals)
685		or die errmsg("Statement '%s' failed.", $tq);
686
687	my $idx = 1;
688	my $acq = qq{SELECT accno from chart where id = ?};
689	my $asth = $dbh->prepare($acq)
690		or die errmsg("Prepare '%s' failed.", $acq);
691
692	for my $line (@items) {
693		$ol_sth->execute($tid, @$line);
694		my ($newpid, $desc, $qty, $price, $discount) = @$line;
695
696		$pl_sth->execute($newpid);
697		my $href = $pl_sth->fetchrow_hashref()
698			or die errmsg("Failed to retrieve part: %s", $DBI::errstr);
699		for(qw/ assembly bin description listprice partnumber unit /) {
700			$res->{$_ . "_$idx"} = defined $href->{$_} ? $href->{$_} : '';
701		}
702		for(qw/ expense_accno inventory_accno income_accno /) {
703			my $id = $href->{$_ . "_id"} || 0;
704			my $acc;
705			if($id > 0) {
706				$asth->execute($id);
707				my $ary;
708				$ary = $asth->fetchrow_arrayref
709					and $acc = $ary->[0];
710			}
711			$res->{$_ . "_$idx"} = $acc || 0;
712		}
713
714		## Shows order: push @items, [$newpid, $desc, $qty, $price, $discount];
715		$res->{"id_$idx"} = $newpid;
716		$res->{"sellprice_$idx"} = $price;
717		$res->{"qty_$idx"} = $qty;
718		$res->{"discount_$idx"} = $discount;
719
720		$idx++;
721	}
722
723	$res->{rowcount} = $idx;
724#::logDebug("past accounting, ready to return res=" . uneval($res));
725
726	if($opt->{do_payment}) {
727		$res->{paid_1} = $opt->{total_cost};
728	}
729
730	if($opt->{do_invoice}) {
731		$res = $self->post_invoice($res);
732	}
733
734    return $res;
735}
736
737my @all_part_fields = qw/
738			partnumber
739			description
740			bin
741			unit
742			listprice
743			sellprice
744			weight
745			onhand
746			notes
747			inventory_accno_id
748			income_accno_id
749			expense_accno_id
750			obsolete
751/;
752my @update_part_fields = qw/
753			partnumber
754			description
755			unit
756			listprice
757			weight
758			obsolete
759/;
760
761my %query = (
762	find   => 'SELECT id FROM parts WHERE partnumber = ?',
763	insert => 'INSERT INTO parts ( $ALLFIELDS$ ) VALUES ( $ALLVALUES$ )',
764	update => 'UPDATE parts set $UPDATEFIELDS$ WHERE id = ?',
765);
766
767my %default_source = (qw/
768	listprice	products:price
769	sellprice	products:price
770	partnumber	products:sku
771	weight		products:weight
772	onhand		inventory:quantity
773	obsolete	products:inactive
774	description	products:description
775/);
776
777my %default_value = (
778	unit	=> 'ea',
779	weight	=> 0,
780	onhand	=> 0,
781	notes	=> 'Added from Interchange',
782	inventory_accno_id	=> 1520,
783	expense_accno_id	=> 5020,
784	income_accno_id	=> 4020,
785);
786
787use vars qw/%value_filter %value_indirect/;
788
789%value_filter = (
790	obsolete => sub { my $val = shift; return $val =~ /1/ ? 't' : 'f'; },
791	inventory_accno_id	=> sub { my $val = shift; return $val || shift || 0 },
792	expense_accno_id	=> sub { my $val = shift; return $val || shift || 0 },
793	income_accno_id		=> sub { my $val = shift; return $val || shift || 0 },
794	weight		=> sub { my $val = shift; return $val || shift || 0 },
795);
796
797
798%value_indirect = (
799	inventory_accno_id	=> 'select id from chart where accno = ?',
800	expense_accno_id	=>  'select id from chart where accno = ?',
801	income_accno_id		=>  'select id from chart where accno = ?',
802);
803
804
805sub parts_update {
806	my ($self, $opt) = @_;
807	my $cfg = $self->{Config};
808	my $atab = $cfg->{link_table}
809		or die errmsg("missing accounting link_table: %s", 'definition');
810	my $adb = ::database_exists_ref($atab)
811		or die errmsg("missing accounting link_table: %s", 'table');
812	my $dbh = $adb->dbh()
813		or die errmsg("missing accounting link_table: %s", 'handle');
814
815
816	my %source  = %default_source;
817	my %default = %default_value;
818	for(@all_part_fields) {
819		my $src = $cfg->{"parts_source_$_"};
820		if(defined $src) {
821			$source{$_} = $src;
822		}
823		my $def = $cfg->{"parts_default_$_"};
824		if(defined $def) {
825			$default{$_} = $def;
826		}
827	}
828	my @fields = grep defined $source{$_} || defined $default{$_}, @all_part_fields;
829	my $fstring = join ", ", @fields;
830
831	my @ufields;
832	if($cfg->{update_fields}) {
833		@ufields = grep /\S/, split /[\s,\0]+/, $cfg->{update_fields};
834	}
835	else {
836		@ufields = @update_part_fields;
837	}
838
839	my @vph;
840	my @uph;
841
842	push(@vph, '?') for @fields;
843	for(@ufields) {
844		push @uph, "$_ = ?";
845	}
846
847	my $partskey = $cfg->{parts_key} || 'sku';
848
849	my %dbo;
850	my %rowfunc;
851	my %row;
852
853	my $colsub = sub {
854		my ($name) = @_;
855		my $src = $source{$name};
856		my $val;
857		my ($st, $sc) = split /:/, ($src || '');
858		if($sc and defined $row{$st}) {
859			$val = defined $row{$st}{$sc} ? $row{$st}{$sc} : $default{$name};
860		}
861		else {
862			$val = $default{$name};
863		}
864
865		$val = '' if ! defined $val;
866		my $filt = $value_filter{$name} || '';
867		my $indir = $value_indirect{$name} || '';
868#::logDebug("$name='$val' filter=$filt indir=$indir");
869		if($indir) {
870			my $sth = $dbh->prepare($indir);
871			$sth->execute($val);
872			$val = ($sth->fetchrow_array)[0];
873		}
874
875		if($filt) {
876			$val = $filt->($val, $default{$name});
877		}
878#::logDebug("$name='$val'");
879		return $val;
880	};
881
882	for (values %source) {
883		my ($t,$c) = split /:/, $_;
884		if(! $t) {
885			$rowfunc{""} ||= sub { return Vend::Data::product_row_hash(shift) };
886		}
887		else {
888			my $d = $dbo{$t} ||= ::database_exists_ref($t);
889			$rowfunc{$t} ||= sub { return $d->row_hash(shift) };
890		}
891	}
892
893	my $qst = $dbh->prepare('select id from parts where partnumber = ?')
894		or die errmsg("accounting statement handle: %s", 'part check');
895
896	my $upq = $query{update};
897	$upq =~ s/\$UPDATEFIELDS\$/join ", ", @uph/e;
898#::logDebug("update query is: $upq");
899	my $qup = $dbh->prepare($upq)
900		or die errmsg("accounting statement prepare: %s", 'update query');
901
902	my $inq = $query{insert};
903	$inq =~ s/\$ALLFIELDS\$/join ", ", @fields/e;
904	$inq =~ s/\$ALLVALUES\$/join ",", @vph/e;
905#::logDebug("insert query is: $inq");
906	my $qin = $dbh->prepare($inq)
907		or die errmsg("accounting statement prepare: %s", 'update query');
908
909	my @parts;
910
911	my $source_tables = $cfg->{parts_tables} || 'products';
912
913	if($opt->{skus}) {
914		@parts = grep /\S/, split /[\s,\0]+/, $opt->{skus};
915	}
916	else {
917		my @tabs = grep /\S/, split /[\s,\0]+/, $source_tables;
918		for(@tabs) {
919			 my $q = "select $partskey from $_";
920			 my $db = ::database_exists_ref($_)
921			 	or next;
922			 my $ary = $db->query($q) || [];
923			 for(@$ary) {
924			 	push @parts, $_->[0];
925			 }
926		}
927	}
928
929	my $updated = 0;
930
931	foreach my $p (@parts) {
932#::logDebug("Doing part $p");
933		%row = ();
934		for(keys %rowfunc) {
935			$row{$_} = $rowfunc{$_}->($p);
936		}
937		my $pid;
938		if($qst->execute($p)) {
939			$pid = ($qst->fetchrow_array)[0];
940		}
941
942		if($pid) {
943			my @v;
944			for(@ufields) {
945				push @v, $colsub->($_);
946			}
947			push @v, $pid;
948			$qup->execute(@v);
949			$updated++;
950		}
951		else {
952			my @v;
953			for(@fields) {
954				push @v, $colsub->($_);
955			}
956			$qin->execute(@v);
957			$updated++;
958		}
959	}
960
961	return $updated;
962}
963
964sub enter_payment {
965    my ($self, $string) = @_;
966	my $datastuff = uneval(\@_);
967    return $string;
968}
969
970sub post_invoice {
971
972	my ($self, $opt) = @_;
973
974	my $form = Form->new($opt);
975	my $myconfig = $self->myconfig();
976	my $cfg = $self->{Config};
977
978#::logDebug("have myconfig=" . uneval($myconfig));
979	$form->{AR}				||= $cfg->{default_ar}			|| 1200;
980	$form->{AR_paid}		||= $cfg->{default_ar_paid}		|| 1060;
981	$form->{fxgain_accno}	||= $cfg->{default_fxgain_accno}|| 4450;
982	$form->{fxloss_accno}	||= $cfg->{default_fxloss_accno}|| 5810;
983	$form->{invnumber}  	||= $Tag->counter( {
984								sql => $cfg->{inv_counter} || $cfg->{counter},
985							});
986
987	if($form->{paid_1} > 0) {
988		$form->{paidaccounts} = 1;
989		$form->{AR_paid_1}  = $form->{AR_paid};
990		$form->{datepaid_1} = $form->{invdate};
991	}
992	else {
993		$form->{paid_1} = 0;
994		$form->{paid} = 0;
995	}
996
997	IS->customer_details($myconfig, $form);
998
999	foreach my $key (qw(name addr1 addr2 addr3 addr4)) {
1000	  unless ($form->{"shipto$key"}) {
1001		$form->{"shipto$key"} = defined $form->{$key} ? $form->{$key} : '';
1002	  }
1003	  $form->{"shipto$key"} =~ s/"/&quot;/g;
1004	}
1005
1006#::logDebug("customer details back, form set up=" . uneval($form));
1007	my $status = IS->post_invoice($myconfig, $form);
1008#::logDebug("post_status=$status, form now=" . uneval($form));
1009	return $form;
1010}
1011
1012package Form;
1013
1014use DBI;
1015use Vend::Util;
1016
1017no strict 'subs';
1018
1019sub new {
1020    my $type = shift;
1021    my $opt = shift;
1022
1023    my $self = {};
1024
1025    if(! ref($opt) eq 'HASH') {
1026    	$opt = { $opt, @_ };
1027    }
1028
1029    while (my ($k, $v) = each %$opt) {
1030		$self->{$k} = $v;
1031	}
1032
1033    $self->{action} = lc $self->{action};
1034    $self->{action} =~ s/( |-|,)/_/g;
1035
1036	$self->{version} = $Vend::Accounting::SQL_Ledger::VERSION;
1037
1038	bless $self, $type;
1039}
1040
1041
1042sub debug {
1043  my $self = shift;
1044
1045  foreach my $key (sort keys %{$self}) {
1046    logDebug("$key = $self->{$key}\n");
1047  }
1048}
1049
1050
1051sub escape {
1052  shift;
1053  return hexify(shift);
1054}
1055
1056
1057sub unescape {
1058  shift;
1059  return unhexify(shift);
1060}
1061
1062sub error {
1063    my ($self, $msg) = @_;
1064
1065    $msg = errmsg($msg, @_);
1066
1067    if ($self->{error_function}) {
1068        $self->{error_function}->($msg);
1069    }
1070	else {
1071        die errmsg("SQL-Ledger error: %s\n", $msg);
1072    }
1073}
1074
1075
1076sub dberror {
1077  my ($self, $msg) = @_;
1078
1079  $self->error("$msg\n".$DBI::errstr);
1080
1081}
1082
1083
1084sub isblank {
1085  my ($self, $name, $msg) = @_;
1086
1087  if ($self->{$name} =~ /^\s*$/) {
1088    $self->error($msg);
1089  }
1090}
1091
1092
1093sub header {
1094  return;
1095}
1096
1097
1098sub redirect {
1099}
1100
1101
1102sub isposted {
1103  my ($self, $rc) = @_;
1104
1105  if ($rc) {
1106    $self->redirect;
1107  }
1108
1109  $rc;
1110
1111}
1112
1113
1114sub isdeleted {
1115  my ($self, $rc) = @_;
1116
1117  if ($rc) {
1118    $self->redirect;
1119  }
1120
1121  $rc;
1122
1123}
1124
1125
1126sub sort_columns {
1127  my ($self, @columns) = @_;
1128
1129  @columns = grep !/^$self->{sort}$/, @columns;
1130  splice @columns, 0, 0, $self->{sort};
1131
1132  @columns;
1133
1134}
1135
1136
1137sub format_amount {
1138  my ($self, $myconfig, $amount, $places, $dash) = @_;
1139
1140  if (defined $places) {
1141    $amount = $self->round_amount($amount, $places) if ($places >= 0);
1142  }
1143
1144  # is the amount negative
1145  my $negative = ($amount < 0);
1146
1147  if ($amount != 0) {
1148    if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) {
1149      my ($whole, $dec) = split /\./, "$amount";
1150      $whole =~ s/-//;
1151      $amount = join '', reverse split m{}, $whole;
1152
1153      if ($myconfig->{numberformat} eq '1,000.00') {
1154	$amount =~ s/\d{3,}?/$&,/g;
1155	$amount =~ s/,$//;
1156	$amount = join '', reverse split m{}, $amount;
1157	$amount .= "\.$dec" if $dec;
1158      }
1159
1160      if ($myconfig->{numberformat} eq '1.000,00') {
1161	$amount =~ s/\d{3,}?/$&./g;
1162	$amount =~ s/\.$//;
1163	$amount = join '', reverse split m{}, $amount;
1164	$amount .= ",$dec" if $dec;
1165      }
1166
1167      if ($myconfig->{numberformat} eq '1000,00') {
1168	$amount = "$whole";
1169	$amount .= ",$dec" if $dec;
1170      }
1171
1172      if ($dash =~ /-/) {
1173	$amount = ($negative) ? "($amount)" : "$amount";
1174      } elsif ($dash =~ /DRCR/) {
1175	$amount = ($negative) ? "$amount DR" : "$amount CR";
1176      } else {
1177	$amount = ($negative) ? "-$amount" : "$amount";
1178      }
1179    }
1180  } else {
1181    $amount = ($dash) ? "$dash" : "";
1182  }
1183
1184  $amount;
1185
1186}
1187
1188
1189sub parse_amount {
1190  my ($self, $myconfig, $amount) = @_;
1191
1192  $amount = 0 if ! defined $amount;
1193
1194  if (($myconfig->{numberformat} eq '1.000,00') ||
1195      ($myconfig->{numberformat} eq '1000,00')) {
1196    $amount =~ s/\.//g;
1197    $amount =~ s/,/\./;
1198  }
1199
1200  $amount =~ s/,//g;
1201
1202  return ($amount * 1);
1203
1204}
1205
1206
1207sub round_amount {
1208  my ($self, $amount, $places) = @_;
1209
1210  # compensate for perl bug, add 1/10^$places+2
1211  sprintf("%.${places}f", $amount + (1 / (10 ** ($places + 2))) * (($amount > 0) ? 1 : -1));
1212
1213}
1214
1215
1216sub parse_template {
1217	return 1;
1218}
1219
1220
1221sub format_string {
1222  my ($self, @fields) = @_;
1223
1224  my $format = $self->{format};
1225  if ($self->{format} =~ /(postscript|pdf)/) {
1226    $format = 'tex';
1227  }
1228
1229  # order matters!!!
1230  my %umlaute = ( 'order' => { 'html' => [ '&', '<', '>', quotemeta('\n'), '
1231',
1232                                           '�', '�', '�',
1233					   '�', '�', '�',
1234					   '�' ],
1235                               'tex'  => [ '&', quotemeta('\n'), '
1236',
1237			                   '�', '�', '�',
1238					   '�', '�', '�',
1239					   '�', '\$', '%' ] },
1240                  'html' => {
1241                '&' => '&amp;', '<' => '&lt;', '>' => '&gt;', quotemeta('\n') => '<br>', '
1242' => '<br>',
1243                '�' => '&auml;', '�' => '&ouml;', '�' => '&uuml;',
1244	        '�' => '&Auml;', '�' => '&Ouml;', '�' => '&Uuml;',
1245	        '�' => '&szlig;',
1246	        '\x84' => '&auml;', '\x94' => '&ouml;', '\x81' => '&uuml;',
1247	        '\x8e' => '&Auml;', '\x99' => '&Ouml;', '\x9a' => '&Uuml;',
1248	        '\xe1' => '&szlig;'
1249		            },
1250	          'tex' => {
1251	        '�' => '\"a', '�' => '\"o', '�' => '\"u',
1252	        '�' => '\"A', '�' => '\"O', '�' => '\"U',
1253	        '�' => '{\ss}',
1254	        '\x84' => '\"a', '\x94' => '\"o', '\x81' => '\"u',
1255	        '\x8e' => '\"A', '\x99' => '\"O', '\x9a' => '\"U',
1256	        '\xe1' => '{\ss}',
1257	        '&' => '\&', '\$' => '\$', '%' => '\%',
1258		quotemeta('\n') => '\newline ', '
1259' => '\newline '
1260                        }
1261	        );
1262
1263  foreach my $key (@{ $umlaute{order}{$format} }) {
1264    map { $self->{$_} =~ s/$key/$umlaute{$format}{$key}/g; } @fields;
1265  }
1266
1267}
1268
1269# Database routines used throughout
1270
1271sub dbconnect {
1272  my ($self, $myconfig) = @_;
1273
1274  # connect to database
1275  my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}) or $self->dberror;
1276
1277  $dbh->trace($Global::DataTrace, $Global::DebugFile)
1278	if $Global::DataTrace and $Global::DebugFile;
1279
1280  # set db options
1281  if ($myconfig->{dboptions}) {
1282    $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
1283  }
1284
1285  $dbh;
1286
1287}
1288
1289
1290sub dbconnect_noauto {
1291  my ($self, $myconfig) = @_;
1292
1293  # connect to database
1294  my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, {AutoCommit => 0}) or $self->dberror;
1295
1296  $dbh->trace($Global::DataTrace, $Global::DebugFile)
1297	if $Global::DataTrace and $Global::DebugFile;
1298
1299  # set db options
1300  if ($myconfig->{dboptions}) {
1301    $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
1302  }
1303
1304  $dbh;
1305
1306}
1307
1308
1309sub update_balance {
1310  my ($self, $dbh, $table, $field, $where, $value) = @_;
1311
1312  # if we have a value, go do it
1313  if ($value != 0) {
1314    # retrieve balance from table
1315    my $query = "SELECT $field FROM $table WHERE $where";
1316    my $sth = $dbh->prepare($query);
1317
1318    $sth->execute || $self->dberror($query);
1319    my ($balance) = $sth->fetchrow_array;
1320    $sth->finish;
1321
1322    $balance += $value;
1323    # update balance
1324    $query = "UPDATE $table SET $field = $balance WHERE $where";
1325    $dbh->do($query) || $self->dberror($query);
1326  }
1327}
1328
1329
1330
1331sub update_exchangerate {
1332  my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
1333
1334  # some sanity check for currency
1335  return if ($curr eq '');
1336
1337  my $query = qq|SELECT curr FROM exchangerate
1338                 WHERE curr = '$curr'
1339	         AND transdate = '$transdate'|;
1340  my $sth = $dbh->prepare($query);
1341  $sth->execute || $self->dberror($query);
1342
1343  my $set;
1344  if ($buy != 0 && $sell != 0) {
1345    $set = "buy = $buy, sell = $sell";
1346  } elsif ($buy != 0) {
1347    $set = "buy = $buy";
1348  } elsif ($sell != 0) {
1349    $set = "sell = $sell";
1350  }
1351
1352  if ($sth->fetchrow_array) {
1353    $query = qq|UPDATE exchangerate
1354                SET $set
1355		WHERE curr = '$curr'
1356		AND transdate = '$transdate'|;
1357  } else {
1358    $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
1359                VALUES ('$curr', $buy, $sell, '$transdate')|;
1360  }
1361  $sth->finish;
1362  $dbh->do($query) || $self->dberror($query);
1363
1364}
1365
1366
1367sub get_exchangerate {
1368  my ($self, $dbh, $curr, $transdate, $fld) = @_;
1369
1370  my $query = qq|SELECT $fld FROM exchangerate
1371                 WHERE curr = '$curr'
1372		 AND transdate = '$transdate'|;
1373  my $sth = $dbh->prepare($query);
1374  $sth->execute || $self->dberror($query);
1375
1376  my ($exchangerate) = $sth->fetchrow_array;
1377  $sth->finish;
1378
1379  ($exchangerate) ? $exchangerate : 1;
1380
1381}
1382
1383
1384# the selection sub is used in the AR, AP and IS module
1385#
1386sub all_vc {
1387  my ($self, $myconfig, $table) = @_;
1388
1389  # create array for vendor or customer
1390  my $dbh = $self->dbconnect($myconfig);
1391
1392  my $query;
1393  my $sth;
1394
1395  unless ($self->{"${table}_id"}) {
1396    my $arap = ($table eq 'customer') ? "ar" : "ap";
1397    $arap = 'oe' if ($self->{type} =~ /_order/);
1398
1399    $query = qq|SELECT ${table}_id FROM $arap
1400                WHERE oid = (SELECT max(oid) FROM $arap
1401		             WHERE ${table}_id > 0)|;
1402    $sth = $dbh->prepare($query);
1403    $sth->execute || $self->dberror($query);
1404
1405    unless (($self->{"${table}_id"}) = $sth->fetchrow_array) {
1406      $self->{"${table}_id"} = 0;
1407    }
1408    $sth->finish;
1409  }
1410
1411  $query = qq|SELECT id, name
1412              FROM $table
1413	      ORDER BY name|;
1414  $sth = $dbh->prepare($query);
1415  $sth->execute || $self->dberror($query);
1416
1417  my $ref = $sth->fetchrow_hashref(NAME_lc);
1418  push @{ $self->{"all_$table"} }, $ref;
1419
1420  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1421    push @{ $self->{"all_$table"} }, $ref;
1422  }
1423
1424  $sth->finish;
1425  $dbh->disconnect;
1426
1427}
1428
1429
1430sub create_links {
1431  my ($self, $module, $myconfig, $table) = @_;
1432
1433  # get all the customers or vendors
1434  &all_vc($self, $myconfig, $table);
1435
1436  my %xkeyref = ();
1437
1438  my $dbh = $self->dbconnect($myconfig);
1439  # now get the account numbers
1440  my $query = qq|SELECT accno, description, link
1441                 FROM chart
1442		 WHERE link LIKE '%$module%'
1443		 ORDER BY accno|;
1444  my $sth = $dbh->prepare($query);
1445  $sth->execute || $self->dberror($query);
1446
1447  while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1448
1449    foreach my $key (split(/:/, $ref->{link})) {
1450      if ($key =~ /$module/) {
1451	# cross reference for keys
1452	$xkeyref{$ref->{accno}} = $key;
1453
1454	push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno},
1455                                       description => $ref->{description} };
1456      }
1457    }
1458  }
1459  $sth->finish;
1460
1461
1462  if ($self->{id}) {
1463    my $arap = ($table eq 'customer') ? 'ar' : 'ap';
1464
1465    $query = qq|SELECT invnumber, transdate, ${table}_id, datepaid, duedate,
1466		ordnumber, taxincluded, curr AS currency
1467		FROM $arap
1468		WHERE id = $self->{id}|;
1469    $sth = $dbh->prepare($query);
1470    $sth->execute || $self->dberror($query);
1471
1472    my $ref = $sth->fetchrow_hashref(NAME_lc);
1473    foreach my $key (keys %$ref) {
1474      $self->{$key} = $ref->{$key};
1475    }
1476    $sth->finish;
1477
1478    # get amounts from individual entries
1479    $query = qq|SELECT accno, description, source, amount, transdate, cleared
1480		FROM acc_trans, chart
1481		WHERE chart.id = acc_trans.chart_id
1482		AND trans_id = $self->{id}
1483		AND fx_transaction = '0'
1484		ORDER BY transdate|;
1485    $sth = $dbh->prepare($query);
1486    $sth->execute || $self->dberror($query);
1487
1488
1489    my $fld = ($module eq 'AR') ? 'buy' : 'sell';
1490    # get exchangerate for currency
1491    $self->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
1492
1493    # store amounts in {acc_trans}{$key} for multiple accounts
1494    while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
1495      $ref->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
1496
1497      push @{ $self->{acc_trans}{$xkeyref{$ref->{accno}}} }, $ref;
1498    }
1499
1500    $sth->finish;
1501
1502    $query = qq|SELECT d.curr AS currencies,
1503                  (SELECT c.accno FROM chart c
1504		   WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
1505                  (SELECT c.accno FROM chart c
1506		   WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
1507		FROM defaults d|;
1508    $sth = $dbh->prepare($query);
1509    $sth->execute || $self->dberror($query);
1510
1511    $ref = $sth->fetchrow_hashref(NAME_lc);
1512    map { $self->{$_} = $ref->{$_} } keys %$ref;
1513    $sth->finish;
1514
1515  } else {
1516    # get date
1517    $query = qq|SELECT current_date AS transdate, current_date + 30 AS duedate,
1518                d.curr AS currencies,
1519                  (SELECT c.accno FROM chart c
1520		   WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
1521                  (SELECT c.accno FROM chart c
1522		   WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
1523		FROM defaults d|;
1524    $sth = $dbh->prepare($query);
1525    $sth->execute || $self->dberror($query);
1526
1527    my $ref = $sth->fetchrow_hashref(NAME_lc);
1528    map { $self->{$_} = $ref->{$_} } keys %$ref;
1529    $sth->finish;
1530  }
1531
1532  $dbh->disconnect;
1533
1534}
1535
1536
1537sub current_date {
1538  my ($self, $myconfig, $thisdate, $days) = @_;
1539
1540  my $dbh = $self->dbconnect($myconfig);
1541  my $query = qq|SELECT current_date AS thisdate
1542                 FROM defaults|;
1543
1544  $days *= 1;
1545  if ($thisdate) {
1546    $query = qq|SELECT date '$thisdate' + $days AS thisdate
1547                FROM defaults|;
1548  }
1549
1550  my $sth = $dbh->prepare($query);
1551  $sth->execute || $self->dberror($query);
1552
1553  ($thisdate) = $sth->fetchrow_array;
1554  $sth->finish;
1555
1556  $dbh->disconnect;
1557
1558  $thisdate;
1559
1560}
1561
1562
1563sub like {
1564  my ($self, $string) = @_;
1565
1566  unless ($string =~ /%/) {
1567    $string = "%$string%";
1568  }
1569
1570  $string;
1571
1572}
1573
1574
1575package Locale;
1576
1577
1578sub new {
1579  my ($type, $country, $NLS_file) = @_;
1580  my $self = {};
1581
1582  if ($country && -d "locale/$country") {
1583    $self->{countrycode} = $country;
1584    eval { require "locale/$country/$NLS_file"; };
1585  }
1586
1587  $self->{NLS_file} = $NLS_file;
1588
1589  push @{ $self->{LONG_MONTH} }, ("January", "February", "March", "April", "May ", "June", "July", "August", "September", "October", "November", "December");
1590  push @{ $self->{SHORT_MONTH} }, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
1591
1592  bless $self, $type;
1593
1594}
1595
1596
1597sub text {
1598  my ($self, $text) = @_;
1599
1600  return (exists $self->{texts}{$text}) ? $self->{texts}{$text} : $text;
1601
1602}
1603
1604
1605sub findsub {
1606  my ($self, $text) = @_;
1607
1608  if (exists $self->{subs}{$text}) {
1609    $text = $self->{subs}{$text};
1610  } else {
1611    if ($self->{countrycode} && $self->{NLS_file}) {
1612      Form->error("$text not defined in locale/$self->{countrycode}/$self->{NLS_file}");
1613    }
1614  }
1615
1616  $text;
1617
1618}
1619
1620
1621sub date {
1622  my ($self, $myconfig, $date, $longformat) = @_;
1623
1624  my $longdate = "";
1625  my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
1626
1627  my $spc;
1628  if ($date) {
1629    # get separator
1630    $spc = $myconfig->{dateformat};
1631    $spc =~ s/\w//g;
1632    $spc = substr($spc, 1, 1);
1633
1634    if ($spc eq '.') {
1635      $spc = '\.';
1636    }
1637    if ($spc eq '/') {
1638      $spc = '\/';
1639    }
1640
1641	my ($yy, $mm, $dd);
1642    if ($myconfig->{dateformat} =~ /^yy/) {
1643      ($yy, $mm, $dd) = split /$spc/, $date;
1644    }
1645    if ($myconfig->{dateformat} =~ /^mm/) {
1646      ($mm, $dd, $yy) = split /$spc/, $date;
1647    }
1648    if ($myconfig->{dateformat} =~ /^dd/) {
1649      ($dd, $mm, $yy) = split /$spc/, $date;
1650    }
1651
1652    $dd *= 1;
1653    $mm--;
1654    $yy = ($yy < 70) ? $yy + 2000 : $yy;
1655    $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
1656
1657    if ($myconfig->{dateformat} =~ /^dd/) {
1658      $longdate = "$dd. ".&text($self, $self->{$longmonth}[$mm])." $yy";
1659    } else {
1660      $longdate = &text($self, $self->{$longmonth}[$mm])." $dd, $yy";
1661    }
1662
1663  }
1664
1665  $longdate;
1666
1667}
1668
16691;
1670
1671=head1 NAME
1672
1673Vend::Accounting::SQL-Ledger - SQL-Ledger Accounting Interface for Interchange
1674
1675=head1 DESCRIPTION
1676
1677This module is an attempt to create a set of callable routines
1678that will allow the easy integration of the SQL-Ledger Accounting
1679package with Interchange.
1680
1681It handles the mapping of the Interchange variable names to the
1682appropriate SQL-Ledger ones as well as parsing the html returned
1683by the SQL-Ledger "API".
1684
1685Background: SQL-Ledger Accounting "www.sql-ledger.org"
1686is a multiuser, double entry, accounting system written in Perl
1687and is licensed under the GNU General Public License.
1688
1689The SQL-Ledger API: SQL-Ledger functions can be accessed from the
1690command line by passing all the variables in one long string to
1691the perl script. The variable=value pairs must be separated by an
1692ampersand. See "www.sql-ledger.org/misc/api.html" for more details
1693on the command line interface.
1694
1695------------------------------------------------------------------
1696
1697This module also happens to be the author's first perl module and probably
1698his second or third perl program in addition to "Hello World". :)
1699
1700So please go easy on me. -Daniel
1701
1702=head1 Schema
1703
1704CREATE SEQUENCE "id" start 1 increment 1 maxvalue 2147483647 minvalue 1  cache 1 ;
1705
1706CREATE TABLE "makemodel" (
1707	"id" integer,
1708	"parts_id" integer,
1709	"name" text
1710);
1711CREATE TABLE "gl" (
1712	"id" integer DEFAULT nextval('id'::text),
1713	"source" text,
1714	"description" text,
1715	"transdate" date DEFAULT date('now'::text)
1716);
1717
1718CREATE TABLE "chart" (
1719	"id" integer DEFAULT nextval('id'::text),
1720	"accno" integer,
1721	"description" text,
1722	"charttype" character(1) DEFAULT 'A',
1723	"gifi" integer,
1724	"category" character(1),
1725	"link" text
1726);
1727
1728CREATE TABLE "defaults" (
1729	"inventory_accno_id" integer,
1730	"income_accno_id" integer,
1731	"expense_accno_id" integer,
1732	"fxgain_accno_id" integer,
1733	"fxloss_accno_id" integer,
1734	"invnumber" text,
1735	"ordnumber" text,
1736	"yearend" character varying(5),
1737	"curr" text,
1738	"weightunit" character varying(5),
1739	"businessnumber" text,
1740	"version" character varying(8)
1741);
1742
1743CREATE TABLE "acc_trans" (
1744	"trans_id" integer,
1745	"chart_id" integer,
1746	"amount" double precision,
1747	"transdate" date DEFAULT date('now'::text),
1748	"source" text,
1749	"cleared" boolean DEFAULT 'f',
1750	"fx_transaction" boolean DEFAULT 'f'
1751);
1752
1753CREATE TABLE "invoice" (
1754	"id" integer DEFAULT nextval('id'::text),
1755	"trans_id" integer,
1756	"parts_id" integer,
1757	"description" text,
1758	"qty" real,
1759	"allocated" real,
1760	"sellprice" double precision,
1761	"fxsellprice" double precision,
1762	"discount" real,
1763	"assemblyitem" boolean DEFAULT 'f'
1764);
1765
1766CREATE TABLE "vendor" (
1767	"id" integer DEFAULT nextval('id'::text),
1768	"name" character varying(35),
1769	"addr1" character varying(35),
1770	"addr2" character varying(35),
1771	"addr3" character varying(35),
1772	"addr4" character varying(35),
1773	"contact" character varying(35),
1774	"phone" character varying(20),
1775	"fax" character varying(20),
1776	"email" text,
1777	"notes" text,
1778	"terms" smallint DEFAULT 0,
1779	"taxincluded" boolean
1780);
1781
1782CREATE TABLE "customer" (
1783	"id" integer DEFAULT nextval('id'::text),
1784	"name" character varying(35),
1785	"addr1" character varying(35),
1786	"addr2" character varying(35),
1787	"addr3" character varying(35),
1788	"addr4" character varying(35),
1789	"contact" character varying(35),
1790	"phone" character varying(20),
1791	"fax" character varying(20),
1792	"email" text,
1793	"notes" text,
1794	"discount" real,
1795	"taxincluded" boolean,
1796	"creditlimit" double precision DEFAULT 0,
1797	"terms" smallint DEFAULT 0,
1798	"shiptoname" character varying(35),
1799	"shiptoaddr1" character varying(35),
1800	"shiptoaddr2" character varying(35),
1801	"shiptoaddr3" character varying(35),
1802	"shiptoaddr4" character varying(35),
1803	"shiptocontact" character varying(20),
1804	"shiptophone" character varying(20),
1805	"shiptofax" character varying(20),
1806	"shiptoemail" text
1807);
1808
1809CREATE TABLE "parts" (
1810	"id" integer DEFAULT nextval('id'::text),
1811	"partnumber" text,
1812	"description" text,
1813	"bin" text,
1814	"unit" character varying(5),
1815	"listprice" double precision,
1816	"sellprice" double precision,
1817	"lastcost" double precision,
1818	"priceupdate" date DEFAULT date('now'::text),
1819	"weight" real,
1820	"onhand" real DEFAULT 0,
1821	"notes" text,
1822	"makemodel" boolean DEFAULT 'f',
1823	"assembly" boolean DEFAULT 'f',
1824	"alternate" boolean DEFAULT 'f',
1825	"rop" real,
1826	"inventory_accno_id" integer,
1827	"income_accno_id" integer,
1828	"expense_accno_id" integer,
1829	"obsolete" boolean DEFAULT 'f'
1830);
1831
1832CREATE TABLE "assembly" (
1833	"id" integer,
1834	"parts_id" integer,
1835	"qty" double precision
1836);
1837
1838CREATE TABLE "ar" (
1839	"id" integer DEFAULT nextval('id'::text),
1840	"invnumber" text,
1841	"ordnumber" text,
1842	"transdate" date DEFAULT date('now'::text),
1843	"customer_id" integer,
1844	"taxincluded" boolean,
1845	"amount" double precision,
1846	"netamount" double precision,
1847	"paid" double precision,
1848	"datepaid" date,
1849	"duedate" date,
1850	"invoice" boolean DEFAULT 'f',
1851	"shippingpoint" text,
1852	"terms" smallint DEFAULT 0,
1853	"notes" text,
1854	"curr" character(3)
1855);
1856
1857CREATE TABLE "ap" (
1858	"id" integer DEFAULT nextval('id'::text),
1859	"invnumber" text,
1860	"transdate" date DEFAULT date('now'::text),
1861	"vendor_id" integer,
1862	"taxincluded" boolean,
1863	"amount" double precision,
1864	"netamount" double precision,
1865	"paid" double precision,
1866	"datepaid" date,
1867	"duedate" date,
1868	"invoice" boolean DEFAULT 'f',
1869	"ordnumber" text,
1870	"curr" character(3)
1871);
1872
1873CREATE TABLE "partstax" (
1874	"parts_id" integer,
1875	"chart_id" integer
1876);
1877
1878CREATE TABLE "tax" (
1879	"chart_id" integer,
1880	"rate" double precision,
1881	"taxnumber" text
1882);
1883
1884CREATE TABLE "customertax" (
1885	"customer_id" integer,
1886	"chart_id" integer
1887);
1888
1889CREATE TABLE "vendortax" (
1890	"vendor_id" integer,
1891	"chart_id" integer
1892);
1893
1894CREATE TABLE "oe" (
1895	"id" integer DEFAULT nextval('id'::text),
1896	"ordnumber" text,
1897	"transdate" date DEFAULT date('now'::text),
1898	"vendor_id" integer,
1899	"customer_id" integer,
1900	"amount" double precision,
1901	"netamount" double precision,
1902	"reqdate" date,
1903	"taxincluded" boolean,
1904	"shippingpoint" text,
1905	"notes" text,
1906	"curr" character(3)
1907);
1908
1909CREATE TABLE "orderitems" (
1910	"trans_id" integer,
1911	"parts_id" integer,
1912	"description" text,
1913	"qty" real,
1914	"sellprice" double precision,
1915	"discount" real
1916);
1917
1918CREATE TABLE "exchangerate" (
1919	"curr" character(3),
1920	"transdate" date,
1921	"buy" double precision,
1922	"sell" double precision
1923);
1924
1925=cut
1926