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/"/"/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 '&' => '&', '<' => '<', '>' => '>', quotemeta('\n') => '<br>', ' 1242' => '<br>', 1243 '�' => 'ä', '�' => 'ö', '�' => 'ü', 1244 '�' => 'Ä', '�' => 'Ö', '�' => 'Ü', 1245 '�' => 'ß', 1246 '\x84' => 'ä', '\x94' => 'ö', '\x81' => 'ü', 1247 '\x8e' => 'Ä', '\x99' => 'Ö', '\x9a' => 'Ü', 1248 '\xe1' => 'ß' 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