diff options
Diffstat (limited to 'sql-ledger/SL')
-rw-r--r-- | sql-ledger/SL/AM.pm | 1478 | ||||
-rw-r--r-- | sql-ledger/SL/AP.pm | 464 | ||||
-rw-r--r-- | sql-ledger/SL/AR.pm | 492 | ||||
-rw-r--r-- | sql-ledger/SL/BP.pm | 371 | ||||
-rw-r--r-- | sql-ledger/SL/CA.pm | 486 | ||||
-rw-r--r-- | sql-ledger/SL/CP.pm | 396 | ||||
-rw-r--r-- | sql-ledger/SL/CT.pm | 1008 | ||||
-rw-r--r-- | sql-ledger/SL/Form.pm | 2357 | ||||
-rw-r--r-- | sql-ledger/SL/GL.pm | 514 | ||||
-rw-r--r-- | sql-ledger/SL/HR.pm | 558 | ||||
-rw-r--r-- | sql-ledger/SL/IC.pm | 1513 | ||||
-rw-r--r-- | sql-ledger/SL/IR.pm | 1243 | ||||
-rw-r--r-- | sql-ledger/SL/IS.pm | 1632 | ||||
-rw-r--r-- | sql-ledger/SL/Inifile.pm | 88 | ||||
-rw-r--r-- | sql-ledger/SL/Mailer.pm | 162 | ||||
-rw-r--r-- | sql-ledger/SL/Menu.pm | 121 | ||||
-rw-r--r-- | sql-ledger/SL/Num2text.pm | 162 | ||||
-rw-r--r-- | sql-ledger/SL/OE.pm | 1581 | ||||
-rw-r--r-- | sql-ledger/SL/OP.pm | 118 | ||||
-rw-r--r-- | sql-ledger/SL/PE.pm | 639 | ||||
-rw-r--r-- | sql-ledger/SL/RC.pm | 474 | ||||
-rw-r--r-- | sql-ledger/SL/RP.pm | 2551 | ||||
-rw-r--r-- | sql-ledger/SL/User.pm | 925 |
23 files changed, 19333 insertions, 0 deletions
diff --git a/sql-ledger/SL/AM.pm b/sql-ledger/SL/AM.pm new file mode 100644 index 000000000..dbdd61111 --- /dev/null +++ b/sql-ledger/SL/AM.pm @@ -0,0 +1,1478 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: Jim Rawlings <jim@your-dba.com> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Administration module +# Chart of Accounts +# template routines +# preferences +# +#====================================================================== + +package AM; + + +sub get_account { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description, charttype, gifi_accno, + category, link + FROM chart + WHERE id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + foreach my $key (keys %$ref) { + $form->{"$key"} = $ref->{"$key"}; + } + + # get default accounts + $query = qq|SELECT inventory_accno_id, income_accno_id, expense_accno_id + FROM defaults|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %ref; + $sth->finish; + + # check if we have any transactions + $query = qq|SELECT trans_id FROM acc_trans + WHERE chart_id = $form->{id}|; + ($form->{orphaned}) = $dbh->selectrow_array($query); + $form->{orphaned} = !$form->{orphaned}; + + $dbh->disconnect; + +} + + +sub save_account { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off AutoCommit + my $dbh = $form->dbconnect_noauto($myconfig); + + $form->{link} = ""; + foreach my $item ($form->{AR}, + $form->{AR_amount}, + $form->{AR_tax}, + $form->{AR_paid}, + $form->{AP}, + $form->{AP_amount}, + $form->{AP_tax}, + $form->{AP_paid}, + $form->{IC}, + $form->{IC_sale}, + $form->{IC_cogs}, + $form->{IC_taxpart}, + $form->{IC_income}, + $form->{IC_expense}, + $form->{IC_taxservice}, + $form->{CT_tax} + ) { + $form->{link} .= "${item}:" if ($item); + } + chop $form->{link}; + + # strip blanks from accno + map { $form->{$_} =~ s/( |')//g } qw(accno gifi_accno); + + foreach my $item (qw(accno gifi_accno description)) { + $form->{$item} =~ s/-(-+)/-/g; + $form->{$item} =~ s/ ( )+/ /g; + } + + my $query; + my $sth; + + # if we have an id then replace the old record + if ($form->{id}) { + $query = qq|UPDATE chart SET + accno = '$form->{accno}', + description = |.$dbh->quote($form->{description}).qq|, + charttype = '$form->{charttype}', + gifi_accno = '$form->{gifi_accno}', + category = '$form->{category}', + link = '$form->{link}' + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO chart + (accno, description, charttype, gifi_accno, category, link) + VALUES ('$form->{accno}',| + .$dbh->quote($form->{description}).qq|, + '$form->{charttype}', '$form->{gifi_accno}', + '$form->{category}', '$form->{link}')|; + } + $dbh->do($query) || $form->dberror($query); + + + $chart_id = $form->{id}; + + if (! $form->{id}) { + # get id from chart + $query = qq|SELECT id + FROM chart + WHERE accno = '$form->{accno}'|; + ($chart_id) = $dbh->selectrow_array($query); + } + + if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) { + + # add account if it doesn't exist in tax + $query = qq|SELECT chart_id + FROM tax + WHERE chart_id = $chart_id|; + my ($tax_id) = $dbh->selectrow_array($query); + + # add tax if it doesn't exist + unless ($tax_id) { + $query = qq|INSERT INTO tax (chart_id, rate) + VALUES ($chart_id, 0)|; + $dbh->do($query) || $form->dberror($query); + } + } else { + # remove tax + if ($form->{id}) { + $query = qq|DELETE FROM tax + WHERE chart_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + } + + # commit + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub delete_account { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off AutoCommit + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query = qq|SELECT * FROM acc_trans + WHERE chart_id = $form->{id}|; + if ($dbh->selectrow_array($query)) { + $dbh->disconnect; + return; + } + + + # delete chart of account record + $query = qq|DELETE FROM chart + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # set inventory_accno_id, income_accno_id, expense_accno_id to defaults + $query = qq|UPDATE parts + SET inventory_accno_id = + (SELECT inventory_accno_id FROM defaults) + WHERE inventory_accno_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|UPDATE parts + SET income_accno_id = + (SELECT income_accno_id FROM defaults) + WHERE income_accno_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|UPDATE parts + SET expense_accno_id = + (SELECT expense_accno_id FROM defaults) + WHERE expense_accno_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + foreach my $table (qw(partstax customertax vendortax tax)) { + $query = qq|DELETE FROM $table + WHERE chart_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + # commit and redirect + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub gifi_accounts { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description + FROM gifi + ORDER BY accno|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $dbh->disconnect; + +} + + + +sub get_gifi { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description + FROM gifi + WHERE accno = '$form->{accno}'|; + + ($form->{accno}, $form->{description}) = $dbh->selectrow_array($query); + + # check for transactions + $query = qq|SELECT * FROM acc_trans a + JOIN chart c ON (a.chart_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + WHERE g.accno = '$form->{accno}'|; + ($form->{orphaned}) = $dbh->selectrow_array($query); + $form->{orphaned} = !$form->{orphaned}; + + $dbh->disconnect; + +} + + +sub save_gifi { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{accno} =~ s/( |')//g; + + foreach my $item (qw(accno description)) { + $form->{$item} =~ s/-(-+)/-/g; + $form->{$item} =~ s/ ( )+/ /g; + } + + # id is the old account number! + if ($form->{id}) { + $query = qq|UPDATE gifi SET + accno = '$form->{accno}', + description = |.$dbh->quote($form->{description}).qq| + WHERE accno = '$form->{id}'|; + } else { + $query = qq|INSERT INTO gifi + (accno, description) + VALUES ('$form->{accno}',| + .$dbh->quote($form->{description}).qq|)|; + } + $dbh->do($query) || $form->dberror; + + $dbh->disconnect; + +} + + +sub delete_gifi { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # id is the old account number! + $query = qq|DELETE FROM gifi + WHERE accno = '$form->{id}'|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub warehouses { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->sort_order(); + my $query = qq|SELECT id, description + FROM warehouse + ORDER BY 2 $form->{direction}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $dbh->disconnect; + +} + + + +sub get_warehouse { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT description + FROM warehouse + WHERE id = $form->{id}|; + ($form->{description}) = $dbh->selectrow_array($query); + + # see if it is in use + $query = qq|SELECT * FROM inventory + WHERE warehouse_id = $form->{id}|; + ($form->{orphaned}) = $dbh->selectrow_array($query); + $form->{orphaned} = !$form->{orphaned}; + + $dbh->disconnect; + +} + + +sub save_warehouse { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/-(-)+/-/g; + $form->{description} =~ s/ ( )+/ /g; + + if ($form->{id}) { + $query = qq|UPDATE warehouse SET + description = |.$dbh->quote($form->{description}).qq| + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO warehouse + (description) + VALUES (|.$dbh->quote($form->{description}).qq|)|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub delete_warehouse { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM warehouse + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + + +sub departments { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->sort_order(); + my $query = qq|SELECT id, description, role + FROM department + ORDER BY 2 $form->{direction}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $dbh->disconnect; + +} + + + +sub get_department { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT description, role + FROM department + WHERE id = $form->{id}|; + ($form->{description}, $form->{role}) = $dbh->selectrow_array($query); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + # see if it is in use + $query = qq|SELECT * FROM dpt_trans + WHERE department_id = $form->{id}|; + ($form->{orphaned}) = $dbh->selectrow_array($query); + $form->{orphaned} = !$form->{orphaned}; + + $dbh->disconnect; + +} + + +sub save_department { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/-(-)+/-/g; + $form->{description} =~ s/ ( )+/ /g; + + if ($form->{id}) { + $query = qq|UPDATE department SET + description = |.$dbh->quote($form->{description}).qq|, + role = '$form->{role}' + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO department + (description, role) + VALUES (| + .$dbh->quote($form->{description}).qq|, '$form->{role}')|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub delete_department { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM department + WHERE id = $form->{id}|; + $dbh->do($query); + + $dbh->disconnect; + +} + + +sub business { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->sort_order(); + my $query = qq|SELECT id, description, discount + FROM business + ORDER BY 2 $form->{direction}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $dbh->disconnect; + +} + + + +sub get_business { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT description, discount + FROM business + WHERE id = $form->{id}|; + ($form->{description}, $form->{discount}) = $dbh->selectrow_array($query); + + $dbh->disconnect; + +} + + +sub save_business { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{description} =~ s/-(-)+/-/g; + $form->{description} =~ s/ ( )+/ /g; + $form->{discount} /= 100; + + if ($form->{id}) { + $query = qq|UPDATE business SET + description = |.$dbh->quote($form->{description}).qq|, + discount = $form->{discount} + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO business + (description, discount) + VALUES (| + .$dbh->quote($form->{description}).qq|, $form->{discount})|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub delete_business { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM business + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub sic { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{sort} = "code" unless $form->{sort}; + my @a = qw(code description); + my %ordinal = ( code => 1, + description => 3 ); + my $sortorder = $form->sort_order(\@a, \%ordinal); + my $query = qq|SELECT code, sictype, description + FROM sic + ORDER BY $sortorder|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $dbh->disconnect; + +} + + + +sub get_sic { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT code, sictype, description + FROM sic + WHERE code = |.$dbh->quote($form->{code}); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + $dbh->disconnect; + +} + + +sub save_sic { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + foreach my $item (qw(code description)) { + $form->{$item} =~ s/-(-)+/-/g; + } + + # if there is an id + if ($form->{id}) { + $query = qq|UPDATE sic SET + code = |.$dbh->quote($form->{code}).qq|, + sictype = '$form->{sictype}', + description = |.$dbh->quote($form->{description}).qq| + WHERE code = |.$dbh->quote($form->{id}); + } else { + $query = qq|INSERT INTO sic + (code, sictype, description) + VALUES (| + .$dbh->quote($form->{code}).qq|, + '$form->{sictype}',| + .$dbh->quote($form->{description}).qq|)|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub delete_sic { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM sic + WHERE code = |.$dbh->quote($form->{code}); + $dbh->do($query); + + $dbh->disconnect; + +} + + +sub language { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{sort} = "code" unless $form->{sort}; + my @a = qw(code description); + my %ordinal = ( code => 1, + description => 2 ); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $query = qq|SELECT code, description + FROM language + ORDER BY $sortorder|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{ALL} }, $ref; + } + + $dbh->disconnect; + +} + + + +sub get_language { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT * + FROM language + WHERE code = |.$dbh->quote($form->{code}); + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + $dbh->disconnect; + +} + + +sub save_language { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{code} =~ s/ //g; + foreach my $item (qw(code description)) { + $form->{$item} =~ s/-(-)+/-/g; + $form->{$item} =~ s/ ( )+/-/g; + } + + # if there is an id + if ($form->{id}) { + $query = qq|UPDATE language SET + code = |.$dbh->quote($form->{code}).qq|, + description = |.$dbh->quote($form->{description}).qq| + WHERE code = |.$dbh->quote($form->{id}); + } else { + $query = qq|INSERT INTO language + (code, description) + VALUES (| + .$dbh->quote($form->{code}).qq|,| + .$dbh->quote($form->{description}).qq|)|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub delete_language { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM language + WHERE code = |.$dbh->quote($form->{code}); + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + + +sub load_template { + my ($self, $form) = @_; + + open(TEMPLATE, "$form->{file}") or $form->error("$form->{file} : $!"); + + while (<TEMPLATE>) { + $form->{body} .= $_; + } + + close(TEMPLATE); + +} + + +sub save_template { + my ($self, $form) = @_; + + open(TEMPLATE, ">$form->{file}") or $form->error("$form->{file} : $!"); + + # strip
+ $form->{body} =~ s/\r\n/\n/g; + print TEMPLATE $form->{body}; + + close(TEMPLATE); + +} + + + +sub save_preferences { + my ($self, $myconfig, $form, $memberfile, $userspath) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # update name + my $query = qq|UPDATE employee + SET name = |.$dbh->quote($form->{name}).qq|, + role = '$form->{role}' + WHERE login = '$form->{login}'|; + $dbh->do($query) || $form->dberror($query); + + # get default currency + $query = qq|SELECT curr, businessnumber + FROM defaults|; + ($form->{currency}, $form->{businessnumber}) = $dbh->selectrow_array($query); + $form->{currency} =~ s/:.*//; + + $dbh->disconnect; + + my $myconfig = new User "$memberfile", "$form->{login}"; + + foreach my $item (keys %$form) { + $myconfig->{$item} = $form->{$item}; + } + + $myconfig->{password} = $form->{new_password} if ($form->{old_password} ne $form->{new_password}); + + $myconfig->save_member($memberfile, $userspath); + + 1; + +} + + +sub save_defaults { + my ($self, $myconfig, $form) = @_; + + map { ($form->{$_}) = split /--/, $form->{$_} } qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno); + + my @a; + $form->{curr} =~ s/ //g; + map { push(@a, uc pack "A3", $_) if $_ } split /:/, $form->{curr}; + $form->{curr} = join ':', @a; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + # save defaults + my $query = qq|UPDATE defaults SET + inventory_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{inventory_accno}'), + income_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{income_accno}'), + expense_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{expense_accno}'), + fxgain_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{fxgain_accno}'), + fxloss_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{fxloss_accno}'), + sinumber = '$form->{sinumber}', + vinumber = '$form->{vinumber}', + sonumber = '$form->{sonumber}', + ponumber = '$form->{ponumber}', + sqnumber = '$form->{sqnumber}', + rfqnumber = '$form->{rfqnumber}', + partnumber = '$form->{partnumber}', + employeenumber = '$form->{employeenumber}', + customernumber = '$form->{customernumber}', + vendornumber = '$form->{vendornumber}', + yearend = '$form->{yearend}', + curr = '$form->{curr}', + weightunit = |.$dbh->quote($form->{weightunit}).qq|, + businessnumber = |.$dbh->quote($form->{businessnumber}); + $dbh->do($query) || $form->dberror($query); + + foreach my $item (split / /, $form->{taxaccounts}) { + $form->{$item} = $form->parse_amount($myconfig, $form->{$item}) / 100; + $query = qq|UPDATE tax + SET rate = $form->{$item}, + taxnumber = |.$dbh->quote($form->{"taxnumber_$item"}).qq| + WHERE chart_id = $item|; + $dbh->do($query) || $form->dberror($query); + } + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub defaultaccounts { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # get defaults from defaults table + my $query = qq|SELECT * FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{defaults} = $sth->fetchrow_hashref(NAME_lc); + $form->{defaults}{IC} = $form->{defaults}{inventory_accno_id}; + $form->{defaults}{IC_income} = $form->{defaults}{income_accno_id}; + $form->{defaults}{IC_expense} = $form->{defaults}{expense_accno_id}; + $form->{defaults}{FX_gain} = $form->{defaults}{fxgain_accno_id}; + $form->{defaults}{FX_loss} = $form->{defaults}{fxloss_accno_id}; + + + $sth->finish; + + + $query = qq|SELECT id, accno, description, link + FROM chart + WHERE link LIKE '%IC%' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + foreach my $key (split(/:/, $ref->{link})) { + if ($key =~ /IC/) { + $nkey = $key; + if ($key =~ /cogs/) { + $nkey = "IC_expense"; + } + if ($key =~ /sale/) { + $nkey = "IC_income"; + } + %{ $form->{IC}{$nkey}{$ref->{accno}} } = ( id => $ref->{id}, + description => $ref->{description} ); + } + } + } + $sth->finish; + + + $query = qq|SELECT id, accno, description + FROM chart + WHERE category = 'I' + AND charttype = 'A' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + %{ $form->{IC}{FX_gain}{$ref->{accno}} } = ( id => $ref->{id}, + description => $ref->{description} ); + } + $sth->finish; + + $query = qq|SELECT id, accno, description + FROM chart + WHERE category = 'E' + AND charttype = 'A' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + %{ $form->{IC}{FX_loss}{$ref->{accno}} } = ( id => $ref->{id}, + description => $ref->{description} ); + } + $sth->finish; + + + # now get the tax rates and numbers + $query = qq|SELECT chart.id, chart.accno, chart.description, + tax.rate * 100 AS rate, tax.taxnumber + FROM chart, tax + WHERE chart.id = tax.chart_id|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{taxrates}{$ref->{accno}}{id} = $ref->{id}; + $form->{taxrates}{$ref->{accno}}{description} = $ref->{description}; + $form->{taxrates}{$ref->{accno}}{taxnumber} = $ref->{taxnumber} if $ref->{taxnumber}; + $form->{taxrates}{$ref->{accno}}{rate} = $ref->{rate} if $ref->{rate}; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub backup { + my ($self, $myconfig, $form, $userspath, $gzip) = @_; + + my $mail; + my $err; + + my @t = localtime(time); + $t[4]++; + $t[5] += 1900; + $t[3] = substr("0$t[3]", -2); + $t[4] = substr("0$t[4]", -2); + + my $boundary = time; + my $tmpfile = "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql"; + my $out = $form->{OUT}; + $form->{OUT} = ">$tmpfile"; + + open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!"); + + # get sequences, functions and triggers + my @tables = (); + my @sequences = (); + my @functions = (); + my @triggers = (); + my @schema = (); + + # get dbversion from -tables.sql + my $file = "$myconfig->{dbdriver}-tables.sql"; + + open(FH, "sql/$file") or $form->error("sql/$file : $!"); + + my @a = <FH>; + close(FH); + + @dbversion = grep /defaults \(version\)/, @a; + + $dbversion = "@dbversion"; + $dbversion =~ /(\d+\.\d+\.\d+)/; + $dbversion = User::calc_version($1); + + opendir SQLDIR, "sql/." or $form->error($!); + @a = grep /$myconfig->{dbdriver}-upgrade-.*?\.sql$/, readdir SQLDIR; + closedir SQLDIR; + + my $mindb; + my $maxdb; + + foreach my $line (@a) { + + $upgradescript = $line; + $line =~ s/(^$myconfig->{dbdriver}-upgrade-|\.sql$)//g; + + ($mindb, $maxdb) = split /-/, $line; + $mindb = User::calc_version($mindb); + + next if $mindb < $dbversion; + + $maxdb = User::calc_version($maxdb); + + $upgradescripts{$maxdb} = $upgradescript; + } + + + $upgradescripts{$dbversion} = "$myconfig->{dbdriver}-tables.sql"; + $upgradescripts{functions} = "$myconfig->{dbdriver}-functions.sql"; + + if (-f "sql/$myconfig->{dbdriver}-custom_tables.sql") { + $upgradescripts{customtables} = "$myconfig->{dbdriver}-custom_tables.sql"; + } + if (-f "sql/$myconfig->{dbdriver}-custom_functions.sql") { + $upgradescripts{customfunctions} = "$myconfig->{dbdriver}-custom_functions.sql"; + } + + foreach my $key (sort keys %upgradescripts) { + + $file = $upgradescripts{$key}; + + open(FH, "sql/$file") or $form->error("sql/$file : $!"); + + push @schema, qq|-- $file\n|; + + while (<FH>) { + + if (/create table (\w+)/i) { + push @tables, $1; + } + + if (/create sequence (\w+)/i) { + push @sequences, $1; + } + + if (/end function/i) { + push @functions, $_; + $function = 0; + next; + } + + if (/create function /i) { + $function = 1; + } + + if ($function) { + push @functions, $_; + next; + } + + if (/end trigger/i) { + push @triggers, $_; + $trigger = 0; + next; + } + + if (/create trigger/i) { + $trigger = 1; + } + + if ($trigger) { + push @triggers, $_; + next; + } + + push @schema, $_ if $_ !~ /^(insert|--)/i; + + } + close(FH); + + } + + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $today = scalar localtime; + + $myconfig->{dbhost} = 'localhost' unless $myconfig->{dbhost}; + + print OUT qq|-- SQL-Ledger Backup +-- Dataset: $myconfig->{dbname} +-- Version: $form->{dbversion} +-- Host: $myconfig->{dbhost} +-- Login: $form->{login} +-- User: $myconfig->{name} +-- Date: $today +-- +|; + + + my $restrict = ($myconfig->{dbdriver} eq 'DB2') ? "RESTRICT" : ""; + + @tables = grep !/^temp/, @tables; + # drop tables and sequences + map { print OUT qq|DROP TABLE $_;\n| } @tables; + map { print OUT qq|DROP SEQUENCE $_ $restrict;\n| } @sequences; + + print OUT "--\n"; + + # triggers and index files are dropped with the tables + + # drop functions + foreach $item (@functions) { + if ($item =~ /create function (.*\))/i) { + print OUT qq|DROP FUNCTION $1;\n|; + } + } + + # add schema + print OUT @schema; + print OUT "\n"; + + print OUT qq|-- set options +$myconfig->{dboptions}; +-- +|; + + my $query; + my $sth; + my @arr; + my $fields; + + foreach $table (@tables) { + + $query = qq|SELECT * FROM $table|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $query = qq|INSERT INTO $table (|; + $query .= join ',', (map { $sth->{NAME}->[$_] } (0 .. $sth->{NUM_OF_FIELDS} - 1)); + $query .= qq|) VALUES|; + + while (@arr = $sth->fetchrow_array) { + + $fields = "("; + + $fields .= join ',', map { $dbh->quote($_) } @arr; + $fields .= ")"; + + print OUT qq|$query $fields;\n|; + } + + $sth->finish; + } + + + # create sequences and triggers + foreach $item (@sequences) { + if ($myconfig->{dbdriver} eq 'DB2') { + $query = qq|SELECT NEXTVAL FOR $item FROM sysibm.sysdummy1|; + } else { + $query = qq|SELECT last_value FROM $item|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my ($id) = $sth->fetchrow_array; + $sth->finish; + $id++; + + print OUT qq|-- +DROP SEQUENCE $item $restrict;\n|; + + if ($myconfig->{dbdriver} eq 'DB2') { + print OUT qq|CREATE SEQUENCE $item AS INTEGER START WITH $id INCREMENT BY 1 MAXVALUE 2147483647 MINVALUE 1 CACHE 5;\n|; + } else { + print OUT qq|CREATE SEQUENCE $item START $id;\n|; + } + } + + print OUT "--\n"; + + # functions + map { print OUT $_ } @functions; + + # triggers + map { print OUT $_ } @triggers; + + # add the index files + open(FH, "sql/$myconfig->{dbdriver}-indices.sql"); + @a = <FH>; + close(FH); + print OUT @a; + + close(OUT); + + $dbh->disconnect; + + # compress backup if gzip defined + my $suffix = ""; + if ($gzip) { + my @args = split / /, $gzip; + my @s = @args; + + push @args, "$tmpfile"; + system(@args) == 0 or $form->error("$args[0] : $?"); + + shift @s; + my %s = @s; + $suffix = ${-S} || ".gz"; + $tmpfile .= $suffix; + } + + if ($form->{media} eq 'email') { + + use SL::Mailer; + $mail = new Mailer; + + $mail->{to} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{subject} = "SQL-Ledger Backup / $myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix"; + @{ $mail->{attachments} } = ($tmpfile); + $mail->{version} = $form->{version}; + $mail->{fileid} = "$boundary."; + + $myconfig->{signature} =~ s/\\n/\r\n/g; + $mail->{message} = "-- \n$myconfig->{signature}"; + + $err = $mail->send($out); + } + + if ($form->{media} eq 'file') { + + open(IN, "$tmpfile") or $form->error("$tmpfile : $!"); + open(OUT, ">-") or $form->error("STDOUT : $!"); + + print OUT qq|Content-Type: application/file; +Content-Disposition: attachment; filename="$myconfig->{dbname}-$form->{dbversion}-$t[5]$t[4]$t[3].sql$suffix" + +|; + + while (<IN>) { + print OUT $_; + } + + close(IN); + close(OUT); + + } + + unlink "$tmpfile"; + +} + + +sub closedto { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT closedto, revtrans, audittrail + FROM defaults|; + ($form->{closedto}, $form->{revtrans}, $form->{audittrail}) = $dbh->selectrow_array($query); + + $dbh->disconnect; + +} + + +sub closebooks { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect_noauto($myconfig); + + if ($form->{revtrans}) { + + $query = qq|UPDATE defaults SET closedto = NULL, + revtrans = '1'|; + } else { + if ($form->{closedto}) { + + $query = qq|UPDATE defaults SET closedto = '$form->{closedto}', + revtrans = '0'|; + } else { + + $query = qq|UPDATE defaults SET closedto = NULL, + revtrans = '0'|; + } + } + + if ($form->{audittrail}) { + $query .= qq|, audittrail = '1'|; + } else { + $query .= qq|, audittrail = '0'|; + } + + # set close in defaults + $dbh->do($query) || $form->dberror($query); + + if ($form->{removeaudittrail}) { + $query = qq|DELETE FROM audittrail + WHERE transdate < '$form->{removeaudittrail}'|; + $dbh->do($query) || $form->dberror($query); + } + + + $dbh->commit; + $dbh->disconnect; + +} + + +sub earningsaccounts { + my ($self, $myconfig, $form) = @_; + + my ($query, $sth, $ref); + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # get chart of accounts + $query = qq|SELECT accno,description + FROM chart + WHERE charttype = 'A' + AND category = 'Q' + ORDER by accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + $form->{chart} = ""; + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{chart} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + + +sub post_yearend { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off AutoCommit + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO gl (reference, employee_id) + VALUES ('$uid', (SELECT id FROM employee + WHERE login = '$form->{login}'))|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM gl + WHERE reference = '$uid'|; + ($form->{id}) = $dbh->selectrow_array($query); + + $query = qq|UPDATE gl SET + reference = |.$dbh->quote($form->{reference}).qq|, + description = |.$dbh->quote($form->{description}).qq|, + notes = |.$dbh->quote($form->{notes}).qq|, + transdate = '$form->{transdate}', + department_id = 0 + WHERE id = $form->{id}|; + + $dbh->do($query) || $form->dberror($query); + + my $amount; + my $accno; + + # insert acc_trans transactions + for my $i (1 .. $form->{rowcount}) { + # extract accno + ($accno) = split(/--/, $form->{"accno_$i"}); + $amount = 0; + + if ($form->{"credit_$i"} != 0) { + $amount = $form->{"credit_$i"}; + } + if ($form->{"debit_$i"} != 0) { + $amount = $form->{"debit_$i"} * -1; + } + + + # if there is an amount, add the record + if ($amount != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source) + VALUES + ($form->{id}, (SELECT id + FROM chart + WHERE accno = '$accno'), + $amount, '$form->{transdate}', | + .$dbh->quote($form->{reference}).qq|)|; + + $dbh->do($query) || $form->dberror($query); + } + } + + $query = qq|INSERT INTO yearend (trans_id, transdate) + VALUES ($form->{id}, '$form->{transdate}')|; + $dbh->do($query) || $form->dberror($query); + + my %audittrail = ( tablename => 'gl', + reference => $form->{reference}, + formname => 'yearend', + action => 'posted', + id => $form->{id} ); + $form->audittrail($dbh, "", \%audittrail); + + # commit and redirect + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +1; + diff --git a/sql-ledger/SL/AP.pm b/sql-ledger/SL/AP.pm new file mode 100644 index 000000000..05bc77a3a --- /dev/null +++ b/sql-ledger/SL/AP.pm @@ -0,0 +1,464 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Accounts Payables database backend routines +# +#====================================================================== + + +package AP; + + +sub post_transaction { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my $null; + my $taxrate; + my $amount; + my $exchangerate = 0; + + # split and store id numbers in link accounts + map { ($form->{AP_amounts}{"amount_$_"}) = split(/--/, $form->{"AP_amount_$_"}) } (1 .. $form->{rowcount}); + ($form->{AP_amounts}{payables}) = split(/--/, $form->{AP}); + + ($null, $form->{department_id}) = split(/--/, $form->{department}); + $form->{department_id} *= 1; + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{exchangerate} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, 'sell'); + + $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate}); + } + + # reverse and parse amounts + for my $i (1 .. $form->{rowcount}) { + $form->{"amount_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"amount_$i"}) * $form->{exchangerate} * -1, 2); + $form->{netamount} += ($form->{"amount_$i"} * -1); + } + + + # taxincluded doesn't make sense if there is no amount + $form->{taxincluded} = 0 if ($form->{netamount} == 0); + + for my $item (split / /, $form->{taxaccounts}) { + $form->{AP_amounts}{"tax_$item"} = $item; + + $form->{"tax_$item"} = $form->round_amount($form->parse_amount($myconfig, $form->{"tax_$item"}) * $form->{exchangerate}, 2) * -1; + $form->{tax} += ($form->{"tax_$item"} * -1); + } + + + # adjust paidaccounts if there is no date in the last row + $form->{paidaccounts}-- unless ($form->{"datepaid_$form->{paidaccounts}"}); + + $form->{paid} = 0; + # add payments + for my $i (1 .. $form->{paidaccounts}) { + $form->{"paid_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"paid_$i"}), 2); + + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"}; + + } + + + if ($form->{taxincluded} *= 1) { + for $i (1 .. $form->{rowcount}) { + $tax = ($form->{netamount}) ? $form->{tax} * $form->{"amount_$i"} / $form->{netamount} : 0; + $amount = $form->{"amount_$i"} - $tax; + $form->{"amount_$i"} = $form->round_amount($amount, 2); + $diff += $amount - $form->{"amount_$i"}; + } + + $form->{netamount} -= $form->{tax}; + # deduct difference from amount_1 + $form->{amount_1} += $form->round_amount($diff, 2); + } + + $form->{amount} = $form->{netamount} + $form->{tax}; + $form->{paid} = $form->round_amount($form->{paid} * $form->{exchangerate}, 2); + + my $query; + my $sth; + + # if we have an id delete old records + if ($form->{id}) { + + # delete detail records + $query = qq|DELETE FROM acc_trans WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO ap (invnumber, employee_id) + VALUES ('$uid', (SELECT id FROM employee + WHERE login = '$form->{login}') )|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM ap + WHERE invnumber = '$uid'|; + ($form->{id}) = $dbh->selectrow_array($query); + } + + $form->{datepaid} = $form->{transdate} unless ($form->{datepaid}); + my $datepaid = ($form->{paid} != 0) ? qq|'$form->{datepaid}'| : 'NULL'; + + $query = qq|UPDATE ap SET + invnumber = |.$dbh->quote($form->{invnumber}).qq|, + transdate = '$form->{transdate}', + ordnumber = |.$dbh->quote($form->{ordnumber}).qq|, + vendor_id = $form->{vendor_id}, + taxincluded = '$form->{taxincluded}', + amount = $form->{amount}, + duedate = |.$form->dbquote($form->{duedate}, SQL_DATE).qq|, + paid = $form->{paid}, + datepaid = $datepaid, + netamount = $form->{netamount}, + curr = |.$dbh->quote($form->{currency}).qq|, + notes = |.$dbh->quote($form->{notes}).qq|, + department_id = $form->{department_id} + WHERE id = $form->{id} + |; + $dbh->do($query) || $form->dberror($query); + + # amount for AP account + $form->{payables} = $form->{amount}; + + + # update exchangerate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, 0, $form->{exchangerate}); + } + + # add individual transactions + foreach my $item (keys %{ $form->{AP_amounts} }) { + + if ($form->{$item} != 0) { + + $project_id = 'NULL'; + if ($item =~ /amount_/) { + if ($form->{"projectnumber_$'"}) { + ($null, $project_id) = split /--/, $form->{"projectnumber_$'"} + } + } + + # insert detail records in acc_trans + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + project_id) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$form->{AP_amounts}{$item}'), + $form->{$item}, '$form->{transdate}', $project_id)|; + $dbh->do($query) || $form->dberror($query); + } + } + + # if there is no amount but a payment record a payable + if ($form->{amount} == 0) { + $form->{payables} = $form->{paid}; + $form->{payables} -= $form->{paid_1} if $form->{amount_1} != 0; + } + + # add paid transactions + for my $i (1 .. $form->{paidaccounts}) { + if ($form->{"paid_$i"} != 0) { + + # get paid account + ($form->{AP_amounts}{"paid_$i"}) = split(/--/, $form->{"AP_paid_$i"}); + $form->{"datepaid_$i"} = $form->{transdate} unless ($form->{"datepaid_$i"}); + + $exchangerate = 0; + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{"datepaid_$i"}, 'sell'); + + $form->{"exchangerate_$i"} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + + # if there is no amount + if ($form->{amount} == 0 && $form->{netamount} == 0) { + $form->{exchangerate} = $form->{"exchangerate_$i"}; + } + + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} * -1, 2); + if ($form->{payables} != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$form->{AP_amounts}{payables}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + $form->{payables} = $amount; + + # add payment + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, source, memo) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$form->{AP_amounts}{"paid_$i"}'), + $form->{"paid_$i"}, '$form->{"datepaid_$i"}', | + .$dbh->quote($form->{"source_$i"}).qq|, | + .$dbh->quote($form->{"memo_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + # add exchange rate difference + $amount = $form->round_amount($form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1), 2); + if ($amount != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, fx_transaction, cleared) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$form->{AP_amounts}{"paid_$i"}'), + $amount, '$form->{"datepaid_$i"}', '1', '0')|; + + $dbh->do($query) || $form->dberror($query); + } + + # exchangerate gain/loss + $amount = $form->round_amount($form->{"paid_$i"} * ($form->{exchangerate} - $form->{"exchangerate_$i"}), 2); + + if ($amount != 0) { + $accno = ($amount > 0) ? $form->{fxgain_accno} : $form->{fxloss_accno}; + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, fx_transaction, cleared) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$accno'), + $amount, '$form->{"datepaid_$i"}', '1', '0')|; + $dbh->do($query) || $form->dberror($query); + } + + # update exchange rate record + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{"datepaid_$i"}, 0, $form->{"exchangerate_$i"}); + } + } + } + + # save printed and queued + $form->save_status($dbh); + + my %audittrail = ( tablename => 'ap', + reference => $form->{invnumber}, + formname => 'transaction', + action => 'posted', + id => $form->{id} ); + $form->audittrail($dbh, "", \%audittrail); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + + +sub delete_transaction { + my ($self, $myconfig, $form, $spool) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my %audittrail = ( tablename => 'ap', + reference => $form->{invnumber}, + formname => 'transaction', + action => 'deleted', + id => $form->{id} ); + $form->audittrail($dbh, "", \%audittrail); + + my $query = qq|DELETE FROM ap WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM acc_trans WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete spool files + $query = qq|SELECT spoolfile FROM status + WHERE trans_id = $form->{id} + AND spoolfile IS NOT NULL|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $spoolfile; + my @spoolfiles = (); + + while (($spoolfile) = $sth->fetchrow_array) { + push @spoolfiles, $spoolfile; + } + $sth->finish; + + $query = qq|DELETE FROM status WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # commit and redirect + my $rc = $dbh->commit; + $dbh->disconnect; + + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "$spool/$spoolfile" if $spoolfile; + } + } + + $rc; + +} + + + + +sub ap_transactions { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $var; + + my $paid = "a.paid"; + + if ($form->{outstanding}) { + $paid = qq|SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE ac.trans_id = a.id + AND (c.link LIKE '%AP_paid%' OR c.link = '')|; + $paid .= qq| + AND ac.transdate <= '$form->{transdateto}'| if $form->{transdateto}; + } + + my $query = qq|SELECT a.id, a.invnumber, a.transdate, a.duedate, + a.amount, ($paid) AS paid, a.ordnumber, v.name, + a.invoice, a.netamount, a.datepaid, a.notes, + a.vendor_id, e.name AS employee, m.name AS manager, + a.curr, ex.sell AS exchangerate + FROM ap a + JOIN vendor v ON (a.vendor_id = v.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + LEFT JOIN employee m ON (e.managerid = m.id) + LEFT JOIN exchangerate ex ON (ex.curr = a.curr + AND ex.transdate = a.transdate) + |; + + my %ordinal = ( 'id' => 1, + 'invnumber' => 2, + 'transdate' => 3, + 'duedate' => 4, + 'ordnumber' => 7, + 'name' => 8, + 'datepaid' => 11, + 'employee' => 14, + 'manager' => 15, + 'curr' => 16 + ); + + my @a = (transdate, invnumber, name); + push @a, "employee" if $form->{l_employee}; + push @a, "manager" if $form->{l_manager}; + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $where = "1 = 1"; + + if ($form->{vendor_id}) { + $where .= " AND a.vendor_id = $form->{vendor_id}"; + } else { + if ($form->{vendor}) { + $var = $form->like(lc $form->{vendor}); + $where .= " AND lower(v.name) LIKE '$var'"; + } + } + if ($form->{department}) { + my ($null, $department_id) = split /--/, $form->{department}; + $where .= " AND a.department_id = $department_id"; + } + if ($form->{invnumber}) { + $var = $form->like(lc $form->{invnumber}); + $where .= " AND lower(a.invnumber) LIKE '$var'"; + $form->{open} = $form->{closed} = 0; + } + if ($form->{ordnumber}) { + $var = $form->like(lc $form->{ordnumber}); + $where .= " AND lower(a.ordnumber) LIKE '$var'"; + $form->{open} = $form->{closed} = 0; + } + if ($form->{notes}) { + $var = $form->like(lc $form->{notes}); + $where .= " AND lower(a.notes) LIKE '$var'"; + } + + ($form->{transdatefrom}, $form->{transdateto}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + $where .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $where .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + if ($form->{open} || $form->{closed}) { + unless ($form->{open} && $form->{closed}) { + $where .= " AND a.amount != a.paid" if ($form->{open}); + $where .= " AND a.amount = a.paid" if ($form->{closed}); + } + } + + + if ($form->{AP}) { + my ($accno) = split /--/, $form->{AP}; + $where .= qq| + AND a.id IN (SELECT ac.trans_id + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE a.id = ac.trans_id + AND c.accno = '$accno') + |; + } + + $query .= "WHERE $where + ORDER by $sortorder"; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + if ($form->{outstanding}) { + next if $form->round_amount($ref->{amount}, 2) == $form->round_amount($ref->{paid}, 2); + } + push @{ $form->{transactions} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +1; + diff --git a/sql-ledger/SL/AR.pm b/sql-ledger/SL/AR.pm new file mode 100644 index 000000000..80487e406 --- /dev/null +++ b/sql-ledger/SL/AR.pm @@ -0,0 +1,492 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Accounts Receivable module backend routines +# +#====================================================================== + +package AR; + + +sub post_transaction { + my ($self, $myconfig, $form) = @_; + + my $null; + my $taxrate; + my $amount; + my $tax; + my $diff; + my $exchangerate = 0; + my $i; + + # split and store id numbers in link accounts + map { ($form->{AR_amounts}{"amount_$_"}) = split(/--/, $form->{"AR_amount_$_"}) } (1 .. $form->{rowcount}); + ($form->{AR_amounts}{receivables}) = split(/--/, $form->{AR}); + + ($null, $form->{department_id}) = split(/--/, $form->{department}); + $form->{department_id} *= 1; + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{exchangerate} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, 'buy'); + + $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate}); + } + + for $i (1 .. $form->{rowcount}) { + $form->{"amount_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"amount_$i"}) * $form->{exchangerate}, 2); + + $form->{netamount} += $form->{"amount_$i"}; + + } + + + # taxincluded doesn't make sense if there is no amount + $form->{taxincluded} = 0 if ($form->{netamount} == 0); + + foreach my $item (split / /, $form->{taxaccounts}) { + $form->{AR_amounts}{"tax_$item"} = $item; + + $form->{"tax_$item"} = $form->round_amount($form->parse_amount($myconfig, $form->{"tax_$item"}) * $form->{exchangerate}, 2); + $form->{tax} += $form->{"tax_$item"}; + } + + # adjust paidaccounts if there is no date in the last row + $form->{paidaccounts}-- unless ($form->{"datepaid_$form->{paidaccounts}"}); + + $form->{paid} = 0; + # add payments + for $i (1 .. $form->{paidaccounts}) { + $form->{"paid_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"paid_$i"}), 2); + + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"}; + + } + + + if ($form->{taxincluded} *= 1) { + for $i (1 .. $form->{rowcount}) { + $tax = ($form->{netamount}) ? $form->{tax} * $form->{"amount_$i"} / $form->{netamount} : 0; + $amount = $form->{"amount_$i"} - $tax; + $form->{"amount_$i"} = $form->round_amount($amount, 2); + $diff += $amount - $form->{"amount_$i"}; + } + + $form->{netamount} -= $form->{tax}; + # deduct difference from amount_1 + $form->{amount_1} += $form->round_amount($diff, 2); + } + + $form->{amount} = $form->{netamount} + $form->{tax}; + $form->{paid} = $form->round_amount($form->{paid} * $form->{exchangerate}, 2); + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $sth; + + ($null, $form->{employee_id}) = split /--/, $form->{employee}; + unless ($form->{employee_id}) { + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + } + + # if we have an id delete old records + if ($form->{id}) { + + # delete detail records + $query = qq|DELETE FROM acc_trans WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO ar (invnumber) + VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM ar + WHERE invnumber = '$uid'|; + ($form->{id}) = $dbh->selectrow_array($query); + } + + + # record last payment date in ar table + $form->{datepaid} = $form->{transdate} unless $form->{datepaid}; + my $datepaid = ($form->{paid} != 0) ? qq|'$form->{datepaid}'| : 'NULL'; + + $query = qq|UPDATE ar set + invnumber = |.$dbh->quote($form->{invnumber}).qq|, + ordnumber = |.$dbh->quote($form->{ordnumber}).qq|, + transdate = '$form->{transdate}', + customer_id = $form->{customer_id}, + taxincluded = '$form->{taxincluded}', + amount = $form->{amount}, + duedate = '$form->{duedate}', + paid = $form->{paid}, + datepaid = $datepaid, + netamount = $form->{netamount}, + curr = '$form->{currency}', + notes = |.$dbh->quote($form->{notes}).qq|, + department_id = $form->{department_id}, + employee_id = $form->{employee_id} + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + + # amount for AR account + $form->{receivables} = $form->{amount} * -1; + + + # update exchangerate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, $form->{exchangerate}, 0); + } + + # add individual transactions for AR, amount and taxes + foreach my $item (keys %{ $form->{AR_amounts} }) { + + if ($form->{$item} != 0) { + + $project_id = 'NULL'; + if ($item =~ /amount_/) { + if ($form->{"projectnumber_$'"}) { + ($null, $project_id) = split /--/, $form->{"projectnumber_$'"}; + } + } + + # insert detail records in acc_trans + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + project_id) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$form->{AR_amounts}{$item}'), + $form->{$item}, '$form->{transdate}', $project_id)|; + $dbh->do($query) || $form->dberror($query); + } + } + + if ($form->{amount} == 0) { + $form->{receivables} = $form->{paid}; + $form->{receivables} -= $form->{paid_1} if $form->{amount_1} != 0; + } + + # add paid transactions + for my $i (1 .. $form->{paidaccounts}) { + if ($form->{"paid_$i"} != 0) { + + ($form->{AR_amounts}{"paid_$i"}) = split(/--/, $form->{"AR_paid_$i"}); + $form->{"datepaid_$i"} = $form->{transdate} unless ($form->{"datepaid_$i"}); + + $exchangerate = 0; + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{"datepaid_$i"}, 'buy'); + + $form->{"exchangerate_$i"} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + + # if there is no amount + if ($form->{amount} == 0 && $form->{netamount} == 0) { + $form->{exchangerate} = $form->{"exchangerate_$i"}; + } + + # receivables amount + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate}, 2); + + if ($form->{receivables} != 0) { + # add receivable + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$form->{AR_amounts}{receivables}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + $form->{receivables} = $amount; + + if ($form->{"paid_$i"} != 0) { + # add payment + $amount = $form->{"paid_$i"} * -1; + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, source, memo) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$form->{AR_amounts}{"paid_$i"}'), + $amount, '$form->{"datepaid_$i"}', | + .$dbh->quote($form->{"source_$i"}).qq|, | + .$dbh->quote($form->{"memo_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + + # exchangerate difference for payment + $amount = $form->round_amount($form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1) * -1, 2); + + if ($amount != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, fx_transaction, cleared) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$form->{AR_amounts}{"paid_$i"}'), + $amount, '$form->{"datepaid_$i"}', '1', '0')|; + $dbh->do($query) || $form->dberror($query); + } + + # exchangerate gain/loss + $amount = $form->round_amount($form->{"paid_$i"} * ($form->{exchangerate} - $form->{"exchangerate_$i"}) * -1, 2); + + if ($amount != 0) { + $accno = ($amount > 0) ? $form->{fxgain_accno} : $form->{fxloss_accno}; + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, fx_transaction, cleared) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$accno'), + $amount, '$form->{"datepaid_$i"}', '1', '0')|; + $dbh->do($query) || $form->dberror($query); + } + } + + # update exchangerate record + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{"datepaid_$i"}, $form->{"exchangerate_$i"}, 0); + } + } + } + + # save printed and queued + $form->save_status($dbh); + + my %audittrail = ( tablename => 'ar', + reference => $form->{invnumber}, + formname => 'transaction', + action => 'posted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub delete_transaction { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn AutoCommit off + my $dbh = $form->dbconnect_noauto($myconfig); + + my %audittrail = ( tablename => 'ar', + reference => $form->{invnumber}, + formname => 'transaction', + action => 'deleted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $query = qq|DELETE FROM ar WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM acc_trans WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete spool files + $query = qq|SELECT spoolfile FROM status + WHERE trans_id = $form->{id} + AND spoolfile IS NOT NULL|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $spoolfile; + my @spoolfiles = (); + + while (($spoolfile) = $sth->fetchrow_array) { + push @spoolfiles, $spoolfile; + } + $sth->finish; + + $query = qq|DELETE FROM status WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # commit + my $rc = $dbh->commit; + $dbh->disconnect; + + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "$spool/$spoolfile" if $spoolfile; + } + } + + $rc; + +} + + + +sub ar_transactions { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $var; + + my $paid = "a.paid"; + + ($form->{transdatefrom}, $form->{transdateto}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + if ($form->{outstanding}) { + $paid = qq|SELECT SUM(ac.amount) * -1 + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE ac.trans_id = a.id + AND (c.link LIKE '%AR_paid%' OR c.link = '')|; + $paid .= qq| + AND ac.transdate <= '$form->{transdateto}'| if $form->{transdateto}; + } + + my $query = qq|SELECT a.id, a.invnumber, a.ordnumber, a.transdate, + a.duedate, a.netamount, a.amount, ($paid) AS paid, + a.invoice, a.datepaid, a.terms, a.notes, + a.shipvia, a.shippingpoint, e.name AS employee, c.name, + a.customer_id, a.till, m.name AS manager, a.curr, + ex.buy AS exchangerate + FROM ar a + JOIN customer c ON (a.customer_id = c.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + LEFT JOIN employee m ON (e.managerid = m.id) + LEFT JOIN exchangerate ex ON (ex.curr = a.curr + AND ex.transdate = a.transdate) + |; + + my %ordinal = ( 'id' => 1, + 'invnumber' => 2, + 'ordnumber' => 3, + 'transdate' => 4, + 'duedate' => 5, + 'datepaid' => 10, + 'shipvia' => 13, + 'shippingpoint' => 14, + 'employee' => 15, + 'name' => 16, + 'manager' => 19, + 'curr' => 20 + ); + + + my @a = (transdate, invnumber, name); + push @a, "employee" if $form->{l_employee}; + push @a, "manager" if $form->{l_manager}; + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $where = "1 = 1"; + if ($form->{customer_id}) { + $where .= " AND a.customer_id = $form->{customer_id}"; + } else { + if ($form->{customer}) { + $var = $form->like(lc $form->{customer}); + $where .= " AND lower(c.name) LIKE '$var'"; + } + } + if ($form->{department}) { + my ($null, $department_id) = split /--/, $form->{department}; + $where .= " AND a.department_id = $department_id"; + } + if ($form->{invnumber}) { + $var = $form->like(lc $form->{invnumber}); + $where .= " AND lower(a.invnumber) LIKE '$var'"; + $form->{open} = $form->{closed} = 0; + } + if ($form->{ordnumber}) { + $var = $form->like(lc $form->{ordnumber}); + $where .= " AND lower(a.ordnumber) LIKE '$var'"; + $form->{open} = $form->{closed} = 0; + } + if ($form->{shipvia}) { + $var = $form->like(lc $form->{shipvia}); + $where .= " AND lower(a.shipvia) LIKE '$var'"; + } + if ($form->{notes}) { + $var = $form->like(lc $form->{notes}); + $where .= " AND lower(a.notes) LIKE '$var'"; + } + + $where .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $where .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + if ($form->{open} || $form->{closed}) { + unless ($form->{open} && $form->{closed}) { + $where .= " AND a.amount != a.paid" if ($form->{open}); + $where .= " AND a.amount = a.paid" if ($form->{closed}); + } + } + + if ($form->{till}) { + $where .= " AND a.invoice = '1' + AND NOT a.till IS NULL"; + if ($myconfig->{role} eq 'user') { + $where .= " AND e.login = '$form->{login}'"; + } + } + + if ($form->{AR}) { + my ($accno) = split /--/, $form->{AR}; + $where .= qq| + AND a.id IN (SELECT ac.trans_id + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE a.id = ac.trans_id + AND c.accno = '$accno') + |; + } + + $query .= "WHERE $where + ORDER by $sortorder"; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + if ($form->{outstanding}) { + next if $form->round_amount($ref->{amount}, 2) == $form->round_amount($ref->{paid}, 2); + } + push @{ $form->{transactions} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +1; + diff --git a/sql-ledger/SL/BP.pm b/sql-ledger/SL/BP.pm new file mode 100644 index 000000000..d85077db2 --- /dev/null +++ b/sql-ledger/SL/BP.pm @@ -0,0 +1,371 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2003 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Batch printing module backend routines +# +#====================================================================== + +package BP; + + +sub get_vc { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my %arap = ( invoice => ['ar'], + packing_list => ['oe', 'ar'], + sales_order => ['oe'], + work_order => ['oe'], + pick_list => ['oe', 'ar'], + purchase_order => ['oe'], + bin_list => ['oe'], + sales_quotation => ['oe'], + request_quotation => ['oe'], + check => ['ap'], + receipt => ['ar'] + ); + + my $query = ""; + my $sth; + my $n; + my $count; + my $item; + + foreach $item (@{ $arap{$form->{type}} }) { + $query = qq| + SELECT count(*) + FROM (SELECT DISTINCT vc.id + FROM $form->{vc} vc, $item a, status s + WHERE a.$form->{vc}_id = vc.id + AND s.trans_id = a.id + AND s.formname = '$form->{type}' + AND s.spoolfile IS NOT NULL) AS total|; + ($n) = $dbh->selectrow_array($query); + $count += $n; + } + + + # build selection list + my $union = ""; + $query = ""; + if ($count < $myconfig->{vclimit}) { + foreach $item (@{ $arap{$form->{type}} }) { + $query .= qq| + $union + SELECT DISTINCT vc.id, vc.name + FROM $form->{vc} vc, $item a, status s + WHERE a.$form->{vc}_id = vc.id + AND s.trans_id = a.id + AND s.formname = '$form->{type}' + AND s.spoolfile IS NOT NULL|; + $union = "UNION"; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{"all_$form->{vc}"} }, $ref; + } + $sth->finish; + } + + $form->all_years($dbh, $myconfig); + + $dbh->disconnect; + +} + + + +sub payment_accounts { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT DISTINCT c.accno, c.description + FROM status s, chart c + WHERE s.chart_id = c.id + AND s.formname = '$form->{type}'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{accounts} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub get_spoolfiles { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query; + my $invnumber = "invnumber"; + my $item; + + my %arap = ( invoice => ['ar'], + packing_list => ['oe', 'ar'], + sales_order => ['oe'], + work_order => ['oe'], + pick_list => ['oe', 'ar'], + purchase_order => ['oe'], + bin_list => ['oe'], + sales_quotation => ['oe'], + request_quotation => ['oe'], + check => ['ap'], + receipt => ['ar'] + ); + + + if ($form->{type} eq 'check' || $form->{type} eq 'receipt') { + + my ($accno) = split /--/, $form->{account}; + + $query = qq|SELECT a.id, vc.name, a.invnumber, ac.transdate, s.spoolfile, + a.invoice, '$arap{$form->{type}}[0]' AS module + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN $arap{$form->{type}}[0] a ON (a.id = ac.trans_id) + JOIN status s ON (s.trans_id = a.id) + JOIN $form->{vc} vc ON (vc.id = a.$form->{vc}_id) + WHERE s.formname = '$form->{type}' + AND c.accno = '$accno' + AND NOT ac.fx_transaction|; + + if ($form->{"$form->{vc}_id"}) { + $query .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } else { + if ($form->{$form->{vc}}) { + $item = $form->like(lc $form->{$form->{vc}}); + $query .= " AND lower(vc.name) LIKE '$item'"; + } + } + if ($form->{invnumber}) { + $item = $form->like(lc $form->{invnumber}); + $query .= " AND lower(a.invnumber) LIKE '$item'"; + } + if ($form->{ordnumber}) { + $item = $form->like(lc $form->{ordnumber}); + $query .= " AND lower(a.ordnumber) LIKE '$item'"; + } + if ($form->{quonumber}) { + $item = $form->like(lc $form->{quonumber}); + $query .= " AND lower(a.quonumber) LIKE '$item'"; + } + + $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + + } else { + + foreach $item (@{ $arap{$form->{type}} }) { + + $invoice = "a.invoice"; + $invnumber = "invnumber"; + + if ($item eq 'oe') { + $invnumber = "ordnumber"; + $invoice = "'0'"; + } + + $query .= qq| + $union + SELECT a.id, vc.name, a.$invnumber AS invnumber, a.transdate, + a.ordnumber, a.quonumber, $invoice AS invoice, + '$item' AS module, s.spoolfile + FROM $item a, $form->{vc} vc, status s + WHERE s.trans_id = a.id + AND s.spoolfile IS NOT NULL + AND s.formname = '$form->{type}' + AND a.$form->{vc}_id = vc.id|; + + if ($form->{"$form->{vc}_id"}) { + $query .= qq| AND a.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } else { + if ($form->{$form->{vc}}) { + $item = $form->like(lc $form->{$form->{vc}}); + $query .= " AND lower(vc.name) LIKE '$item'"; + } + } + if ($form->{invnumber}) { + $item = $form->like(lc $form->{invnumber}); + $query .= " AND lower(a.invnumber) LIKE '$item'"; + } + if ($form->{ordnumber}) { + $item = $form->like(lc $form->{ordnumber}); + $query .= " AND lower(a.ordnumber) LIKE '$item'"; + } + if ($form->{quonumber}) { + $item = $form->like(lc $form->{quonumber}); + $query .= " AND lower(a.quonumber) LIKE '$item'"; + } + + $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + $union = "UNION"; + + } + } + + my %ordinal = ( 'name' => 2, + 'invnumber' => 3, + 'transdate' => 4, + 'ordnumber' => 5, + 'quonumber' => 6 + ); + my @a = (transdate, $invnumber, name); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + $query .= " ORDER by $sortorder"; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{SPOOL} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub delete_spool { + my ($self, $myconfig, $form, $spool) = @_; + + # connect to database, turn AutoCommit off + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my %audittrail; + + if ($form->{type} =~ /(check|receipt)/) { + $query = qq|DELETE FROM status + WHERE spoolfile = ?|; + } else { + $query = qq|UPDATE status SET + spoolfile = NULL, + printed = '1' + WHERE spoolfile = ?|; + } + my $sth = $dbh->prepare($query) || $form->dberror($query); + + + foreach my $i (1 .. $form->{rowcount}) { + if ($form->{"checked_$i"}) { + $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query); + $sth->finish; + + %audittrail = ( tablename => $form->{module}, + reference => $form->{"reference_$i"}, + formname => $form->{type}, + action => 'dequeued', + id => $form->{"id_$i"} ); + + $form->audittrail($dbh, "", \%audittrail); + } + } + + # commit + my $rc = $dbh->commit; + $dbh->disconnect; + + if ($rc) { + foreach my $i (1 .. $form->{rowcount}) { + $_ = qq|$spool/$form->{"spoolfile_$i"}|; + if ($form->{"checked_$i"}) { + unlink; + } + } + } + + $rc; + +} + + +sub print_spool { + my ($self, $myconfig, $form, $spool) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my %audittrail; + + my $query = qq|UPDATE status SET + printed = '1' + WHERE formname = '$form->{type}' + AND spoolfile = ?|; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + foreach my $i (1 .. $form->{rowcount}) { + if ($form->{"checked_$i"}) { + open(OUT, $form->{OUT}) or $form->error("$form->{OUT} : $!"); + + $spoolfile = qq|$spool/$form->{"spoolfile_$i"}|; + + # send file to printer + open(IN, $spoolfile) or $form->error("$spoolfile : $!"); + + while (<IN>) { + print OUT $_; + } + close(IN); + close(OUT); + + $sth->execute($form->{"spoolfile_$i"}) || $form->dberror($query); + $sth->finish; + + %audittrail = ( tablename => $form->{module}, + reference => $form->{"reference_$i"}, + formname => $form->{type}, + action => 'printed', + id => $form->{"id_$i"} ); + + $form->audittrail($dbh, "", \%audittrail); + + $dbh->commit; + } + } + + $dbh->disconnect; + +} + + +1; + diff --git a/sql-ledger/SL/CA.pm b/sql-ledger/SL/CA.pm new file mode 100644 index 000000000..2ae78bd5c --- /dev/null +++ b/sql-ledger/SL/CA.pm @@ -0,0 +1,486 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2001 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# chart of accounts +# +#====================================================================== + + +package CA; + + +sub all_accounts { + my ($self, $myconfig, $form) = @_; + + my $amount = (); + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, + SUM(acc_trans.amount) AS amount + FROM chart, acc_trans + WHERE chart.id = acc_trans.chart_id + GROUP BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $amount{$ref->{accno}} = $ref->{amount} + } + $sth->finish; + + $query = qq|SELECT accno, description + FROM gifi|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $gifi = (); + while (my ($accno, $description) = $sth->fetchrow_array) { + $gifi{$accno} = $description; + } + $sth->finish; + + $query = qq|SELECT c.id, c.accno, c.description, c.charttype, c.gifi_accno, + c.category, c.link + FROM chart c + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ca = $sth->fetchrow_hashref(NAME_lc)) { + $ca->{amount} = $amount{$ca->{accno}}; + $ca->{gifi_description} = $gifi{$ca->{gifi_accno}}; + if ($ca->{amount} < 0) { + $ca->{debit} = $ca->{amount} * -1; + } else { + $ca->{credit} = $ca->{amount}; + } + push @{ $form->{CA} }, $ca; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub all_transactions { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # get chart_id + my $query = qq|SELECT id FROM chart + WHERE accno = '$form->{accno}'|; + if ($form->{accounttype} eq 'gifi') { + $query = qq|SELECT id FROM chart + WHERE gifi_accno = '$form->{gifi_accno}'|; + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my @id = (); + while (my ($id) = $sth->fetchrow_array) { + push @id, $id; + } + $sth->finish; + + my $fromdate_where; + my $todate_where; + + ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + if ($form->{fromdate}) { + $fromdate_where = qq| + AND ac.transdate >= '$form->{fromdate}' + |; + } + if ($form->{todate}) { + $todate_where .= qq| + AND ac.transdate <= '$form->{todate}' + |; + } + + + my $false = ($myconfig->{dbdriver} =~ /Pg/) ? FALSE : q|'0'|; + + # Oracle workaround, use ordinal positions + my %ordinal = ( transdate => 4, + reference => 2, + description => 3 ); + + my @a = qw(transdate reference description); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $null; + my $department_id; + my $dpt_where; + my $dpt_join; + + ($null, $department_id) = split /--/, $form->{department}; + + if ($department_id) { + $dpt_join = qq| + JOIN department t ON (t.id = a.department_id) + |; + $dpt_where = qq| + AND t.id = $department_id + |; + } + + my $project; + my $project_id; + if ($form->{projectnumber}) { + ($null, $project_id) = split /--/, $form->{projectnumber}; + $project = qq| + AND ac.project_id = $project_id + |; + } + + if ($form->{accno} || $form->{gifi_accno}) { + # get category for account + $query = qq|SELECT category, link + FROM chart + WHERE accno = '$form->{accno}'|; + + if ($form->{accounttype} eq 'gifi') { + $query = qq|SELECT category, link + FROM chart + WHERE gifi_accno = '$form->{gifi_accno}' + AND charttype = 'A'|; + } + + $sth = $dbh->prepare($query); + + $sth->execute || $form->dberror($query); + ($form->{category}, $form->{link}) = $sth->fetchrow_array; + $sth->finish; + + if ($form->{fromdate}) { + + # get beginning balance + $query = qq|SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + $dpt_join + WHERE c.accno = '$form->{accno}' + AND ac.transdate < '$form->{fromdate}' + $dpt_where + $project + |; + + if ($project_id) { + + $query .= qq| + + UNION + + SELECT SUM(ac.sellprice * ac.qty) + FROM invoice ac + JOIN ar a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.income_accno_id = c.id) + $dpt_join + WHERE c.accno = '$form->{accno}' + AND a.transdate < '$form->{fromdate}' + AND c.category = 'I' + $dpt_where + $project + + UNION + + SELECT SUM(ac.sellprice * ac.qty) + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + $dpt_join + WHERE c.accno = '$form->{accno}' + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + AND a.transdate < '$form->{fromdate}' + AND c.category = 'E' + $dpt_where + $project + + UNION + + SELECT SUM(ac.sellprice * ac.allocated) * -1 + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + $dpt_join + WHERE c.accno = '$form->{accno}' + AND ac.assemblyitem = '0' + AND a.transdate < '$form->{fromdate}' + AND c.category = 'E' + $dpt_where + $project + |; + + } + + if ($form->{accounttype} eq 'gifi') { + $query = qq|SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + $dpt_join + WHERE c.gifi_accno = '$form->{gifi_accno}' + AND ac.transdate < '$form->{fromdate}' + $dpt_where + $project + |; + + if ($project_id) { + + $query .= qq| + + UNION + + SELECT SUM(ac.sellprice * ac.qty) + FROM invoice ac + JOIN ar a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.income_accno_id = c.id) + $dpt_join + WHERE c.gifi_accno = '$form->{gifi_accno}' + AND a.transdate < '$form->{fromdate}' + AND c.category = 'I' + $dpt_where + $project + + UNION + + SELECT SUM(ac.sellprice * ac.qty) + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + $dpt_join + WHERE c.gifi_accno = '$form->{gifi_accno}' + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + AND a.transdate < '$form->{fromdate}' + AND c.category = 'E' + $dpt_where + $project + + UNION + + SELECT SUM(ac.sellprice * ac.allocated) * -1 + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + $dpt_join + WHERE c.gifi_accno = '$form->{gifi_accno}' + AND ac.assemblyitem = '0' + AND a.transdate < '$form->{fromdate}' + AND c.category = 'E' + $dpt_where + $project + |; + + } + } + + ($form->{balance}) = $dbh->selectrow_array($query); + + } + } + + $query = ""; + my $union = ""; + + foreach my $id (@id) { + + # get all transactions + $query .= qq|$union + SELECT a.id, a.reference, a.description, ac.transdate, + $false AS invoice, ac.amount, 'gl' as module, ac.cleared, + '' AS till + FROM gl a + JOIN acc_trans ac ON (ac.trans_id = a.id) + $dpt_join + WHERE ac.chart_id = $id + $fromdate_where + $todate_where + $dpt_where + $project + + UNION ALL + + SELECT a.id, a.invnumber, c.name, ac.transdate, + a.invoice, ac.amount, 'ar' as module, ac.cleared, + a.till + FROM ar a + JOIN acc_trans ac ON (ac.trans_id = a.id) + JOIN customer c ON (a.customer_id = c.id) + $dpt_join + WHERE ac.chart_id = $id + $fromdate_where + $todate_where + $dpt_where + $project + + UNION ALL + + SELECT a.id, a.invnumber, v.name, ac.transdate, + a.invoice, ac.amount, 'ap' as module, ac.cleared, + a.till + FROM ap a + JOIN acc_trans ac ON (ac.trans_id = a.id) + JOIN vendor v ON (a.vendor_id = v.id) + $dpt_join + WHERE ac.chart_id = $id + $fromdate_where + $todate_where + $dpt_where + $project + |; + + if ($project_id) { + + $fromdate_where =~ s/ac\./a\./; + $todate_where =~ s/ac\./a\./; + + $query .= qq| + + UNION ALL + + -- sold items + + SELECT a.id, a.invnumber, c.name, a.transdate, + a.invoice, ac.sellprice * ac.qty, 'ar' as module, '0' AS cleared, + a.till + FROM ar a + JOIN invoice ac ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN customer c ON (a.customer_id = c.id) + $dpt_join + WHERE p.income_accno_id = $id + $fromdate_where + $todate_where + $dpt_where + $project + + UNION ALL + + -- bought services + + SELECT a.id, a.invnumber, v.name, a.transdate, + a.invoice, ac.sellprice * ac.qty, 'ap' as module, '0' AS cleared, + a.till + FROM ap a + JOIN invoice ac ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN vendor v ON (a.vendor_id = v.id) + $dpt_join + WHERE p.expense_accno_id = $id + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $fromdate_where + $todate_where + $dpt_where + $project + + UNION ALL + + -- cogs + + SELECT a.id, a.invnumber, v.name, a.transdate, + a.invoice, ac.sellprice * ac.allocated * -1, 'ap' as module, '0' AS cleared, + a.till + FROM ap a + JOIN invoice ac ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN vendor v ON (a.vendor_id = v.id) + $dpt_join + WHERE p.expense_accno_id = $id + AND ac.assemblyitem = '0' + $fromdate_where + $todate_where + $dpt_where + $project + + |; + + $fromdate_where =~ s/a\./ac\./; + $todate_where =~ s/a\./ac\./; + + } + + $union = qq| + UNION ALL + |; + } + + $query .= qq| + ORDER BY $sortorder|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ca = $sth->fetchrow_hashref(NAME_lc)) { + + # gl + if ($ca->{module} eq "gl") { + $ca->{module} = "gl"; + } + + # ap + if ($ca->{module} eq "ap") { + $ca->{module} = ($ca->{invoice}) ? 'ir' : 'ap'; + $ca->{module} = 'ps' if $ca->{till}; + } + + # ar + if ($ca->{module} eq "ar") { + $ca->{module} = ($ca->{invoice}) ? 'is' : 'ar'; + $ca->{module} = 'ps' if $ca->{till}; + } + + if ($ca->{amount}) { + if ($ca->{amount} < 0) { + $ca->{debit} = $ca->{amount} * -1; + $ca->{credit} = 0; + } else { + $ca->{credit} = $ca->{amount}; + $ca->{debit} = 0; + } + + push @{ $form->{CA} }, $ca; + } + + } + + $sth->finish; + $dbh->disconnect; + +} + +1; + diff --git a/sql-ledger/SL/CP.pm b/sql-ledger/SL/CP.pm new file mode 100644 index 000000000..539ff6d9a --- /dev/null +++ b/sql-ledger/SL/CP.pm @@ -0,0 +1,396 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2003 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Check and receipt printing payment module backend routines +# Number to text conversion routines are in +# locale/{countrycode}/Num2text +# +#====================================================================== + +package CP; + + +sub new { + my ($type, $countrycode) = @_; + + $self = {}; + + if ($countrycode) { + if (-f "locale/$countrycode/Num2text") { + require "locale/$countrycode/Num2text"; + } else { + use SL::Num2text; + } + } else { + use SL::Num2text; + } + + bless $self, $type; + +} + + +sub paymentaccounts { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description, link + FROM chart + WHERE link LIKE '%$form->{ARAP}%' + ORDER BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{PR}{$form->{ARAP}} = (); + $form->{PR}{"$form->{ARAP}_paid"} = (); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + foreach my $item (split /:/, $ref->{link}) { + if ($item eq $form->{ARAP}) { + push @{ $form->{PR}{$form->{ARAP}} }, $ref; + } + if ($item eq "$form->{ARAP}_paid") { + push @{ $form->{PR}{"$form->{ARAP}_paid"} }, $ref; + } + } + } + $sth->finish; + + # get currencies and closedto + $query = qq|SELECT curr, closedto, current_date + FROM defaults|; + ($form->{currencies}, $form->{closedto}, $form->{datepaid}) = $dbh->selectrow_array($query); + + $dbh->disconnect; + +} + + +sub get_openvc { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $arap = ($form->{vc} eq 'customer') ? 'ar' : 'ap'; + my $query = qq|SELECT count(*) + FROM $form->{vc} ct, $arap a + WHERE a.$form->{vc}_id = ct.id + AND a.amount != a.paid|; + my ($count) = $dbh->selectrow_array($query); + + my $sth; + my $ref; + + # build selection list + if ($count < $myconfig->{vclimit}) { + $query = qq|SELECT DISTINCT ct.id, ct.name + FROM $form->{vc} ct, $arap a + WHERE a.$form->{vc}_id = ct.id + AND a.amount != a.paid + ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{"all_$form->{vc}"} }, $ref; + } + + $sth->finish; + + } + + if ($form->{ARAP} eq 'AR') { + $query = qq|SELECT id, description + FROM department + WHERE role = 'P' + ORDER BY 2|; + } else { + $query = qq|SELECT id, description + FROM department + ORDER BY 2|; + } + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_departments} }, $ref; + } + $sth->finish; + + # get language codes + $query = qq|SELECT * + FROM language + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $form->{all_languages} = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_languages} }, $ref; + } + $sth->finish; + + # get currency for first name + if ($form->{"all_$form->{vc}"}) { + $query = qq|SELECT curr FROM $form->{vc} + WHERE id = $form->{"all_$form->{vc}"}->[0]->{id}|; + ($form->{currency}) = $dbh->selectrow_array($query); + } + + $dbh->disconnect; + +} + + +sub get_openinvoices { + my ($self, $myconfig, $form) = @_; + + my $null; + my $department_id; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $where = qq|WHERE $form->{vc}_id = $form->{"$form->{vc}_id"} + AND curr = '$form->{currency}' + AND amount != paid|; + + my ($buysell); + if ($form->{vc} eq 'customer') { + $buysell = "buy"; + } else { + $buysell = "sell"; + } + + ($null, $department_id) = split /--/, $form->{department}; + if ($department_id) { + $where .= qq| + AND department_id = $department_id|; + } + + my $query = qq|SELECT id, invnumber, transdate, amount, paid, curr + FROM $form->{arap} + $where + ORDER BY transdate, invnumber|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + # if this is a foreign currency transaction get exchangerate + $ref->{exchangerate} = $form->get_exchangerate($dbh, $ref->{curr}, $ref->{transdate}, $buysell) if ($form->{currency} ne $form->{defaultcurrency}); + push @{ $form->{PR} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + + +sub process_payment { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn AutoCommit off + my $dbh = $form->dbconnect_noauto($myconfig); + + my $sth; + + my ($paymentaccno) = split /--/, $form->{account}; + + # if currency ne defaultcurrency update exchangerate + if ($form->{currency} ne $form->{defaultcurrency}) { + $form->{exchangerate} = $form->parse_amount($myconfig, $form->{exchangerate}); + + if ($form->{vc} eq 'customer') { + $form->update_exchangerate($dbh, $form->{currency}, $form->{datepaid}, $form->{exchangerate}, 0); + } else { + $form->update_exchangerate($dbh, $form->{currency}, $form->{datepaid}, 0, $form->{exchangerate}); + } + } else { + $form->{exchangerate} = 1; + } + + my $query = qq|SELECT fxgain_accno_id, fxloss_accno_id + FROM defaults|; + my ($fxgain_accno_id, $fxloss_accno_id) = $dbh->selectrow_array($query); + + my ($buysell); + + if ($form->{vc} eq 'customer') { + $buysell = "buy"; + } else { + $buysell = "sell"; + } + + my $ml; + my $where; + + if ($form->{ARAP} eq 'AR') { + $ml = 1; + $where = qq| + (c.link = 'AR' + OR c.link LIKE 'AR:%') + |; + } else { + $ml = -1; + $where = qq| + (c.link = 'AP' + OR c.link LIKE '%:AP' + OR c.link LIKE '%:AP:%') + |; + } + + my $paymentamount = $form->parse_amount($myconfig, $form->{amount}); + + my $null; + ($null, $form->{department_id}) = split /--/, $form->{department}; + $form->{department_id} *= 1; + + + # query to retrieve paid amount + $query = qq|SELECT paid FROM $form->{arap} + WHERE id = ? + FOR UPDATE|; + my $pth = $dbh->prepare($query) || $form->dberror($query); + + my %audittrail; + + # go through line by line + for my $i (1 .. $form->{rowcount}) { + + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + $form->{"due_$i"} = $form->parse_amount($myconfig, $form->{"due_$i"}); + + if ($form->{"checked_$i"} && $form->{"paid_$i"}) { + + $paymentamount -= $form->{"paid_$i"}; + + # get exchangerate for original + $query = qq|SELECT $buysell + FROM exchangerate e + JOIN $form->{arap} a ON (a.transdate = e.transdate) + WHERE e.curr = '$form->{currency}' + AND a.id = $form->{"id_$i"}|; + my ($exchangerate) = $dbh->selectrow_array($query); + + $exchangerate = 1 unless $exchangerate; + + $query = qq|SELECT c.id + FROM chart c + JOIN acc_trans a ON (a.chart_id = c.id) + WHERE $where + AND a.trans_id = $form->{"id_$i"}|; + my ($id) = $dbh->selectrow_array($query); + + $amount = $form->round_amount($form->{"paid_$i"} * $exchangerate, 2); + + # add AR/AP + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, + amount) + VALUES ($form->{"id_$i"}, $id, '$form->{datepaid}', + $amount * $ml)|; + $dbh->do($query) || $form->dberror($query); + + # add payment + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, + amount, source, memo) + VALUES ($form->{"id_$i"}, + (SELECT id FROM chart + WHERE accno = '$paymentaccno'), + '$form->{datepaid}', $form->{"paid_$i"} * $ml * -1, | + .$dbh->quote($form->{source}).qq|, | + .$dbh->quote($form->{memo}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + # add exchangerate difference if currency ne defaultcurrency + $amount = $form->round_amount($form->{"paid_$i"} * ($form->{exchangerate} - 1), 2); + + if ($amount != 0) { + # exchangerate difference + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, + amount, cleared, fx_transaction) + VALUES ($form->{"id_$i"}, + (SELECT id FROM chart + WHERE accno = '$paymentaccno'), + '$form->{datepaid}', $amount * $ml * -1, '0', '1')|; + $dbh->do($query) || $form->dberror($query); + + # gain/loss + $amount = $form->round_amount($form->{"paid_$i"} * ($exchangerate - $form->{exchangerate}) * $ml * -1, 2); + if ($amount != 0) { + my $accno_id = ($amount > 0) ? $fxgain_accno_id : $fxloss_accno_id; + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, + amount, cleared, fx_transaction) + VALUES ($form->{"id_$i"}, $accno_id, + '$form->{datepaid}', $amount, '0', '1')|; + $dbh->do($query) || $form->dberror($query); + } + } + + $form->{"paid_$i"} = $form->round_amount($form->{"paid_$i"} * $exchangerate, 2); + + $pth->execute($form->{"id_$i"}) || $form->dberror; + ($amount) = $pth->fetchrow_array; + $pth->finish; + + $amount += $form->{"paid_$i"}; + + # update AR/AP transaction + $query = qq|UPDATE $form->{arap} set + paid = $amount, + datepaid = '$form->{datepaid}' + WHERE id = $form->{"id_$i"}|; + $dbh->do($query) || $form->dberror($query); + + %audittrail = ( tablename => $form->{arap}, + reference => $form->{source}, + formname => $form->{formname}, + action => 'posted', + id => $form->{"id_$i"} ); + + $form->audittrail($dbh, "", \%audittrail); + + } + } + + + # record a AR/AP with a payment + if ($form->round_amount($paymentamount, 2) != 0) { + $form->{invnumber} = ""; + OP::overpayment("", $myconfig, $form, $dbh, $paymentamount, $ml, 1); + } + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +1; + diff --git a/sql-ledger/SL/CT.pm b/sql-ledger/SL/CT.pm new file mode 100644 index 000000000..bfcc2196a --- /dev/null +++ b/sql-ledger/SL/CT.pm @@ -0,0 +1,1008 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# backend code for customers and vendors +# +#====================================================================== + +package CT; + + +sub create_links { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + my $query; + my $sth; + my $ref; + + if ($form->{id}) { + $query = qq|SELECT ct.*, b.description AS business, s.*, + e.name AS employee, g.pricegroup AS pricegroup, + l.description AS language, ct.curr + FROM $form->{db} ct + LEFT JOIN business b ON (ct.business_id = b.id) + LEFT JOIN shipto s ON (ct.id = s.trans_id) + LEFT JOIN employee e ON (ct.employee_id = e.id) + LEFT JOIN pricegroup g ON (g.id = ct.pricegroup_id) + LEFT JOIN language l ON (l.code = ct.language_code) + WHERE ct.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # check if it is orphaned + my $arap = ($form->{db} eq 'customer') ? "ar" : "ap"; + $query = qq|SELECT a.id + FROM $arap a + JOIN $form->{db} ct ON (a.$form->{db}_id = ct.id) + WHERE ct.id = $form->{id} + UNION + SELECT a.id + FROM oe a + JOIN $form->{db} ct ON (a.$form->{db}_id = ct.id) + WHERE ct.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + unless ($sth->fetchrow_array) { + $form->{status} = "orphaned"; + } + $sth->finish; + + + # get taxes for customer/vendor + $query = qq|SELECT c.accno + FROM chart c + JOIN $form->{db}tax t ON (t.chart_id = c.id) + WHERE t.$form->{db}_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{tax}{$ref->{accno}}{taxable} = 1; + } + $sth->finish; + + } else { + + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + + $query = qq|SELECT current_date FROM defaults|; + ($form->{startdate}) = $dbh->selectrow_array($query); + + } + + # get tax labels + $query = qq|SELECT c.accno, c.description + FROM chart c + JOIN tax t ON (t.chart_id = c.id) + WHERE c.link LIKE '%CT_tax%' + ORDER BY c.accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{taxaccounts} .= "$ref->{accno} "; + $form->{tax}{$ref->{accno}}{description} = $ref->{description}; + } + $sth->finish; + chop $form->{taxaccounts}; + + + # get business types + $query = qq|SELECT * + FROM business + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_business} }, $ref; + } + $sth->finish; + + # this is for the salesperson + $query = qq|SELECT id, name + FROM employee + WHERE sales = '1' + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_employee} }, $ref; + } + $sth->finish; + + # get language + $query = qq|SELECT * + FROM language + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_language} }, $ref; + } + $sth->finish; + + # get pricegroups + $query = qq|SELECT * + FROM pricegroup + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_pricegroup} }, $ref; + } + $sth->finish; + + # get currencies + $query = qq|SELECT curr AS currencies + FROM defaults|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{currencies}) = $sth->fetchrow_array; + $sth->finish; + + $dbh->disconnect; + +} + + +sub save_customer { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + my $query; + my $sth; + my $null; + + # remove double spaces + $form->{name} =~ s/ / /g; + # remove double minus and minus at the end + $form->{name} =~ s/--+/-/g; + $form->{name} =~ s/-+$//; + + # assign value discount, terms, creditlimit + $form->{discount} = $form->parse_amount($myconfig, $form->{discount}); + $form->{discount} /= 100; + $form->{terms} *= 1; + $form->{taxincluded} *= 1; + $form->{creditlimit} = $form->parse_amount($myconfig, $form->{creditlimit}); + + + if ($form->{id}) { + $query = qq|DELETE FROM customertax + WHERE customer_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM shipto + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # retrieve enddate + if ($form->{type} && $form->{enddate}) { + my $now; + $query = qq|SELECT enddate, current_date AS now FROM customer|; + ($form->{enddate}, $now) = $dbh->selectrow_array($query); + $form->{enddate} = $now if $form->{enddate} lt $now; + } + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO customer (name) + VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM customer + WHERE name = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + + } + + my $employee_id; + ($null, $employee_id) = split /--/, $form->{employee}; + $employee_id *= 1; + + my $pricegroup_id; + ($null, $pricegroup_id) = split /--/, $form->{pricegroup}; + $pricegroup_id *= 1; + + my $business_id; + ($null, $business_id) = split /--/, $form->{business}; + $business_id *= 1; + + my $language_code; + ($null, $language_code) = split /--/, $form->{language}; + + $form->{customernumber} = $form->update_defaults($myconfig, "customernumber", $dbh) if ! $form->{customernumber}; + + $query = qq|UPDATE customer SET + customernumber = |.$dbh->quote($form->{customernumber}).qq|, + name = |.$dbh->quote($form->{name}).qq|, + address1 = |.$dbh->quote($form->{address1}).qq|, + address2 = |.$dbh->quote($form->{address2}).qq|, + city = |.$dbh->quote($form->{city}).qq|, + state = |.$dbh->quote($form->{state}).qq|, + zipcode = |.$dbh->quote($form->{zipcode}).qq|, + country = |.$dbh->quote($form->{country}).qq|, + contact = |.$dbh->quote($form->{contact}).qq|, + phone = '$form->{phone}', + fax = '$form->{fax}', + email = '$form->{email}', + cc = '$form->{cc}', + bcc = '$form->{bcc}', + notes = |.$dbh->quote($form->{notes}).qq|, + discount = $form->{discount}, + creditlimit = $form->{creditlimit}, + terms = $form->{terms}, + taxincluded = '$form->{taxincluded}', + business_id = $business_id, + taxnumber = |.$dbh->quote($form->{taxnumber}).qq|, + sic_code = '$form->{sic}', + iban = '$form->{iban}', + bic = '$form->{bic}', + employee_id = $employee_id, + pricegroup_id = $pricegroup_id, + language_code = '$language_code', + curr = '$form->{curr}', + startdate = |.$form->dbquote($form->{startdate}, SQL_DATE).qq|, + enddate = |.$form->dbquote($form->{enddate}, SQL_DATE).qq| + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # save taxes + foreach $item (split / /, $form->{taxaccounts}) { + if ($form->{"tax_$item"}) { + $query = qq|INSERT INTO customertax (customer_id, chart_id) + VALUES ($form->{id}, (SELECT id + FROM chart + WHERE accno = '$item'))|; + $dbh->do($query) || $form->dberror($query); + } + } + + # add shipto + $form->add_shipto($dbh, $form->{id}); + + $dbh->commit; + $dbh->disconnect; + +} + + +sub save_vendor { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $sth; + my $null; + + # remove double spaces + $form->{name} =~ s/ / /g; + # remove double minus and minus at the end + $form->{name} =~ s/--+/-/g; + $form->{name} =~ s/-+$//; + + $form->{discount} = $form->parse_amount($myconfig, $form->{discount}); + $form->{discount} /= 100; + $form->{terms} *= 1; + $form->{taxincluded} *= 1; + $form->{creditlimit} = $form->parse_amount($myconfig, $form->{creditlimit}); + + + if ($form->{id}) { + $query = qq|DELETE FROM vendortax + WHERE vendor_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM shipto + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO vendor (name) + VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM vendor + WHERE name = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + + } + + my $employee_id; + ($null, $employee_id) = split /--/, $form->{employee}; + $employee_id *= 1; + + my $pricegroup_id; + ($null, $pricegroup_id) = split /--/, $form->{pricegroup}; + $pricegroup_id *= 1; + + my $business_id; + ($null, $business_id) = split /--/, $form->{business}; + $business_id *= 1; + + my $language_code; + ($null, $language_code) = split /--/, $form->{language}; + + $form->{vendornumber} = $form->update_defaults($myconfig, "vendornumber", $dbh) if ! $form->{vendornumber}; + + $query = qq|UPDATE vendor SET + vendornumber = |.$dbh->quote($form->{vendornumber}).qq|, + name = |.$dbh->quote($form->{name}).qq|, + address1 = |.$dbh->quote($form->{address1}).qq|, + address2 = |.$dbh->quote($form->{address2}).qq|, + city = |.$dbh->quote($form->{city}).qq|, + state = |.$dbh->quote($form->{state}).qq|, + zipcode = |.$dbh->quote($form->{zipcode}).qq|, + country = |.$dbh->quote($form->{country}).qq|, + contact = |.$dbh->quote($form->{contact}).qq|, + phone = '$form->{phone}', + fax = '$form->{fax}', + email = '$form->{email}', + cc = '$form->{cc}', + bcc = '$form->{bcc}', + notes = |.$dbh->quote($form->{notes}).qq|, + terms = $form->{terms}, + discount = $form->{discount}, + creditlimit = $form->{creditlimit}, + taxincluded = '$form->{taxincluded}', + gifi_accno = '$form->{gifi_accno}', + business_id = $business_id, + taxnumber = |.$dbh->quote($form->{taxnumber}).qq|, + sic_code = '$form->{sic}', + iban = '$form->{iban}', + bic = '$form->{bic}', + employee_id = $employee_id, + language_code = '$language_code', + pricegroup_id = $pricegroup_id, + curr = '$form->{curr}', + startdate = |.$form->dbquote($form->{startdate}, SQL_DATE).qq|, + enddate = |.$form->dbquote($form->{enddate}, SQL_DATE).qq| + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # save taxes + foreach $item (split / /, $form->{taxaccounts}) { + if ($form->{"tax_$item"}) { + $query = qq|INSERT INTO vendortax (vendor_id, chart_id) + VALUES ($form->{id}, (SELECT id + FROM chart + WHERE accno = '$item'))|; + $dbh->do($query) || $form->dberror($query); + } + } + + # add shipto + $form->add_shipto($dbh, $form->{id}); + + $dbh->commit; + $dbh->disconnect; + +} + + + +sub delete { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # delete customer/vendor + my $query = qq|DELETE FROM $form->{db} + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub search { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $where = "1 = 1"; + $form->{sort} = ($form->{sort}) ? $form->{sort} : "name"; + my @a = qw(name); + my $sortorder = $form->sort_order(\@a); + + my $var; + my $item; + + @a = ("$form->{db}number"); + push @a, qw(name contact city state zipcode country notes email); + + foreach $item (@a) { + if ($form->{$item}) { + $var = $form->like(lc $form->{$item}); + $where .= " AND lower(ct.$item) LIKE '$var'"; + } + } + if ($form->{address}) { + $var = $form->like(lc $form->{address}); + $where .= " AND (lower(ct.address1) LIKE '$var' OR lower(ct.address2) LIKE '$var')"; + } + + if ($form->{status} eq 'orphaned') { + $where .= qq| AND ct.id NOT IN (SELECT o.$form->{db}_id + FROM oe o, $form->{db} cv + WHERE cv.id = o.$form->{db}_id)|; + if ($form->{db} eq 'customer') { + $where .= qq| AND ct.id NOT IN (SELECT a.customer_id + FROM ar a, customer cv + WHERE cv.id = a.customer_id)|; + } + if ($form->{db} eq 'vendor') { + $where .= qq| AND ct.id NOT IN (SELECT a.vendor_id + FROM ap a, vendor cv + WHERE cv.id = a.vendor_id)|; + } + $form->{l_invnumber} = $form->{l_ordnumber} = $form->{l_quonumber} = ""; + } + + + my $query = qq|SELECT ct.*, b.description AS business, + e.name AS employee, g.pricegroup, l.description AS language, + m.name AS manager + FROM $form->{db} ct + LEFT JOIN business b ON (ct.business_id = b.id) + LEFT JOIN employee e ON (ct.employee_id = e.id) + LEFT JOIN employee m ON (m.id = e.managerid) + LEFT JOIN pricegroup g ON (ct.pricegroup_id = g.id) + LEFT JOIN language l ON (l.code = ct.language_code) + WHERE $where|; + + # redo for invoices, orders and quotations + if ($form->{l_transnumber} || $form->{l_invnumber} || $form->{l_ordnumber} || $form->{l_quonumber}) { + + my ($ar, $union, $module); + $query = ""; + my $transwhere; + my $openarap = ""; + my $openoe = ""; + + if ($form->{open} || $form->{closed}) { + unless ($form->{open} && $form->{closed}) { + $openarap = " AND a.amount != a.paid" if $form->{open}; + $openarap = " AND a.amount = a.paid" if $form->{closed}; + $openoe = " AND o.closed = '0'" if $form->{open}; + $openoe = " AND o.closed = '1'" if $form->{closed}; + } + } + + if ($form->{l_transnumber}) { + $ar = ($form->{db} eq 'customer') ? 'ar' : 'ap'; + $module = $ar; + + $transwhere = ""; + $transwhere .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $transwhere .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + + $query = qq|SELECT ct.*, b.description AS business, + a.invnumber, a.ordnumber, a.quonumber, a.id AS invid, + '$ar' AS module, 'invoice' AS formtype, + (a.amount = a.paid) AS closed, a.amount, a.netamount + FROM $form->{db} ct + JOIN $ar a ON (a.$form->{db}_id = ct.id) + LEFT JOIN business b ON (ct.business_id = b.id) + WHERE $where + AND a.invoice = '0' + $transwhere + $openarap + |; + + $union = qq| + UNION|; + + } + + if ($form->{l_invnumber}) { + $ar = ($form->{db} eq 'customer') ? 'ar' : 'ap'; + $module = ($ar eq 'ar') ? 'is' : 'ir'; + + $transwhere = ""; + $transwhere .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $transwhere .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + $query .= qq|$union + SELECT ct.*, b.description AS business, + a.invnumber, a.ordnumber, a.quonumber, a.id AS invid, + '$module' AS module, 'invoice' AS formtype, + (a.amount = a.paid) AS closed, a.amount, a.netamount + FROM $form->{db} ct + JOIN $ar a ON (a.$form->{db}_id = ct.id) + LEFT JOIN business b ON (ct.business_id = b.id) + WHERE $where + AND a.invoice = '1' + $transwhere + $openarap + |; + + $union = qq| + UNION|; + + } + + if ($form->{l_ordnumber}) { + + $transwhere = ""; + $transwhere .= " AND o.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $transwhere .= " AND o.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + $query .= qq|$union + SELECT ct.*, b.description AS business, + ' ' AS invnumber, o.ordnumber, o.quonumber, o.id AS invid, + 'oe' AS module, 'order' AS formtype, + o.closed, o.amount, o.netamount + FROM $form->{db} ct + JOIN oe o ON (o.$form->{db}_id = ct.id) + LEFT JOIN business b ON (ct.business_id = b.id) + WHERE $where + AND o.quotation = '0' + $transwhere + $openoe + |; + + $union = qq| + UNION|; + + } + + if ($form->{l_quonumber}) { + + $transwhere = ""; + $transwhere .= " AND o.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $transwhere .= " AND o.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + $query .= qq|$union + SELECT ct.*, b.description AS business, + ' ' AS invnumber, o.ordnumber, o.quonumber, o.id AS invid, + 'oe' AS module, 'quotation' AS formtype, + o.closed, o.amount, o.netamount + FROM $form->{db} ct + JOIN oe o ON (o.$form->{db}_id = ct.id) + LEFT JOIN business b ON (ct.business_id = b.id) + WHERE $where + AND o.quotation = '1' + $transwhere + $openoe + |; + + } + + $sortorder .= ", invid"; + } + + $query .= qq| + ORDER BY $sortorder|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{address} = ""; + map { $ref->{address} .= "$ref->{$_} "; } qw(address1 address2 city state zipcode country); + push @{ $form->{CT} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub get_history { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query; + my $where = "1 = 1"; + $form->{sort} = "partnumber" unless $form->{sort}; + my $sortorder = $form->{sort}; + my %ordinal = (); + my $var; + my $table; + + # setup ASC or DESC + $form->sort_order(); + + if ($form->{"$form->{db}number"}) { + $var = $form->like(lc $form->{"$form->{db}number"}); + $where .= " AND lower(ct.$form->{db}number) LIKE '$var'"; + } + if ($form->{name}) { + $var = $form->like(lc $form->{name}); + $where .= " AND lower(ct.name) LIKE '$var'"; + } + if ($form->{address}) { + $var = $form->like(lc $form->{address}); + $where .= " AND lower(ct.address1) LIKE '$var'"; + } + if ($form->{city}) { + $var = $form->like(lc $form->{city}); + $where .= " AND lower(ct.city) LIKE '$var'"; + } + if ($form->{state}) { + $var = $form->like(lc $form->{state}); + $where .= " AND lower(ct.state) LIKE '$var'"; + } + if ($form->{zipcode}) { + $var = $form->like(lc $form->{zipcode}); + $where .= " AND lower(ct.zipcode) LIKE '$var'"; + } + if ($form->{country}) { + $var = $form->like(lc $form->{country}); + $where .= " AND lower(ct.country) LIKE '$var'"; + } + if ($form->{contact}) { + $var = $form->like(lc $form->{contact}); + $where .= " AND lower(ct.contact) LIKE '$var'"; + } + if ($form->{notes}) { + $var = $form->like(lc $form->{notes}); + $where .= " AND lower(ct.notes) LIKE '$var'"; + } + if ($form->{email}) { + $var = $form->like(lc $form->{email}); + $where .= " AND lower(ct.email) LIKE '$var'"; + } + + $where .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $where .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + if ($form->{open} || $form->{closed}) { + unless ($form->{open} && $form->{closed}) { + if ($form->{type} eq 'invoice') { + $where .= " AND a.amount != a.paid" if $form->{open}; + $where .= " AND a.amount = a.paid" if $form->{closed}; + } else { + $where .= " AND a.closed = '0'" if $form->{open}; + $where .= " AND a.closed = '1'" if $form->{closed}; + } + } + } + + my $invnumber = 'invnumber'; + my $deldate = 'deliverydate'; + my $buysell; + + if ($form->{db} eq 'customer') { + $buysell = "buy"; + if ($form->{type} eq 'invoice') { + $where .= qq| AND a.invoice = '1' AND i.assemblyitem = '0'|; + $table = 'ar'; + } else { + $table = 'oe'; + if ($form->{type} eq 'order') { + $invnumber = 'ordnumber'; + $where .= qq| AND a.quotation = '0'|; + } else { + $invnumber = 'quonumber'; + $where .= qq| AND a.quotation = '1'|; + } + $deldate = 'reqdate'; + } + } + if ($form->{db} eq 'vendor') { + $buysell = "sell"; + if ($form->{type} eq 'invoice') { + $where .= qq| AND a.invoice = '1' AND i.assemblyitem = '0'|; + $table = 'ap'; + } else { + $table = 'oe'; + if ($form->{type} eq 'order') { + $invnumber = 'ordnumber'; + $where .= qq| AND a.quotation = '0'|; + } else { + $invnumber = 'quonumber'; + $where .= qq| AND a.quotation = '1'|; + } + $deldate = 'reqdate'; + } + } + + my $invjoin = qq| + JOIN invoice i ON (i.trans_id = a.id)|; + + if ($form->{type} eq 'order') { + $invjoin = qq| + JOIN orderitems i ON (i.trans_id = a.id)|; + } + if ($form->{type} eq 'quotation') { + $invjoin = qq| + JOIN orderitems i ON (i.trans_id = a.id)|; + $where .= qq| AND a.quotation = '1'|; + } + + + if ($form->{history} eq 'summary') { + $query = qq|SELECT curr FROM defaults|; + my ($curr) = $dbh->selectrow_array($query); + $curr =~ s/:.*//; + + %ordinal = ( partnumber => 8, + description => 9 + ); + $sortorder = "2 $form->{direction}, 1, $ordinal{$sortorder} $form->{direction}"; + + $query = qq|SELECT ct.id AS ctid, ct.name, ct.address1, + ct.address2, ct.city, ct.state, + p.id AS pid, p.partnumber, i.description, p.unit, + sum(i.qty) AS qty, sum(i.sellprice) AS sellprice, + '$curr' AS curr, + ct.zipcode, ct.country + FROM $form->{db} ct + JOIN $table a ON (a.$form->{db}_id = ct.id) + $invjoin + JOIN parts p ON (p.id = i.parts_id) + WHERE $where + GROUP BY ct.id, ct.name, ct.address1, ct.address2, ct.city, + ct.state, ct.zipcode, ct.country, + p.id, p.partnumber, i.description, p.unit + ORDER BY $sortorder|; + } else { + %ordinal = ( partnumber => 9, + description => 12, + "$deldate" => 16, + serialnumber => 17, + projectnumber => 18 + ); + + $sortorder = "2 $form->{direction}, 1, 11, $ordinal{$sortorder} $form->{direction}"; + + $query = qq|SELECT ct.id AS ctid, ct.name, ct.address1, + ct.address2, ct.city, ct.state, + p.id AS pid, p.partnumber, a.id AS invid, + a.$invnumber, a.curr, i.description, + i.qty, i.sellprice, i.discount, + i.$deldate, i.serialnumber, pr.projectnumber, + e.name AS employee, ct.zipcode, ct.country, i.unit|; + $query .= qq|, i.fxsellprice| if $form->{type} eq 'invoice'; + + if ($form->{type} ne 'invoice') { + if ($form->{l_curr}) { + $query .= qq|, (SELECT $buysell FROM exchangerate ex + WHERE a.curr = ex.curr + AND a.transdate = ex.transdate) AS exchangerate|; + } + } + + $query .= qq| + FROM $form->{db} ct + JOIN $table a ON (a.$form->{db}_id = ct.id) + $invjoin + JOIN parts p ON (p.id = i.parts_id) + LEFT JOIN project pr ON (pr.id = i.project_id) + LEFT JOIN employee e ON (e.id = a.employee_id) + WHERE $where + ORDER BY $sortorder|; + } + + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{address} = ""; + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + map { $ref->{address} .= "$ref->{$_} "; } qw(address1 address2 city state zipcode country); + $ref->{id} = $ref->{ctid}; + push @{ $form->{CT} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub pricelist { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query; + + if ($form->{db} eq 'customer') { + $query = qq|SELECT p.id, p.partnumber, p.description, + p.sellprice, pg.partsgroup, p.partsgroup_id, + m.pricebreak, m.sellprice, + m.validfrom, m.validto, m.curr + FROM partscustomer m + JOIN parts p ON (p.id = m.parts_id) + LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) + WHERE m.customer_id = $form->{id} + ORDER BY partnumber|; + } + if ($form->{db} eq 'vendor') { + $query = qq|SELECT p.id, p.partnumber AS sku, p.description, + pg.partsgroup, p.partsgroup_id, + m.partnumber, m.leadtime, m.lastcost, m.curr + FROM partsvendor m + JOIN parts p ON (p.id = m.parts_id) + LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) + WHERE m.vendor_id = $form->{id} + ORDER BY p.partnumber|; + } + + my $sth; + my $ref; + + if ($form->{id}) { + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_partspricelist} }, $ref; + } + $sth->finish; + } + + $query = qq|SELECT curr FROM defaults|; + ($form->{currencies}) = $dbh->selectrow_array($query); + + $query = qq|SELECT id, partsgroup FROM partsgroup + ORDER BY partsgroup|; + + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $form->{all_partsgroup} = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_partsgroup} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + + +sub save_pricelist { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query = qq|DELETE FROM parts$form->{db} + WHERE $form->{db}_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + + foreach $i (1 .. $form->{rowcount}) { + + if ($form->{"id_$i"}) { + + if ($form->{db} eq 'customer') { + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"}) } qw(pricebreak sellprice); + + $query = qq|INSERT INTO parts$form->{db} (parts_id, customer_id, + pricebreak, sellprice, validfrom, validto, curr) + VALUES ($form->{"id_$i"}, $form->{id}, + $form->{"pricebreak_$i"}, $form->{"sellprice_$i"},| + .$form->dbquote($form->{"validfrom_$i"}, SQL_DATE) .qq|,| + .$form->dbquote($form->{"validto_$i"}, SQL_DATE) .qq|, + '$form->{"curr_$i"}')|; + } else { + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"}) } qw(leadtime lastcost); + + $query = qq|INSERT INTO parts$form->{db} (parts_id, vendor_id, + partnumber, lastcost, leadtime, curr) + VALUES ($form->{"id_$i"}, $form->{id}, + '$form->{"partnumber_$i"}', $form->{"lastcost_$i"}, + $form->{"leadtime_$i"}, '$form->{"curr_$i"}')|; + + } + $dbh->do($query) || $form->dberror($query); + } + + } + + $_ = $dbh->commit; + $dbh->disconnect; + +} + + + +sub retrieve_item { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $i = $form->{rowcount}; + my $var; + my $null; + + my $where = "WHERE p.obsolete = '0' AND p.income_accno_id > 0"; + + if ($form->{"partnumber_$i"}) { + $var = $form->like(lc $form->{"partnumber_$i"}); + $where .= " AND lower(p.partnumber) LIKE '$var'"; + } + if ($form->{"description_$i"}) { + $var = $form->like(lc $form->{"description_$i"}); + $where .= " AND lower(p.description) LIKE '$var'"; + } + + if ($form->{"partsgroup_$i"}) { + ($null, $var) = split /--/, $form->{"partsgroup_$i"}; + $where .= qq| AND p.partsgroup_id = $var|; + } + + + my $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice, + p.lastcost, p.unit, pg.partsgroup, p.partsgroup_id + FROM parts p + LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) + $where + |; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref; + $form->{item_list} = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{item_list} }, $ref; + } + $sth->finish; + $dbh->disconnect; + +} + + +1; + diff --git a/sql-ledger/SL/Form.pm b/sql-ledger/SL/Form.pm new file mode 100644 index 000000000..c722b4417 --- /dev/null +++ b/sql-ledger/SL/Form.pm @@ -0,0 +1,2357 @@ +#================================================================= +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: Thomas Bayen <bayen@gmx.de> +# Antti Kaihola <akaihola@siba.fi> +# Moritz Bunkus (tex) +# Jim Rawlings <jim@your-dba.com> (DB2) +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# main package +# +#====================================================================== + +package Form; + + +sub new { + my $type = shift; + + my $self = {}; + + read(STDIN, $_, $ENV{CONTENT_LENGTH}); + + if ($ENV{QUERY_STRING}) { + $_ = $ENV{QUERY_STRING}; + } + + if ($ARGV[0]) { + $_ = $ARGV[0]; + } + + foreach $item (split(/&/)) { + ($key, $value) = split(/=/, $item); + $self->{$key} = &unescape("",$value); + } + + $self->{menubar} = 1 if $self->{path} =~ /lynx/i; + + if (substr($self->{action}, 0, 1) !~ /( |\.)/) { + $self->{action} = lc $self->{action}; + $self->{action} =~ s/(( |-|,|#|\/)|\.$)/_/g; + } + + $self->{version} = "2.4.4"; + $self->{dbversion} = "2.4.4"; + + bless $self, $type; + +} + + +sub debug { + my ($self) = @_; + + print "\n"; + + map { print "$_ = $self->{$_}\n" } (sort keys %$self); + +} + + +sub escape { + my ($self, $str, $beenthere) = @_; + + # for Apache 2 we escape strings twice + if (($ENV{SERVER_SIGNATURE} =~ /Apache\/2\.(\d+)\.(\d+)/) && !$beenthere) { + $str = $self->escape($str, 1) if $2 < 44; + } + + $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; + $str; + +} + + +sub unescape { + my ($self, $str) = @_; + + $str =~ tr/+/ /; + $str =~ s/\\$//; + + $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; + + $str; + +} + + +sub quote { + my ($self, $str) = @_; + + if ($str && ! ref($str)) { + $str =~ s/"/"/g; + } + + $str; + +} + + +sub hide_form { + my $self = shift; + + map { print qq|<input type=hidden name=$_ value="|.$self->quote($self->{$_}).qq|">\n| } sort keys %$self; + +} + + +sub error { + my ($self, $msg) = @_; + + if ($ENV{HTTP_USER_AGENT}) { + $msg =~ s/\n/<br>/g; + + delete $self->{pre}; + + if (!$self->{header}) { + $self->header; + } + + print qq|<body><h2 class=error>Error!</h2> + + <p><b>$msg</b>|; + + exit; + + } else { + + if ($self->{error_function}) { + &{ $self->{error_function} }($msg); + } else { + die "Error: $msg\n"; + } + } + +} + + +sub info { + my ($self, $msg) = @_; + + if ($ENV{HTTP_USER_AGENT}) { + $msg =~ s/\n/<br>/g; + + delete $self->{pre}; + + if (!$self->{header}) { + $self->header; + print qq| + <body>|; + $self->{header} = 1; + } + + print "<br><b>$msg</b>"; + + } else { + + if ($self->{info_function}) { + &{ $self->{info_function} }($msg); + } else { + print "$msg\n"; + } + } + +} + + + + +sub numtextrows { + my ($self, $str, $cols, $maxrows) = @_; + + my $rows = 0; + + map { $rows += int (((length) - 2)/$cols) + 1 } split /\r/, $str; + + $maxrows = $rows unless defined $maxrows; + + return ($rows > $maxrows) ? $maxrows : $rows; + +} + + +sub dberror { + my ($self, $msg) = @_; + + $self->error("$msg\n".$DBI::errstr); + +} + + +sub isblank { + my ($self, $name, $msg) = @_; + + if ($self->{$name} =~ /^\s*$/) { + $self->error($msg); + } +} + + +sub header { + my ($self, $init) = @_; + + return if $self->{header}; + + my ($stylesheet, $favicon, $charset); + + if ($ENV{HTTP_USER_AGENT}) { + + if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { + $stylesheet = qq|<LINK REL="stylesheet" HREF="css/$self->{stylesheet}" TYPE="text/css" TITLE="SQL-Ledger stylesheet"> + |; + } + + if ($self->{favicon} && (-f "$self->{favicon}")) { + $favicon = qq|<LINK REL="shortcut icon" HREF="$self->{favicon}" TYPE="image/x-icon"> + |; + } + + if ($self->{charset}) { + $charset = qq|<META HTTP-EQUIV="Content-Type" CONTENT="text/plain; charset=$self->{charset}"> + |; + } + + $self->{titlebar} = ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar}; + + $self->set_cookie($init); + + print qq|Content-Type: text/html + +<head> + <title>$self->{titlebar}</title> + $favicon + $stylesheet + $charset +</head> + +$self->{pre} +|; + } + + $self->{header} = 1; + +} + + +sub set_cookie { + my ($self, $init) = @_; + + $self->{timeout} = ($self->{timeout} > 0) ? $self->{timeout} : 3600; + + if ($self->{endsession}) { + $_ = time; + } else { + $_ = time + $self->{timeout}; + } + + if ($ENV{HTTP_USER_AGENT}) { + + my @d = split / +/, scalar gmtime($_); + my $today = "$d[0], $d[2]-$d[1]-$d[4] $d[3] GMT"; + + if ($init) { + $self->{sessionid} = time; + } + print qq|Set-Cookie: SQL-Ledger-$self->{login}=$self->{sessionid}; expires=$today; path=/;\n| if $self->{login}; + } + +} + + +sub redirect { + my ($self, $msg) = @_; + + if ($self->{callback}) { + + ($script, $argv) = split(/\?/, $self->{callback}); + exec ("perl", "$script", $argv); + + } else { + + $self->info($msg); + exit; + } + +} + + +sub sort_columns { + my ($self, @columns) = @_; + + if ($self->{sort}) { + if (@columns) { + @columns = grep !/^$self->{sort}$/, @columns; + splice @columns, 0, 0, $self->{sort}; + } + } + + @columns; + +} + + +sub sort_order { + my ($self, $columns, $ordinal) = @_; + + # setup direction + if ($self->{direction}) { + if ($self->{sort} eq $self->{oldsort}) { + if ($self->{direction} eq 'ASC') { + $self->{direction} = "DESC"; + } else { + $self->{direction} = "ASC"; + } + } + } else { + $self->{direction} = "ASC"; + } + $self->{oldsort} = $self->{sort}; + + my $sortorder = join ',', $self->sort_columns(@{$columns}); + + if ($ordinal) { + map { $sortorder =~ s/$_/$ordinal->{$_}/ } keys %$ordinal; + } + my @a = split /,/, $sortorder; + $a[0] = "$a[0] $self->{direction}"; + $sortorder = join ',', @a; + + $sortorder; + +} + + +sub format_amount { + my ($self, $myconfig, $amount, $places, $dash) = @_; + + if ($places =~ /\d/) { + $amount = $self->round_amount($amount, $places); + } + + # is the amount negative + my $negative = ($amount < 0); + + if ($amount != 0) { + if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) { + my ($whole, $dec) = split /\./, "$amount"; + $whole =~ s/-//; + $amount = join '', reverse split //, $whole; + + if ($myconfig->{numberformat} eq '1,000.00') { + $amount =~ s/\d{3,}?/$&,/g; + $amount =~ s/,$//; + $amount = join '', reverse split //, $amount; + $amount .= "\.$dec" if ($dec ne ""); + } + + if ($myconfig->{numberformat} eq "1'000.00") { + $amount =~ s/\d{3,}?/$&'/g; + $amount =~ s/'$//; + $amount = join '', reverse split //, $amount; + $amount .= "\.$dec" if ($dec ne ""); + } + + if ($myconfig->{numberformat} eq '1.000,00') { + $amount =~ s/\d{3,}?/$&./g; + $amount =~ s/\.$//; + $amount = join '', reverse split //, $amount; + $amount .= ",$dec" if ($dec ne ""); + } + + if ($myconfig->{numberformat} eq '1000,00') { + $amount = "$whole"; + $amount .= ",$dec" if ($dec ne ""); + } + + if ($dash =~ /-/) { + $amount = ($negative) ? "($amount)" : "$amount"; + } elsif ($dash =~ /DRCR/) { + $amount = ($negative) ? "$amount DR" : "$amount CR"; + } else { + $amount = ($negative) ? "-$amount" : "$amount"; + } + } + } else { + if ($dash eq "0" && $places) { + if ($myconfig->{numberformat} eq '1.000,00') { + $amount = "0".","."0" x $places; + } else { + $amount = "0"."."."0" x $places; + } + } else { + $amount = ($dash ne "") ? "$dash" : ""; + } + } + + $amount; + +} + + +sub parse_amount { + my ($self, $myconfig, $amount) = @_; + + if (($myconfig->{numberformat} eq '1.000,00') || + ($myconfig->{numberformat} eq '1000,00')) { + $amount =~ s/\.//g; + $amount =~ s/,/\./; + } + + if ($myconfig->{numberformat} eq "1'000.00") { + $amount =~ s/'//g; + } + + $amount =~ s/,//g; + + return ($amount * 1); + +} + + +sub round_amount { + my ($self, $amount, $places) = @_; + +# $places = 3 if $places == 2; + + if (($places * 1) >= 0) { + # add 1/10^$places+3 + sprintf("%.${places}f", $amount + (1 / (10 ** ($places + 3))) * (($amount > 0) ? 1 : -1)); + } else { + $places *= -1; + sprintf("%.f", $amount / (10 ** $places) + (($amount > 0) ? 0.1 : -0.1)) * (10 ** $places); + } + +} + + +sub parse_template { + my ($self, $myconfig, $userspath) = @_; + + my ($chars_per_line, $lines_on_first_page, $lines_on_second_page) = (0, 0, 0); + my ($current_page, $current_line) = (1, 1); + my $pagebreak = ""; + my $sum = 0; + + my $subdir = ""; + my $err = ""; + + if ($self->{language_code}) { + if (-f "$self->{templates}/$self->{language_code}/$self->{IN}") { + open(IN, "$self->{templates}/$self->{language_code}/$self->{IN}") or $self->error("$self->{IN} : $!"); + } else { + open(IN, "$self->{templates}/$self->{IN}") or $self->error("$self->{IN} : $!"); + } + } else { + open(IN, "$self->{templates}/$self->{IN}") or $self->error("$self->{IN} : $!"); + } + + @_ = <IN>; + close(IN); + + $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); + + # OUT is used for the media, screen, printer, email + # for postscript we store a copy in a temporary file + my $fileid = time; + my $tmpfile = $self->{IN}; + $tmpfile =~ s/\./\.$self->{fileid}./ if $self->{fileid}; + $self->{tmpfile} = "$userspath/${fileid}.${tmpfile}"; + + if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { + $out = $self->{OUT}; + $self->{OUT} = ">$self->{tmpfile}"; + } + + if ($self->{OUT}) { + open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); + } else { + open(OUT, ">-") or $self->error("STDOUT : $!"); + + $self->header; + + } + + # first we generate a tmpfile + # read file and replace <%variable%> + while ($_ = shift) { + + $par = ""; + $var = $_; + + + # detect pagebreak block and its parameters + if (/\s*<%pagebreak ([0-9]+) ([0-9]+) ([0-9]+)%>/) { + $chars_per_line = $1; + $lines_on_first_page = $2; + $lines_on_second_page = $3; + + while ($_ = shift) { + last if (/\s*<%end pagebreak%>/); + $pagebreak .= $_; + } + } + + + if (/\s*<%foreach /) { + + # this one we need for the count + chomp $var; + $var =~ s/\s*<%foreach (.+?)%>/$1/; + while ($_ = shift) { + last if (/\s*<%end /); + + # store line in $par + $par .= $_; + } + + # display contents of $self->{number}[] array + for $i (0 .. $#{ $self->{$var} }) { + + # Try to detect whether a manual page break is necessary + # but only if there was a <%pagebreak ...%> block before + + if ($chars_per_line) { + my $lines = int(length($self->{"description"}[$i]) / $chars_per_line + 0.95); + my $lpp; + + if ($current_page == 1) { + $lpp = $lines_on_first_page; + } else { + $lpp = $lines_on_second_page; + } + + # Yes we need a manual page break + if (($current_line + $lines) > $lpp) { + my $pb = $pagebreak; + + # replace the special variables <%sumcarriedforward%> + # and <%lastpage%> + + my $psum = $self->format_amount($myconfig, $sum, 2); + $pb =~ s/<%sumcarriedforward%>/$psum/g; + $pb =~ s/<%lastpage%>/$current_page/g; + + # only "normal" variables are supported here + # (no <%if, no <%foreach, no <%include) + + $pb =~ s/<%(.+?)%>/$self->{$1}/g; + + # page break block is ready to rock + print(OUT $pb); + $current_page++; + $current_line = 1; + } + $current_line += $lines; + } + $sum += $self->parse_amount($myconfig, $self->{"linetotal"}[$i]); + + # don't parse par, we need it for each line + print OUT $self->format_line($par, $i); + + } + next; + } + + # if not comes before if! + if (/\s*<%if not /) { + # check if it is not set and display + chop; + s/\s*<%if not (.+?)%>/$1/; + + unless ($self->{$_}) { + while ($_ = shift) { + last if (/\s*<%end /); + + # store line in $par + $par .= $_; + } + + $_ = $par; + + } else { + while ($_ = shift) { + last if (/\s*<%end /); + } + next; + } + } + + if (/\s*<%if /) { + # check if it is set and display + chop; + s/\s*<%if (.+?)%>/$1/; + + if ($self->{$_}) { + while ($_ = shift) { + last if (/\s*<%end /); + + # store line in $par + $par .= $_; + } + + $_ = $par; + + } else { + while ($_ = shift) { + last if (/\s*<%end /); + } + next; + } + } + + # check for <%include filename%> + if (/\s*<%include /) { + + # get the filename + chomp $var; + $var =~ s/\s*<%include (.+?)%>/$1/; + + # mangle filename + $var =~ s/(\/|\.\.)//g; + + # prevent the infinite loop! + next if ($self->{"$var"}); + + unless (open(INC, "$self->{templates}/$var")) { + $err = $!; + $self->cleanup; + $self->error("$self->{templates}/$var : $err"); + } + unshift(@_, <INC>); + close(INC); + + $self->{"$var"} = 1; + + next; + } + + print OUT $self->format_line($_); + + } + + close(OUT); + + + # Convert the tex file to postscript + if ($self->{format} =~ /(postscript|pdf)/) { + + use Cwd; + $self->{cwd} = cwd(); + $self->{tmpdir} = "$self->{cwd}/$userspath"; + + unless (chdir("$userspath")) { + $err = $!; + $self->cleanup; + $self->error("chdir : $err"); + } + + $self->{tmpfile} =~ s/$userspath\///g; + + if ($self->{format} eq 'postscript') { + system("latex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err"); + $self->error($self->cleanup) if ($?); + + $self->{tmpfile} =~ s/tex$/dvi/; + + system("dvips $self->{tmpfile} -o -q"); + $self->error($self->cleanup."dvips : $!") if ($?); + $self->{tmpfile} =~ s/dvi$/ps/; + } + if ($self->{format} eq 'pdf') { + system("pdflatex --interaction=nonstopmode $self->{tmpfile} > $self->{tmpfile}.err"); + $self->error($self->cleanup) if ($?); + $self->{tmpfile} =~ s/tex$/pdf/; + } + + } + + + if ($self->{format} =~ /(postscript|pdf)/ || $self->{media} eq 'email') { + + if ($self->{media} eq 'email') { + + use SL::Mailer; + + my $mail = new Mailer; + + map { $mail->{$_} = $self->{$_} } qw(cc bcc subject message version format charset); + $mail->{to} = qq|$self->{email}|; + $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|; + $mail->{fileid} = "$fileid."; + + # if we send html or plain text inline + if (($self->{format} =~ /(html|txt)/) && ($self->{sendmode} eq 'inline')) { + my $br = ""; + $br = "<br>" if $self->{format} eq 'html'; + + $mail->{contenttype} = "text/$self->{format}"; + + $mail->{message} =~ s/\r\n/$br\n/g; + $myconfig->{signature} =~ s/\\n/$br\n/g; + $mail->{message} .= "$br\n-- $br\n$myconfig->{signature}\n$br" if $myconfig->{signature}; + + unless (open(IN, $self->{tmpfile})) { + $err = $!; + $self->cleanup; + $self->error("$self->{tmpfile} : $err"); + } + + while (<IN>) { + $mail->{message} .= $_; + } + + close(IN); + + } else { + + @{ $mail->{attachments} } = ($self->{tmpfile}); + + $myconfig->{signature} =~ s/\\n/\r\n/g; + $mail->{message} .= "\r\n-- \r\n$myconfig->{signature}" if $myconfig->{signature}; + + } + + if ($err = $mail->send($out)) { + $self->cleanup; + $self->error($err); + } + + } else { + + $self->{OUT} = $out; + unless (open(IN, $self->{tmpfile})) { + $err = $!; + $self->cleanup; + $self->error("$self->{tmpfile} : $err"); + } + + binmode(IN); + + $self->{copies} = 1 if $self->{media} =~ /(screen|email|queue)/; + + chdir("$self->{cwd}"); + + for my $i (1 .. $self->{copies}) { + if ($self->{OUT}) { + unless (open(OUT, $self->{OUT})) { + $err = $!; + $self->cleanup; + $self->error("$self->{OUT} : $err"); + } + } else { + + # launch application + print qq|Content-Type: application/$self->{format} +Content-Disposition: attachment; filename="$self->{tmpfile}"\n\n|; + + unless (open(OUT, ">-")) { + $err = $!; + $self->cleanup; + $self->error("STDOUT : $err"); + } + + } + + binmode(OUT); + + while (<IN>) { + print OUT $_; + } + + close(OUT); + seek IN, 0, 0; + } + + close(IN); + } + + $self->cleanup; + + } + +} + + +sub format_line { + my $self = shift; + + $_ = shift; + my $i = shift; + my ($str, $pos, $l, $item, $newstr); + my $var = ""; + my %a; + + while (/<%(.+?)%>/) { + + %a = (); + + foreach $item (split / /, $1) { + my ($key, $value) = split /=/, $item; + if (defined $value) { + $a{$key} = $value; + } else { + $var = $item; + } + } + + $str = (defined $i) ? $self->{$var}[$i] : $self->{$var}; + + if ($a{align} || $a{width} || $a{offset}) { + + $str =~ s/(
|\n)+/" " x $a{offset}/ge; + $l = length $str; + + if ($l > $a{width}) { + if (($pos = rindex $str, " ", $a{width}) > 0) { + $newstr = substr($str, 0, $pos); + $newstr .= "\n"; + $str = substr($str, $pos + 1); + + while (length $str > $a{width}) { + if (($pos = rindex $str, " ", $a{width}) > 0) { + $newstr .= (" " x $a{offset}).substr($str, 0, $pos); + $newstr .= "\n"; + $str = substr($str, $pos + 1); + } else { + $newstr .= (" " x $a{offset}).substr($str, 0, $a{width}); + $newstr .= "\n"; + $str = substr($str, $a{width} + 1); + } + } + } + $l = length $str; + $str .= " " x ($a{width} - $l); + $newstr .= (" " x $a{offset}).$str; + $str = $newstr; + + $l = $a{width}; + } + + # pad left, right or center + $pos = lc $a{align}; + $l = ($a{width} - $l); + + my $pad = " " x $l; + + if ($pos eq 'right') { + $str = "$pad$str"; + } + + if ($pos eq 'left') { + $str = "$str$pad"; + } + + if ($pos eq 'center') { + $pad = " " x ($l/2); + $str = "$pad$str"; + $pad = " " x ($l/2 + 1) if ($l % 2); + $str .= "$pad"; + } + } + + s/<%(.+?)%>/$str/; + + } + + $_; + +} + + +sub cleanup { + my $self = shift; + + chdir("$self->{tmpdir}"); + + my @err = (); + if (-f "$self->{tmpfile}.err") { + open(FH, "$self->{tmpfile}.err"); + @err = <FH>; + close(FH); + } + + if ($self->{tmpfile}) { + # strip extension + $self->{tmpfile} =~ s/\.\w+$//g; + my $tmpfile = $self->{tmpfile}; + unlink(<$tmpfile.*>); + } + + chdir("$self->{cwd}"); + + "@err"; + +} + + +sub format_string { + my ($self, @fields) = @_; + + my $format = $self->{format}; + if ($self->{format} =~ /(postscript|pdf)/) { + $format = 'tex'; + } + + my %replace = ( 'order' => { html => [ '<', '>', quotemeta('\n'), '
' ], + txt => [ quotemeta('\n') ], + tex => [ '&', quotemeta('\n'), '
', + '\$', '%', '_', '#', quotemeta('^'), + '{', '}', '<', '>', '£', + quotemeta('\\\\') ] }, + html => { '<' => '<', '>' => '>', + quotemeta('\n') => '<br>', '
' => '<br>' + }, + txt => { quotemeta('\n') }, + tex => { + '&' => '\&', '\$' => '\$', '%' => '\%', '_' => '\_', + '#' => '\#', quotemeta('^') => '\^\\', '{' => '\{', '}' => '\}', + '<' => '$<$', '>' => '$>$', + quotemeta('\n') => '\newline ', '
' => '\newline ', + '£' => '\pounds ', quotemeta('\\\\') => '$\backslash$' + } + ); + + foreach my $key (@{ $replace{order}{$format} }) { + map { $self->{$_} =~ s/$key/$replace{$format}{$key}/g; } @fields; + } + +} + + +sub datetonum { + my ($self, $date, $myconfig) = @_; + + if ($date && $date =~ /\D/) { + + if ($myconfig->{dateformat} =~ /^yy/) { + ($yy, $mm, $dd) = split /\D/, $date; + } + if ($myconfig->{dateformat} =~ /^mm/) { + ($mm, $dd, $yy) = split /\D/, $date; + } + if ($myconfig->{dateformat} =~ /^dd/) { + ($dd, $mm, $yy) = split /\D/, $date; + } + + $dd *= 1; + $mm *= 1; + $yy = ($yy < 70) ? $yy + 2000 : $yy; + $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; + + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + + $date = "$yy$mm$dd"; + } + + $date; + +} + + +# Database routines used throughout + +sub dbconnect { + my ($self, $myconfig) = @_; + + # connect to database + my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}) or $self->dberror; + + # set db options + if ($myconfig->{dboptions}) { + $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions}); + } + + $dbh; + +} + + +sub dbconnect_noauto { + my ($self, $myconfig) = @_; + + # connect to database + $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, {AutoCommit => 0}) or $self->dberror; + + # set db options + if ($myconfig->{dboptions}) { + $dbh->do($myconfig->{dboptions}); + } + + $dbh; + +} + + +sub dbquote { + my ($self, $var, $type) = @_; + + my $rv = 'NULL'; + + # DBI does not return NULL for SQL_DATE if the date is empty, bug ? + if (defined $var) { + if (defined $type) { + if ($type eq 'SQL_DATE') { + $rv = "'$var'" if $var; + } elsif ($type eq 'SQL_INT.*') { + $rv = int $var; + } else { + if ($type !~ /SQL_.*CHAR/) { + $rv = $var * 1; + } else { + $var =~ s/'/''/g; + $rv = "'$var'"; + } + } + } else { + $var =~ s/'/''/g; + $rv = "'$var'"; + } + } + + $rv; + +} + + +sub update_balance { + my ($self, $dbh, $table, $field, $where, $value) = @_; + + # if we have a value, go do it + if ($value != 0) { + # retrieve balance from table + my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE"; + my ($balance) = $dbh->selectrow_array($query); + + $balance += $value; + # update balance + $query = "UPDATE $table SET $field = $balance WHERE $where"; + $dbh->do($query) || $self->dberror($query); + } +} + + + +sub update_exchangerate { + my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; + + # some sanity check for currency + return if ($curr eq ''); + + my $query = qq|SELECT curr FROM exchangerate + WHERE curr = '$curr' + AND transdate = '$transdate' + FOR UPDATE|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + my $set; + if ($buy != 0 && $sell != 0) { + $set = "buy = $buy, sell = $sell"; + } elsif ($buy != 0) { + $set = "buy = $buy"; + } elsif ($sell != 0) { + $set = "sell = $sell"; + } + + if ($sth->fetchrow_array) { + $query = qq|UPDATE exchangerate + SET $set + WHERE curr = '$curr' + AND transdate = '$transdate'|; + } else { + $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate) + VALUES ('$curr', $buy, $sell, '$transdate')|; + } + $sth->finish; + $dbh->do($query) || $self->dberror($query); + +} + + +sub save_exchangerate { + my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_; + + my $dbh = $self->dbconnect($myconfig); + + my ($buy, $sell) = (0, 0); + $buy = $rate if $fld eq 'buy'; + $sell = $rate if $fld eq 'sell'; + + $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); + + $dbh->disconnect; + +} + + +sub get_exchangerate { + my ($self, $dbh, $curr, $transdate, $fld) = @_; + + my $query = qq|SELECT $fld FROM exchangerate + WHERE curr = '$curr' + AND transdate = '$transdate'|; + my ($exchangerate) = $dbh->selectrow_array($query); + + $exchangerate; + +} + + +sub check_exchangerate { + my ($self, $myconfig, $currency, $transdate, $fld) = @_; + + return "" unless $transdate; + + my $dbh = $self->dbconnect($myconfig); + + my $query = qq|SELECT $fld FROM exchangerate + WHERE curr = '$currency' + AND transdate = '$transdate'|; + my ($exchangerate) = $dbh->selectrow_array($query); + + $dbh->disconnect; + + $exchangerate; + +} + + +sub add_shipto { + my ($self, $dbh, $id) = @_; + + my $shipto; + foreach my $item (qw(name address1 address2 city state zipcode country contact phone fax email)) { + if ($self->{"shipto$item"}) { + $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"}); + } + } + + if ($shipto) { + my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptoaddress1, + shiptoaddress2, shiptocity, shiptostate, + shiptozipcode, shiptocountry, shiptocontact, + shiptophone, shiptofax, shiptoemail) VALUES ($id, | + .$dbh->quote($self->{shiptoname}).qq|, | + .$dbh->quote($self->{shiptoaddress1}).qq|, | + .$dbh->quote($self->{shiptoaddress2}).qq|, | + .$dbh->quote($self->{shiptocity}).qq|, | + .$dbh->quote($self->{shiptostate}).qq|, | + .$dbh->quote($self->{shiptozipcode}).qq|, | + .$dbh->quote($self->{shiptocountry}).qq|, | + .$dbh->quote($self->{shiptocontact}).qq|, + '$self->{shiptophone}', '$self->{shiptofax}', + '$self->{shiptoemail}')|; + $dbh->do($query) || $self->dberror($query); + } + +} + + +sub get_employee { + my ($self, $dbh) = @_; + + my $login = $self->{login}; + $login =~ s/@.*//; + my $query = qq|SELECT name, id FROM employee + WHERE login = '$login'|; + my (@a) = $dbh->selectrow_array($query); + $a[1] *= 1; + + @a; + +} + + +# this sub gets the id and name from $table +sub get_name { + my ($self, $myconfig, $table) = @_; + + # connect to database + my $dbh = $self->dbconnect($myconfig); + + my $name = $self->like(lc $self->{$table}); + my $query = qq~SELECT c.id, c.name, c.address1, c.address2, + c.city, c.state, c.zipcode, c.country + FROM $table c + WHERE lower(c.name) LIKE '$name' + ORDER BY c.name~; + + if ($self->{openinvoices}) { + $query = qq~SELECT DISTINCT c.id, c.name, c.address1, c.address2, + c.city, c.state, c.zipcode, c.country + FROM $self->{arap} a + JOIN $table c ON (a.${table}_id = c.id) + WHERE a.amount != a.paid + AND lower(c.name) LIKE '$name' + ORDER BY c.name~; + } + + my $sth = $dbh->prepare($query); + + $sth->execute || $self->dberror($query); + + my $i = 0; + @{ $self->{name_list} } = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push(@{ $self->{name_list} }, $ref); + $i++; + } + $sth->finish; + $dbh->disconnect; + + $i; + +} + + +# the selection sub is used in the AR, AP, IS, IR and OE module +# +sub all_vc { + my ($self, $myconfig, $table, $module, $dbh, $enddate) = @_; + + my $ref; + my $closedb; + if (! defined $dbh) { + $dbh = $self->dbconnect($myconfig); + $closedb = 1; + } + my $sth; + + my $query = qq|SELECT count(*) FROM $table|; + my $where; + + if (defined $enddate) { + $where = qq|AND (enddate IS NULL OR enddate >= '$enddate')|; + $query .= qq| WHERE 1=1 + $where|; + } + my ($count) = $dbh->selectrow_array($query); + + # build selection list + if ($count < $myconfig->{vclimit}) { + $query = qq|SELECT id, name + FROM $table + WHERE 1=1 + $where + ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{"all_$table"} }, $ref; + } + $sth->finish; + + } + + + # get self + if (! $self->{employee_id}) { + ($self->{employee}, $self->{employee_id}) = split /--/, $self->{employee}; + ($self->{employee}, $self->{employee_id}) = $self->get_employee($dbh) unless $self->{employee_id}; + } + + # setup sales contacts + $query = qq|SELECT id, name + FROM employee + WHERE sales = '1' + $where + ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_employees} }, $ref; + } + $sth->finish; + + + if ($module eq 'AR') { + # prepare query for departments + $query = qq|SELECT id, description + FROM department + WHERE role = 'P' + ORDER BY 2|; + + } else { + $query = qq|SELECT id, description + FROM department + ORDER BY 2|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_departments} }, $ref; + } + $sth->finish; + + + # get projects + $query = qq|SELECT * + FROM project + ORDER BY projectnumber|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{all_projects} = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_projects} }, $ref; + } + $sth->finish; + + # get language codes + $query = qq|SELECT * + FROM language + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{all_languages} = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_languages} }, $ref; + } + $sth->finish; + + $self->all_years($dbh, $myconfig); + + $dbh->disconnect if $closedb; + +} + + +# this is only used for reports +sub all_projects { + my ($self, $myconfig) = @_; + + my $dbh = $self->dbconnect($myconfig); + + my $query = qq|SELECT * + FROM project + ORDER BY projectnumber|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{all_projects} = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_projects} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + + +sub all_departments { + my ($self, $myconfig, $table) = @_; + + my $dbh = $self->dbconnect($myconfig); + my $where = "1 = 1"; + + if (defined $table) { + if ($table eq 'customer') { + $where = " role = 'P'"; + } + } + + my $query = qq|SELECT id, description + FROM department + WHERE $where + ORDER BY 2|; + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_departments} }, $ref; + } + $sth->finish; + + $self->all_years($dbh, $myconfig); + + $dbh->disconnect; + +} + + +sub all_years { + my ($self, $dbh, $myconfig) = @_; + + # get years + my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans), + (SELECT MAX(transdate) FROM acc_trans) + FROM defaults|; + my ($startdate, $enddate) = $dbh->selectrow_array($query); + + if ($myconfig->{dateformat} =~ /^yy/) { + ($startdate) = split /\W/, $startdate; + ($enddate) = split /\W/, $enddate; + } else { + (@_) = split /\W/, $startdate; + $startdate = @_[2]; + (@_) = split /\W/, $enddate; + $enddate = @_[2]; + } + + while ($enddate >= $startdate) { + push @{ $self->{all_years} }, $enddate--; + } + + %{ $self->{all_month} } = ( '01' => 'January', + '02' => 'February', + '03' => 'March', + '04' => 'April', + '05' => 'May ', + '06' => 'June', + '07' => 'July', + '08' => 'August', + '09' => 'September', + '10' => 'October', + '11' => 'November', + '12' => 'December' ); + +} + + +sub create_links { + my ($self, $module, $myconfig, $table) = @_; + + # get last customers or vendors + my ($query, $sth); + + my $dbh = $self->dbconnect($myconfig); + + my %xkeyref = (); + + + # now get the account numbers + $query = qq|SELECT accno, description, link + FROM chart + WHERE link LIKE '%$module%' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{accounts} = ""; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + foreach my $key (split /:/, $ref->{link}) { + if ($key =~ /$module/) { + # cross reference for keys + $xkeyref{$ref->{accno}} = $key; + + push @{ $self->{"${module}_links"}{$key} }, { accno => $ref->{accno}, + description => $ref->{description} }; + + $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/; + } + } + } + $sth->finish; + + if ($self->{id}) { + my $arap = ($table eq 'customer') ? 'ar' : 'ap'; + + $query = qq|SELECT a.invnumber, a.transdate, + a.${table}_id, a.datepaid, a.duedate, a.ordnumber, + a.taxincluded, a.curr AS currency, a.notes, a.intnotes, + c.name AS $table, a.department_id, d.description AS department, + a.amount AS oldinvtotal, a.paid AS oldtotalpaid, + a.employee_id, e.name AS employee, c.language_code + FROM $arap a + JOIN $table c ON (a.${table}_id = c.id) + LEFT JOIN employee e ON (e.id = a.employee_id) + LEFT JOIN department d ON (d.id = a.department_id) + WHERE a.id = $self->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + foreach $key (keys %$ref) { + $self->{$key} = $ref->{$key}; + } + $sth->finish; + + + # get printed, emailed + $query = qq|SELECT s.printed, s.emailed, s.spoolfile, s.formname + FROM status s + WHERE s.trans_id = $self->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $self->{printed} .= "$ref->{formname} " if $ref->{printed}; + $self->{emailed} .= "$ref->{formname} " if $ref->{emailed}; + $self->{queued} .= "$ref->{formname} $ref->{spoolfile} " if $ref->{spoolfile}; + } + $sth->finish; + map { $self->{$_} =~ s/ +$//g } qw(printed emailed queued); + + + # get amounts from individual entries + $query = qq|SELECT c.accno, c.description, a.source, a.amount, a.memo, + a.transdate, a.cleared, a.project_id, p.projectnumber + FROM acc_trans a + JOIN chart c ON (c.id = a.chart_id) + LEFT JOIN project p ON (p.id = a.project_id) + WHERE a.trans_id = $self->{id} + AND a.fx_transaction = '0' + ORDER BY transdate|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + + my $fld = ($table eq 'customer') ? 'buy' : 'sell'; + + $self->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld); + + # store amounts in {acc_trans}{$key} for multiple accounts + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld); + + push @{ $self->{acc_trans}{$xkeyref{$ref->{accno}}} }, $ref; + } + $sth->finish; + + $query = qq|SELECT d.curr AS currencies, d.closedto, d.revtrans, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno + FROM defaults d|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $self->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + } else { + + # get date + $query = qq|SELECT current_date AS transdate, + d.curr AS currencies, d.closedto, d.revtrans, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno + FROM defaults d|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $self->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + if (! $self->{"$self->{vc}_id"}) { + $self->lastname_used($dbh, $myconfig, $table, $module); + } + + } + + $self->all_vc($myconfig, $table, $module, $dbh, $self->{transdate}); + + $dbh->disconnect; + +} + + +sub lastname_used { + my ($self, $dbh, $myconfig, $table, $module) = @_; + + my $arap = ($table eq 'customer') ? "ar" : "ap"; + my $where = "1 = 1"; + my $sth; + + if ($self->{type} =~ /_order/) { + $arap = 'oe'; + $where = "quotation = '0'"; + } + if ($self->{type} =~ /_quotation/) { + $arap = 'oe'; + $where = "quotation = '1'"; + } + + my $query = qq|SELECT id FROM $arap + WHERE id IN (SELECT MAX(id) FROM $arap + WHERE $where + AND ${table}_id > 0)|; + my ($trans_id) = $dbh->selectrow_array($query); + + $trans_id *= 1; + + my $DAYS = ($myconfig->{dbdriver} eq 'DB2') ? "DAYS" : ""; + + $query = qq|SELECT ct.name AS $table, a.curr AS currency, a.${table}_id, + current_date + ct.terms $DAYS AS duedate, a.department_id, + d.description AS department, ct.notes, ct.curr AS currency + FROM $arap a + JOIN $table ct ON (a.${table}_id = ct.id) + LEFT JOIN department d ON (a.department_id = d.id) + WHERE a.id = $trans_id|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + map { $self->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + +} + + + +sub current_date { + my ($self, $myconfig, $thisdate, $days) = @_; + + my $dbh = $self->dbconnect($myconfig); + my ($sth, $query); + + $days *= 1; + if ($thisdate) { + my $dateformat = $myconfig->{dateformat}; + if ($myconfig->{dateformat} !~ /^y/) { + my @a = split /\D/, $thisdate; + $dateformat .= "yy" if (length $a[2] > 2); + } + + if ($thisdate !~ /\D/) { + $dateformat = 'yyyymmdd'; + } + + if ($myconfig->{dbdriver} eq 'DB2') { + $query = qq|SELECT date('$thisdate') + $days DAYS AS thisdate + FROM defaults|; + } else { + $query = qq|SELECT to_date('$thisdate', '$dateformat') + $days AS thisdate + FROM defaults|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + } else { + $query = qq|SELECT current_date AS thisdate + FROM defaults|; + $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + } + + ($thisdate) = $sth->fetchrow_array; + $sth->finish; + + $dbh->disconnect; + + $thisdate; + +} + + +sub like { + my ($self, $str) = @_; + + if ($str !~ /(%|_)/) { + $str = "%$str%"; + } + + $str =~ s/'/''/g; + $str; + +} + + +sub redo_rows { + my ($self, $flds, $new, $count, $numrows) = @_; + + my @ndx = (); + + map { push @ndx, { num => $new->[$_-1]->{runningnumber}, ndx => $_ } } (1 .. $count); + + my $i = 0; + # fill rows + foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) { + $i++; + $j = $item->{ndx} - 1; + map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds}; + } + + # delete empty rows + for $i ($count + 1 .. $numrows) { + map { delete $self->{"${_}_$i"} } @{$flds}; + } + +} + + +sub get_partsgroup { + my ($self, $myconfig, $p) = @_; + + my $dbh = $self->dbconnect($myconfig); + + my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup + FROM partsgroup pg + JOIN parts p ON (p.partsgroup_id = pg.id)|; + + if ($p->{searchitems} eq 'part') { + $query .= qq| + WHERE p.inventory_accno_id > 0|; + } + if ($p->{searchitems} eq 'service') { + $query .= qq| + WHERE p.inventory_accno_id IS NULL|; + } + if ($p->{searchitems} eq 'assembly') { + $query .= qq| + WHERE p.assembly = '1'|; + } + if ($p->{searchitems} eq 'labor') { + $query .= qq| + WHERE p.inventory_accno_id > 0 AND p.income_accno_id IS NULL|; + } + + $query .= qq| + ORDER BY partsgroup|; + + if ($p->{all}) { + $query = qq|SELECT id, partsgroup FROM partsgroup + ORDER BY partsgroup|; + } + + if ($p->{language_code}) { + $query = qq|SELECT DISTINCT pg.id, pg.partsgroup, + t.description AS translation + FROM partsgroup pg + JOIN parts p ON (p.partsgroup_id = pg.id) + LEFT JOIN translation t ON (t.trans_id = pg.id AND t.language_code = '$p->{language_code}') + ORDER BY translation|; + } + + my $sth = $dbh->prepare($query); + $sth->execute || $self->dberror($query); + + $self->{all_partsgroup} = (); + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $self->{all_partsgroup} }, $ref; + } + $sth->finish; + $dbh->disconnect; + +} + + +sub update_status { + my ($self, $myconfig) = @_; + + # no id return + return unless $self->{id}; + + my $i; + my $id; + + my $dbh = $self->dbconnect_noauto($myconfig); + + my $query = qq|DELETE FROM status + WHERE formname = |.$dbh->quote($self->{formname}).qq| + AND trans_id = ?|; + my $sth = $dbh->prepare($query) || $self->dberror($query); + + if ($self->{formname} =~ /(check|receipt)/) { + for $i (1 .. $self->{rowcount}) { + $sth->execute($self->{"id_$i"} * 1) || $self->dberror($query); + $sth->finish; + } + } else { + $sth->execute($self->{id}) || $self->dberror($query); + $sth->finish; + } + + my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; + my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + + my %queued = split / /, $self->{queued}; + + if ($self->{formname} =~ /(check|receipt)/) { + # this is a check or receipt, add one entry for each lineitem + my ($accno) = split /--/, $self->{account}; + $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, + chart_id) VALUES (?, '$printed',| + .$dbh->quote($queued{$self->{formname}}).qq|, | + .$dbh->quote($self->{formname}).qq|, + (SELECT id FROM chart WHERE accno = | + .$dbh->quote($accno).qq|))|; + $sth = $dbh->prepare($query) || $self->dberror($query); + + for $i (1 .. $self->{rowcount}) { + if ($self->{"checked_$i"}) { + $sth->execute($self->{"id_$i"}) || $self->dberror($query); + $sth->finish; + } + } + } else { + $query = qq|INSERT INTO status (trans_id, printed, emailed, + spoolfile, formname) + VALUES ($self->{id}, '$printed', '$emailed', | + .$dbh->quote($queued{$self->{formname}}).qq|, | + .$dbh->quote($self->{formname}).qq|)|; + $dbh->do($query) || $self->dberror($query); + } + + $dbh->commit; + $dbh->disconnect; + +} + + +sub save_status { + my ($self, $dbh) = @_; + + my ($query, $printed, $emailed); + + my $formnames = $self->{printed}; + my $emailforms = $self->{emailed}; + + my $query = qq|DELETE FROM status + WHERE formname = '$self->{formname}' + AND trans_id = $self->{id}|; + $dbh->do($query) || $self->dberror($query); + + if ($self->{queued}) { + $query = qq|DELETE FROM status + WHERE spoolfile IS NOT NULL + AND trans_id = $self->{id}|; + $dbh->do($query) || $self->dberror($query); + + my %queued = split / /, $self->{queued}; + + foreach my $formname (keys %queued) { + $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; + $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + + $query = qq|INSERT INTO status (trans_id, printed, emailed, + spoolfile, formname) + VALUES ($self->{id}, '$printed', '$emailed', + '$queued{$formname}', '$formname')|; + $dbh->do($query) || $self->dberror($query); + $formnames =~ s/$formname//; + $emailforms =~ s/$formname//; + + } + } + + # save printed, emailed info + $formnames =~ s/^ +//g; + $emailforms =~ s/^ +//g; + + my %status = (); + map { $status{$_}{printed} = 1 } split / +/, $formnames; + map { $status{$_}{emailed} = 1 } split / +/, $emailforms; + + foreach my $formname (keys %status) { + $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; + $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0"; + + $query = qq|INSERT INTO status (trans_id, printed, emailed, formname) + VALUES ($self->{id}, '$printed', '$emailed', '$formname')|; + $dbh->do($query) || $self->dberror($query); + } + +} + + +sub save_intnotes { + my ($self, $myconfig, $table) = @_; + + # no id return + return unless $self->{id}; + + my $dbh = $self->dbconnect($myconfig); + + my $query = qq|UPDATE $table SET + intnotes = |.$dbh->quote($self->{intnotes}).qq| + WHERE id = $self->{id}|; + $dbh->do($query) || $self->dberror($query); + + $dbh->disconnect; + +} + + +sub update_defaults { + my ($self, $myconfig, $fld, $dbh) = @_; + + my $closedb; + + if (! defined $dbh) { + $dbh = $self->dbconnect_noauto($myconfig); + $closedb = 1; + } + + my $query = qq|SELECT $fld FROM defaults FOR UPDATE|; + ($_) = $dbh->selectrow_array($query); + + $_ = "0" unless $_; + + # check for and replace + # <%DATE%>, <%YYMMDD%> or variations of + # <%NAME 1 1 3%>, <%BUSINESS%>, <%BUSINESS 10%>, <%CURR...%> + # <%DESCRIPTION 1 1 3%>, <%ITEM 1 1 3%>, <%PARTSGROUP 1 1 3%> only for parts + # <%PHONE%> for customer and vendors + + my $num = $_; + $num =~ s/(<%.*?%>)//g; + ($num) = $num =~ /(\d+)/; + if (defined $num) { + my $incnum; + # if we have leading zeros check how long it is + if ($num =~ /^0/) { + my $l = length $num; + $incnum = $num + 1; + $l -= length $incnum; + + # pad it out with zeros + my $padzero = "0" x $l; + $incnum = ("0" x $l) . $incnum; + } else { + $incnum = $num + 1; + } + + s/$num/$incnum/; + } + + my $dbvar = $_; + my $var = $_; + my $str; + my $param; + + if (/<%/) { + while (/<%/) { + s/<%.*?%>//; + last unless $&; + $param = $&; + $str = ""; + + if ($param =~ /<%date%>/i) { + $str = ($self->split_date($myconfig->{dateformat}, $self->{transdate}))[0]; + $var =~ s/$param/$str/; + } + + if ($param =~ /<%(name|business|description|item|partsgroup|phone|custom)/i) { + my $fld = lc $&; + $fld =~ s/<%//; + if ($fld =~ /name/) { + if ($self->{type}) { + $fld = $self->{vc}; + } + } + + my $p = $param; + $p =~ s/(<|>|%)//g; + my @p = split / /, $p; + my @n = split / /, uc $self->{$fld}; + if ($#p > 0) { + for (my $i = 1; $i <= $#p; $i++) { + $str .= substr($n[$i-1], 0, $p[$i]); + } + } else { + ($str) = split /--/, $self->{$fld}; + } + $var =~ s/$param/$str/; + + $var =~ s/\W//g if $fld eq 'phone'; + } + + if ($param =~ /<%(yy|mm|dd)/i) { + my $p = $param; + $p =~ s/(<|>|%)//g; + my $spc = $p; + $spc =~ s/\w//g; + $spc = substr($spc, 0, 1); + my %d = ( yy => 1, mm => 2, dd => 3 ); + my @p = (); + + my @a = $self->split_date($myconfig->{dateformat}, $self->{transdate}); + map { push @p, $a[$d{$_}] if ($p =~ /$_/) } sort keys %d; + $str = join $spc, @p; + + $var =~ s/$param/$str/; + } + + if ($param =~ /<%curr/i) { + $var =~ s/$param/$self->{currency}/; + } + + } + } + + $query = qq|UPDATE defaults + SET $fld = '$dbvar'|; + $dbh->do($query) || $form->dberror($query); + + if ($closedb) { + $dbh->commit; + $dbh->disconnect; + } + + $var; + +} + + +sub split_date { + my ($self, $dateformat, $date) = @_; + + my @d = localtime; + my $mm; + my $dd; + my $yy; + my $rv; + + if (! $date) { + $dd = $d[3]; + $mm = $d[4]++; + $yy = substr($d[5],-2); + $mm *= 1; + $dd *= 1; + $mm = "0$mm" if $mm < 10; + $dd = "0$dd" if $dd < 10; + } + + if ($dateformat =~ /^yy/) { + if ($date) { + if ($date =~ /\D/) { + ($yy, $mm, $dd) = split /\D/, $date; + $mm *= 1; + $dd *= 1; + $mm = "0$mm" if $mm < 10; + $dd = "0$dd" if $dd < 10; + $yy = substr($yy, -2); + $rv = "$yy$mm$dd"; + } else { + $rv = $date; + } + } else { + $rv = "$yy$mm$dd"; + } + } + + if ($dateformat =~ /^mm/) { + if ($date) { + if ($date =~ /\D/) { + ($mm, $dd, $yy) = split /\D/, $date if $date; + $mm *= 1; + $dd *= 1; + $mm = "0$mm" if $mm < 10; + $dd = "0$dd" if $dd < 10; + $yy = substr($yy, -2); + $rv = "$mm$dd$yy"; + } else { + $rv = $date; + } + } else { + $rv = "$mm$dd$yy"; + } + } + + if ($dateformat =~ /^dd/) { + if ($date) { + if ($date =~ /\D/) { + ($dd, $mm, $yy) = split /\D/, $date if $date; + $mm *= 1; + $dd *= 1; + $mm = "0$mm" if $mm < 10; + $dd = "0$dd" if $dd < 10; + $yy = substr($yy, -2); + $rv = "$dd$mm$yy"; + } else { + $rv = $date; + } + } else { + $rv = "$dd$mm$yy"; + } + } + + ($rv, $yy, $mm, $dd); + +} + + +sub from_to { + my ($self, $yy, $mm, $interval) = @_; + + use Time::Local; + + my @t; + my $dd = 1; + my $fromdate = "$yy${mm}01"; + my $bd = 1; + + if (defined $interval) { + if ($interval == 12) { + $yy++ if $mm > 1; + } else { + if (($mm += $interval) > 12) { + $mm -= 12; + $yy++ if $mm > 1; + } + if ($interval == 0) { + @t = localtime(time); + $dd = $t[3]; + $mm = $t[4] + 1; + $yy = $t[5] + 1900; + $bd = 0; + } + } + } else { + if ($mm++ > 12) { + $mm -= 12; + $yy++; + } + } + + $mm--; + @t = localtime(timelocal(0,0,0,$dd,$mm,$yy) - $bd); + + $t[4]++; + $t[4] = substr("0$t[4]",-2); + $t[3] = substr("0$t[3]",-2); + + ($fromdate, "$yy$t[4]$t[3]"); + +} + + +sub audittrail { + my ($self, $dbh, $myconfig, $audittrail) = @_; + +# table, $reference, $formname, $action, $id, $transdate) = @_; + + my $query; + my $rv; + + # if we have an id add audittrail, otherwise get a new timestamp + + if ($audittrail->{id}) { + $dbh = $self->dbconnect($myconfig) if $myconfig; + + $query = qq|SELECT audittrail FROM defaults|; + + if ($dbh->selectrow_array($query)) { + my ($null, $employee_id) = $self->get_employee($dbh); + + if ($self->{audittrail} && !$myconfig) { + chop $self->{audittrail}; + + my @a = split /\|/, $self->{audittrail}; + my %newtrail = (); + my $key; + my $i; + my @flds = qw(tablename reference formname action transdate); + + # put into hash and remove dups + while (@a) { + $key = "$a[2]$a[3]"; + $i = 0; + $newtrail{$key} = { map { $_ => $a[$i++] } @flds }; + splice @a, 0, 5; + } + + $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, + formname, action, employee_id, transdate) + VALUES ($audittrail->{id}, ?, ?, + ?, ?, $employee_id, ?)|; + my $sth = $dbh->prepare($query) || $self->dberror($query); + + foreach $key (sort { $newtrail{$a}{transdate} cmp $newtrail{$b}{transdate} } keys %newtrail) { + $i = 1; + map { $sth->bind_param($i++, $newtrail{$key}{$_}) } @flds; + + $sth->execute || $self->dberror; + $sth->finish; + } + } + + + if ($audittrail->{transdate}) { + $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, + formname, action, employee_id, transdate) VALUES ( + $audittrail->{id}, '$audittrail->{tablename}', | + .$dbh->quote($audittrail->{reference}).qq|', + '$audittrail->{formname}', '$audittrail->{action}', + $employee_id, '$audittrail->{transdate}')|; + } else { + $query = qq|INSERT INTO audittrail (trans_id, tablename, reference, + formname, action, employee_id) VALUES ($audittrail->{id}, + '$audittrail->{tablename}', | + .$dbh->quote($audittrail->{reference}).qq|, + '$audittrail->{formname}', '$audittrail->{action}', + $employee_id)|; + } + $dbh->do($query); + } + } else { + $dbh = $self->dbconnect($myconfig); + + $query = qq|SELECT current_timestamp FROM defaults|; + my ($timestamp) = $dbh->selectrow_array($query); + + $rv = "$audittrail->{tablename}|$audittrail->{reference}|$audittrail->{formname}|$audittrail->{action}|$timestamp|"; + } + + $dbh->disconnect if $myconfig; + + $rv; + +} + + + +package Locale; + + +sub new { + my ($type, $country, $NLS_file) = @_; + my $self = {}; + + %self = (); + if ($country && -d "locale/$country") { + $self->{countrycode} = $country; + eval { require "locale/$country/$NLS_file"; }; + } + + $self->{NLS_file} = $NLS_file; + + push @{ $self->{LONG_MONTH} }, ("January", "February", "March", "April", "May ", "June", "July", "August", "September", "October", "November", "December"); + push @{ $self->{SHORT_MONTH} }, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)); + + bless $self, $type; + +} + + +sub text { + my ($self, $text) = @_; + + return (exists $self{texts}{$text}) ? $self{texts}{$text} : $text; + +} + + +sub findsub { + my ($self, $text) = @_; + + if (exists $self{subs}{$text}) { + $text = $self{subs}{$text}; + } else { + if ($self->{countrycode} && $self->{NLS_file}) { + Form->error("$text not defined in locale/$self->{countrycode}/$self->{NLS_file}"); + } + } + + $text; + +} + + +sub date { + my ($self, $myconfig, $date, $longformat) = @_; + + my $longdate = ""; + my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH'; + + + if ($date) { + # get separator + $spc = $myconfig->{dateformat}; + $spc =~ s/\w//g; + $spc = substr($spc, 0, 1); + + if ($date =~ /\D/) { + if ($myconfig->{dateformat} =~ /^yy/) { + ($yy, $mm, $dd) = split /\D/, $date; + } + if ($myconfig->{dateformat} =~ /^mm/) { + ($mm, $dd, $yy) = split /\D/, $date; + } + if ($myconfig->{dateformat} =~ /^dd/) { + ($dd, $mm, $yy) = split /\D/, $date; + } + } else { + $date = substr($date, 2); + ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); + } + + $dd *= 1; + $mm--; + $yy = ($yy < 70) ? $yy + 2000 : $yy; + $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; + + if ($myconfig->{dateformat} =~ /^dd/) { + $mm++; + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + $longdate = "$dd$spc$mm$spc$yy"; + + if (defined $longformat) { + $longdate = "$dd"; + $longdate .= ($spc eq '.') ? ". " : " "; + $longdate .= &text($self, $self->{$longmonth}[--$mm])." $yy"; + } + } elsif ($myconfig->{dateformat} =~ /^yy/) { + $mm++; + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + $longdate = "$yy$spc$mm$spc$dd"; + + if (defined $longformat) { + $longdate = &text($self, $self->{$longmonth}[--$mm])." $dd $yy"; + } + } else { + $mm++; + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + $longdate = "$mm$spc$dd$spc$yy"; + + if (defined $longformat) { + $longdate = &text($self, $self->{$longmonth}[--$mm])." $dd $yy"; + } + } + + } + + $longdate; + +} + + +1; + diff --git a/sql-ledger/SL/GL.pm b/sql-ledger/SL/GL.pm new file mode 100644 index 000000000..221f71726 --- /dev/null +++ b/sql-ledger/SL/GL.pm @@ -0,0 +1,514 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# General ledger backend code +# +#====================================================================== + +package GL; + + +sub delete_transaction { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my %audittrail = ( tablename => 'gl', + reference => $form->{reference}, + formname => 'transaction', + action => 'deleted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $query = qq|DELETE FROM gl WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM acc_trans WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # commit and redirect + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub post_transaction { + my ($self, $myconfig, $form) = @_; + + my $null; + my $project_id; + my $department_id; + my $i; + + # connect to database, turn off AutoCommit + my $dbh = $form->dbconnect_noauto($myconfig); + + # post the transaction + # make up a unique handle and store in reference field + # then retrieve the record based on the unique handle to get the id + # replace the reference field with the actual variable + # add records to acc_trans + + # if there is a $form->{id} replace the old transaction + # delete all acc_trans entries and add the new ones + + my $query; + my $sth; + + if ($form->{id}) { + # delete individual transactions + $query = qq|DELETE FROM acc_trans + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO gl (reference, employee_id) + VALUES ('$uid', (SELECT id FROM employee + WHERE login = '$form->{login}'))|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM gl + WHERE reference = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + } + + ($null, $department_id) = split /--/, $form->{department}; + $department_id *= 1; + + $query = qq|UPDATE gl SET + reference = |.$dbh->quote($form->{reference}).qq|, + description = |.$dbh->quote($form->{description}).qq|, + notes = |.$dbh->quote($form->{notes}).qq|, + transdate = '$form->{transdate}', + department_id = $department_id + WHERE id = $form->{id}|; + + $dbh->do($query) || $form->dberror($query); + + + my $amount = 0; + my $posted = 0; + # insert acc_trans transactions + for $i (1 .. $form->{rowcount}) { + + $form->{"debit_$i"} = $form->parse_amount($myconfig, $form->{"debit_$i"}); + $form->{"credit_$i"} = $form->parse_amount($myconfig, $form->{"credit_$i"}); + + # extract accno + ($accno) = split(/--/, $form->{"accno_$i"}); + $amount = 0; + + if ($form->{"credit_$i"} != 0) { + $amount = $form->{"credit_$i"}; + $posted = 0; + } + if ($form->{"debit_$i"} != 0) { + $amount = $form->{"debit_$i"} * -1; + $posted = 0; + } + + + # add the record + if (! $posted) { + + ($null, $project_id) = split /--/, $form->{"projectnumber_$i"}; + $project_id *= 1; + $form->{"fx_transaction_$i"} *= 1; + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source, project_id, fx_transaction) + VALUES + ($form->{id}, (SELECT id + FROM chart + WHERE accno = '$accno'), + $amount, '$form->{transdate}', | + .$dbh->quote($form->{reference}).qq|, + $project_id, '$form->{"fx_transaction_$i"}')|; + + $dbh->do($query) || $form->dberror($query); + + $posted = 1; + } + + } + + my %audittrail = ( tablename => 'gl', + reference => $form->{reference}, + formname => 'transaction', + action => 'posted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + # commit and redirect + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub all_transactions { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $query; + my $sth; + my $var; + my $null; + + my ($glwhere, $arwhere, $apwhere) = ("1 = 1", "1 = 1", "1 = 1"); + + if ($form->{reference}) { + $var = $form->like(lc $form->{reference}); + $glwhere .= " AND lower(g.reference) LIKE '$var'"; + $arwhere .= " AND lower(a.invnumber) LIKE '$var'"; + $apwhere .= " AND lower(a.invnumber) LIKE '$var'"; + } + if ($form->{department}) { + ($null, $var) = split /--/, $form->{department}; + $glwhere .= " AND g.department_id = $var"; + $arwhere .= " AND a.department_id = $var"; + $apwhere .= " AND a.department_id = $var"; + } + + if ($form->{source}) { + $var = $form->like(lc $form->{source}); + $glwhere .= " AND lower(ac.source) LIKE '$var'"; + $arwhere .= " AND lower(ac.source) LIKE '$var'"; + $apwhere .= " AND lower(ac.source) LIKE '$var'"; + } + + ($form->{datefrom}, $form->{dateto}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + if ($form->{datefrom}) { + $glwhere .= " AND ac.transdate >= '$form->{datefrom}'"; + $arwhere .= " AND ac.transdate >= '$form->{datefrom}'"; + $apwhere .= " AND ac.transdate >= '$form->{datefrom}'"; + } + if ($form->{dateto}) { + $glwhere .= " AND ac.transdate <= '$form->{dateto}'"; + $arwhere .= " AND ac.transdate <= '$form->{dateto}'"; + $apwhere .= " AND ac.transdate <= '$form->{dateto}'"; + } + if ($form->{amountfrom}) { + $glwhere .= " AND abs(ac.amount) >= $form->{amountfrom}"; + $arwhere .= " AND abs(ac.amount) >= $form->{amountfrom}"; + $apwhere .= " AND abs(ac.amount) >= $form->{amountfrom}"; + } + if ($form->{amountto}) { + $glwhere .= " AND abs(ac.amount) <= $form->{amountto}"; + $arwhere .= " AND abs(ac.amount) <= $form->{amountto}"; + $apwhere .= " AND abs(ac.amount) <= $form->{amountto}"; + } + if ($form->{description}) { + $var = $form->like(lc $form->{description}); + $glwhere .= " AND lower(g.description) LIKE '$var'"; + $arwhere .= " AND lower(ct.name) LIKE '$var'"; + $apwhere .= " AND lower(ct.name) LIKE '$var'"; + } + if ($form->{notes}) { + $var = $form->like(lc $form->{notes}); + $glwhere .= " AND lower(g.notes) LIKE '$var'"; + $arwhere .= " AND lower(a.notes) LIKE '$var'"; + $apwhere .= " AND lower(a.notes) LIKE '$var'"; + } + if ($form->{accno}) { + $glwhere .= " AND c.accno = '$form->{accno}'"; + $arwhere .= " AND c.accno = '$form->{accno}'"; + $apwhere .= " AND c.accno = '$form->{accno}'"; + } + if ($form->{gifi_accno}) { + $glwhere .= " AND c.gifi_accno = '$form->{gifi_accno}'"; + $arwhere .= " AND c.gifi_accno = '$form->{gifi_accno}'"; + $apwhere .= " AND c.gifi_accno = '$form->{gifi_accno}'"; + } + if ($form->{category} ne 'X') { + $glwhere .= " AND c.category = '$form->{category}'"; + $arwhere .= " AND c.category = '$form->{category}'"; + $apwhere .= " AND c.category = '$form->{category}'"; + } + + if ($form->{accno}) { + # get category for account + $query = qq|SELECT category, link + FROM chart + WHERE accno = '$form->{accno}'|; + ($form->{ml}, $form->{link}) = $dbh->selectrow_array($query); + + if ($form->{datefrom}) { + $query = qq|SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + WHERE c.accno = '$form->{accno}' + AND ac.transdate < date '$form->{datefrom}' + |; + ($form->{balance}) = $dbh->selectrow_array($query); + } + } + + if ($form->{gifi_accno}) { + # get category for account + $query = qq|SELECT category, link + FROM chart + WHERE gifi_accno = '$form->{gifi_accno}'|; + ($form->{ml}, $form->{link}) = $dbh->selectrow_array($query); + + if ($form->{datefrom}) { + $query = qq|SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + WHERE c.gifi_accno = '$form->{gifi_accno}' + AND ac.transdate < date '$form->{datefrom}' + |; + ($form->{balance}) = $dbh->selectrow_array($query); + } + } + + my $false = ($myconfig->{dbdriver} =~ /Pg/) ? FALSE : q|'0'|; + + my %ordinal = ( id => 1, + accno => 9, + transdate => 6, + reference => 4, + source => 7, + description => 5 ); + + my @a = (id, transdate, reference, source, description, accno); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $query = qq|SELECT g.id, 'gl' AS type, $false AS invoice, g.reference, + g.description, ac.transdate, ac.source, + ac.amount, c.accno, c.gifi_accno, g.notes, c.link, + '' AS till, ac.cleared + FROM gl g, acc_trans ac, chart c + WHERE $glwhere + AND ac.chart_id = c.id + AND g.id = ac.trans_id + UNION ALL + SELECT a.id, 'ar' AS type, a.invoice, a.invnumber, + ct.name, ac.transdate, ac.source, + ac.amount, c.accno, c.gifi_accno, a.notes, c.link, + a.till, ac.cleared + FROM ar a, acc_trans ac, chart c, customer ct + WHERE $arwhere + AND ac.chart_id = c.id + AND a.customer_id = ct.id + AND a.id = ac.trans_id + UNION ALL + SELECT a.id, 'ap' AS type, a.invoice, a.invnumber, + ct.name, ac.transdate, ac.source, + ac.amount, c.accno, c.gifi_accno, a.notes, c.link, + a.till, ac.cleared + FROM ap a, acc_trans ac, chart c, vendor ct + WHERE $apwhere + AND ac.chart_id = c.id + AND a.vendor_id = ct.id + AND a.id = ac.trans_id + ORDER BY $sortorder|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + # gl + if ($ref->{type} eq "gl") { + $ref->{module} = "gl"; + } + + # ap + if ($ref->{type} eq "ap") { + if ($ref->{invoice}) { + $ref->{module} = "ir"; + } else { + $ref->{module} = "ap"; + } + } + + # ar + if ($ref->{type} eq "ar") { + if ($ref->{invoice}) { + $ref->{module} = ($ref->{till}) ? "ps" : "is"; + } else { + $ref->{module} = "ar"; + } + } + + if ($ref->{amount} < 0) { + $ref->{debit} = $ref->{amount} * -1; + $ref->{credit} = 0; + } else { + $ref->{credit} = $ref->{amount}; + $ref->{debit} = 0; + } + + push @{ $form->{GL} }, $ref; + + } + + + $sth->finish; + + if ($form->{accno}) { + $query = qq|SELECT description FROM chart WHERE accno = '$form->{accno}'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{account_description}) = $sth->fetchrow_array; + $sth->finish; + } + if ($form->{gifi_accno}) { + $query = qq|SELECT description FROM gifi WHERE accno = '$form->{gifi_accno}'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{gifi_account_description}) = $sth->fetchrow_array; + $sth->finish; + } + + $dbh->disconnect; + +} + + +sub transaction { + my ($self, $myconfig, $form) = @_; + + my ($query, $sth, $ref); + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + if ($form->{id}) { + $query = "SELECT closedto, revtrans + FROM defaults"; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array; + $sth->finish; + + $query = qq|SELECT g.*, + d.description AS department + FROM gl g + LEFT JOIN department d ON (d.id = g.department_id) + WHERE g.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # retrieve individual rows + $query = qq|SELECT c.accno, c.description, ac.amount, ac.project_id, + p.projectnumber, ac.fx_transaction + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + LEFT JOIN project p ON (p.id = ac.project_id) + WHERE ac.trans_id = $form->{id} + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($ref->{fx_transaction}) { + $form->{transfer} = 1; + } + push @{ $form->{GL} }, $ref; + } + } else { + $query = "SELECT current_date AS transdate, closedto, revtrans + FROM defaults"; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{transdate}, $form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array; + } + + $sth->finish; + + my $paid; + if ($form->{transfer}) { + $paid = "AND link LIKE '%_paid%' + AND NOT (category = 'I' + OR category = 'E') + + UNION + + SELECT accno,description + FROM chart + WHERE id IN (SELECT fxgain_accno_id FROM defaults) + OR id IN (SELECT fxloss_accno_id FROM defaults)"; + } + + # get chart of accounts + $query = qq|SELECT accno,description + FROM chart + WHERE charttype = 'A' + $paid + ORDER by accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_accno} }, $ref; + } + $sth->finish; + + # get projects + $query = qq|SELECT * + FROM project + ORDER BY projectnumber|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_projects} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + + +1; + diff --git a/sql-ledger/SL/HR.pm b/sql-ledger/SL/HR.pm new file mode 100644 index 000000000..6e1bae850 --- /dev/null +++ b/sql-ledger/SL/HR.pm @@ -0,0 +1,558 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2003 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# backend code for human resources and payroll +# +#====================================================================== + +package HR; + + +sub get_employee { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $query; + my $sth; + my $ref; + my $notid = ""; + + if ($form->{id}) { + $query = qq|SELECT e.* + FROM employee e + WHERE e.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + # check if employee can be deleted, orphaned + $form->{status} = "orphaned" unless $ref->{login}; + +$form->{status} = 'orphaned'; # leave orphaned for now until payroll is done + + $ref->{employeelogin} = $ref->{login}; + delete $ref->{login}; + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # get manager + $form->{managerid} *= 1; + $query = qq|SELECT name + FROM employee + WHERE id = $form->{managerid}|; + ($form->{manager}) = $dbh->selectrow_array($query); + + +######### disabled for now +if ($form->{deductions}) { + # get allowances + $query = qq|SELECT d.id, d.description, da.before, da.after, da.rate + FROM employeededuction da + JOIN deduction d ON (da.deduction_id = d.id) + WHERE da.employee_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{rate} *= 100; + push @{ $form->{all_employeededuction} }, $ref; + } + $sth->finish; +} + + $notid = qq|AND id != $form->{id}|; + + } + + + # get managers + $query = qq|SELECT id, name + FROM employee + WHERE sales = '1' + AND role = 'manager' + $notid + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_manager} }, $ref; + } + $sth->finish; + + + # get deductions +if ($form->{deductions}) { + $query = qq|SELECT id, description + FROM deduction + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_deduction} }, $ref; + } + $sth->finish; +} + + $dbh->disconnect; + +} + + + +sub save_employee { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + my $query; + my $sth; + + if (! $form->{id}) { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO employee (name) + VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM employee + WHERE name = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + } + + my ($null, $managerid) = split /--/, $form->{manager}; + $managerid *= 1; + $form->{sales} *= 1; + + $form->{employeenumber} = $form->update_defaults($myconfig, "employeenumber", $dbh) if ! $form->{employeenumber}; + + $query = qq|UPDATE employee SET + employeenumber = |.$dbh->quote($form->{employeenumber}).qq|, + name = |.$dbh->quote($form->{name}).qq|, + address1 = |.$dbh->quote($form->{address1}).qq|, + address2 = |.$dbh->quote($form->{address2}).qq|, + city = |.$dbh->quote($form->{city}).qq|, + state = |.$dbh->quote($form->{state}).qq|, + zipcode = |.$dbh->quote($form->{zipcode}).qq|, + country = |.$dbh->quote($form->{country}).qq|, + workphone = '$form->{workphone}', + homephone = '$form->{homephone}', + startdate = |.$form->dbquote($form->{startdate}, SQL_DATE).qq|, + enddate = |.$form->dbquote($form->{enddate}, SQL_DATE).qq|, + notes = |.$dbh->quote($form->{notes}).qq|, + role = '$form->{role}', + sales = '$form->{sales}', + email = |.$dbh->quote($form->{email}).qq|, + ssn = '$form->{ssn}', + dob = |.$form->dbquote($form->{dob}, SQL_DATE).qq|, + iban = '$form->{iban}', + bic = '$form->{bic}', + managerid = $managerid + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + +# for now +if ($form->{selectdeduction}) { + # insert deduction and allowances for payroll + $query = qq|DELETE FROM employeededuction + WHERE employee_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO employeededuction (employee_id, deduction_id, + before, after, rate) VALUES ($form->{id},?,?,?,?)|; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + for ($i = 1; $i <= $form->{deduction_rows}; $i++) { + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"}) } qw(before after); + ($null, $deduction_id) = split /--/, $form->{"deduction_$i"}; + if ($deduction_id) { + $sth->execute($deduction_id, $form->{"before_$i"}, $form->{"after_$i"}, $form->{"rate_$i"} / 100) || $form->dberror($query); + } + } + $sth->finish; +} + + $dbh->commit; + $dbh->disconnect; + +} + + +sub delete_employee { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + # delete employee + my $query = qq|DELETE FROM $form->{db} + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->commit; + $dbh->disconnect; + +} + + +sub employees { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $where = "1 = 1"; + $form->{sort} = ($form->{sort}) ? $form->{sort} : "name"; + my @a = qw(name); + my $sortorder = $form->sort_order(\@a); + + my $var; + + if ($form->{startdate}) { + $where .= " AND e.startdate >= '$startdate'"; + } + if ($form->{enddate}) { + $where .= " AND e.enddate >= '$enddate'"; + } + if ($form->{name}) { + $var = $form->like(lc $form->{name}); + $where .= " AND lower(e.name) LIKE '$var'"; + } + if ($form->{notes}) { + $var = $form->like(lc $form->{notes}); + $where .= " AND lower(e.notes) LIKE '$var'"; + } + if ($form->{status} eq 'sales') { + $where .= " AND e.sales = '1'"; + } + if ($form->{status} eq 'orphaned') { + $where .= qq| AND e.login IS NULL|; + } + + my $query = qq|SELECT e.*, m.name AS manager + FROM employee e + LEFT JOIN employee m ON (m.id = e.managerid) + WHERE $where + ORDER BY $sortorder|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{address} = ""; + map { $ref->{address} .= "$ref->{$_} "; } qw(address1 address2 city state zipcode country); + push @{ $form->{all_employee} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub get_deduction { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + my $query; + my $sth; + my $ref; + my $item; + my $i; + + if ($form->{id}) { + $query = qq|SELECT d.*, + c1.accno AS ap_accno, + c1.description AS ap_description, + c2.accno AS expense_accno, + c2.description AS expense_description + FROM deduction d + LEFT JOIN chart c1 ON (c1.id = d.ap_accno_id) + LEFT JOIN chart c2 ON (c2.id = d.expense_accno_id) + WHERE d.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # check if orphaned +$form->{status} = 'orphaned'; # for now + + + # get the rates + $query = qq|SELECT rate, amount, above, below + FROM deductionrate + WHERE trans_id = $form->{id} + ORDER BY rate, amount|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{deductionrate} }, $ref; + } + $sth->finish; + + # get all for deductionbase + $query = qq|SELECT d.description, d.id, db.maximum + FROM deductionbase db + JOIN deduction d ON (d.id = db.deduction_id) + WHERE db.trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{deductionbase} }, $ref; + } + $sth->finish; + + # get all for deductionafter + $query = qq|SELECT d.description, d.id + FROM deductionafter da + JOIN deduction d ON (d.id = da.deduction_id) + WHERE da.trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{deductionafter} }, $ref; + } + $sth->finish; + + # build selection list for base and after + $query = qq|SELECT id, description + FROM deduction + WHERE id != $form->{id} + ORDER BY 2|; + + } else { + # build selection list for base and after + $query = qq|SELECT id, description + FROM deduction + ORDER BY 2|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_deduction} }, $ref; + } + $sth->finish; + + + my %category = ( ap => 'L', + expense => 'E' ); + + foreach $item (keys %category) { + $query = qq|SELECT accno, description + FROM chart + WHERE charttype = 'A' + AND category = '$category{$item}' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{"${item}_accounts"} }, $ref; + } + $sth->finish; + } + + + $dbh->disconnect; + +} + + +sub deductions { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT d.id, d.description, d.employeepays, d.employerpays, + c1.accno AS ap_accno, c2.accno AS expense_accno, + dr.rate, dr.amount, dr.above, dr.below + FROM deduction d + JOIN deductionrate dr ON (dr.trans_id = d.id) + LEFT JOIN chart c1 ON (d.ap_accno_id = c1.id) + LEFT JOIN chart c2 ON (d.expense_accno_id = c2.id) + ORDER BY 2, 7, 8|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_deduction} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub save_deduction { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + ($form->{ap_accno}) = split /--/, $form->{ap_accno}; + ($form->{expense_accno}) = split /--/, $form->{expense_accno}; + + my $null; + my $deduction_id; + my $query; + my $sth; + + if (! $form->{id}) { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO deduction (description) + VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM deduction + WHERE description = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + } + + + map { $form->{$_} = $form->parse_amount($myconfig, $form->{$_}) } qw(employeepays employerpays); + + $query = qq|UPDATE deduction SET + description = |.$dbh->quote($form->{description}).qq|, + ap_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{ap_accno}'), + expense_accno_id = + (SELECT id FROM chart + WHERE accno = '$form->{expense_accno}'), + employerpays = '$form->{employerpays}', + employeepays = '$form->{employeepays}', + fromage = |.$form->dbquote($form->{fromage}, SQL_INT).qq|, + toage = |.$form->dbquote($form->{toage}, SQL_INT).qq| + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + + $query = qq|DELETE FROM deductionrate + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO deductionrate + (trans_id, rate, amount, above, below) VALUES (?,?,?,?,?)|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + for ($i = 1; $i <= $form->{rate_rows}; $i++) { + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"}) } qw(rate amount above below); + $form->{"rate_$i"} /= 100; + + if ($form->{"rate_$i"} || $form->{"amount_$i"}) { + $sth->execute($form->{id}, $form->{"rate_$i"}, $form->{"amount_$i"}, $form->{"above_$i"}, $form->{"below_$i"}) || $form->dberror($query); + } + } + $sth->finish; + + + $query = qq|DELETE FROM deductionbase + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO deductionbase + (trans_id, deduction_id, maximum) VALUES (?,?,?)|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + for ($i = 1; $i <= $form->{base_rows}; $i++) { + ($null, $deduction_id) = split /--/, $form->{"base_$i"}; + $form->{"maximum_$i"} = $form->parse_amount($myconfig, $form->{"maximum_$i"}); + if ($deduction_id) { + $sth->execute($form->{id}, $deduction_id, $form->{"maximum_$i"}) || $form->dberror($query); + } + } + $sth->finish; + + + $query = qq|DELETE FROM deductionafter + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO deductionafter + (trans_id, deduction_id) VALUES (?,?)|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + for ($i = 1; $i <= $form->{after_rows}; $i++) { + ($null, $deduction_id) = split /--/, $form->{"after_$i"}; + if ($deduction_id) { + $sth->execute($form->{id}, $deduction_id) || $form->dberror($query); + } + } + $sth->finish; + + $dbh->commit; + $dbh->disconnect; + +} + + +sub delete_deduction { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + # delete deduction + my $query = qq|DELETE FROM $form->{db} + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + foreach $item (qw(rate base after)) { + $query = qq|DELETE FROM deduction$item + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + $dbh->commit; + $dbh->disconnect; + +} + +1; + diff --git a/sql-ledger/SL/IC.pm b/sql-ledger/SL/IC.pm new file mode 100644 index 000000000..cf70b06ca --- /dev/null +++ b/sql-ledger/SL/IC.pm @@ -0,0 +1,1513 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Inventory Control backend +# +#====================================================================== + +package IC; + + +sub get_part { + my ($self, $myconfig, $form) = @_; + + # connect to db + my $dbh = $form->dbconnect($myconfig); + my $i; + + my $query = qq|SELECT p.*, + c1.accno AS inventory_accno, + c2.accno AS income_accno, + c3.accno AS expense_accno, + pg.partsgroup + FROM parts p + LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) + LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) + LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE p.id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my $ref = $sth->fetchrow_hashref(NAME_lc); + + # copy to $form variables + map { $form->{$_} = $ref->{$_} } ( keys %{ $ref } ); + + $sth->finish; + + my %oid = ('Pg' => 'a.oid', + 'PgPP' => 'a.oid', + 'Oracle' => 'a.rowid', + 'DB2' => '1=1' + ); + + # part, service item or labor + $form->{item} = ($form->{inventory_accno}) ? 'part' : 'service'; + $form->{item} = 'labor' if ! $form->{income_accno}; + + if ($form->{assembly}) { + $form->{item} = 'assembly'; + + # retrieve assembly items + $query = qq|SELECT p.id, p.partnumber, p.description, + p.sellprice, p.weight, a.qty, a.bom, a.adj, p.unit, + p.lastcost, p.listprice, + pg.partsgroup, p.assembly, p.partsgroup_id + FROM parts p + JOIN assembly a ON (a.parts_id = p.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE a.id = $form->{id} + ORDER BY $oid{$myconfig->{dbdriver}}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{assembly_rows} = 0; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{assembly_rows}++; + foreach my $key ( keys %{ $ref } ) { + $form->{"${key}_$form->{assembly_rows}"} = $ref->{$key}; + } + } + $sth->finish; + + } + + # setup accno hash for <option checked> {amount} is used in create_links + $form->{amount}{IC} = $form->{inventory_accno}; + $form->{amount}{IC_income} = $form->{income_accno}; + $form->{amount}{IC_sale} = $form->{income_accno}; + $form->{amount}{IC_expense} = $form->{expense_accno}; + $form->{amount}{IC_cogs} = $form->{expense_accno}; + + + if ($form->{item} =~ /(part|assembly)/) { + # get makes + if ($form->{makemodel}) { + $query = qq|SELECT make, model + FROM makemodel + WHERE parts_id = $form->{id}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{makemodels} }, $ref; + } + $sth->finish; + } + } + + # now get accno for taxes + $query = qq|SELECT c.accno + FROM chart c, partstax pt + WHERE pt.chart_id = c.id + AND pt.parts_id = $form->{id}|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (($key) = $sth->fetchrow_array) { + $form->{amount}{$key} = $key; + } + + $sth->finish; + + # is it an orphan + $query = qq|SELECT parts_id + FROM invoice + WHERE parts_id = $form->{id} + UNION + SELECT parts_id + FROM orderitems + WHERE parts_id = $form->{id} + UNION + SELECT parts_id + FROM assembly + WHERE parts_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{orphaned}) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + $sth->finish; + + + if ($form->{item} =~ /(part|service)/) { + # get vendors + $query = qq|SELECT v.id, v.name, pv.partnumber, + pv.lastcost, pv.leadtime, pv.curr AS vendorcurr + FROM partsvendor pv + JOIN vendor v ON (v.id = pv.vendor_id) + WHERE pv.parts_id = $form->{id} + ORDER BY 2|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{vendormatrix} }, $ref; + } + $sth->finish; + } + + # get matrix + if ($form->{item} ne 'labor') { + $query = qq|SELECT pc.pricebreak, pc.sellprice AS customerprice, + pc.curr AS customercurr, + pc.validfrom, pc.validto, + c.name, c.id AS cid, g.pricegroup, g.id AS gid + FROM partscustomer pc + LEFT JOIN customer c ON (c.id = pc.customer_id) + LEFT JOIN pricegroup g ON (g.id = pc.pricegroup_id) + WHERE pc.parts_id = $form->{id} + ORDER BY c.name, g.pricegroup, pc.pricebreak|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{customermatrix} }, $ref; + } + $sth->finish; + } + + $dbh->disconnect; + +} + + +sub save { + my ($self, $myconfig, $form) = @_; + + ($form->{inventory_accno}) = split(/--/, $form->{IC}); + ($form->{expense_accno}) = split(/--/, $form->{IC_expense}); + ($form->{income_accno}) = split(/--/, $form->{IC_income}); + + # connect to database, turn off AutoCommit + my $dbh = $form->dbconnect_noauto($myconfig); + + # save the part + # make up a unique handle and store in partnumber field + # then retrieve the record based on the unique handle to get the id + # replace the partnumber field with the actual variable + # add records for makemodel + + # if there is a $form->{id} then replace the old entry + # delete all makemodel entries and add the new ones + + # undo amount formatting + map { $form->{$_} = $form->parse_amount($myconfig, $form->{$_}) } qw(rop weight listprice sellprice lastcost stock); + + $form->{lastcost} = $form->{sellprice} if $form->{item} eq 'labor'; + + $form->{makemodel} = (($form->{make_1}) || ($form->{model_1})) ? 1 : 0; + + $form->{assembly} = ($form->{item} eq 'assembly') ? 1 : 0; + map { $form->{$_} *= 1 } qw(alternate obsolete onhand); + + my $query; + my $sth; + my $i; + my $null; + my $vendor_id; + my $customer_id; + + if ($form->{id}) { + + # get old price + $query = qq|SELECT listprice, sellprice, lastcost, weight + FROM parts + WHERE id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($listprice, $sellprice, $lastcost, $weight) = $sth->fetchrow_array; + $sth->finish; + + # if item is part of an assembly adjust all assemblies + $query = qq|SELECT id, qty, adj + FROM assembly + WHERE parts_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($id, $qty, $adj) = $sth->fetchrow_array) { + &update_assembly($dbh, $form, $id, $qty, $adj, $listprice * 1, $sellprice * 1, $lastcost * 1, $weight * 1); + } + $sth->finish; + + if ($form->{item} =~ /(part|service)/) { + # delete partsvendor records + $query = qq|DELETE FROM partsvendor + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + if ($form->{item} !~ /(service|labor)/) { + # delete makemodel records + $query = qq|DELETE FROM makemodel + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + if ($form->{item} eq 'assembly') { + if ($form->{onhand} != 0) { + &adjust_inventory($dbh, $form, $form->{id}, $form->{onhand} * -1); + } + + if ($form->{orphaned}) { + # delete assembly records + $query = qq|DELETE FROM assembly + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } else { + # update BOM, A only + $query = qq|UPDATE assembly + SET bom = ?, adj = ? + WHERE id = ? + AND parts_id = ?|; + $sth = $dbh->prepare($query); + + for $i (1 .. $form->{assembly_rows} - 1) { + $sth->execute(($form->{"bom_$i"}) ? '1' : '0', ($form->{"adj_$i"}) ? '1' : '0', $form->{id}, $form->{"id_$i"}); + $sth->finish; + } + } + + $form->{onhand} += $form->{stock}; + + } + + # delete tax records + $query = qq|DELETE FROM partstax + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete matrix + $query = qq|DELETE FROM partscustomer + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO parts (partnumber) + VALUES ('$uid')|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM parts + WHERE partnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + + $form->{orphaned} = 1; + $form->{onhand} = ($form->{stock} * 1) if $form->{item} eq 'assembly'; + + } + + my $partsgroup_id; + ($null, $partsgroup_id) = split /--/, $form->{partsgroup}; + $partsgroup_id *= 1; + + $form->{partnumber} = $form->update_defaults($myconfig, "partnumber", $dbh) if ! $form->{partnumber}; + + $query = qq|UPDATE parts SET + partnumber = |.$dbh->quote($form->{partnumber}).qq|, + description = |.$dbh->quote($form->{description}).qq|, + makemodel = '$form->{makemodel}', + alternate = '$form->{alternate}', + assembly = '$form->{assembly}', + listprice = $form->{listprice}, + sellprice = $form->{sellprice}, + lastcost = $form->{lastcost}, + weight = $form->{weight}, + priceupdate = |.$form->dbquote($form->{priceupdate}, SQL_DATE).qq|, + unit = |.$dbh->quote($form->{unit}).qq|, + notes = |.$dbh->quote($form->{notes}).qq|, + rop = $form->{rop}, + bin = |.$dbh->quote($form->{bin}).qq|, + inventory_accno_id = (SELECT id FROM chart + WHERE accno = '$form->{inventory_accno}'), + income_accno_id = (SELECT id FROM chart + WHERE accno = '$form->{income_accno}'), + expense_accno_id = (SELECT id FROM chart + WHERE accno = '$form->{expense_accno}'), + obsolete = '$form->{obsolete}', + image = '$form->{image}', + drawing = '$form->{drawing}', + microfiche = '$form->{microfiche}', + partsgroup_id = $partsgroup_id + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + + # insert makemodel records + if ($form->{item} =~ /(part|assembly)/) { + for $i (1 .. $form->{makemodel_rows}) { + if (($form->{"make_$i"}) || ($form->{"model_$i"})) { + $query = qq|INSERT INTO makemodel (parts_id, make, model) + VALUES ($form->{id},| + .$dbh->quote($form->{"make_$i"}).qq|, | + .$dbh->quote($form->{"model_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + + # insert taxes + foreach $item (split / /, $form->{taxaccounts}) { + if ($form->{"IC_tax_$item"}) { + $query = qq|INSERT INTO partstax (parts_id, chart_id) + VALUES ($form->{id}, + (SELECT id + FROM chart + WHERE accno = '$item'))|; + $dbh->do($query) || $form->dberror($query); + } + } + + # add assembly records + if ($form->{item} eq 'assembly') { + + if ($form->{orphaned}) { + for $i (1 .. $form->{assembly_rows}) { + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + + if ($form->{"qty_$i"} != 0) { + map { $form->{"${_}_$i"} *= 1 } qw(bom adj); + $query = qq|INSERT INTO assembly (id, parts_id, qty, bom, adj) + VALUES ($form->{id}, $form->{"id_$i"}, + $form->{"qty_$i"}, '$form->{"bom_$i"}', + '$form->{"adj_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + # adjust onhand for the parts + if ($form->{onhand} != 0) { + &adjust_inventory($dbh, $form, $form->{id}, $form->{onhand}); + } + + @a = localtime; $a[5] += 1900; $a[4]++; + my $shippingdate = "$a[5]-$a[4]-$a[3]"; + + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + + # add inventory record + if ($form->{stock} != 0) { + $query = qq|INSERT INTO inventory (warehouse_id, parts_id, qty, + shippingdate, employee_id) VALUES ( + 0, $form->{id}, $form->{stock}, '$shippingdate', + $form->{employee_id})|; + $dbh->do($query) || $form->dberror($query); + } + + } + + + # add vendors + if ($form->{item} ne 'assembly') { + for $i (1 .. $form->{vendor_rows}) { + if ($form->{"vendor_$i"} && $form->{"lastcost_$i"}) { + + ($null, $vendor_id) = split /--/, $form->{"vendor_$i"}; + + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"})} qw(lastcost leadtime); + + $query = qq|INSERT INTO partsvendor (vendor_id, parts_id, partnumber, + lastcost, leadtime, curr) + VALUES ($vendor_id, $form->{id},| + .$dbh->quote($form->{"partnumber_$i"}).qq|, + $form->{"lastcost_$i"}, + $form->{"leadtime_$i"}, '$form->{"vendorcurr_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + + # add pricematrix + for $i (1 .. $form->{customer_rows}) { + + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"})} qw(pricebreak customerprice); + + if ($form->{"customerprice_$i"}) { + + ($null, $customer_id) = split /--/, $form->{"customer_$i"}; + $customer_id *= 1; + + ($null, $pricegroup_id) = split /--/, $form->{"pricegroup_$i"}; + $pricegroup_id *= 1; + + $query = qq|INSERT INTO partscustomer (parts_id, customer_id, + pricegroup_id, pricebreak, sellprice, curr, + validfrom, validto) + VALUES ($form->{id}, $customer_id, + $pricegroup_id, $form->{"pricebreak_$i"}, + $form->{"customerprice_$i"}, '$form->{"customercurr_$i"}',| + .$form->dbquote($form->{"validfrom_$i"}, SQL_DATE).qq|, | + .$form->dbquote($form->{"validto_$i"}, SQL_DATE).qq|)|; + $dbh->do($query) || $form->dberror($query); + } + } + + # commit + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub update_assembly { + my ($dbh, $form, $id, $qty, $adj, $listprice, $sellprice, $lastcost, $weight) = @_; + + my $formlistprice = $form->{listprice}; + my $formsellprice = $form->{sellprice}; + + if (!$adj) { + $formlistprice = $listprice; + $formsellprice = $sellprice; + } + + my $query = qq|SELECT id, qty, adj + FROM assembly + WHERE parts_id = $id|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{$id} = 1; + + while (my ($pid, $aqty, $aadj) = $sth->fetchrow_array) { + &update_assembly($dbh, $form, $pid, $aqty * $qty, $aadj, $listprice, $sellprice, $lastcost, $weight) if !$form->{$pid}; + } + $sth->finish; + + $query = qq|UPDATE parts + SET listprice = listprice + + $qty * ($formlistprice - $listprice), + sellprice = sellprice + + $qty * ($formsellprice - $sellprice), + lastcost = lastcost + + $qty * ($form->{lastcost} - $lastcost), + weight = weight + + $qty * ($form->{weight} - $weight) + WHERE id = $id|; + $dbh->do($query) || $form->dberror($query); + + delete $form->{$id}; + +} + + + +sub retrieve_assemblies { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $where = '1 = 1'; + + if ($form->{partnumber}) { + my $partnumber = $form->like(lc $form->{partnumber}); + $where .= " AND lower(p.partnumber) LIKE '$partnumber'"; + } + + if ($form->{description}) { + my $description = $form->like(lc $form->{description}); + $where .= " AND lower(p.description) LIKE '$description'"; + } + $where .= " AND NOT p.obsolete = '1'"; + + my %ordinal = ( 'partnumber' => 2, + 'description' => 3, + 'bin' => 4 + ); + + my @a = qw(partnumber description bin); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + + # retrieve assembly items + my $query = qq|SELECT p.id, p.partnumber, p.description, + p.bin, p.onhand, p.rop, + (SELECT sum(p2.inventory_accno_id) + FROM parts p2, assembly a + WHERE p2.id = a.parts_id + AND a.id = p.id) AS inventory + FROM parts p + WHERE $where + AND assembly = '1' + ORDER BY $sortorder|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $inh; + if ($form->{checkinventory}) { + $query = qq|SELECT p.id, p.onhand, a.qty FROM parts p + JOIN assembly a ON (a.parts_id = p.id) + WHERE a.id = ?|; + $inh = $dbh->prepare($query) || $form->dberror($query); + } + + my $onhand = (); + my $ref; + my $aref; + my $stock; + my $howmany; + my $ok; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($ref->{inventory}) { + $ok = 1; + if ($form->{checkinventory}) { + $inh->execute($ref->{id}) || $form->dberror($query);; + $ok = 0; + while ($aref = $inh->fetchrow_hashref(NAME_lc)) { + $onhand{$aref->{id}} = (exists $onhand{$aref->{id}}) ? $onhand{$aref->{id}} : $aref->{onhand}; + + if ($aref->{onhand} >= $aref->{qty}) { + + $howmany = ($aref->{qty}) ? $aref->{onhand}/$aref->{qty} : 1; + if ($stock) { + $stock = ($stock > $howmany) ? $howmany : $stock; + } else { + $stock = $howmany; + } + $ok = 1; + + $onhand{$aref->{id}} -= ($aref->{qty} * $stock); + + } else { + $ok = 0; + last; + } + } + $inh->finish; + $ref->{stock} = (($ref->{rop} - $ref->{qty}) > $stock) ? int $stock : $ref->{rop}; + } + push @{ $form->{assembly_items} }, $ref if $ok; + } + } + $sth->finish; + + $dbh->disconnect; + +} + + +sub restock_assemblies { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + @a = localtime; $a[5] += 1900; $a[4]++; + my $shippingdate = "$a[5]-$a[4]-$a[3]"; + + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + + for my $i (1 .. $form->{rowcount}) { + + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + + if ($form->{"qty_$i"} != 0) { + &adjust_inventory($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"}); + } + + # add inventory record + if ($form->{"qty_$i"} != 0) { + $query = qq|INSERT INTO inventory (warehouse_id, parts_id, qty, + shippingdate, employee_id) VALUES ( + 0, $form->{"id_$i"}, $form->{"qty_$i"}, '$shippingdate', + $form->{employee_id})|; + $dbh->do($query) || $form->dberror($query); + } + + } + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub adjust_inventory { + my ($dbh, $form, $id, $qty) = @_; + + my $query = qq|SELECT p.id, p.inventory_accno_id, p.assembly, a.qty + FROM parts p, assembly a + WHERE a.parts_id = p.id + AND a.id = $id|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + my $allocate = $qty * $ref->{qty}; + + # is it a service item then loop + if (($ref->{inventory_accno_id} *= 1) == 0) { + next unless $ref->{assembly}; # assembly + } + + # adjust parts onhand + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $ref->{id}|, + $allocate * -1); + } + + $sth->finish; + + # update assembly + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $id|, + $qty); + +} + + +sub delete { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off AutoCommit + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query = qq|DELETE FROM parts + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM partstax + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + + if ($form->{item} ne 'assembly') { + $query = qq|DELETE FROM partsvendor + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + # check if it is a part, assembly or service + if ($form->{item} ne 'service') { + $query = qq|DELETE FROM makemodel + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + if ($form->{item} eq 'assembly') { + # delete inventory + $query = qq|DELETE FROM inventory + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM assembly + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + if ($form->{item} eq 'alternate') { + $query = qq|DELETE FROM alternate + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + $query = qq|DELETE FROM partscustomer + WHERE parts_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM translation + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # commit + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub assembly_item { + my ($self, $myconfig, $form) = @_; + + my $i = $form->{assembly_rows}; + my $var; + my $null; + my $where = "p.obsolete = '0'"; + + if ($form->{"partnumber_$i"}) { + $var = $form->like(lc $form->{"partnumber_$i"}); + $where .= " AND lower(p.partnumber) LIKE '$var'"; + } + if ($form->{"description_$i"}) { + $var = $form->like(lc $form->{"description_$i"}); + $where .= " AND lower(p.description) LIKE '$var'"; + } + if ($form->{"partsgroup_$i"}) { + ($null, $var) = split /--/, $form->{"partsgroup_$i"}; + $where .= qq| AND p.partsgroup_id = $var|; + } + + if ($form->{id}) { + $where .= " AND p.id != $form->{id}"; + } + + if ($partnumber) { + $where .= " ORDER BY p.partnumber"; + } else { + $where .= " ORDER BY p.description"; + } + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice, + p.weight, p.onhand, p.unit, p.lastcost, + pg.partsgroup, p.partsgroup_id + FROM parts p + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE $where|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{item_list} }, $ref; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub all_parts { + my ($self, $myconfig, $form) = @_; + + my $where = '1 = 1'; + my $null; + my $var; + my $ref; + my $item; + + foreach $item (qw(partnumber drawing microfiche)) { + if ($form->{$item}) { + $var = $form->like(lc $form->{$item}); + $where .= " AND lower(p.$item) LIKE '$var'"; + } + } + # special case for description + if ($form->{description}) { + unless ($form->{bought} || $form->{sold} || $form->{onorder} || $form->{ordered} || $form->{rfq} || $form->{quoted}) { + $var = $form->like(lc $form->{description}); + $where .= " AND lower(p.description) LIKE '$var'"; + } + } + + # assembly components + my $assemblyflds; + if ($form->{searchitems} eq 'component') { + $assemblyflds = qq|, p1.partnumber AS assemblypartnumber, a.id AS assembly_id|; + } + + # special case for serialnumber + if ($form->{l_serialnumber}) { + if ($form->{serialnumber}) { + $var = $form->like(lc $form->{serialnumber}); + $where .= " AND lower(i.serialnumber) LIKE '$var'"; + } + } + + if ($form->{warehouse} || $form->{l_warehouse}) { + $form->{l_warehouse} = 1; + } + + if ($form->{searchitems} eq 'part') { + $where .= " AND p.inventory_accno_id > 0 AND p.assembly = '0' AND p.income_accno_id > 0"; + } + if ($form->{searchitems} eq 'assembly') { + $form->{bought} = ""; + $where .= " AND p.assembly = '1'"; + } + if ($form->{searchitems} eq 'service') { + $where .= " AND p.inventory_accno_id IS NULL AND p.assembly = '0'"; + } + if ($form->{searchitems} eq 'labor') { + $where .= " AND p.inventory_accno_id > 0 AND p.income_accno_id IS NULL"; + } + + # items which were never bought, sold or on an order + if ($form->{itemstatus} eq 'orphaned') { + $where .= " AND p.onhand = 0 + AND p.id NOT IN (SELECT p.id FROM parts p, invoice i + WHERE p.id = i.parts_id) + AND p.id NOT IN (SELECT p.id FROM parts p, assembly a + WHERE p.id = a.parts_id) + AND p.id NOT IN (SELECT p.id FROM parts p, orderitems o + WHERE p.id = o.parts_id)"; + } + + if ($form->{itemstatus} eq 'active') { + $where .= " AND p.obsolete = '0'"; + } + if ($form->{itemstatus} eq 'obsolete') { + $where .= " AND p.obsolete = '1'"; + } + if ($form->{itemstatus} eq 'onhand') { + $where .= " AND p.onhand > 0"; + } + if ($form->{itemstatus} eq 'short') { + $where .= " AND p.onhand < p.rop"; + } + + my $makemodelflds = qq|, '', ''|;; + my $makemodeljoin; + + if ($form->{make} || $form->{l_make} || $form->{model} || $form->{l_model}) { + $makemodelflds = qq|, m.make, m.model|; + $makemodeljoin = qq|LEFT JOIN makemodel m ON (m.parts_id = p.id)|; + + if ($form->{make}) { + $var = $form->like(lc $form->{make}); + $where .= " AND lower(m.make) LIKE '$var'"; + } + if ($form->{model}) { + $var = $form->like(lc $form->{model}); + $where .= " AND lower(m.model) LIKE '$var'"; + } + } + if ($form->{partsgroup}) { + ($null, $var) = split /--/, $form->{partsgroup}; + $where .= qq| AND p.partsgroup_id = $var|; + } + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my %ordinal = ( 'partnumber' => 2, + 'description' => 3, + 'bin' => 6, + 'priceupdate' => 12, + 'drawing' => 14, + 'microfiche' => 15, + 'partsgroup' => 17, + 'make' => 19, + 'model' => 20, + 'assemblypartnumber' => 21 + ); + + my @a = qw(partnumber description); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $query = qq|SELECT curr FROM defaults|; + my ($curr) = $dbh->selectrow_array($query); + $curr =~ s/:.*//; + + my $flds = qq|p.id, p.partnumber, p.description, p.onhand, p.unit, + p.bin, p.sellprice, p.listprice, p.lastcost, p.rop, + p.weight, p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, pg.partsgroup, '$curr' AS curr + $makemodelflds $assemblyflds + |; + + $query = qq|SELECT $flds + FROM parts p + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + $makemodeljoin + WHERE $where + ORDER BY $sortorder|; + + # redo query for components report + if ($form->{searchitems} eq 'component') { + + $query = qq|SELECT $flds + FROM assembly a + JOIN parts p ON (a.parts_id = p.id) + JOIN parts p1 ON (a.id = p1.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + $makemodeljoin + WHERE $where + ORDER BY $sortorder|; + + } + + + # rebuild query for bought and sold items + if ($form->{bought} || $form->{sold} || $form->{onorder} || $form->{ordered} || $form->{rfq} || $form->{quoted}) { + + $form->sort_order(); + my @a = qw(partnumber description employee); + + push @a, qw(invnumber serialnumber) if ($form->{bought} || $form->{sold}); + push @a, "ordnumber" if ($form->{onorder} || $form->{ordered}); + push @a, "quonumber" if ($form->{rfq} || $form->{quoted}); + + %ordinal = ( 'partnumber' => 2, + 'description' => 3, + 'serialnumber' => 4, + 'bin' => 7, + 'priceupdate' => 13, + 'partsgroup' => 18, + 'invnumber' => 19, + 'ordnumber' => 20, + 'quonumber' => 21, + 'name' => 23, + 'employee' => 24, + 'make' => 27, + 'model' => 28 + ); + + $sortorder = $form->sort_order(\@a, \%ordinal); + + my $union = ""; + $query = ""; + + if ($form->{bought} || $form->{sold}) { + + my $invwhere = "$where"; + my $transdate = ($form->{method} eq 'accrual') ? "transdate" : "datepaid"; + + $invwhere .= " AND i.assemblyitem = '0'"; + $invwhere .= " AND a.$transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $invwhere .= " AND a.$transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + if ($form->{description}) { + $var = $form->like(lc $form->{description}); + $invwhere .= " AND lower(i.description) LIKE '$var'"; + } + + if ($form->{open} || $form->{closed}) { + if ($form->{open} && $form->{closed}) { + if ($form->{method} eq 'cash') { + $invwhere .= " AND a.amount = a.paid"; + } + } else { + if ($form->{open}) { + if ($form->{method} eq 'cash') { + $invwhere .= " AND a.id = 0"; + } else { + $invwhere .= " AND NOT a.amount = a.paid"; + } + } else { + $invwhere .= " AND a.amount = a.paid"; + } + } + } else { + $invwhere .= " AND a.id = 0"; + } + + my $flds = qq|p.id, p.partnumber, i.description, i.serialnumber, + i.qty AS onhand, i.unit, p.bin, i.sellprice, + p.listprice, p.lastcost, p.rop, p.weight, + p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, + pg.partsgroup, a.invnumber, a.ordnumber, a.quonumber, + i.trans_id, ct.name, e.name AS employee, a.curr, a.till + $makemodelfld|; + + + if ($form->{bought}) { + $query = qq| + SELECT $flds, 'ir' AS module, '' AS type, + (SELECT sell FROM exchangerate ex + WHERE ex.curr = a.curr + AND ex.transdate = a.$transdate) AS exchangerate, + i.discount + FROM invoice i + JOIN parts p ON (p.id = i.parts_id) + JOIN ap a ON (a.id = i.trans_id) + JOIN vendor ct ON (a.vendor_id = ct.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $makemodeljoin + WHERE $invwhere|; + $union = " + UNION"; + } + + if ($form->{sold}) { + $query .= qq|$union + SELECT $flds, 'is' AS module, '' AS type, + (SELECT buy FROM exchangerate ex + WHERE ex.curr = a.curr + AND ex.transdate = a.$transdate) AS exchangerate, + i.discount + FROM invoice i + JOIN parts p ON (p.id = i.parts_id) + JOIN ar a ON (a.id = i.trans_id) + JOIN customer ct ON (a.customer_id = ct.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $makemodeljoin + WHERE $invwhere|; + $union = " + UNION"; + } + } + + if ($form->{onorder} || $form->{ordered}) { + my $ordwhere = "$where + AND a.quotation = '0'"; + $ordwhere .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $ordwhere .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + if ($form->{description}) { + $var = $form->like(lc $form->{description}); + $ordwhere .= " AND lower(i.description) LIKE '$var'"; + } + + if ($form->{open} || $form->{closed}) { + unless ($form->{open} && $form->{closed}) { + $ordwhere .= " AND a.closed = '0'" if $form->{open}; + $ordwhere .= " AND a.closed = '1'" if $form->{closed}; + } + } else { + $ordwhere .= " AND a.id = 0"; + } + + $flds = qq|p.id, p.partnumber, i.description, '' AS serialnumber, + i.qty AS onhand, i.unit, p.bin, i.sellprice, + p.listprice, p.lastcost, p.rop, p.weight, + p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, + pg.partsgroup, '' AS invnumber, a.ordnumber, a.quonumber, + i.trans_id, ct.name,e.name AS employee, a.curr, '0' AS till + $makemodelfld|; + + if ($form->{ordered}) { + $query .= qq|$union + SELECT $flds, 'oe' AS module, 'sales_order' AS type, + (SELECT buy FROM exchangerate ex + WHERE ex.curr = a.curr + AND ex.transdate = a.transdate) AS exchangerate, + i.discount + FROM orderitems i + JOIN parts p ON (i.parts_id = p.id) + JOIN oe a ON (i.trans_id = a.id) + JOIN customer ct ON (a.customer_id = ct.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $makemodeljoin + WHERE $ordwhere + AND a.customer_id > 0|; + $union = " + UNION"; + } + + if ($form->{onorder}) { + $flds = qq|p.id, p.partnumber, i.description, '' AS serialnumber, + i.qty AS onhand, i.unit, p.bin, i.sellprice, + p.listprice, p.lastcost, p.rop, p.weight, + p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, + pg.partsgroup, '' AS invnumber, a.ordnumber, a.quonumber, + i.trans_id, ct.name,e.name AS employee, a.curr, '0' AS till + $makemodelfld|; + + $query .= qq|$union + SELECT $flds, 'oe' AS module, 'purchase_order' AS type, + (SELECT sell FROM exchangerate ex + WHERE ex.curr = a.curr + AND ex.transdate = a.transdate) AS exchangerate, + i.discount + FROM orderitems i + JOIN parts p ON (i.parts_id = p.id) + JOIN oe a ON (i.trans_id = a.id) + JOIN vendor ct ON (a.vendor_id = ct.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $makemodeljoin + WHERE $ordwhere + AND a.vendor_id > 0|; + } + + } + + if ($form->{rfq} || $form->{quoted}) { + my $quowhere = "$where + AND a.quotation = '1'"; + $quowhere .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom}; + $quowhere .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto}; + + if ($form->{description}) { + $var = $form->like(lc $form->{description}); + $quowhere .= " AND lower(i.description) LIKE '$var'"; + } + + if ($form->{open} || $form->{closed}) { + unless ($form->{open} && $form->{closed}) { + $ordwhere .= " AND a.closed = '0'" if $form->{open}; + $ordwhere .= " AND a.closed = '1'" if $form->{closed}; + } + } else { + $ordwhere .= " AND a.id = 0"; + } + + + $flds = qq|p.id, p.partnumber, i.description, '' AS serialnumber, + i.qty AS onhand, i.unit, p.bin, i.sellprice, + p.listprice, p.lastcost, p.rop, p.weight, + p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, + pg.partsgroup, '' AS invnumber, a.ordnumber, a.quonumber, + i.trans_id, ct.name, e.name AS employee, a.curr, '0' AS till + $makemodelfld|; + + if ($form->{quoted}) { + $query .= qq|$union + SELECT $flds, 'oe' AS module, 'sales_quotation' AS type, + (SELECT buy FROM exchangerate ex + WHERE ex.curr = a.curr + AND ex.transdate = a.transdate) AS exchangerate, + i.discount + FROM orderitems i + JOIN parts p ON (i.parts_id = p.id) + JOIN oe a ON (i.trans_id = a.id) + JOIN customer ct ON (a.customer_id = ct.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $makemodeljoin + WHERE $quowhere + AND a.customer_id > 0|; + $union = " + UNION"; + } + + if ($form->{rfq}) { + $flds = qq|p.id, p.partnumber, i.description, '' AS serialnumber, + i.qty AS onhand, i.unit, p.bin, i.sellprice, + p.listprice, p.lastcost, p.rop, p.weight, + p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, + pg.partsgroup, '' AS invnumber, a.ordnumber, a.quonumber, + i.trans_id, ct.name, e.name AS employee, a.curr, '0' AS till + $makemodelfld|; + + $query .= qq|$union + SELECT $flds, 'oe' AS module, 'request_quotation' AS type, + (SELECT sell FROM exchangerate ex + WHERE ex.curr = a.curr + AND ex.transdate = a.transdate) AS exchangerate, + i.discount + FROM orderitems i + JOIN parts p ON (i.parts_id = p.id) + JOIN oe a ON (i.trans_id = a.id) + JOIN vendor ct ON (a.vendor_id = ct.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $makemodeljoin + WHERE $quowhere + AND a.vendor_id > 0|; + } + + } + + $query .= qq| + ORDER BY $sortorder|; + + } + + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{parts} }, $ref; + } + $sth->finish; + + my @a = (); + + # include individual items for assembly + if ($form->{searchitems} eq 'assembly' && $form->{bom}) { + + if ($form->{sold} || $form->{ordered} || $form->{quoted}) { + $flds = qq|p.id, p.partnumber, p.description, a.qty AS onhand, p.unit, + p.bin, p.sellprice, p.listprice, p.lastcost, p.rop, + p.weight, p.priceupdate, p.image, p.drawing, p.microfiche, + p.assembly, pg.partsgroup + $makemodelflds $assemblyflds + |; + } else { + # replace p.onhand with a.qty AS onhand + $flds =~ s/p.onhand/a.qty AS onhand/; + } + + while ($item = shift @{ $form->{parts} }) { + push @a, $item; + $flds =~ s/a\.qty.*AS onhand/a\.qty * $item->{onhand} AS onhand/; + push @a, &include_assembly($dbh, $form, $item->{id}, $flds, $makemodeljoin); + push @a, {id => $item->{id}}; + } + + # copy assemblies to $form->{parts} + @{ $form->{parts} } = @a; + + } + + + @a = (); + if ($form->{l_warehouse} || $form->{l_warehouse}) { + + if ($form->{warehouse}) { + ($null, $var) = split /--/, $form->{warehouse}; + $var *= 1; + $query = qq|SELECT SUM(qty) AS onhand, '$null' AS description + FROM inventory + WHERE warehouse_id = $var + AND parts_id = ?|; + } else { + + $query = qq|SELECT SUM(i.qty) AS onhand, w.description AS warehouse + FROM inventory i + JOIN warehouse w ON (w.id = i.warehouse_id) + WHERE i.parts_id = ? + GROUP BY w.description|; + } + + $sth = $dbh->prepare($query) || $form->dberror($query); + + foreach $item (@{ $form->{parts} }) { + + if ($item->{onhand} <= 0 && ! $form->{warehouse}) { + push @a, $item; + next; + } + + $sth->execute($item->{id}) || $form->dberror($query); + + if ($form->{warehouse}) { + + $ref = $sth->fetchrow_hashref(NAME_lc); + if ($ref->{onhand} > 0) { + $item->{onhand} = $ref->{onhand}; + push @a, $item; + } + + } else { + + push @a, $item; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($ref->{onhand} > 0) { + push @a, $ref; + } + } + } + + $sth->finish; + } + + @{ $form->{parts} } = @a; + + } + + $dbh->disconnect; + +} + + +sub include_assembly { + my ($dbh, $form, $id, $flds, $makemodeljoin) = @_; + + $form->{stagger}++; + if ($form->{stagger} > $form->{pncol}) { + $form->{pncol} = $form->{stagger}; + } + + $form->{$id} = 1; + + my @a = (); + my $query = qq|SELECT $flds + FROM parts p + JOIN assembly a ON (a.parts_id = p.id) + LEFT JOIN partsgroup pg ON (pg.id = p.id) + $makemodeljoin + WHERE a.id = $id|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{assemblyitem} = 1; + $ref->{stagger} = $form->{stagger}; + push @a, $ref; + if ($ref->{assembly} && !$form->{$ref->{id}}) { + push @a, &include_assembly($dbh, $form, $ref->{id}, $flds, $makemodeljoin); + if ($form->{stagger} > $form->{pncol}) { + $form->{pncol} = $form->{stagger}; + } + } + } + $sth->finish; + + $form->{$id} = 0; + $form->{stagger}--; + + @a; + +} + + +sub create_links { + my ($self, $module, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $ref; + + my $query = qq|SELECT accno, description, link + FROM chart + WHERE link LIKE '%$module%' + ORDER BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + foreach my $key (split /:/, $ref->{link}) { + if ($key =~ /$module/) { + push @{ $form->{"${module}_links"}{$key} }, { accno => $ref->{accno}, + description => $ref->{description} }; + } + } + } + $sth->finish; + + if ($form->{item} ne 'assembly') { + $query = qq|SELECT count(*) FROM vendor|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my ($count) = $sth->fetchrow_array; + $sth->finish; + + if ($count < $myconfig->{vclimit}) { + $query = qq|SELECT id, name + FROM vendor + ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_vendor} }, $ref; + } + $sth->finish; + } + } + + + # pricegroups, customers + $query = qq|SELECT count(*) FROM customer|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + my ($count) = $sth->fetchrow_array; + $sth->finish; + + if ($count < $myconfig->{vclimit}) { + $query = qq|SELECT id, name + FROM customer + ORDER BY name|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_customer} }, $ref; + } + $sth->finish; + } + + $query = qq|SELECT id, pricegroup + FROM pricegroup + ORDER BY pricegroup|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_pricegroup} }, $ref; + } + $sth->finish; + + + if ($form->{id}) { + $query = qq|SELECT weightunit, curr AS currencies + FROM defaults|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{weightunit}, $form->{currencies}) = $sth->fetchrow_array; + $sth->finish; + + } else { + $query = qq|SELECT weightunit, current_date, curr AS currencies + FROM defaults|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{weightunit}, $form->{priceupdate}, $form->{currencies}) = $sth->fetchrow_array; + $sth->finish; + } + + $dbh->disconnect; + +} + + +sub get_warehouses { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT id, description + FROM warehouse|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_warehouses} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + +1; + diff --git a/sql-ledger/SL/IR.pm b/sql-ledger/SL/IR.pm new file mode 100644 index 000000000..79a619be8 --- /dev/null +++ b/sql-ledger/SL/IR.pm @@ -0,0 +1,1243 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: Jim Rawlings <jim@your-dba.com> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Inventory received module +# +#====================================================================== + +package IR; + + +sub post_invoice { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off autocommit + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $sth; + my $null; + my $project_id; + my $exchangerate = 0; + my $allocated; + my $taxrate; + my $taxamount; + my $taxdiff; + my $item; + + if ($form->{id}) { + + &reverse_invoice($dbh, $form); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO ap (invnumber, employee_id) + VALUES ('$uid', (SELECT id FROM employee + WHERE login = '$form->{login}'))|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM ap + WHERE invnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + + } + + my ($amount, $linetotal, $lastinventoryaccno, $lastexpenseaccno); + my ($netamount, $invoicediff, $expensediff) = (0, 0, 0); + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{exchangerate} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, 'sell'); + } + + $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate}); + + + for my $i (1 .. $form->{rowcount}) { + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + + if ($form->{"qty_$i"} != 0) { + + # project + $project_id = 'NULL'; + if ($form->{"projectnumber_$i"}) { + ($null, $project_id) = split /--/, $form->{"projectnumber_$i"}; + } + + # undo discount formatting + $form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100; + + @taxaccounts = split / /, $form->{"taxaccounts_$i"}; + $taxdiff = 0; + $allocated = 0; + $taxrate = 0; + + # keep entered selling price + my $fxsellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"}); + + my ($dec) = ($fxsellprice =~ /\.(\d+)/); + $dec = length $dec; + my $decimalplaces = ($dec > 2) ? $dec : 2; + + # deduct discount + my $discount = $form->round_amount($fxsellprice * $form->{"discount_$i"}, $decimalplaces); + $form->{"sellprice_$i"} = $fxsellprice - $discount; + + map { $taxrate += $form->{"${_}_rate"} } @taxaccounts; + + if ($form->{"inventory_accno_$i"}) { + + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2); + + if ($form->{taxincluded}) { + $taxamount = $linetotal * ($taxrate / (1 + $taxrate)); + $form->{"sellprice_$i"} = $form->{"sellprice_$i"} * (1 / (1 + $taxrate)); + } else { + $taxamount = $linetotal * $taxrate; + } + + $netamount += $linetotal; + + if (@taxaccounts && $form->round_amount($taxamount, 2) == 0) { + if ($form->{taxincluded}) { + foreach $item (@taxaccounts) { + $taxamount = $form->round_amount($linetotal * $form->{"${item}_rate"} / (1 + abs($form->{"${item}_rate"})), 2); + $taxdiff += $taxamount; + $form->{amount}{$form->{id}}{$item} -= $taxamount; + } + $form->{amount}{$form->{id}}{$taxaccounts[0]} += $taxdiff; + } else { + map { $form->{amount}{$form->{id}}{$_} -= $linetotal * $form->{"${_}_rate"} } @taxaccounts; + } + } else { + map { $form->{amount}{$form->{id}}{$_} -= $taxamount * $form->{"${_}_rate"} / $taxrate } @taxaccounts; + } + + + # add purchase to inventory, this one is without the tax! + $amount = $form->{"sellprice_$i"} * $form->{"qty_$i"} * $form->{exchangerate}; + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2) * $form->{exchangerate}; + $linetotal = $form->round_amount($linetotal, 2); + + # this is the difference for the inventory + $invoicediff += ($amount - $linetotal); + + $form->{amount}{$form->{id}}{$form->{"inventory_accno_$i"}} -= $linetotal; + + # adjust and round sellprice + $form->{"sellprice_$i"} = $form->round_amount($form->{"sellprice_$i"} * $form->{exchangerate}, $decimalplaces); + + + # update parts table + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"qty_$i"}) unless $form->{shipped}; + + + # check if we sold the item already and + # make an entry for the expense and inventory + $query = qq|SELECT i.id, i.qty, i.allocated, i.trans_id, + p.inventory_accno_id, p.expense_accno_id, a.transdate + FROM invoice i, ar a, parts p + WHERE i.parts_id = p.id + AND i.parts_id = $form->{"id_$i"} + AND (i.qty + i.allocated) > 0 + AND i.trans_id = a.id + ORDER BY transdate|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + my $totalqty = $form->{"qty_$i"}; + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + my $qty = $ref->{qty} + $ref->{allocated}; + + if (($qty - $totalqty) > 0) { + $qty = $totalqty; + } + + + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $qty, 2); + + if ($ref->{allocated} < 0) { + # we have an entry for it already, adjust amount + $form->update_balance($dbh, + "acc_trans", + "amount", + qq|trans_id = $ref->{trans_id} AND chart_id = $ref->{inventory_accno_id} AND transdate = '$ref->{transdate}'|, + $linetotal); + + $form->update_balance($dbh, + "acc_trans", + "amount", + qq|trans_id = $ref->{trans_id} AND chart_id = $ref->{expense_accno_id} AND transdate = '$ref->{transdate}'|, + $linetotal * -1); + + } else { + # add entry for inventory, this one is for the sold item + if ($linetotal != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($ref->{trans_id}, $ref->{inventory_accno_id}, + $linetotal, '$ref->{transdate}')|; + $dbh->do($query) || $form->dberror($query); + + # add expense + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($ref->{trans_id}, $ref->{expense_accno_id}, + |. ($linetotal * -1) .qq|, '$ref->{transdate}')|; + $dbh->do($query) || $form->dberror($query); + } + } + + # update allocated for sold item + $form->update_balance($dbh, + "invoice", + "allocated", + qq|id = $ref->{id}|, + $qty * -1); + + $allocated += $qty; + + last if (($totalqty -= $qty) <= 0); + } + + $sth->finish; + + $lastinventoryaccno = $form->{"inventory_accno_$i"}; + + } else { + + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2); + + if ($form->{taxincluded}) { + $taxamount = $linetotal * ($taxrate / (1 + $taxrate)); + + $form->{"sellprice_$i"} = $form->{"sellprice_$i"} * (1 / (1 + $taxrate)); + } else { + $taxamount = $linetotal * $taxrate; + } + + $netamount += $linetotal; + + if (@taxaccounts && $form->round_amount($taxamount, 2) == 0) { + if ($form->{taxincluded}) { + foreach $item (@taxaccounts) { + $taxamount = $form->round_amount($linetotal * $form->{"${item}_rate"} / (1 + abs($form->{"${item}_rate"})), 2); + $totaltax += $taxamount; + $taxdiff += $taxamount; + $form->{amount}{$form->{id}}{$item} -= $taxamount; + } + $form->{amount}{$form->{id}}{$taxaccounts[0]} += $taxdiff; + } else { + map { $form->{amount}{$form->{id}}{$_} -= $linetotal * $form->{"${_}_rate"} } @taxaccounts; + } + } else { + map { $form->{amount}{$form->{id}}{$_} -= $taxamount * $form->{"${_}_rate"} / $taxrate } @taxaccounts; + } + + + $amount = $form->{"sellprice_$i"} * $form->{"qty_$i"} * $form->{exchangerate}; + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2) * $form->{exchangerate}; + $linetotal = $form->round_amount($linetotal, 2); + + # this is the difference for expense + $expensediff += ($amount - $linetotal); + + # add amount to expense + $form->{amount}{$form->{id}}{$form->{"expense_accno_$i"}} -= $linetotal; + + $lastexpenseaccno = $form->{"expense_accno_$i"}; + + # adjust and round sellprice + $form->{"sellprice_$i"} = $form->round_amount($form->{"sellprice_$i"} * $form->{exchangerate}, $decimalplaces); + + } + + + # save detail record in invoice table + $query = qq|INSERT INTO invoice (trans_id, parts_id, description, qty, + sellprice, fxsellprice, discount, allocated, + unit, deliverydate, project_id, serialnumber) + VALUES ($form->{id}, $form->{"id_$i"}, | + .$dbh->quote($form->{"description_$i"}).qq|, | + .($form->{"qty_$i"} * -1) .qq|, + $form->{"sellprice_$i"}, $fxsellprice, + $form->{"discount_$i"}, $allocated, | + .$dbh->quote($form->{"unit_$i"}).qq|, | + .$form->dbquote($form->{"deliverydate_$i"}, SQL_DATE).qq|, + $project_id, | + .$dbh->quote($form->{"serialnumber_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + } + } + + + $form->{datepaid} = $form->{transdate}; + + # all amounts are in natural state, netamount includes the taxes + # if tax is included, netamount is rounded to 2 decimal places, + + # total payments + for my $i (1 .. $form->{paidaccounts}) { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"} if ($form->{"datepaid_$i"}); + } + + my ($tax, $paiddiff) = (0, 0); + + $netamount = $form->round_amount($netamount, 2); + + # figure out rounding errors for amount paid and total amount + if ($form->{taxincluded}) { + + $amount = $form->round_amount($netamount * $form->{exchangerate}, 2); + $paiddiff = $amount - $netamount * $form->{exchangerate}; + $netamount = $amount; + + foreach $item (split / /, $form->{taxaccounts}) { + $amount = $form->{amount}{$form->{id}}{$item} * $form->{exchangerate}; + $form->{amount}{$form->{id}}{$item} = $form->round_amount($amount, 2); + $amount = $form->{amount}{$form->{id}}{$item} * -1; + $tax += $amount; + $netamount -= $amount; + } + + $invoicediff += $paiddiff; + $expensediff += $paiddiff; + + ######## this only applies to tax included + if ($lastinventoryaccno) { + $form->{amount}{$form->{id}}{$lastinventoryaccno} -= $invoicediff; + } + if ($lastexpenseaccno) { + $form->{amount}{$form->{id}}{$lastexpenseaccno} -= $expensediff; + } + + } else { + $amount = $form->round_amount($netamount * $form->{exchangerate}, 2); + $paiddiff = $amount - $netamount * $form->{exchangerate}; + $netamount = $amount; + foreach my $item (split / /, $form->{taxaccounts}) { + $form->{amount}{$form->{id}}{$item} = $form->round_amount($form->{amount}{$form->{id}}{$item}, 2); + $amount = $form->round_amount($form->{amount}{$form->{id}}{$item} * $form->{exchangerate} * -1, 2); + $paiddiff += $amount - $form->{amount}{$form->{id}}{$item} * $form->{exchangerate} * -1; + $form->{amount}{$form->{id}}{$item} = $form->round_amount($amount * -1, 2); + $amount = $form->{amount}{$form->{id}}{$item} * -1; + $tax += $amount; + } + } + + + $form->{amount}{$form->{id}}{$form->{AP}} = $netamount + $tax; + + if ($form->{paid} != 0) { + $form->{paid} = $form->round_amount($form->{paid} * $form->{exchangerate} + $paiddiff, 2); + } + + + # update exchangerate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, 0, $form->{exchangerate}); + } + + # record acc_trans transactions + foreach my $trans_id (keys %{$form->{amount}}) { + foreach my $accno (keys %{ $form->{amount}{$trans_id} }) { + if (($form->{amount}{$trans_id}{$accno} = $form->round_amount($form->{amount}{$trans_id}{$accno}, 2)) != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($trans_id, (SELECT id FROM chart + WHERE accno = '$accno'), + $form->{amount}{$trans_id}{$accno}, + '$form->{transdate}')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + # deduct payment differences from paiddiff + for my $i (1 .. $form->{paidaccounts}) { + if ($form->{"paid_$i"} != 0) { + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate}, 2); + $paiddiff -= $amount - $form->{"paid_$i"} * $form->{exchangerate}; + } + } + + # force AP entry if 0 + $form->{amount}{$form->{id}}{$form->{AP}} = $form->{paid} if ($form->{amount}{$form->{id}}{$form->{AP}} == 0); + + # record payments and offsetting AP + for my $i (1 .. $form->{paidaccounts}) { + + if ($form->{"paid_$i"} != 0) { + my ($accno) = split /--/, $form->{"AP_paid_$i"}; + $form->{"datepaid_$i"} = $form->{transdate} unless ($form->{"datepaid_$i"}); + $form->{datepaid} = $form->{"datepaid_$i"}; + + $amount = ($form->round_amount($form->{"paid_$i"} * $form->{exchangerate} + $paiddiff, 2)) * -1; + + # record AP + + if ($form->{amount}{$form->{id}}{$form->{AP}} != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$form->{AP}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + + # record payment + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source, memo) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$accno'), + $form->{"paid_$i"}, '$form->{"datepaid_$i"}', | + .$dbh->quote($form->{"source_$i"}).qq|, | + .$dbh->quote($form->{"memo_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + + $exchangerate = 0; + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{"datepaid_$i"}, 'sell'); + + $form->{"exchangerate_$i"} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + + # exchangerate difference + $form->{fx}{$accno}{$form->{"datepaid_$i"}} += $form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1) + $paiddiff; + + + # gain/loss + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate},2) - $form->round_amount($form->{"paid_$i"} * $form->{"exchangerate_$i"},2); + if ($amount > 0) { + $form->{fx}{$form->{fxgain_accno}}{$form->{"datepaid_$i"}} += $amount; + } else { + $form->{fx}{$form->{fxloss_accno}}{$form->{"datepaid_$i"}} += $amount; + } + + $paiddiff = 0; + + # update exchange rate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{"datepaid_$i"}, 0, $form->{"exchangerate_$i"}); + } + } + } + + # record exchange rate differences and gains/losses + foreach my $accno (keys %{$form->{fx}}) { + foreach my $transdate (keys %{ $form->{fx}{$accno} }) { + if (($form->{fx}{$accno}{$transdate} = $form->round_amount($form->{fx}{$accno}{$transdate}, 2)) != 0) { + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, cleared, fx_transaction) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$accno'), + $form->{fx}{$accno}{$transdate}, '$transdate', '0', '1')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + + $amount = $netamount + $tax; + + # set values which could be empty + $form->{taxincluded} *= 1; + + ($null, $form->{department_id}) = split(/--/, $form->{department}); + $form->{department_id} *= 1; + + # save AP record + $query = qq|UPDATE ap set + invnumber = |.$dbh->quote($form->{invnumber}).qq|, + ordnumber = |.$dbh->quote($form->{ordnumber}).qq|, + quonumber = |.$dbh->quote($form->{quonumber}).qq|, + transdate = '$form->{transdate}', + vendor_id = $form->{vendor_id}, + amount = $amount, + netamount = $netamount, + paid = $form->{paid}, + datepaid = |.$form->dbquote($form->{datepaid}, SQL_DATE).qq|, + duedate = |.$form->dbquote($form->{duedate}, SQL_DATE).qq|, + invoice = '1', + taxincluded = '$form->{taxincluded}', + notes = |.$dbh->quote($form->{notes}).qq|, + intnotes = |.$dbh->quote($form->{intnotes}).qq|, + curr = '$form->{currency}', + department_id = $form->{department_id}, + language_code = '$form->{language_code}' + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # add shipto + $form->{name} = $form->{vendor}; + $form->{name} =~ s/--$form->{vendor_id}//; + $form->add_shipto($dbh, $form->{id}); + + my %audittrail = ( tablename => 'ap', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'posted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $rc = $dbh->commit; + $dbh->disconnect; + $rc; + +} + + + +sub reverse_invoice { + my ($dbh, $form) = @_; + + # reverse inventory items + my $query = qq|SELECT i.parts_id, p.inventory_accno_id, p.expense_accno_id, + i.qty, i.allocated, i.sellprice + FROM invoice i, parts p + WHERE i.parts_id = p.id + AND i.trans_id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $netamount = 0; + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $netamount += $form->round_amount($ref->{sellprice} * $ref->{qty} * -1, 2); + + if ($ref->{inventory_accno_id}) { + # update onhand + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $ref->{parts_id}|, + $ref->{qty}); + + # if $ref->{allocated} > 0 than we sold that many items + if ($ref->{allocated} > 0) { + + # get references for sold items + $query = qq|SELECT i.id, i.trans_id, i.allocated, a.transdate + FROM invoice i, ar a + WHERE i.parts_id = $ref->{parts_id} + AND i.allocated < 0 + AND i.trans_id = a.id + ORDER BY transdate DESC|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $pthref = $sth->fetchrow_hashref(NAME_lc)) { + my $qty = $ref->{allocated}; + + if (($ref->{allocated} + $pthref->{allocated}) > 0) { + $qty = $pthref->{allocated} * -1; + } + + my $amount = $form->round_amount($ref->{sellprice} * $qty, 2); + + #adjust allocated + $form->update_balance($dbh, + "invoice", + "allocated", + qq|id = $pthref->{id}|, + $qty); + + $form->update_balance($dbh, + "acc_trans", + "amount", + qq|trans_id = $pthref->{trans_id} AND chart_id = $ref->{expense_accno_id} AND transdate = '$pthref->{transdate}'|, + $amount); + + $form->update_balance($dbh, + "acc_trans", + "amount", + qq|trans_id = $pthref->{trans_id} AND chart_id = $ref->{inventory_accno_id} AND transdate = '$pthref->{transdate}'|, + $amount * -1); + + $query = qq|DELETE FROM acc_trans + WHERE trans_id = $pthref->{trans_id} + AND amount = 0|; + $dbh->do($query) || $form->dberror($query); + + last if (($ref->{allocated} -= $qty) <= 0); + } + $sth->finish; + } + } + } + $sth->finish; + + # delete acc_trans + $query = qq|DELETE FROM acc_trans + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete invoice entries + $query = qq|DELETE FROM invoice + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM shipto + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + +} + + + +sub delete_invoice { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my %audittrail = ( tablename => 'ap', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + &reverse_invoice($dbh, $form); + + # delete AP record + my $query = qq|DELETE FROM ap + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub retrieve_invoice { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + + if ($form->{id}) { + # get default accounts and last invoice number + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE d.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE d.income_accno_id = c.id) AS income_accno, + (SELECT c.accno FROM chart c + WHERE d.expense_accno_id = c.id) AS expense_accno, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + d.curr AS currencies + FROM defaults d|; + } else { + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE d.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE d.income_accno_id = c.id) AS income_accno, + (SELECT c.accno FROM chart c + WHERE d.expense_accno_id = c.id) AS expense_accno, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + d.curr AS currencies, + current_date AS transdate + FROM defaults d|; + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + + if ($form->{id}) { + + # retrieve invoice + $query = qq|SELECT a.invnumber, a.transdate, a.duedate, + a.ordnumber, a.quonumber, a.paid, a.taxincluded, a.notes, + a.intnotes, a.curr AS currency, a.vendor_id, a.language_code + FROM ap a + WHERE id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # get shipto + $query = qq|SELECT * FROM shipto + WHERE trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # retrieve individual items + $query = qq|SELECT c1.accno AS inventory_accno, + c2.accno AS income_accno, + c3.accno AS expense_accno, + p.partnumber, i.description, i.qty, i.fxsellprice, i.sellprice, + i.parts_id AS id, i.unit, p.bin, i.deliverydate, + pr.projectnumber, + i.project_id, i.serialnumber, i.discount, + pg.partsgroup, p.partsgroup_id, p.partnumber AS sku, + t.description AS partsgrouptranslation + FROM invoice i + JOIN parts p ON (i.parts_id = p.id) + LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) + LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) + LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN project pr ON (i.project_id = pr.id) + LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) + LEFT JOIN translation t ON (t.trans_id = p.partsgroup_id AND t.language_code = '$form->{language_code}') + WHERE i.trans_id = $form->{id} + ORDER BY i.id|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + # exchangerate defaults + &exchangerate_defaults($dbh, $form); + + # price matrix and vendor partnumber + $query = qq|SELECT partnumber + FROM partsvendor + WHERE parts_id = ? + AND vendor_id = $form->{vendor_id}|; + my $pmh = $dbh->prepare($query) || $form->dberror($query); + + # tax rates for part + $query = qq|SELECT c.accno + FROM chart c + JOIN partstax pt ON (pt.chart_id = c.id) + WHERE pt.parts_id = ?|; + my $tth = $dbh->prepare($query); + + my $ptref; + my $taxrate; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + ($decimalplaces) = ($ref->{fxsellprice} =~ /\.(\d+)/); + $decimalplaces = length $decimalplaces; + $decimalplaces = 2 unless $decimalplaces; + + $tth->execute($ref->{id}); + $ref->{taxaccounts} = ""; + $taxrate = 0; + + while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + $taxrate += $form->{"$ptref->{accno}_rate"}; + } + + $tth->finish; + chop $ref->{taxaccounts}; + + # price matrix + $ref->{sellprice} = $form->round_amount($ref->{fxsellprice} * $form->{$form->{currency}}, 2); + &price_matrix($pmh, $ref, $decimalplaces, $form); + + $ref->{sellprice} = $ref->{fxsellprice}; + $ref->{qty} *= -1; + + $ref->{partsgroup} = $ref->{partsgrouptranslation} if $ref->{partsgrouptranslation}; + + push @{ $form->{invoice_details} }, $ref; + + } + + $sth->finish; + + } + + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub get_vendor { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $dateformat = $myconfig->{dateformat}; + if ($myconfig->{dateformat} !~ /^y/) { + my @a = split /\W/, $form->{transdate}; + $dateformat .= "yy" if (length $a[2] > 2); + } + + if ($form->{transdate} !~ /\W/) { + $dateformat = 'yyyymmdd'; + } + + my $duedate; + + if ($myconfig->{dbdriver} eq 'DB2') { + $duedate = ($form->{transdate}) ? "date('$form->{transdate}') + v.terms DAYS" : "current_date + v.terms DAYS"; + } else { + $duedate = ($form->{transdate}) ? "to_date('$form->{transdate}', '$dateformat') + v.terms" : "current_date + v.terms"; + } + + $form->{vendor_id} *= 1; + # get vendor + my $query = qq|SELECT v.name AS vendor, v.creditlimit, v.terms, + v.email, v.cc, v.bcc, v.taxincluded, + v.address1, v.address2, v.city, v.state, + v.zipcode, v.country, v.curr AS currency, v.language_code, + $duedate AS duedate, v.notes AS intnotes, + e.name AS employee, e.id AS employee_id + FROM vendor v + LEFT JOIN employee e ON (e.id = v.employee_id) + WHERE v.id = $form->{vendor_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + if ($form->{id}) { + map { delete $ref->{$_} } qw(currency taxincluded employee employee_id intnotes); + } + + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # if no currency use defaultcurrency + $form->{currency} = ($form->{currency}) ? $form->{currency} : $form->{defaultcurrency}; + + $form->{exchangerate} = 0 if $form->{currency} eq $form->{defaultcurrency}; + if ($form->{transdate} && ($form->{currency} ne $form->{defaultcurrency})) { + $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{transdate}, "sell"); + } + $form->{forex} = $form->{exchangerate}; + + # if no employee, default to login + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh) unless $form->{employee_id}; + + $form->{creditremaining} = $form->{creditlimit}; + $query = qq|SELECT SUM(amount - paid) + FROM ap + WHERE vendor_id = $form->{vendor_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{creditremaining}) -= $sth->fetchrow_array; + + $sth->finish; + + $query = qq|SELECT o.amount, + (SELECT e.sell FROM exchangerate e + WHERE e.curr = o.curr + AND e.transdate = o.transdate) + FROM oe o + WHERE o.vendor_id = $form->{vendor_id} + AND o.quotation = '0' + AND o.closed = '0'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($amount, $exch) = $sth->fetchrow_array) { + $exch = 1 unless $exch; + $form->{creditremaining} -= $amount * $exch; + } + $sth->finish; + + + # get shipto if we do not convert an order or invoice + if (!$form->{shipto}) { + map { delete $form->{$_} } qw(shiptoname shiptoaddress1 shiptoaddress2 shiptocity shiptostate shiptozipcode shiptocountry shiptocontact shiptophone shiptofax shiptoemail); + + $query = qq|SELECT * FROM shipto + WHERE trans_id = $form->{vendor_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + } + + # get taxes for vendor + $query = qq|SELECT c.accno + FROM chart c + JOIN vendortax v ON (v.chart_id = c.id) + WHERE v.vendor_id = $form->{vendor_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $vendortax = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $vendortax{$ref->{accno}} = 1; + } + $sth->finish; + + + # get tax rates and description + $query = qq|SELECT c.accno, c.description, c.link, t.rate, t.taxnumber + FROM chart c + JOIN tax t ON (c.id = t.chart_id) + WHERE c.link LIKE '%CT_tax%' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{taxaccounts} = ""; + $form->{taxpart} = ""; + $form->{taxservice} = ""; + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($vendortax{$ref->{accno}}) { + $form->{"$ref->{accno}_rate"} = $ref->{rate}; + $form->{"$ref->{accno}_description"} = $ref->{description}; + $form->{"$ref->{accno}_taxnumber"} = $ref->{taxnumber}; + $form->{taxaccounts} .= "$ref->{accno} "; + } + + foreach my $item (split /:/, $ref->{link}) { + if ($item =~ /IC_taxpart/) { + $form->{taxpart} .= "$ref->{accno} "; + } + + if ($item =~ /IC_taxservice/) { + $form->{taxservice} .= "$ref->{accno} "; + } + } + } + $sth->finish; + chop $form->{taxaccounts}; + chop $form->{taxpart}; + chop $form->{taxservice}; + + + if (!$form->{id} && $form->{type} !~ /_(order|quotation)/) { + # setup last accounts used + $query = qq|SELECT c.accno, c.description, c.link, c.category, + ac.project_id, p.projectnumber, a.department_id, + d.description AS department + FROM chart c + JOIN acc_trans ac ON (ac.chart_id = c.id) + JOIN ap a ON (a.id = ac.trans_id) + LEFT JOIN project p ON (ac.project_id = p.id) + LEFT JOIN department d ON (a.department_id = d.id) + WHERE a.vendor_id = $form->{vendor_id} + AND a.id IN (SELECT max(id) FROM ap + WHERE vendor_id = $form->{vendor_id})|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $i = 0; + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{department} = $ref->{department}; + $form->{department_id} = $ref->{department_id}; + + if ($ref->{link} =~ /_amount/) { + $i++; + $form->{"AP_amount_$i"} = "$ref->{accno}--$ref->{description}"; + $form->{"projectnumber_$i"} = "$ref->{projectnumber}--$ref->{project_id}"; + } + if ($ref->{category} eq 'L') { + $form->{AP} = $form->{AP_1} = "$ref->{accno}--$ref->{description}"; + } + } + $sth->finish; + $form->{rowcount} = $i if ($i && !$form->{type}); + } + + $dbh->disconnect; + +} + + +sub retrieve_item { + my ($self, $myconfig, $form) = @_; + + my $i = $form->{rowcount}; + my $null; + my $var; + + # don't include assemblies or obsolete parts + my $where = "WHERE p.assembly = '0' AND p.obsolete = '0'"; + + if ($form->{"partnumber_$i"}) { + $var = $form->like(lc $form->{"partnumber_$i"}); + $where .= " AND lower(p.partnumber) LIKE '$var'"; + } + + if ($form->{"description_$i"}) { + $var = $form->like(lc $form->{"description_$i"}); + if ($form->{language_code}) { + $where .= " AND lower(t1.description) LIKE '$var'"; + } else { + $where .= " AND lower(p.description) LIKE '$var'"; + } + } + + if ($form->{"partsgroup_$i"}) { + ($null, $var) = split /--/, $form->{"partsgroup_$i"}; + $where .= qq| AND p.partsgroup_id = $var|; + } + + if ($form->{"description_$i"}) { + $where .= " ORDER BY 3"; + } else { + $where .= " ORDER BY 2"; + } + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT p.id, p.partnumber, p.description, + c1.accno AS inventory_accno, + c2.accno AS income_accno, + c3.accno AS expense_accno, + pg.partsgroup, p.partsgroup_id, + p.lastcost AS sellprice, p.unit, p.bin, p.onhand, + p.partnumber AS sku, p.weight, + t1.description AS translation, + t2.description AS grouptranslation + FROM parts p + LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) + LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) + LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) + LEFT JOIN translation t1 ON (t1.trans_id = p.id AND t1.language_code = '$form->{language_code}') + LEFT JOIN translation t2 ON (t2.trans_id = p.partsgroup_id AND t2.language_code = '$form->{language_code}') + $where|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + # foreign currency + &exchangerate_defaults($dbh, $form); + + # taxes + $query = qq|SELECT c.accno + FROM chart c + JOIN partstax pt ON (pt.chart_id = c.id) + WHERE pt.parts_id = ?|; + my $tth = $dbh->prepare($query) || $form->dberror($query); + + # price matrix + $query = qq|SELECT p.* + FROM partsvendor p + WHERE p.parts_id = ? + AND vendor_id = $form->{vendor_id}|; + my $pmh = $dbh->prepare($query) || $form->dberror($query); + + my $ref; + my $ptref; + my $decimalplaces; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + ($decimalplaces) = ($ref->{sellprice} =~ /\.(\d+)/); + $decimalplaces = length $decimalplaces; + $decimalplaces = 2 unless $decimalplaces; + + # get taxes for part + $tth->execute($ref->{id}); + + $ref->{taxaccounts} = ""; + while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + } + $tth->finish; + chop $ref->{taxaccounts}; + + # get vendor price and partnumber + &price_matrix($pmh, $ref, $decimalplaces, $form, $myconfig); + + $ref->{description} = $ref->{translation} if $ref->{translation}; + $ref->{partsgroup} = $ref->{grouptranslation} if $ref->{grouptranslation}; + + push @{ $form->{item_list} }, $ref; + + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub exchangerate_defaults { + my ($dbh, $form) = @_; + + my $var; + + # get default currencies + my $query = qq|SELECT substr(curr,1,3), curr FROM defaults|; + my $eth = $dbh->prepare($query) || $form->dberror($query); + $eth->execute; + ($form->{defaultcurrency}, $form->{currencies}) = $eth->fetchrow_array; + $eth->finish; + + $query = qq|SELECT sell + FROM exchangerate + WHERE curr = ? + AND transdate = ?|; + my $eth1 = $dbh->prepare($query) || $form->dberror($query); + + $query = qq~SELECT max(transdate || ' ' || sell || ' ' || curr) + FROM exchangerate + WHERE curr = ?~; + my $eth2 = $dbh->prepare($query) || $form->dberror($query); + + # get exchange rates for transdate or max + foreach $var (split /:/, substr($form->{currencies},4)) { + $eth1->execute($var, $form->{transdate}); + ($form->{$var}) = $eth1->fetchrow_array; + if (! $form->{$var} ) { + $eth2->execute($var); + + ($form->{$var}) = $eth2->fetchrow_array; + ($null, $form->{$var}) = split / /, $form->{$var}; + $form->{$var} = 1 unless $form->{$var}; + $eth2->finish; + } + $eth1->finish; + } + + $form->{$form->{defaultcurrency}} = 1; + +} + + +sub price_matrix { + my ($pmh, $ref, $decimalplaces, $form, $myconfig) = @_; + + $pmh->execute($ref->{id}); + my $mref = $pmh->fetchrow_hashref(NAME_lc); + + if ($mref->{partnumber}) { + $ref->{partnumber} = $mref->{partnumber}; + } + + if ($mref->{lastcost}) { + # do a conversion + $ref->{sellprice} = $form->round_amount($mref->{lastcost} * $form->{$mref->{curr}}, $decimalplaces); + } + $pmh->finish; + + $ref->{sellprice} *= 1; + + # add 0:price to matrix + $ref->{pricematrix} = "0:$ref->{sellprice}"; + +} + + +sub vendor_details { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # get rest for the vendor + my $query = qq|SELECT vendornumber, name, address1, address2, city, state, + zipcode, country, + contact, phone as vendorphone, fax as vendorfax, vendornumber, + taxnumber, sic_code AS sic, iban, bic + FROM vendor + WHERE id = $form->{vendor_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + $dbh->disconnect; + +} + + +sub item_links { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description, link + FROM chart + WHERE link LIKE '%IC%' + ORDER BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + foreach my $key (split(/:/, $ref->{link})) { + if ($key =~ /IC/) { + push @{ $form->{IC_links}{$key} }, { accno => $ref->{accno}, + description => $ref->{description} }; + } + } + } + + $sth->finish; +} + +1; + diff --git a/sql-ledger/SL/IS.pm b/sql-ledger/SL/IS.pm new file mode 100644 index 000000000..788dd9568 --- /dev/null +++ b/sql-ledger/SL/IS.pm @@ -0,0 +1,1632 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: Jim Rawlings <jim@your-dba.com> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Inventory invoicing module +# +#====================================================================== + +package IS; + + +sub invoice_details { + my ($self, $myconfig, $form) = @_; + + $form->{duedate} = $form->{transdate} unless ($form->{duedate}); + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT date '$form->{duedate}' - date '$form->{transdate}' + AS terms + FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{terms}) = $sth->fetchrow_array; + $sth->finish; + + # this is for the template + $form->{invdate} = $form->{transdate}; + + my $tax = 0; + my $item; + my $i; + my @sortlist = (); + my $projectnumber; + my $projectnumber_id; + my $translation; + my $partsgroup; + + my %oid = ( 'Pg' => 'oid', + 'PgPP' => 'oid', + 'Oracle' => 'rowid', + 'DB2' => '1=1' + ); + + # sort items by partsgroup + for $i (1 .. $form->{rowcount}) { + $projectnumber = ""; + $partsgroup = ""; + $projectnumber_id = 0; + if ($form->{"projectnumber_$i"} && $form->{groupprojectnumber}) { + ($projectnumber, $projectnumber_id) = split /--/, $form->{"projectnumber_$i"}; + } + if ($form->{"partsgroup_$i"} && $form->{grouppartsgroup}) { + ($partsgroup) = split /--/, $form->{"partsgroup_$i"}; + } + push @sortlist, [ $i, "$projectnumber$partsgroup", $projectnumber, $projectnumber_id, $partsgroup ]; + + + # sort the whole thing by project and group + @sortlist = sort { $a->[1] cmp $b->[1] } @sortlist; + + } + + my @taxaccounts; + my %taxaccounts; + my $taxrate; + my $taxamount; + my $taxbase; + my $taxdiff; + + $query = qq|SELECT p.description, t.description + FROM project p + LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code = '$form->{language_code}') + WHERE id = ?|; + my $prh = $dbh->prepare($query) || $form->dberror($query); + + my $runningnumber = 1; + my $sameitem = ""; + my $subtotal; + my $k = scalar @sortlist; + my $j = 0; + + foreach $item (@sortlist) { + $i = $item->[0]; + $j++; + + if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { + if ($item->[1] ne $sameitem) { + + $projectnumber = ""; + if ($form->{groupprojectnumber} && $item->[2]) { + # get project description + $prh->execute($item->[3]) || $form->dberror($query); + + ($projectnumber, $translation) = $prh->fetchrow_array; + $prh->finish; + + $projectnumber = ($translation) ? "$item->[2], $translation" : "$item->[2], $projectnumber"; + } + + if ($form->{grouppartsgroup} && $item->[4]) { + $projectnumber .= " / " if $projectnumber; + $projectnumber .= $item->[4]; + } + + $form->{projectnumber} = $projectnumber; + $form->format_string(projectnumber); + + push(@{ $form->{description} }, qq|$form->{projectnumber}|); + $sameitem = $item->[1]; + + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku serialnumber bin qty unit deliverydate projectnumber sellprice listprice netprice discount discountrate linetotal weight); + } + } + + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + + if ($form->{"qty_$i"} != 0) { + + $form->{totalqty} += $form->{"qty_$i"}; + $form->{totalship} += $form->{"ship_$i"}; + $form->{totalweight} += ($form->{"qty_$i"} * $form->{"weight_$i"}); + + # add number, description and qty to $form->{number}, .... + push(@{ $form->{runningnumber} }, $runningnumber++); + push(@{ $form->{number} }, qq|$form->{"partnumber_$i"}|); + push(@{ $form->{sku} }, qq|$form->{"sku_$i"}|); + push(@{ $form->{serialnumber} }, qq|$form->{"serialnumber_$i"}|); + push(@{ $form->{bin} }, qq|$form->{"bin_$i"}|); + push(@{ $form->{description} }, qq|$form->{"description_$i"}|); + push(@{ $form->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"})); + push(@{ $form->{unit} }, qq|$form->{"unit_$i"}|); + push(@{ $form->{deliverydate} }, qq|$form->{"deliverydate_$i"}|); + push(@{ $form->{projectnumber} }, qq|$form->{"projectnumber_$i"}|); + + push(@{ $form->{sellprice} }, $form->{"sellprice_$i"}); + + # listprice + push(@{ $form->{listprice} }, $form->{"listprice_$i"}); + + push(@{ $form->{weight} }, $form->{"weight_$i"}); + + my $sellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"}); + my ($dec) = ($sellprice =~ /\.(\d+)/); + $dec = length $dec; + my $decimalplaces = ($dec > 2) ? $dec : 2; + + my $discount = $form->round_amount($sellprice * $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100, $decimalplaces); + + # keep a netprice as well, (sellprice - discount) + $form->{"netprice_$i"} = $sellprice - $discount; + push(@{ $form->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : " "); + + + my $linetotal = $form->round_amount($form->{"qty_$i"} * $form->{"netprice_$i"}, 2); + + $discount = ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, $decimalplaces) : " "; + $linetotal = ($linetotal != 0) ? $linetotal : " "; + + push(@{ $form->{discount} }, $discount); + push(@{ $form->{discountrate} }, $form->format_amount($myconfig, $form->{"discount_$i"})); + + $form->{total} += $linetotal; + + # this is for the subtotals for grouping + $subtotal += $linetotal; + + push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2)); + + @taxaccounts = split / /, $form->{"taxaccounts_$i"}; + $taxrate = 0; + $taxdiff = 0; + + map { $taxrate += $form->{"${_}_rate"} } @taxaccounts; + + if ($form->{taxincluded}) { + # calculate tax + $taxamount = $linetotal * $taxrate / (1 + $taxrate); + $taxbase = $linetotal - $taxamount; + } else { + $taxamount = $linetotal * $taxrate; + $taxbase = $linetotal; + } + + if (@taxaccounts && $form->round_amount($taxamount, 2) == 0) { + if ($form->{taxincluded}) { + foreach $item (@taxaccounts) { + $taxamount = $form->round_amount($linetotal * $form->{"${item}_rate"} / (1 + abs($form->{"${item}_rate"})), 2); + + $taxaccounts{$item} += $taxamount; + $taxdiff += $taxamount; + + $taxbase{$item} += $taxbase; + } + $taxaccounts{$taxaccounts[0]} += $taxdiff; + } else { + foreach $item (@taxaccounts) { + $taxaccounts{$item} += $linetotal * $form->{"${item}_rate"}; + $taxbase{$item} += $taxbase; + } + } + } else { + foreach $item (@taxaccounts) { + $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate; + $taxbase{$item} += $taxbase; + } + } + + + if ($form->{"assembly_$i"}) { + my $sm = ""; + + # get parts and push them onto the stack + my $sortorder = ""; + if ($form->{groupitems}) { + $sortorder = qq|ORDER BY pg.partsgroup, a.$oid{$myconfig->{dbdriver}}|; + } else { + $sortorder = qq|ORDER BY a.$oid{$myconfig->{dbdriver}}|; + } + + $query = qq|SELECT p.partnumber, p.description, p.unit, a.qty, + pg.partsgroup, p.partnumber AS sku + FROM assembly a + JOIN parts p ON (a.parts_id = p.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE a.bom = '1' + AND a.id = '$form->{"id_$i"}' + $sortorder|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($form->{grouppartsgroup} && $ref->{partsgroup} ne $sameitem) { + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku serialnumber unit qty bin deliverydate projectnumber sellprice listprice netprice discount discountrate linetotal weight); + $sm = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--"; + push(@{ $form->{description} }, $sm); + } + + map { $form->{"a_$_"} = $ref->{$_} } qw(partnumber description); + $form->format_string("a_partnumber", "a_description"); + + push(@{ $form->{description} }, $form->format_amount($myconfig, $ref->{qty} * $form->{"qty_$i"}) . qq| -- $form->{"a_partnumber"}, $form->{"a_description"}|); + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku serialnumber unit qty bin deliverydate projectnumber sellprice listprice netprice discount discountrate linetotal weight); + + } + $sth->finish; + } + } + + # add subtotal + if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { + if ($subtotal) { + if ($j < $k) { + # look at next item + if ($sortlist[$j]->[1] ne $sameitem) { + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku serialnumber bin qty unit deliverydate projectnumber sellprice listprice netprice discount discountrate weight); + push(@{ $form->{description} }, $form->{groupsubtotaldescription}); + if (exists $form->{groupsubtotaldescription}) { + push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $subtotal, 2)); + } else { + push(@{ $form->{linetotal} }, ""); + } + $subtotal = 0; + } + } else { + + # got last item + if (exists $form->{groupsubtotaldescription}) { + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku serialnumber bin qty unit deliverydate projectnumber sellprice listprice netprice discount discountrate weight); + push(@{ $form->{description} }, $form->{groupsubtotaldescription}); + push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $subtotal, 2)); + } + } + } + } + + } + + + foreach my $item (sort keys %taxaccounts) { + if ($form->round_amount($taxaccounts{$item}, 2) != 0) { + push(@{ $form->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2)); + + $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2); + + push(@{ $form->{tax} }, $form->format_amount($myconfig, $taxamount)); + push(@{ $form->{taxdescription} }, $form->{"${item}_description"}); + push(@{ $form->{taxrate} }, $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); + push(@{ $form->{taxnumber} }, $form->{"${item}_taxnumber"}); + } + } + + + for my $i (1 .. $form->{paidaccounts}) { + if ($form->{"paid_$i"}) { + push(@{ $form->{payment} }, $form->{"paid_$i"}); + my ($accno, $description) = split /--/, $form->{"AR_paid_$i"}; + push(@{ $form->{paymentaccount} }, $description); + push(@{ $form->{paymentdate} }, $form->{"datepaid_$i"}); + push(@{ $form->{paymentsource} }, $form->{"source_$i"}); + push(@{ $form->{paymentmemo} }, $form->{"memo_$i"}); + + $form->{paid} += $form->parse_amount($myconfig, $form->{"paid_$i"}); + } + } + + map { $form->{$_} = $form->format_amount($myconfig, $form->{$_}) } qw(totalqty totalship totalweight); + $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2); + $form->{invtotal} = ($form->{taxincluded}) ? $form->{total} : $form->{total} + $tax; + + use SL::CP; + my $c; + if ($form->{language_code}) { + $c = new CP $form->{language_code}; + } else { + $c = new CP $myconfig->{countrycode}; + } + $c->init; + my $whole; + ($whole, $form->{decimal}) = split /\./, $form->{invtotal}; + $form->{decimal} .= "00"; + $form->{decimal} = substr($form->{decimal}, 0, 2); + $form->{text_amount} = $c->num2text($whole); + + $form->{total} = $form->format_amount($myconfig, $form->{invtotal} - $form->{paid}, 2); + $form->{invtotal} = $form->format_amount($myconfig, $form->{invtotal}, 2); + + $form->{paid} = $form->format_amount($myconfig, $form->{paid}, 2); + + $dbh->disconnect; + +} + + +sub project_description { + my ($self, $dbh, $id) = @_; + + my $query = qq|SELECT description + FROM project + WHERE id = $id|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($_) = $sth->fetchrow_array; + + $sth->finish; + + $_; + +} + + +sub customer_details { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # get rest for the customer + my $query = qq|SELECT customernumber, name, address1, address2, city, + state, zipcode, country, + phone as customerphone, fax as customerfax, contact, + taxnumber, sic_code AS sic, iban, bic + FROM customer + WHERE id = $form->{customer_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + $dbh->disconnect; + +} + + +sub post_invoice { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off autocommit + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $sth; + my $null; + my $project_id; + my $exchangerate = 0; + + ($null, $form->{employee_id}) = split /--/, $form->{employee}; + unless ($form->{employee_id}) { + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + } + + ($null, $form->{department_id}) = split(/--/, $form->{department}); + $form->{department_id} *= 1; + + if ($form->{id}) { + + &reverse_invoice($dbh, $form); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO ar (invnumber, employee_id) + VALUES ('$uid', $form->{employee_id})|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM ar + WHERE invnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + } + + my ($netamount, $invoicediff) = (0, 0); + my ($amount, $linetotal, $lastincomeaccno); + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{exchangerate} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, 'buy'); + } + + $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate}); + + + foreach my $i (1 .. $form->{rowcount}) { + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + + if ($form->{"qty_$i"} != 0) { + + # project + $project_id = 'NULL'; + if ($form->{"projectnumber_$i"}) { + ($null, $project_id) = split /--/, $form->{"projectnumber_$i"}; + } + + # undo discount formatting + $form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100; + + my ($allocated, $taxrate) = (0, 0); + my $taxamount; + + # keep entered selling price + my $fxsellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"}); + + my ($dec) = ($fxsellprice =~ /\.(\d+)/); + $dec = length $dec; + my $decimalplaces = ($dec > 2) ? $dec : 2; + + # deduct discount + my $discount = $form->round_amount($fxsellprice * $form->{"discount_$i"}, $decimalplaces); + $form->{"sellprice_$i"} = $fxsellprice - $discount; + + # add tax rates + map { $taxrate += $form->{"${_}_rate"} } split / /, $form->{"taxaccounts_$i"}; + + # round linetotal to 2 decimal places + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2); + + if ($form->{taxincluded}) { + $taxamount = $linetotal * ($taxrate / (1 + $taxrate)); + $form->{"sellprice_$i"} = $form->{"sellprice_$i"} * (1 / (1 + $taxrate)); + } else { + $taxamount = $linetotal * $taxrate; + } + + $netamount += $linetotal; + + if ($form->round_amount($taxamount, 2) != 0) { + map { $form->{amount}{$form->{id}}{$_} += $taxamount * $form->{"${_}_rate"} / $taxrate } split / /, $form->{"taxaccounts_$i"}; + } + + + # add amount to income, $form->{amount}{trans_id}{accno} + $amount = $form->{"sellprice_$i"} * $form->{"qty_$i"} * $form->{exchangerate}; + + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2) * $form->{exchangerate}; + $linetotal = $form->round_amount($linetotal, 2); + + # this is the difference from the inventory + $invoicediff += ($amount - $linetotal); + + $form->{amount}{$form->{id}}{$form->{"income_accno_$i"}} += $linetotal; + + $lastincomeaccno = $form->{"income_accno_$i"}; + + # adjust and round sellprice + $form->{"sellprice_$i"} = $form->round_amount($form->{"sellprice_$i"} * $form->{exchangerate}, $decimalplaces); + + if ($form->{"inventory_accno_$i"} || $form->{"assembly_$i"}) { + # adjust parts onhand quantity + + if ($form->{"assembly_$i"}) { + # do not update if assembly consists of all services + $query = qq|SELECT sum(p.inventory_accno_id) + FROM parts p + JOIN assembly a ON (a.parts_id = p.id) + WHERE a.id = $form->{"id_$i"}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + if ($sth->fetchrow_array) { + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"qty_$i"} * -1) unless $form->{shipped}; + } + $sth->finish; + + # record assembly item as allocated + &process_assembly($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"}); + } else { + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"qty_$i"} * -1) unless $form->{shipped}; + + $allocated = &cogs($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"}); + } + } + + + # save detail record in invoice table + $query = qq|INSERT INTO invoice (trans_id, parts_id, description, qty, + sellprice, fxsellprice, discount, allocated, assemblyitem, + unit, deliverydate, project_id, serialnumber) + VALUES ($form->{id}, $form->{"id_$i"}, | + .$dbh->quote($form->{"description_$i"}).qq|, + $form->{"qty_$i"}, $form->{"sellprice_$i"}, $fxsellprice, + $form->{"discount_$i"}, $allocated, 'f', | + .$dbh->quote($form->{"unit_$i"}).qq|, | + .$form->dbquote($form->{"deliverydate_$i"}, SQL_DATE).qq|, + $project_id, | + .$dbh->quote($form->{"serialnumber_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + } + } + + + $form->{datepaid} = $form->{transdate}; + + # total payments, don't move we need it here + $form->{paid} = 0; + for my $i (1 .. $form->{paidaccounts}) { + $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"}); + $form->{paid} += $form->{"paid_$i"}; + $form->{datepaid} = $form->{"datepaid_$i"} if ($form->{"datepaid_$i"}); + } + + my ($tax, $diff) = (0, 0); + + $netamount = $form->round_amount($netamount, 2); + + # figure out rounding errors for total amount vs netamount + taxes + if ($form->{taxincluded}) { + + $amount = $form->round_amount($netamount * $form->{exchangerate}, 2); + $diff += $amount - $netamount * $form->{exchangerate}; + $netamount = $amount; + + foreach my $item (split / /, $form->{taxaccounts}) { + $amount = $form->{amount}{$form->{id}}{$item} * $form->{exchangerate}; + $form->{amount}{$form->{id}}{$item} = $form->round_amount($amount, 2); + $tax += $form->{amount}{$form->{id}}{$item}; + $netamount -= $form->{amount}{$form->{id}}{$item}; + } + + $invoicediff += $diff; + ######## this only applies to tax included + if ($lastincomeaccno) { + $form->{amount}{$form->{id}}{$lastincomeaccno} += $invoicediff; + } + + } else { + $amount = $form->round_amount($netamount * $form->{exchangerate}, 2); + $diff = $amount - $netamount * $form->{exchangerate}; + $netamount = $amount; + foreach my $item (split / /, $form->{taxaccounts}) { + $form->{amount}{$form->{id}}{$item} = $form->round_amount($form->{amount}{$form->{id}}{$item}, 2); + $amount = $form->round_amount($form->{amount}{$form->{id}}{$item} * $form->{exchangerate}, 2); + $diff += $amount - $form->{amount}{$form->{id}}{$item} * $form->{exchangerate}; + $form->{amount}{$form->{id}}{$item} = $form->round_amount($amount, 2); + $tax += $form->{amount}{$form->{id}}{$item}; + } + } + + $diff = 0 if $form->{paidaccounts} < 2; + + $form->{amount}{$form->{id}}{$form->{AR}} = $netamount + $tax; + $form->{paid} = $form->round_amount($form->{paid} * $form->{exchangerate} + $diff, 2); + + # reverse AR + $form->{amount}{$form->{id}}{$form->{AR}} *= -1; + + + # update exchangerate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, $form->{exchangerate}, 0); + } + + foreach my $trans_id (keys %{$form->{amount}}) { + foreach my $accno (keys %{ $form->{amount}{$trans_id} }) { + if (($form->{amount}{$trans_id}{$accno} = $form->round_amount($form->{amount}{$trans_id}{$accno}, 2)) != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($trans_id, (SELECT id FROM chart + WHERE accno = '$accno'), + $form->{amount}{$trans_id}{$accno}, + '$form->{transdate}')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + # deduct payment differences from diff + for my $i (1 .. $form->{paidaccounts}) { + if ($form->{"paid_$i"} != 0) { + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate}, 2); + $diff -= $amount - $form->{"paid_$i"} * $form->{exchangerate}; + } + } + + + # force AR entry if 0 + $form->{amount}{$form->{id}}{$form->{AR}} = $form->{paid} if ($form->{amount}{$form->{id}}{$form->{AR}} == 0); + + # record payments and offsetting AR + for my $i (1 .. $form->{paidaccounts}) { + + if ($form->{"paid_$i"} != 0) { + my ($accno) = split /--/, $form->{"AR_paid_$i"}; + $form->{"datepaid_$i"} = $form->{transdate} unless ($form->{"datepaid_$i"}); + $form->{datepaid} = $form->{"datepaid_$i"}; + + $exchangerate = 0; + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{"exchangerate_$i"} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{"datepaid_$i"}, 'buy'); + + $form->{"exchangerate_$i"} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{"exchangerate_$i"}); + } + + + # record AR + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} + $diff, 2); + + if ($form->{amount}{$form->{id}}{$form->{AR}} != 0) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$form->{AR}'), + $amount, '$form->{"datepaid_$i"}')|; + $dbh->do($query) || $form->dberror($query); + } + + # record payment + $form->{"paid_$i"} *= -1; + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate, + source, memo) + VALUES ($form->{id}, (SELECT id FROM chart + WHERE accno = '$accno'), + $form->{"paid_$i"}, '$form->{"datepaid_$i"}', | + .$dbh->quote($form->{"source_$i"}).qq|, | + .$dbh->quote($form->{"memo_$i"}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + + # exchangerate difference + $form->{fx}{$accno}{$form->{"datepaid_$i"}} += $form->{"paid_$i"} * ($form->{"exchangerate_$i"} - 1) + $diff; + + # gain/loss + $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate},2) - $form->round_amount($form->{"paid_$i"} * $form->{"exchangerate_$i"},2); + if ($amount > 0) { + $form->{fx}{$form->{fxgain_accno}}{$form->{"datepaid_$i"}} += $amount; + } else { + $form->{fx}{$form->{fxloss_accno}}{$form->{"datepaid_$i"}} += $amount; + } + + $diff = 0; + + # update exchange rate + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + $form->update_exchangerate($dbh, $form->{currency}, $form->{"datepaid_$i"}, $form->{"exchangerate_$i"}, 0); + } + } + } + + + # record exchange rate differences and gains/losses + foreach my $accno (keys %{$form->{fx}}) { + foreach my $transdate (keys %{ $form->{fx}{$accno} }) { + if (($form->{fx}{$accno}{$transdate} = $form->round_amount($form->{fx}{$accno}{$transdate}, 2)) != 0) { + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, + transdate, cleared, fx_transaction) + VALUES ($form->{id}, + (SELECT id FROM chart + WHERE accno = '$accno'), + $form->{fx}{$accno}{$transdate}, '$transdate', '0', '1')|; + $dbh->do($query) || $form->dberror($query); + } + } + } + + + $amount = $netamount + $tax; + + # set values which could be empty to 0 + $form->{terms} *= 1; + $form->{taxincluded} *= 1; + + # if this is from a till + my $till = ($form->{till}) ? qq|'$form->{till}'| : "NULL"; + + # save AR record + $query = qq|UPDATE ar set + invnumber = |.$dbh->quote($form->{invnumber}).qq|, + ordnumber = |.$dbh->quote($form->{ordnumber}).qq|, + quonumber = |.$dbh->quote($form->{quonumber}).qq|, + transdate = '$form->{transdate}', + customer_id = $form->{customer_id}, + amount = $amount, + netamount = $netamount, + paid = $form->{paid}, + datepaid = |.$form->dbquote($form->{datepaid}, SQL_DATE).qq|, + duedate = |.$form->dbquote($form->{duedate}, SQL_DATE).qq|, + invoice = '1', + shippingpoint = |.$dbh->quote($form->{shippingpoint}).qq|, + shipvia = |.$dbh->quote($form->{shipvia}).qq|, + terms = $form->{terms}, + notes = |.$dbh->quote($form->{notes}).qq|, + intnotes = |.$dbh->quote($form->{intnotes}).qq|, + taxincluded = '$form->{taxincluded}', + curr = '$form->{currency}', + department_id = $form->{department_id}, + employee_id = $form->{employee_id}, + till = $till, + language_code = '$form->{language_code}' + WHERE id = $form->{id} + |; + $dbh->do($query) || $form->dberror($query); + + # add shipto + $form->{name} = $form->{customer}; + $form->{name} =~ s/--$form->{customer_id}//; + $form->add_shipto($dbh, $form->{id}); + + # save printed, emailed and queued + $form->save_status($dbh); + + my %audittrail = ( tablename => 'ar', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'posted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub process_assembly { + my ($dbh, $form, $id, $totalqty) = @_; + + my $query = qq|SELECT a.parts_id, a.qty, p.assembly, + p.partnumber, p.description, p.unit, + p.inventory_accno_id, p.income_accno_id, + p.expense_accno_id + FROM assembly a + JOIN parts p ON (a.parts_id = p.id) + WHERE a.id = $id|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + my $allocated = 0; + + $ref->{inventory_accno_id} *= 1; + $ref->{expense_accno_id} *= 1; + + # multiply by number of assemblies + $ref->{qty} *= $totalqty; + + if ($ref->{assembly}) { + &process_assembly($dbh, $form, $ref->{parts_id}, $ref->{qty}); + next; + } else { + if ($ref->{inventory_accno_id}) { + $allocated = &cogs($dbh, $form, $ref->{parts_id}, $ref->{qty}); + } + } + + # save detail record for individual assembly item in invoice table + $query = qq|INSERT INTO invoice (trans_id, description, parts_id, qty, + sellprice, fxsellprice, allocated, assemblyitem, unit) + VALUES + ($form->{id}, | + .$dbh->quote($ref->{description}).qq|, + $ref->{parts_id}, $ref->{qty}, 0, 0, $allocated, 't', | + .$dbh->quote($ref->{unit}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + } + + $sth->finish; + +} + + +sub cogs { + my ($dbh, $form, $id, $totalqty) = @_; + + my $query = qq|SELECT i.id, i.trans_id, i.qty, i.allocated, i.sellprice, + (SELECT c.accno FROM chart c + WHERE p.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE p.expense_accno_id = c.id) AS expense_accno + FROM invoice i, parts p + WHERE i.parts_id = p.id + AND i.parts_id = $id + AND (i.qty + i.allocated) < 0 + ORDER BY trans_id|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $allocated = 0; + my $qty; + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + if (($qty = (($ref->{qty} * -1) - $ref->{allocated})) > $totalqty) { + $qty = $totalqty; + } + + $form->update_balance($dbh, + "invoice", + "allocated", + qq|id = $ref->{id}|, + $qty); + + # total expenses and inventory + # sellprice is the cost of the item + $linetotal = $form->round_amount($ref->{sellprice} * $qty, 2); + + # add to expense + $form->{amount}{$form->{id}}{$ref->{expense_accno}} += -$linetotal; + + # deduct inventory + $form->{amount}{$form->{id}}{$ref->{inventory_accno}} -= -$linetotal; + + # add allocated + $allocated += -$qty; + + last if (($totalqty -= $qty) <= 0); + } + + $sth->finish; + + $allocated; + +} + + + +sub reverse_invoice { + my ($dbh, $form) = @_; + + # reverse inventory items + my $query = qq|SELECT i.id, i.parts_id, i.qty, i.assemblyitem, p.assembly, + p.inventory_accno_id + FROM invoice i + JOIN parts p ON (i.parts_id = p.id) + WHERE i.trans_id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + if ($ref->{inventory_accno_id} || $ref->{assembly}) { + + # if the invoice item is not an assemblyitem adjust parts onhand + if (!$ref->{assemblyitem}) { + # adjust onhand in parts table + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $ref->{parts_id}|, + $ref->{qty}); + } + + # loop if it is an assembly + next if ($ref->{assembly}); + + # de-allocated purchases + $query = qq|SELECT id, trans_id, allocated + FROM invoice + WHERE parts_id = $ref->{parts_id} + AND allocated > 0 + ORDER BY trans_id DESC|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $inhref = $sth->fetchrow_hashref(NAME_lc)) { + $qty = $ref->{qty}; + if (($ref->{qty} - $inhref->{allocated}) > 0) { + $qty = $inhref->{allocated}; + } + + # update invoice + $form->update_balance($dbh, + "invoice", + "allocated", + qq|id = $inhref->{id}|, + $qty * -1); + + last if (($ref->{qty} -= $qty) <= 0); + } + $sth->finish; + } + } + + $sth->finish; + + # delete acc_trans + $query = qq|DELETE FROM acc_trans + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete invoice entries + $query = qq|DELETE FROM invoice + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM shipto + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + +} + + + +sub delete_invoice { + my ($self, $myconfig, $form, $spool) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + &reverse_invoice($dbh, $form); + + my %audittrail = ( tablename => 'ar', + reference => $form->{invnumber}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + # delete AR record + my $query = qq|DELETE FROM ar + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete spool files + $query = qq|SELECT spoolfile FROM status + WHERE trans_id = $form->{id} + AND spoolfile IS NOT NULL|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $spoolfile; + my @spoolfiles = (); + + while (($spoolfile) = $sth->fetchrow_array) { + push @spoolfiles, $spoolfile; + } + $sth->finish; + + # delete status entries + $query = qq|DELETE FROM status + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + my $rc = $dbh->commit; + $dbh->disconnect; + + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "$spool/$spoolfile" if $spoolfile; + } + } + + $rc; + +} + + + +sub retrieve_invoice { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + + if ($form->{id}) { + # get default accounts and last invoice number + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE d.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE d.income_accno_id = c.id) AS income_accno, + (SELECT c.accno FROM chart c + WHERE d.expense_accno_id = c.id) AS expense_accno, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + d.curr AS currencies + FROM defaults d|; + } else { + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE d.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE d.income_accno_id = c.id) AS income_accno, + (SELECT c.accno FROM chart c + WHERE d.expense_accno_id = c.id) AS expense_accno, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + d.curr AS currencies, current_date AS transdate + FROM defaults d|; + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + + if ($form->{id}) { + + # retrieve invoice + $query = qq|SELECT a.invnumber, a.ordnumber, a.quonumber, + a.transdate, a.paid, + a.shippingpoint, a.shipvia, a.terms, a.notes, a.intnotes, + a.duedate, a.taxincluded, a.curr AS currency, + a.employee_id, e.name AS employee, a.till, a.customer_id, + a.language_code + FROM ar a + LEFT JOIN employee e ON (e.id = a.employee_id) + WHERE a.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # get shipto + $query = qq|SELECT * FROM shipto + WHERE trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # retrieve individual items + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE p.inventory_accno_id = c.id) + AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE p.income_accno_id = c.id) + AS income_accno, + (SELECT c.accno FROM chart c + WHERE p.expense_accno_id = c.id) + AS expense_accno, + i.description, i.qty, i.fxsellprice, i.sellprice, + i.discount, i.parts_id AS id, i.unit, i.deliverydate, + i.project_id, pr.projectnumber, i.serialnumber, + p.partnumber, p.assembly, p.bin, + pg.partsgroup, p.partsgroup_id, p.partnumber AS sku, + p.listprice, p.lastcost, p.weight, + t.description AS partsgrouptranslation + FROM invoice i + JOIN parts p ON (i.parts_id = p.id) + LEFT JOIN project pr ON (i.project_id = pr.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN translation t ON (t.trans_id = p.partsgroup_id AND t.language_code = '$form->{language_code}') + WHERE i.trans_id = $form->{id} + AND NOT i.assemblyitem = '1' + ORDER BY i.id|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + # foreign currency + &exchangerate_defaults($dbh, $form); + + # query for price matrix + my $pmh = &price_matrix_query($dbh, $form); + + # taxes + $query = qq|SELECT c.accno + FROM chart c + JOIN partstax pt ON (pt.chart_id = c.id) + WHERE pt.parts_id = ?|; + my $tth = $dbh->prepare($query) || $form->dberror($query); + + my $taxrate; + my $ptref; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + ($decimalplaces) = ($ref->{fxsellprice} =~ /\.(\d+)/); + $decimalplaces = length $decimalplaces; + $decimalplaces = 2 unless $decimalplaces; + + $tth->execute($ref->{id}); + + $ref->{taxaccounts} = ""; + $taxrate = 0; + + while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + $taxrate += $form->{"$ptref->{accno}_rate"}; + } + $tth->finish; + chop $ref->{taxaccounts}; + + # price matrix + $ref->{sellprice} = ($ref->{fxsellprice} * $form->{$form->{currency}}); + &price_matrix($pmh, $ref, $form->{transdate}, $decimalplaces, $form, $myconfig, 1); + $ref->{sellprice} = $ref->{fxsellprice}; + + $ref->{partsgroup} = $ref->{partsgrouptranslation} if $ref->{partsgrouptranslation}; + + push @{ $form->{invoice_details} }, $ref; + } + $sth->finish; + + } + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub get_customer { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $dateformat = $myconfig->{dateformat}; + if ($myconfig->{dateformat} !~ /^y/) { + my @a = split /\W/, $form->{transdate}; + $dateformat .= "yy" if (length $a[2] > 2); + } + + if ($form->{transdate} !~ /\W/) { + $dateformat = 'yyyymmdd'; + } + + my $duedate; + + if ($myconfig->{dbdriver} eq 'DB2') { + $duedate = ($form->{transdate}) ? "date('$form->{transdate}') + c.terms DAYS" : "current_date + c.terms DAYS"; + } else { + $duedate = ($form->{transdate}) ? "to_date('$form->{transdate}', '$dateformat') + c.terms" : "current_date + c.terms"; + } + + $form->{customer_id} *= 1; + # get customer + my $query = qq|SELECT c.name AS customer, c.discount, c.creditlimit, c.terms, + c.email, c.cc, c.bcc, c.taxincluded, + c.address1, c.address2, c.city, c.state, + c.zipcode, c.country, c.curr AS currency, c.language_code, + $duedate AS duedate, c.notes AS intnotes, + b.discount AS tradediscount, b.description AS business, + e.name AS employee, e.id AS employee_id + FROM customer c + LEFT JOIN business b ON (b.id = c.business_id) + LEFT JOIN employee e ON (e.id = c.employee_id) + WHERE c.id = $form->{customer_id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + + if ($form->{id}) { + map { delete $ref->{$_} } qw(currency taxincluded employee employee_id intnotes); + } + + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # if no currency use defaultcurrency + $form->{currency} = ($form->{currency}) ? $form->{currency} : $form->{defaultcurrency}; + $form->{exchangerate} = 0 if $form->{currency} eq $form->{defaultcurrency}; + if ($form->{transdate} && ($form->{currency} ne $form->{defaultcurrency})) { + $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{transdate}, "buy"); + } + $form->{forex} = $form->{exchangerate}; + + # if no employee, default to login + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh) unless $form->{employee_id}; + + $form->{creditremaining} = $form->{creditlimit}; + $query = qq|SELECT SUM(amount - paid) + FROM ar + WHERE customer_id = $form->{customer_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{creditremaining}) -= $sth->fetchrow_array; + + $sth->finish; + + $query = qq|SELECT o.amount, + (SELECT e.buy FROM exchangerate e + WHERE e.curr = o.curr + AND e.transdate = o.transdate) + FROM oe o + WHERE o.customer_id = $form->{customer_id} + AND o.quotation = '0' + AND o.closed = '0'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($amount, $exch) = $sth->fetchrow_array) { + $exch = 1 unless $exch; + $form->{creditremaining} -= $amount * $exch; + } + $sth->finish; + + + # get shipto if we did not converted an order or invoice + if (!$form->{shipto}) { + map { delete $form->{$_} } qw(shiptoname shiptoaddress1 shiptoaddress2 shiptocity shiptostate shiptozipcode shiptocountry shiptocontact shiptophone shiptofax shiptoemail); + + $query = qq|SELECT * FROM shipto + WHERE trans_id = $form->{customer_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + } + + # get taxes we charge for this customer + $query = qq|SELECT c.accno + FROM chart c + JOIN customertax ct ON (ct.chart_id = c.id) + WHERE ct.customer_id = $form->{customer_id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $customertax = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $customertax{$ref->{accno}} = 1; + } + $sth->finish; + + # get tax rates and description + $query = qq|SELECT c.accno, c.description, t.rate, t.taxnumber + FROM chart c + JOIN tax t ON (c.id = t.chart_id) + WHERE c.link LIKE '%CT_tax%' + ORDER BY accno|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $form->{taxaccounts} = ""; + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + if ($customertax{$ref->{accno}}) { + $form->{"$ref->{accno}_rate"} = $ref->{rate}; + $form->{"$ref->{accno}_description"} = $ref->{description}; + $form->{"$ref->{accno}_taxnumber"} = $ref->{taxnumber}; + $form->{taxaccounts} .= "$ref->{accno} "; + } + } + $sth->finish; + chop $form->{taxaccounts}; + + # setup last accounts used for this customer + if (!$form->{id} && $form->{type} !~ /_(order|quotation)/) { + $query = qq|SELECT c.accno, c.description, c.link, c.category, + ac.project_id, p.projectnumber, a.department_id, + d.description AS department + FROM chart c + JOIN acc_trans ac ON (ac.chart_id = c.id) + JOIN ar a ON (a.id = ac.trans_id) + LEFT JOIN project p ON (ac.project_id = p.id) + LEFT JOIN department d ON (d.id = a.department_id) + WHERE a.customer_id = $form->{customer_id} + AND a.id IN (SELECT max(id) FROM ar + WHERE customer_id = $form->{customer_id})|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $i = 0; + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{department} = $ref->{department}; + $form->{department_id} = $ref->{department_id}; + + if ($ref->{link} =~ /_amount/) { + $i++; + $form->{"AR_amount_$i"} = "$ref->{accno}--$ref->{description}"; + $form->{"projectnumber_$i"} = "$ref->{projectnumber}--$ref->{project_id}"; + } + if ($ref->{category} eq 'A') { + $form->{AR} = $form->{AR_1} = "$ref->{accno}--$ref->{description}"; + } + } + $sth->finish; + $form->{rowcount} = $i if ($i && !$form->{type}); + } + + $dbh->disconnect; + +} + + + +sub retrieve_item { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $i = $form->{rowcount}; + my $null; + my $var; + + my $where = "WHERE p.obsolete = '0' AND NOT p.income_accno_id IS NULL"; + + if ($form->{"partnumber_$i"}) { + $var = $form->like(lc $form->{"partnumber_$i"}); + $where .= " AND lower(p.partnumber) LIKE '$var'"; + } + if ($form->{"description_$i"}) { + $var = $form->like(lc $form->{"description_$i"}); + if ($form->{language_code}) { + $where .= " AND lower(t1.description) LIKE '$var'"; + } else { + $where .= " AND lower(p.description) LIKE '$var'"; + } + } + + if ($form->{"partsgroup_$i"}) { + ($null, $var) = split /--/, $form->{"partsgroup_$i"}; + $var *= 1; + if ($var == 0) { + # search by partsgroup, this is for the POS + $where .= qq| AND pg.partsgroup = '$form->{"partsgroup_$i"}'|; + } else { + $where .= qq| AND p.partsgroup_id = $var|; + } + } + + if ($form->{"description_$i"}) { + $where .= " ORDER BY 3"; + } else { + $where .= " ORDER BY 2"; + } + + my $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice, + p.listprice, p.lastcost, + c1.accno AS inventory_accno, + c2.accno AS income_accno, + c3.accno AS expense_accno, + p.unit, p.assembly, p.bin, p.onhand, + pg.partsgroup, p.partsgroup_id, p.partnumber AS sku, + p.weight, + t1.description AS translation, + t2.description AS grouptranslation + FROM parts p + LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) + LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) + LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN partsgroup pg ON (pg.id = p.partsgroup_id) + LEFT JOIN translation t1 ON (t1.trans_id = p.id AND t1.language_code = '$form->{language_code}') + LEFT JOIN translation t2 ON (t2.trans_id = p.partsgroup_id AND t2.language_code = '$form->{language_code}') + $where|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref; + my $ptref; + + # setup exchange rates + &exchangerate_defaults($dbh, $form); + + # taxes + $query = qq|SELECT c.accno + FROM chart c + JOIN partstax pt ON (c.id = pt.chart_id) + WHERE pt.parts_id = ?|; + my $tth = $dbh->prepare($query) || $form->dberror($query); + + + # price matrix + my $pmh = &price_matrix_query($dbh, $form); + + my $transdate = $form->datetonum($form->{transdate}, $myconfig); + my $decimalplaces; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + ($decimalplaces) = ($ref->{sellprice} =~ /\.(\d+)/); + $decimalplaces = length $decimalplaces; + $decimalplaces = 2 unless $decimalplaces; + + # get taxes for part + $tth->execute($ref->{id}); + + $ref->{taxaccounts} = ""; + while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + } + $tth->finish; + chop $ref->{taxaccounts}; + + # get matrix + &price_matrix($pmh, $ref, $transdate, $decimalplaces, $form, $myconfig); + + $ref->{description} = $ref->{translation} if $ref->{translation}; + $ref->{partsgroup} = $ref->{grouptranslation} if $ref->{grouptranslation}; + + push @{ $form->{item_list} }, $ref; + + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub price_matrix_query { + my ($dbh, $form) = @_; + + my $query = qq|SELECT p.*, g.pricegroup + FROM partscustomer p + LEFT JOIN pricegroup g ON (g.id = p.pricegroup_id) + WHERE p.parts_id = ? + AND p.customer_id = $form->{customer_id} + + UNION + + SELECT p.*, g.pricegroup + FROM partscustomer p + LEFT JOIN pricegroup g ON (g.id = p.pricegroup_id) + JOIN customer c ON (c.pricegroup_id = g.id) + WHERE p.parts_id = ? + AND c.id = $form->{customer_id} + + UNION + + SELECT p.*, '' AS pricegroup + FROM partscustomer p + WHERE p.customer_id = 0 + AND p.pricegroup_id = 0 + AND p.parts_id = ? + + ORDER BY customer_id DESC, pricegroup_id DESC, pricebreak + + |; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + $sth; + +} + + +sub price_matrix { + my ($pmh, $ref, $transdate, $decimalplaces, $form, $myconfig, $init) = @_; + + $pmh->execute($ref->{id}, $ref->{id}, $ref->{id}); + + $ref->{pricematrix} = ""; + my $customerprice; + my $pricegroup; + my $sellprice; + my $mref; + + while ($mref = $pmh->fetchrow_hashref(NAME_lc)) { + + $customerprice = 0; + $pricegroup = 0; + + # check date + if ($mref->{validfrom}) { + next if $transdate < $form->datetonum($mref->{validfrom}, $myconfig); + } + if ($mref->{validto}) { + next if $transdate > $form->datetonum($mref->{validto}, $myconfig); + } + + # convert price + $sellprice = $form->round_amount($mref->{sellprice} * $form->{$mref->{curr}}, $decimalplaces); + + if ($mref->{customer_id}) { + $ref->{sellprice} = $sellprice unless $mref->{pricebreak}; + $ref->{pricematrix} .= "$mref->{pricebreak}:$sellprice "; + $customerprice = 1; + } + + if ($mref->{pricegroup_id}) { + if (! $customerprice) { + $ref->{sellprice} = $sellprice unless $mref->{pricebreak}; + $ref->{pricematrix} .= "$mref->{pricebreak}:$sellprice "; + $pricegroup = 1; + } + } + + if (! $customerprice && ! $pricegroup) { + $ref->{sellprice} = $sellprice unless $mref->{pricebreak}; + $ref->{pricematrix} .= "$mref->{pricebreak}:$sellprice "; + } + + if ($form->{tradediscount}) { + $ref->{sellprice} = $form->round_amount($ref->{sellprice} / (1 - $form->{tradediscount}), $decimalplaces); + } + + } + $pmh->finish; + + if ($ref->{pricematrix} !~ /^0:/) { + if ($init) { + $sellprice = $form->round_amount($ref->{sellprice}, $decimalplaces); + } else { + $sellprice = $form->round_amount($ref->{sellprice} * (1 - $form->{tradediscount}), $decimalplaces); + } + $ref->{pricematrix} = "0:$sellprice ".$ref->{pricematrix}; + } + chop $ref->{pricematrix}; + +} + + +sub exchangerate_defaults { + my ($dbh, $form) = @_; + + my $var; + + # get default currencies + my $query = qq|SELECT substr(curr,1,3), curr FROM defaults|; + my $eth = $dbh->prepare($query) || $form->dberror($query); + $eth->execute; + ($form->{defaultcurrency}, $form->{currencies}) = $eth->fetchrow_array; + $eth->finish; + + $query = qq|SELECT buy + FROM exchangerate + WHERE curr = ? + AND transdate = ?|; + my $eth1 = $dbh->prepare($query) || $form->dberror($query); + + $query = qq~SELECT max(transdate || ' ' || buy || ' ' || curr) + FROM exchangerate + WHERE curr = ?~; + my $eth2 = $dbh->prepare($query) || $form->dberror($query); + + # get exchange rates for transdate or max + foreach $var (split /:/, substr($form->{currencies},4)) { + $eth1->execute($var, $form->{transdate}); + ($form->{$var}) = $eth1->fetchrow_array; + if (! $form->{$var} ) { + $eth2->execute($var); + + ($form->{$var}) = $eth2->fetchrow_array; + ($null, $form->{$var}) = split / /, $form->{$var}; + $form->{$var} = 1 unless $form->{$var}; + $eth2->finish; + } + $eth1->finish; + } + + $form->{$form->{defaultcurrency}} = 1; + +} + + +1; + diff --git a/sql-ledger/SL/Inifile.pm b/sql-ledger/SL/Inifile.pm new file mode 100644 index 000000000..8ccf4334d --- /dev/null +++ b/sql-ledger/SL/Inifile.pm @@ -0,0 +1,88 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2002 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#===================================================================== +# +# routines to retrieve / manipulate win ini style files +# ORDER is used to keep the elements in the order they appear in .ini +# +#===================================================================== + +package Inifile; + + +sub new { + my ($type, $file, $level) = @_; + + my $id = ""; + my $skip; + + $self ||= {}; + $type = ref($self) || $self; + + open FH, "$file" or Form->error("$file : $!"); + + while (<FH>) { + next if /^(#|;|\s)/; + last if /^\./; + + chop; + + # strip comments + s/\s*(#|;).*//g; + + # remove any trailing whitespace + s/^\s*(.*?)\s*$/$1/; + + if (/^\[/) { + s/(\[|\])//g; + + $id = $_; + + # if there is a level skip + if ($skip = ($id !~ /^$level/)) { + next; + } + + push @{$self->{ORDER}}, $_; + + next; + + } + + if (!$skip) { + # add key=value to $id + my ($key, $value) = split /=/, $_, 2; + + $self->{$id}{$key} = $value; + } + + } + close FH; + + bless $self, $type; + +} + + +1; + diff --git a/sql-ledger/SL/Mailer.pm b/sql-ledger/SL/Mailer.pm new file mode 100644 index 000000000..712b1d727 --- /dev/null +++ b/sql-ledger/SL/Mailer.pm @@ -0,0 +1,162 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2002 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# mailer package +# +#====================================================================== + +package Mailer; + +sub new { + my ($type) = @_; + my $self = {}; + + bless $self, $type; +} + + +sub send { + my ($self, $out) = @_; + + my $boundary = time; + $boundary = "SL-$self->{version}-$boundary"; + my $domain = $self->{from}; + $domain =~ s/(.*?\@|>)//g; + my $msgid = "$boundary\@$domain"; + + $self->{charset} = "ISO-8859-1" unless $self->{charset}; + + if ($out) { + open(OUT, $out) or return "$out : $!"; + } else { + open(OUT, ">-") or return "STDOUT : $!"; + } + + $self->{contenttype} = "text/plain" unless $self->{contenttype}; + + my ($cc, $bcc); + $cc = "Cc: $self->{cc}\n" if $self->{cc}; + $bcc = "Bcc: $self->{bcc}\n" if $self->{bcc}; + + foreach my $item (qw(from to cc bcc)) { + $self->{$item} =~ s/\\_/_/g; + $self->{$item} =~ s/\</</g; + $self->{$item} =~ s/\$<\$/</g; + $self->{$item} =~ s/\>/>/g; + $self->{$item} =~ s/\$>\$/>/g; + } + + print OUT qq|From: $self->{from} +To: $self->{to} +${cc}${bcc}Subject: $self->{subject} +Message-ID: <$msgid> +X-Mailer: SQL-Ledger $self->{version} +MIME-Version: 1.0 +|; + + + if ($self->{attachments}) { + print OUT qq|Content-Type: multipart/mixed; boundary="$boundary" + +|; + if ($self->{message}) { + print OUT qq|--${boundary} +Content-Type: $self->{contenttype}; charset="$self->{charset}" + +$self->{message} + +|; + } + + foreach my $attachment (@{ $self->{attachments} }) { + + my $application = ($attachment =~ /(^\w+$)|\.(html|text|txt|sql)$/) ? "text" : "application"; + + open(IN, $attachment); + if ($?) { + close(OUT); + return "$attachment : $!"; + } + + my $filename = $attachment; + # strip path + $filename =~ s/(.*\/|$self->{fileid})//g; + + print OUT qq|--${boundary} +Content-Type: $application/$self->{format}; name="$filename"; charset="$self->{charset}" +Content-Transfer-Encoding: BASE64 +Content-Disposition: attachment; filename="$filename"\n\n|; + + my $msg = ""; + while (<IN>) {; + $msg .= $_; + } + print OUT &encode_base64($msg); + + close(IN); + + } + print OUT qq|--${boundary}--\n|; + + } else { + print OUT qq|Content-Type: $self->{contenttype}; charset="$self->{charset}" + +$self->{message} +|; + } + + close(OUT); + + return ""; + +} + + +sub encode_base64 ($;$) { + + # this code is from the MIME-Base64-2.12 package + # Copyright 1995-1999,2001 Gisle Aas <gisle@ActiveState.com> + + my $res = ""; + my $eol = $_[1]; + $eol = "\n" unless defined $eol; + pos($_[0]) = 0; # ensure start at the beginning + + $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs)); + + $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs + # fix padding at the end + my $padding = (3 - length($_[0]) % 3) % 3; + $res =~ s/.{$padding}$/'=' x $padding/e if $padding; + # break encoded string into lines of no more than 60 characters each + if (length $eol) { + $res =~ s/(.{1,60})/$1$eol/g; + } + return $res; + +} + + +1; + diff --git a/sql-ledger/SL/Menu.pm b/sql-ledger/SL/Menu.pm new file mode 100644 index 000000000..0df3067aa --- /dev/null +++ b/sql-ledger/SL/Menu.pm @@ -0,0 +1,121 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2002 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#===================================================================== +# +# routines for menu items +# +#===================================================================== + +package Menu; + + +sub new { + my ($type, $menufile, $level) = @_; + + use SL::Inifile; + my $self = Inifile->new($menufile, $level); + + bless $self, $type if $self; + +} + + +sub menuitem { + my ($self, $myconfig, $form, $item, $level) = @_; + + my $module = $form->{script}; + my $action = "section_menu"; + my $target = ""; + + if ($self->{$item}{module}) { + $module = $self->{$item}{module}; + } + if ($self->{$item}{action}) { + $action = $self->{$item}{action}; + } + if ($self->{$item}{target}) { + $target = $self->{$item}{target}; + } + + $level = $form->escape($item); + my $str = qq|<a href=$module?path=$form->{path}&action=$action&level=$level&login=$form->{login}&timeout=$form->{timeout}&sessionid=$form->{sessionid}|; + + my @vars = qw(module action target href); + + if ($self->{$item}{href}) { + $str = qq|<a href=$self->{$item}{href}|; + @vars = qw(module target href); + } + + map { delete $self->{$item}{$_} } @vars; + + delete $self->{$item}{submenu}; + + # add other params + foreach my $key (keys %{ $self->{$item} }) { + $str .= "&".$form->escape($key)."="; + ($value, $conf) = split /=/, $self->{$item}{$key}, 2; + $value = $myconfig->{$value}."/$conf" if ($conf); + $str .= $form->escape($value); + } + + $str .= qq|#id$form->{tag}| if $target eq 'acc_menu'; + + if ($target) { + $str .= qq| target=$target|; + } + + $str .= qq|>|; + +} + + +sub access_control { + my ($self, $myconfig, $menulevel) = @_; + + my @menu = (); + + if ($menulevel eq "") { + @menu = grep { !/--/ } @{ $self->{ORDER} }; + } else { + @menu = grep { /^${menulevel}--/ } @{ $self->{ORDER} }; + } + + my @a = split /;/, $myconfig->{acs}; + my $excl = (); + + # remove --AR, --AP from array + grep { ($a, $b) = split /--/; s/--$a$//; } @a; + + map { $excl{$_} = 1 } @a; + + @a = (); + map { push @a, $_ unless $excl{$_} } (@menu); + + @a; + +} + + +1; + diff --git a/sql-ledger/SL/Num2text.pm b/sql-ledger/SL/Num2text.pm new file mode 100644 index 000000000..06eee7183 --- /dev/null +++ b/sql-ledger/SL/Num2text.pm @@ -0,0 +1,162 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2002 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#===================================================================== +# +# this is the default code for the Check package +# +#===================================================================== + + +sub init { + my $self = shift; + + %{ $self->{numbername} } = + (0 => 'Zero', + 1 => 'One', + 2 => 'Two', + 3 => 'Three', + 4 => 'Four', + 5 => 'Five', + 6 => 'Six', + 7 => 'Seven', + 8 => 'Eight', + 9 => 'Nine', + 10 => 'Ten', + 11 => 'Eleven', + 12 => 'Twelve', + 13 => 'Thirteen', + 14 => 'Fourteen', + 15 => 'Fifteen', + 16 => 'Sixteen', + 17 => 'Seventeen', + 18 => 'Eighteen', + 19 => 'Nineteen', + 20 => 'Twenty', + 30 => 'Thirty', + 40 => 'Forty', + 50 => 'Fifty', + 60 => 'Sixty', + 70 => 'Seventy', + 80 => 'Eighty', + 90 => 'Ninety', + 10**2 => 'Hundred', + 10**3 => 'Thousand', + 10**6 => 'Million', + 10**9 => 'Billion', + 10**12 => 'Trillion', + ); + +} + + +sub num2text { + my ($self, $amount) = @_; + + return $self->{numbername}{0} unless $amount; + + my @textnumber = (); + + # split amount into chunks of 3 + my @num = reverse split //, abs($amount); + my @numblock = (); + my @a; + my $i; + + while (@num) { + @a = (); + for (1 .. 3) { + push @a, shift @num; + } + push @numblock, join / /, reverse @a; + } + + while (@numblock) { + + $i = $#numblock; + @num = split //, $numblock[$i]; + + if ($numblock[$i] == 0) { + pop @numblock; + next; + } + + if ($numblock[$i] > 99) { + # the one from hundreds + push @textnumber, $self->{numbername}{$num[0]}; + + # add hundred designation + push @textnumber, $self->{numbername}{10**2}; + + # reduce numblock + $numblock[$i] -= $num[0] * 100; + + } + + $numblock[$i] *= 1; + + if ($numblock[$i] > 9) { + # tens + push @textnumber, $self->format_ten($numblock[$i]); + } elsif ($numblock[$i] > 0) { + # ones + push @textnumber, $self->{numbername}{$numblock[$i]}; + } + + # add thousand, million + if ($i) { + $num = 10**($i * 3); + push @textnumber, $self->{numbername}{$num}; + } + + pop @numblock; + + } + + join ' ', @textnumber; + +} + + +sub format_ten { + my ($self, $amount) = @_; + + my $textnumber = ""; + my @num = split //, $amount; + + if ($amount > 20) { + $textnumber = $self->{numbername}{$num[0]*10}; + $amount = $num[1]; + } else { + $textnumber = $self->{numbername}{$amount}; + $amount = 0; + } + + $textnumber .= " ".$self->{numbername}{$amount} if $amount; + + $textnumber; + +} + + +1; + diff --git a/sql-ledger/SL/OE.pm b/sql-ledger/SL/OE.pm new file mode 100644 index 000000000..dfa424c31 --- /dev/null +++ b/sql-ledger/SL/OE.pm @@ -0,0 +1,1581 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2001 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Order entry module +# Quotation +# +#====================================================================== + +package OE; + + +sub transactions { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query; + my $ordnumber = 'ordnumber'; + my $quotation = '0'; + my ($null, $department_id) = split /--/, $form->{department}; + + my $department = " AND o.department_id = $department_id" if $department_id; + + my $rate = ($form->{vc} eq 'customer') ? 'buy' : 'sell'; + + ($form->{transdatefrom}, $form->{transdateto}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + if ($form->{type} =~ /_quotation$/) { + $quotation = '1'; + $ordnumber = 'quonumber'; + } + + my $number = $form->like(lc $form->{$ordnumber}); + my $name = $form->like(lc $form->{$form->{vc}}); + + my $query = qq|SELECT o.id, o.ordnumber, o.transdate, o.reqdate, + o.amount, ct.name, o.netamount, o.$form->{vc}_id, + ex.$rate AS exchangerate, + o.closed, o.quonumber, o.shippingpoint, o.shipvia, + e.name AS employee, m.name AS manager, o.curr + FROM oe o + JOIN $form->{vc} ct ON (o.$form->{vc}_id = ct.id) + LEFT JOIN employee e ON (o.employee_id = e.id) + LEFT JOIN employee m ON (e.managerid = m.id) + LEFT JOIN exchangerate ex ON (ex.curr = o.curr + AND ex.transdate = o.transdate) + WHERE o.quotation = '$quotation' + $department|; + + my %ordinal = ( 'id' => 1, + 'ordnumber' => 2, + 'transdate' => 3, + 'reqdate' => 4, + 'name' => 6, + 'quonumber' => 11, + 'shipvia' => 13, + 'employee' => 14, + 'manager' => 15 + ); + + my @a = (transdate, $ordnumber, name); + push @a, "employee" if $form->{l_employee}; + if ($form->{type} !~ /(ship|receive)_order/) { + push @a, "manager" if $form->{l_manager}; + } + my $sortorder = $form->sort_order(\@a, \%ordinal); + + + # build query if type eq (ship|receive)_order + if ($form->{type} =~ /(ship|receive)_order/) { + + my ($warehouse, $warehouse_id) = split /--/, $form->{warehouse}; + + $query = qq|SELECT DISTINCT o.id, o.ordnumber, o.transdate, + o.reqdate, o.amount, ct.name, o.netamount, o.$form->{vc}_id, + ex.$rate AS exchangerate, + o.closed, o.quonumber, o.shippingpoint, o.shipvia, + e.name AS employee, o.curr + FROM oe o + JOIN $form->{vc} ct ON (o.$form->{vc}_id = ct.id) + JOIN orderitems oi ON (oi.trans_id = o.id) + JOIN parts p ON (p.id = oi.parts_id)|; + + if ($warehouse_id && $form->{type} eq 'ship_order') { + $query .= qq| + JOIN inventory i ON (oi.parts_id = i.parts_id) + |; + } + + $query .= qq| + LEFT JOIN employee e ON (o.employee_id = e.id) + LEFT JOIN exchangerate ex ON (ex.curr = o.curr + AND ex.transdate = o.transdate) + WHERE o.quotation = '0' + AND (p.inventory_accno_id > 0 OR p.assembly = '1') + AND oi.qty != oi.ship + $department|; + + if ($warehouse_id && $form->{type} eq 'ship_order') { + $query .= qq| + AND i.warehouse_id = $warehouse_id + AND i.qty >= (oi.qty - oi.ship) + |; + } + + } + + if ($form->{"$form->{vc}_id"}) { + $query .= qq| AND o.$form->{vc}_id = $form->{"$form->{vc}_id"}|; + } else { + if ($form->{$form->{vc}}) { + $query .= " AND lower(ct.name) LIKE '$name'"; + } + } + if (!$form->{open} && !$form->{closed}) { + $query .= " AND o.id = 0"; + } elsif (!($form->{open} && $form->{closed})) { + $query .= ($form->{open}) ? " AND o.closed = '0'" : " AND o.closed = '1'"; + } + + if ($form->{$ordnumber}) { + $query .= " AND lower($ordnumber) LIKE '$number'"; + } + if ($form->{shipvia}) { + $var = $form->like(lc $form->{shipvia}); + $query .= " AND lower(o.shipvia) LIKE '$var'"; + } + if ($form->{transdatefrom}) { + $query .= " AND o.transdate >= '$form->{transdatefrom}'"; + } + if ($form->{transdateto}) { + $query .= " AND o.transdate <= '$form->{transdateto}'"; + } + + $query .= " ORDER by $sortorder"; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my %id = (); + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + push @{ $form->{OE} }, $ref if $ref->{id} != $id{$ref->{id}}; + $id{$ref->{id}} = $ref->{id}; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub save { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn off autocommit + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $sth; + my $null; + my $exchangerate = 0; + + ($null, $form->{employee_id}) = split /--/, $form->{employee}; + unless ($form->{employee_id}) { + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + $form->{employee} = "$form->{employee}--$form->{employee_id}"; + } + + my $ml = ($form->{type} eq 'sales_order') ? 1 : -1; + + if ($form->{id}) { + + &adj_onhand($dbh, $form, $ml) if $form->{type} =~ /_order$/; + + $query = qq|DELETE FROM orderitems + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM shipto + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + } else { + my $uid = time; + $uid .= $form->{login}; + + $query = qq|INSERT INTO oe (ordnumber, employee_id) + VALUES ('$uid', $form->{employee_id})|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM oe + WHERE ordnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{id}) = $sth->fetchrow_array; + $sth->finish; + + } + + my $amount; + my $linetotal; + my $discount; + my $project_id; + my $taxrate; + my $taxamount; + my $fxsellprice; + my %taxbase; + my @taxaccounts; + my %taxaccounts; + my $netamount = 0; + + for my $i (1 .. $form->{rowcount}) { + + map { $form->{"${_}_$i"} = $form->parse_amount($myconfig, $form->{"${_}_$i"}) } qw(qty ship); + + $form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100; + $form->{"sellprice_$i"} = $form->parse_amount($myconfig, $form->{"sellprice_$i"}); + + if ($form->{"qty_$i"}) { + + $fxsellprice = $form->{"sellprice_$i"}; + + my ($dec) = ($form->{"sellprice_$i"} =~ /\.(\d+)/); + $dec = length $dec; + my $decimalplaces = ($dec > 2) ? $dec : 2; + + $discount = $form->round_amount($form->{"sellprice_$i"} * $form->{"discount_$i"}, $decimalplaces); + $form->{"sellprice_$i"} = $form->round_amount($form->{"sellprice_$i"} - $discount, $decimalplaces); + + $form->{"inventory_accno_$i"} *= 1; + $form->{"expense_accno_$i"} *= 1; + + $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2); + + @taxaccounts = split / /, $form->{"taxaccounts_$i"}; + $taxrate = 0; + $taxdiff = 0; + + map { $taxrate += $form->{"${_}_rate"} } @taxaccounts; + + if ($form->{taxincluded}) { + $taxamount = $linetotal * $taxrate / (1 + $taxrate); + $taxbase = $linetotal - $taxamount; + # we are not keeping a natural price, do not round + $form->{"sellprice_$i"} = $form->{"sellprice_$i"} * (1 / (1 + $taxrate)); + } else { + $taxamount = $linetotal * $taxrate; + $taxbase = $linetotal; + } + + if (@taxaccounts && $form->round_amount($taxamount, 2) == 0) { + if ($form->{taxincluded}) { + foreach $item (@taxaccounts) { + $taxamount = $form->round_amount($linetotal * $form->{"${item}_rate"} / (1 + abs($form->{"${item}_rate"})), 2); + + $taxaccounts{$item} += $taxamount; + $taxdiff += $taxamount; + + $taxbase{$item} += $taxbase; + } + $taxaccounts{$taxaccounts[0]} += $taxdiff; + } else { + foreach $item (@taxaccounts) { + $taxaccounts{$item} += $linetotal * $form->{"${item}_rate"}; + $taxbase{$item} += $taxbase; + } + } + } else { + foreach $item (@taxaccounts) { + $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate; + $taxbase{$item} += $taxbase; + } + } + + + $netamount += $form->{"sellprice_$i"} * $form->{"qty_$i"}; + + $project_id = 'NULL'; + if ($form->{"projectnumber_$i"}) { + ($null, $project_id) = split /--/, $form->{"projectnumber_$i"}; + $project_id *= 1; + } + + # save detail record in orderitems table + $query = qq|INSERT INTO orderitems (|; + $query .= "id, " if $form->{"orderitems_id_$i"}; + $query .= qq|trans_id, parts_id, description, qty, sellprice, discount, + unit, reqdate, project_id, serialnumber, ship) + VALUES (|; + $query .= qq|$form->{"orderitems_id_$i"},| if $form->{"orderitems_id_$i"}; + $query .= qq|$form->{id}, $form->{"id_$i"}, | + .$dbh->quote($form->{"description_$i"}).qq|, + $form->{"qty_$i"}, $fxsellprice, $form->{"discount_$i"}, | + .$dbh->quote($form->{"unit_$i"}).qq|, | + .$form->dbquote($form->{"reqdate_$i"}, SQL_DATE).qq|, + $project_id, | + .$dbh->quote($form->{"serialnumber_$i"}).qq|, + $form->{"ship_$i"})|; + $dbh->do($query) || $form->dberror($query); + + $form->{"sellprice_$i"} = $fxsellprice; + $form->{"discount_$i"} *= 100; + } + } + + + # set values which could be empty + map { $form->{$_} *= 1 } qw(vendor_id customer_id taxincluded closed quotation); + + # add up the tax + my $tax = 0; + map { $tax += $form->round_amount($taxaccounts{$_}, 2) } keys %taxaccounts; + + $amount = $form->round_amount($netamount + $tax, 2); + $netamount = $form->round_amount($netamount, 2); + + if ($form->{currency} eq $form->{defaultcurrency}) { + $form->{exchangerate} = 1; + } else { + $exchangerate = $form->check_exchangerate($myconfig, $form->{currency}, $form->{transdate}, ($form->{vc} eq 'customer') ? 'buy' : 'sell'); + } + + $form->{exchangerate} = ($exchangerate) ? $exchangerate : $form->parse_amount($myconfig, $form->{exchangerate}); + + my $quotation = ($form->{type} =~ /_order$/) ? '0' : '1'; + + ($null, $form->{department_id}) = split(/--/, $form->{department}); + $form->{department_id} *= 1; + + # save OE record + $query = qq|UPDATE oe set + ordnumber = |.$dbh->quote($form->{ordnumber}).qq|, + quonumber = |.$dbh->quote($form->{quonumber}).qq|, + transdate = '$form->{transdate}', + vendor_id = $form->{vendor_id}, + customer_id = $form->{customer_id}, + amount = $amount, + netamount = $netamount, + reqdate = |.$form->dbquote($form->{reqdate}, SQL_DATE).qq|, + taxincluded = '$form->{taxincluded}', + shippingpoint = |.$dbh->quote($form->{shippingpoint}).qq|, + shipvia = |.$dbh->quote($form->{shipvia}).qq|, + notes = |.$dbh->quote($form->{notes}).qq|, + intnotes = |.$dbh->quote($form->{intnotes}).qq|, + curr = '$form->{currency}', + closed = '$form->{closed}', + quotation = '$quotation', + department_id = $form->{department_id}, + employee_id = $form->{employee_id}, + language_code = '$form->{language_code}' + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $form->{ordtotal} = $amount; + + # add shipto + $form->{name} = $form->{$form->{vc}}; + $form->{name} =~ s/--$form->{"$form->{vc}_id"}//; + $form->add_shipto($dbh, $form->{id}); + + # save printed, emailed, queued + $form->save_status($dbh); + + if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) { + if ($form->{vc} eq 'customer') { + $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, $form->{exchangerate}, 0); + } + if ($form->{vc} eq 'vendor') { + $form->update_exchangerate($dbh, $form->{currency}, $form->{transdate}, 0, $form->{exchangerate}); + } + } + + + if ($form->{type} =~ /_order$/) { + # adjust onhand + &adj_onhand($dbh, $form, $ml * -1); + &adj_inventory($dbh, $myconfig, $form); + } + + my %audittrail = ( tablename => 'oe', + reference => ($form->{type} =~ /_order$/) ? $form->{ordnumber} : $form->{quonumber}, + formname => $form->{type}, + action => 'saved', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + + +sub delete { + my ($self, $myconfig, $form, $spool) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + # delete spool files + my $query = qq|SELECT spoolfile FROM status + WHERE trans_id = $form->{id} + AND spoolfile IS NOT NULL|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $spoolfile; + my @spoolfiles = (); + + while (($spoolfile) = $sth->fetchrow_array) { + push @spoolfiles, $spoolfile; + } + $sth->finish; + + + $query = qq|SELECT o.parts_id, o.ship, p.inventory_accno_id + FROM orderitems o + JOIN parts p ON (p.id = o.parts_id) + WHERE trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + if ($form->{type} =~ /_order$/) { + $ml = ($form->{type} eq 'purchase_order') ? -1 : 1; + while (my ($id, $ship, $inv) = $sth->fetchrow_array) { + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $id|, + $ship * $ml) if $inv; + } + } + $sth->finish; + + # delete inventory + $query = qq|DELETE FROM inventory + WHERE oe_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete status entries + $query = qq|DELETE FROM status + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete OE record + $query = qq|DELETE FROM oe + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + # delete individual entries + $query = qq|DELETE FROM orderitems + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|DELETE FROM shipto + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + my %audittrail = ( tablename => 'oe', + reference => ($form->{type} =~ /_order$/) ? $form->{ordnumber} : $form->{quonumber}, + formname => $form->{type}, + action => 'deleted', + id => $form->{id} ); + + $form->audittrail($dbh, "", \%audittrail); + + my $rc = $dbh->commit; + $dbh->disconnect; + + if ($rc) { + foreach $spoolfile (@spoolfiles) { + unlink "$spool/$spoolfile" if $spoolfile; + } + } + + $rc; + +} + + + +sub retrieve { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query; + my $var; + + if ($form->{id}) { + # get default accounts and last order number + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE d.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE d.income_accno_id = c.id) AS income_accno, + (SELECT c.accno FROM chart c + WHERE d.expense_accno_id = c.id) AS expense_accno, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + d.curr AS currencies + FROM defaults d|; + } else { + $query = qq|SELECT (SELECT c.accno FROM chart c + WHERE d.inventory_accno_id = c.id) AS inventory_accno, + (SELECT c.accno FROM chart c + WHERE d.income_accno_id = c.id) AS income_accno, + (SELECT c.accno FROM chart c + WHERE d.expense_accno_id = c.id) AS expense_accno, + (SELECT c.accno FROM chart c + WHERE d.fxgain_accno_id = c.id) AS fxgain_accno, + (SELECT c.accno FROM chart c + WHERE d.fxloss_accno_id = c.id) AS fxloss_accno, + d.curr AS currencies, + current_date AS transdate + FROM defaults d|; + } + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + + if ($form->{id}) { + + # retrieve order + $query = qq|SELECT o.ordnumber, o.transdate, o.reqdate, + o.taxincluded, o.shippingpoint, o.shipvia, o.notes, o.intnotes, + o.curr AS currency, e.name AS employee, o.employee_id, + o.$form->{vc}_id, cv.name AS $form->{vc}, o.amount AS invtotal, + o.closed, o.reqdate, o.quonumber, o.department_id, + d.description AS department, o.language_code + FROM oe o + JOIN $form->{vc} cv ON (o.$form->{vc}_id = cv.id) + LEFT JOIN employee e ON (o.employee_id = e.id) + LEFT JOIN department d ON (o.department_id = d.id) + WHERE o.id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + + $query = qq|SELECT * FROM shipto + WHERE trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $ref = $sth->fetchrow_hashref(NAME_lc); + map { $form->{$_} = $ref->{$_} } keys %$ref; + $sth->finish; + + # get printed, emailed and queued + $query = qq|SELECT s.printed, s.emailed, s.spoolfile, s.formname + FROM status s + WHERE s.trans_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $form->{printed} .= "$ref->{formname} " if $ref->{printed}; + $form->{emailed} .= "$ref->{formname} " if $ref->{emailed}; + $form->{queued} .= "$ref->{formname} $ref->{spoolfile} " if $ref->{spoolfile}; + } + $sth->finish; + map { $form->{$_} =~ s/ +$//g } qw(printed emailed queued); + + + my %oid = ( 'Pg' => 'oid', + 'PgPP' => 'oid', + 'Oracle' => 'rowid', + 'DB2' => '1=1' + ); + + # retrieve individual items + $query = qq|SELECT o.id AS orderitems_id, + c1.accno AS inventory_accno, + c2.accno AS income_accno, + c3.accno AS expense_accno, + p.partnumber, p.assembly, o.description, o.qty, + o.sellprice, o.parts_id AS id, o.unit, o.discount, p.bin, + o.reqdate, o.project_id, o.serialnumber, o.ship, + pr.projectnumber, + pg.partsgroup, p.partsgroup_id, p.partnumber AS sku, + p.listprice, p.lastcost, p.weight, + t.description AS partsgrouptranslation + FROM orderitems o + JOIN parts p ON (o.parts_id = p.id) + LEFT JOIN chart c1 ON (p.inventory_accno_id = c1.id) + LEFT JOIN chart c2 ON (p.income_accno_id = c2.id) + LEFT JOIN chart c3 ON (p.expense_accno_id = c3.id) + LEFT JOIN project pr ON (o.project_id = pr.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + LEFT JOIN translation t ON (t.trans_id = p.partsgroup_id AND t.language_code = '$form->{language_code}') + WHERE o.trans_id = $form->{id} + ORDER BY o.$oid{$myconfig->{dbdriver}}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + # foreign exchange rates + &exchangerate_defaults($dbh, $form); + + # query for price matrix + my $pmh = &price_matrix_query($dbh, $form); + + # taxes + $query = qq|SELECT c.accno + FROM chart c + JOIN partstax pt ON (pt.chart_id = c.id) + WHERE pt.parts_id = ?|; + my $tth = $dbh->prepare($query) || $form->dberror($query); + + my $taxrate; + my $ptref; + my $sellprice; + my $listprice; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + ($decimalplaces) = ($ref->{sellprice} =~ /\.(\d+)/); + $decimalplaces = length $decimalplaces; + $decimalplaces = 2 unless $decimalplaces; + + $tth->execute($ref->{id}); + $ref->{taxaccounts} = ""; + $taxrate = 0; + + while ($ptref = $tth->fetchrow_hashref(NAME_lc)) { + $ref->{taxaccounts} .= "$ptref->{accno} "; + $taxrate += $form->{"$ptref->{accno}_rate"}; + } + $tth->finish; + chop $ref->{taxaccounts}; + + # preserve prices + $sellprice = $ref->{sellprice}; + $listprice = $ref->{listprice}; + + # multiply by exchangerate + $ref->{sellprice} = $form->round_amount($ref->{sellprice} * $form->{$form->{currency}}, $decimalplaces); + $ref->{listprice} = $form->round_amount($ref->{listprice} * $form->{$form->{currency}}, $decimalplaces); + + # partnumber and price matrix + &price_matrix($pmh, $ref, $form->{transdate}, $decimalplaces, $form, $myconfig, 1); + + $ref->{sellprice} = $sellprice; + $ref->{listprice} = $listprice; + + $ref->{partsgroup} = $ref->{partsgrouptranslation} if $ref->{partsgrouptranslation}; + + push @{ $form->{form_details} }, $ref; + + } + $sth->finish; + + } else { + + # get last name used + $form->lastname_used($dbh, $myconfig, $form->{vc}) unless $form->{"$form->{vc}_id"}; + delete $form->{notes}; + + } + + $dbh->disconnect; + +} + + +sub price_matrix_query { + my ($dbh, $form) = @_; + + my $query; + my $sth; + + if ($form->{customer_id}) { + $query = qq|SELECT p.*, g.pricegroup + FROM partscustomer p + LEFT JOIN pricegroup g ON (g.id = p.pricegroup_id) + WHERE p.parts_id = ? + AND p.customer_id = $form->{customer_id} + + UNION + + SELECT p.*, g.pricegroup + FROM partscustomer p + LEFT JOIN pricegroup g ON (g.id = p.pricegroup_id) + JOIN customer c ON (c.pricegroup_id = g.id) + WHERE p.parts_id = ? + AND c.id = $form->{customer_id} + + UNION + + SELECT p.*, '' AS pricegroup + FROM partscustomer p + WHERE p.customer_id = 0 + AND p.pricegroup_id = 0 + AND p.parts_id = ? + + ORDER BY customer_id DESC, pricegroup_id DESC, pricebreak + |; + $sth = $dbh->prepare($query) || $form->dberror($query); + } + + if ($form->{vendor_id}) { + # price matrix and vendor's partnumber + $query = qq|SELECT partnumber + FROM partsvendor + WHERE parts_id = ? + AND vendor_id = $form->{vendor_id}|; + $sth = $dbh->prepare($query) || $form->dberror($query); + } + + $sth; + +} + + +sub price_matrix { + my ($pmh, $ref, $transdate, $decimalplaces, $form, $myconfig, $init) = @_; + + $ref->{pricematrix} = ""; + my $customerprice = 0; + my $pricegroup = 0; + my $sellprice; + my $mref; + + # depends if this is a customer or vendor + if ($form->{customer_id}) { + $pmh->execute($ref->{id}, $ref->{id}, $ref->{id}); + + while ($mref = $pmh->fetchrow_hashref(NAME_lc)) { + + # check date + if ($mref->{validfrom}) { + next if $transdate < $form->datetonum($mref->{validfrom}, $myconfig); + } + if ($mref->{validto}) { + next if $transdate > $form->datetonum($mref->{validto}, $myconfig); + } + + # convert price + $sellprice = $form->round_amount($mref->{sellprice} * $form->{$mref->{curr}}, $decimalplaces); + + if ($mref->{customer_id}) { + $ref->{sellprice} = $sellprice unless $mref->{pricebreak}; + $ref->{pricematrix} .= "$mref->{pricebreak}:$sellprice "; + $customerprice = 1; + } + + if ($mref->{pricegroup_id}) { + if (! $customerprice) { + $ref->{sellprice} = $sellprice unless $mref->{pricebreak}; + $ref->{pricematrix} .= "$mref->{pricebreak}:$sellprice "; + $pricegroup = 1; + } + } + + if (! $customerprice && ! $pricegroup) { + $ref->{sellprice} = $sellprice unless $mref->{pricebreak}; + $ref->{pricematrix} .= "$mref->{pricebreak}:$sellprice "; + } + + } + $pmh->finish; + + if ($ref->{pricematrix} !~ /^0:/) { + if ($init) { + $sellprice = $form->round_amount($ref->{sellprice}, $decimalplaces); + } else { + $sellprice = $form->round_amount($ref->{sellprice} * (1 - $form->{tradediscount}), $decimalplaces); + } + $ref->{pricematrix} = "0:$sellprice ".$ref->{pricematrix}; + } + chop $ref->{pricematrix}; + + } + + + if ($form->{vendor_id}) { + $pmh->execute($ref->{id}); + + $mref = $pmh->fetchrow_hashref(NAME_lc); + + if ($mref->{partnumber}) { + $ref->{partnumber} = $mref->{partnumber}; + } + + if ($mref->{lastcost}) { + # do a conversion + $ref->{sellprice} = $form->round_amount($mref->{lastcost} * $form->{$mref->{curr}}, $decimalplaces); + } + $pmh->finish; + + $ref->{sellprice} *= 1; + + # add 0:price to matrix + $ref->{pricematrix} = "0:$ref->{sellprice}"; + + } + +} + + +sub exchangerate_defaults { + my ($dbh, $form) = @_; + + my $var; + my $buysell = ($form->{vc} eq "customer") ? "buy" : "sell"; + + # get default currencies + my $query = qq|SELECT substr(curr,1,3), curr FROM defaults|; + my $eth = $dbh->prepare($query) || $form->dberror($query); + $eth->execute; + ($form->{defaultcurrency}, $form->{currencies}) = $eth->fetchrow_array; + $eth->finish; + + $query = qq|SELECT $buysell + FROM exchangerate + WHERE curr = ? + AND transdate = ?|; + my $eth1 = $dbh->prepare($query) || $form->dberror($query); + $query = qq~SELECT max(transdate || ' ' || $buysell || ' ' || curr) + FROM exchangerate + WHERE curr = ?~; + my $eth2 = $dbh->prepare($query) || $form->dberror($query); + + # get exchange rates for transdate or max + foreach $var (split /:/, substr($form->{currencies},4)) { + $eth1->execute($var, $form->{transdate}); + ($form->{$var}) = $eth1->fetchrow_array; + if (! $form->{$var} ) { + $eth2->execute($var); + + ($form->{$var}) = $eth2->fetchrow_array; + ($null, $form->{$var}) = split / /, $form->{$var}; + $form->{$var} = 1 unless $form->{$var}; + $eth2->finish; + } + $eth1->finish; + } + + $form->{$form->{defaultcurrency}} = 1; + +} + + +sub order_details { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $query; + my $sth; + + my $item; + my $i; + my @sortlist = (); + my $projectnumber; + my $projectnumber_id; + my $translation; + my $partsgroup; + + my %oid = ( 'Pg' => 'oid', + 'PgPP' => 'oid', + 'Oracle' => 'rowid', + 'DB2' => '1=1' + ); + + # sort items by project and partsgroup + for $i (1 .. $form->{rowcount}) { + $projectnumber = ""; + $partsgroup = ""; + $projectnumber_id = 0; + if ($form->{"projectnumber_$i"} && $form->{groupprojectnumber}) { + ($projectnumber, $projectnumber_id) = split /--/, $form->{"projectnumber_$i"}; + } + if ($form->{"partsgroup_$i"} && $form->{grouppartsgroup}) { + ($partsgroup) = split /--/, $form->{"partsgroup_$i"}; + } + push @sortlist, [ $i, "$projectnumber$partsgroup", $projectnumber, $projectnumber_id, $partsgroup ]; + + # sort the whole thing by project and group + @sortlist = sort { $a->[1] cmp $b->[1] } @sortlist; + + } + + # if there is a warehouse limit picking + if ($form->{warehouse_id} && $form->{formname} =~ /(pick|packing)_list/) { + # run query to check for inventory + $query = qq|SELECT sum(qty) AS qty + FROM inventory + WHERE parts_id = ? + AND warehouse_id = ?|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + for $i (1 .. $form->{rowcount}) { + $sth->execute($form->{"id_$i"}, $form->{warehouse_id}) || $form->dberror; + + ($qty) = $sth->fetchrow_array; + $sth->finish; + + $form->{"qty_$i"} = 0 if $qty == 0; + + if ($form->parse_amount($myconfig, $form->{"ship_$i"}) > $qty) { + $form->{"ship_$i"} = $form->format_amount($myconfig, $qty); + } + } + } + + my @taxaccounts; + my %taxaccounts; + my $taxrate; + my $taxamount; + my $taxbase; + my $taxdiff; + + $query = qq|SELECT p.description, t.description + FROM project p + LEFT JOIN translation t ON (t.trans_id = p.id AND t.language_code = '$form->{language_code}') + WHERE id = ?|; + my $prh = $dbh->prepare($query) || $form->dberror($query); + + my $runningnumber = 1; + my $sameitem = ""; + my $subtotal; + my $k = scalar @sortlist; + my $j = 0; + + foreach $item (@sortlist) { + $i = $item->[0]; + $j++; + + if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { + if ($item->[1] ne $sameitem) { + + $projectnumber = ""; + if ($form->{groupprojectnumber} && $item->[2]) { + # get project description + $prh->execute($item->[3]) || $form->dberror($query); + + ($projectnumber, $translation) = $prh->fetchrow_array; + $prh->finish; + + $projectnumber = ($translation) ? "$item->[2], $translation" : "$item->[2], $projectnumber"; + } + + if ($form->{grouppartsgroup} && $item->[4]) { + $projectnumber .= " / " if $projectnumber; + $projectnumber .= $item->[4]; + } + + $form->{projectnumber} = $projectnumber; + $form->format_string(projectnumber); + + push(@{ $form->{description} }, qq|$form->{projectnumber}|); + $sameitem = $item->[1]; + + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku qty ship unit bin serialnumber reqdate projectnumber sellprice listprice netprice discount discountrate linetotal weight); + } + } + + $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"}); + + if ($form->{"qty_$i"} != 0) { + + $form->{totalqty} += $form->{"qty_$i"}; + $form->{totalship} += $form->{"ship_$i"}; + $form->{totalweight} += ($form->{"weight_$i"} * $form->{"qty_$i"}); + + # add number, description and qty to $form->{number}, .... + push(@{ $form->{runningnumber} }, $runningnumber++); + push(@{ $form->{number} }, qq|$form->{"partnumber_$i"}|); + push(@{ $form->{sku} }, qq|$form->{"sku_$i"}|); + push(@{ $form->{description} }, qq|$form->{"description_$i"}|); + push(@{ $form->{qty} }, $form->format_amount($myconfig, $form->{"qty_$i"})); + push(@{ $form->{ship} }, $form->format_amount($myconfig, $form->{"ship_$i"})); + push(@{ $form->{unit} }, qq|$form->{"unit_$i"}|); + push(@{ $form->{bin} }, qq|$form->{"bin_$i"}|); + push(@{ $form->{serialnumber} }, qq|$form->{"serialnumber_$i"}|); + push(@{ $form->{reqdate} }, qq|$form->{"reqdate_$i"}|); + push(@{ $form->{projectnumber} }, qq|$form->{"projectnumber_$i"}|); + + push(@{ $form->{sellprice} }, $form->{"sellprice_$i"}); + + push(@{ $form->{listprice} }, $form->{"listprice_$i"}); + + push(@{ $form->{weight} }, $form->{"weight_$i"}); + + my $sellprice = $form->parse_amount($myconfig, $form->{"sellprice_$i"}); + my ($dec) = ($sellprice =~ /\.(\d+)/); + $dec = length $dec; + my $decimalplaces = ($dec > 2) ? $dec : 2; + + my $discount = $form->round_amount($sellprice * $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100, $decimalplaces); + + # keep a netprice as well, (sellprice - discount) + $form->{"netprice_$i"} = $sellprice - $discount; + + my $linetotal = $form->round_amount($form->{"qty_$i"} * $form->{"netprice_$i"}, 2); + + push(@{ $form->{netprice} }, ($form->{"netprice_$i"} != 0) ? $form->format_amount($myconfig, $form->{"netprice_$i"}, $decimalplaces) : " "); + + $discount = ($discount != 0) ? $form->format_amount($myconfig, $discount * -1, $decimalplaces) : " "; + $linetotal = ($linetotal != 0) ? $linetotal : " "; + + push(@{ $form->{discount} }, $discount); + push(@{ $form->{discountrate} }, $form->format_amount($myconfig, $form->{"discount_$i"})); + + $form->{ordtotal} += $linetotal; + + # this is for the subtotals for grouping + $subtotal += $linetotal; + + push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2)); + + $taxrate = 0; + + map { $taxrate += $form->{"${_}_rate"} } split / /, $form->{"taxaccounts_$i"}; + + if ($form->{taxincluded}) { + # calculate tax + $taxamount = $linetotal * $taxrate / (1 + $taxrate); + $taxbase = $linetotal / (1 + $taxrate); + } else { + $taxamount = $linetotal * $taxrate; + $taxbase = $linetotal; + } + + + if ($form->round_amount($taxamount, 2) != 0) { + foreach my $item (split / /, $form->{"taxaccounts_$i"}) { + $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate; + $taxbase{$item} += $taxbase; + } + } + + if ($form->{"assembly_$i"}) { + $form->{stagger} = -1; + &assembly_details($dbh, $form, $form->{"id_$i"}, $oid{$myconfig->{dbdriver}}, $form->{"qty_$i"}); + } + + } + + # add subtotal + if ($form->{groupprojectnumber} || $form->{grouppartsgroup}) { + if ($subtotal) { + if ($j < $k) { + # look at next item + if ($sortlist[$j]->[1] ne $sameitem) { + + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku qty ship unit bin serialnumber reqdate projectnumber sellprice listprice netprice discount discountrate weight); + + push(@{ $form->{description} }, $form->{groupsubtotaldescription}); + + if (exists $form->{groupsubtotaldescription}) { + push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $subtotal, 2)); + } else { + push(@{ $form->{linetotal} }, ""); + } + + $subtotal = 0; + } + + } else { + + # got last item + if (exists $form->{groupsubtotaldescription}) { + + map { push(@{ $form->{$_} }, "") } qw(runningnumber number sku qty ship unit bin serialnumber reqdate projectnumber sellprice listprice netprice discount discountrate weight); + + push(@{ $form->{description} }, $form->{groupsubtotaldescription}); + push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $subtotal, 2)); + } + } + } + } + } + + + my $tax = 0; + foreach $item (sort keys %taxaccounts) { + if ($form->round_amount($taxaccounts{$item}, 2) != 0) { + push(@{ $form->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2)); + + $tax += $taxamount = $form->round_amount($taxaccounts{$item}, 2); + + push(@{ $form->{tax} }, $form->format_amount($myconfig, $taxamount, 2)); + push(@{ $form->{taxdescription} }, $form->{"${item}_description"}); + push(@{ $form->{taxrate} }, $form->format_amount($myconfig, $form->{"${item}_rate"} * 100)); + push(@{ $form->{taxnumber} }, $form->{"${item}_taxnumber"}); + } + } + + map { $form->{$_} = $form->format_amount($myconfig, $form->{$_}) } qw(totalqty totalship totalweight); + $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2); + $form->{ordtotal} = ($form->{taxincluded}) ? $form->{ordtotal} : $form->{ordtotal} + $tax; + + use SL::CP; + my $c; + if ($form->{language_code}) { + $c = new CP $form->{language_code}; + } else { + $c = new CP $myconfig->{countrycode}; + } + $c->init; + my $whole; + ($whole, $form->{decimal}) = split /\./, $form->{ordtotal}; + $form->{decimal} .= "00"; + $form->{decimal} = substr($form->{decimal}, 0, 2); + $form->{text_amount} = $c->num2text($whole); + + # format amounts + $form->{quototal} = $form->{ordtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2); + + $dbh->disconnect; + +} + + +sub assembly_details { + my ($dbh, $form, $id, $oid, $qty) = @_; + + my $sm = ""; + my $spacer; + + $form->{stagger}++; + if ($form->{format} eq 'html') { + $spacer = " " x (3 * ($form->{stagger} - 1)) if $form->{stagger} > 1; + } + if ($form->{format} =~ /(postscript|pdf)/) { + if ($form->{stagger} > 1) { + $spacer = ($form->{stagger} - 1) * 3; + $spacer = '\rule{'.$spacer.'mm}{0mm}'; + } + } + + # get parts and push them onto the stack + my $sortorder = ""; + + if ($form->{grouppartsgroup}) { + $sortorder = qq|ORDER BY pg.partsgroup, a.$oid|; + } else { + $sortorder = qq|ORDER BY a.$oid|; + } + + my $where = ($form->{formname} eq 'work_order') ? "1 = 1" : "a.bom = '1'"; + + my $query = qq|SELECT p.partnumber, p.description, p.unit, a.qty, + pg.partsgroup, p.partnumber AS sku, p.assembly, p.id, p.bin + FROM assembly a + JOIN parts p ON (a.parts_id = p.id) + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE $where + AND a.id = '$id' + $sortorder|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + if ($form->{grouppartsgroup} && $ref->{partsgroup} ne $sm) { + map { push(@{ $form->{$_} }, "") } qw(number sku unit qty runningnumber ship bin serialnumber reqdate projectnumber sellprice listprice netprice discount discountrate linetotal); + $sm = ($ref->{partsgroup}) ? $ref->{partsgroup} : ""; + push(@{ $form->{description} }, "$spacer$sm"); + } + + if ($form->{stagger}) { + push(@{ $form->{description} }, qq|$spacer$ref->{sku}, $ref->{description}|); + map { push(@{ $form->{$_} }, "") } qw(number sku runningnumber ship serialnumber reqdate projectnumber sellprice listprice netprice discount discountrate linetotal); + } else { + push(@{ $form->{description} }, qq|$ref->{description}|); + push(@{ $form->{sku} }, $ref->{partnumber}); + push(@{ $form->{number} }, $ref->{partnumber}); + + map { push(@{ $form->{$_} }, "") } qw(runningnumber ship serialnumber reqdate projectnumber sellprice listprice netprice discount discountrate linetotal); + } + + push(@{ $form->{qty} }, $form->format_amount($myconfig, $ref->{qty} * $qty)); + map { push(@{ $form->{$_} }, $ref->{$_}) } qw(unit bin); + + + if ($ref->{assembly} && $form->{formname} eq 'work_order') { + &assembly_details($dbh, $form, $ref->{id}, $oid, $ref->{qty} * $qty); + } + + } + $sth->finish; + + $form->{stagger}--; + +} + + +sub project_description { + my ($self, $dbh, $id) = @_; + + my $query = qq|SELECT description + FROM project + WHERE id = $id|; + ($_) = $dbh->selectrow_array; + + $_; + +} + + +sub get_warehouses { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + # setup warehouses + my $query = qq|SELECT id, description + FROM warehouse + ORDER BY 2|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_warehouses} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + + +sub save_inventory { + my ($self, $myconfig, $form) = @_; + + my ($null, $warehouse_id) = split /--/, $form->{warehouse}; + $warehouse_id *= 1; + + my $ml = ($form->{type} eq 'ship_order') ? -1 : 1; + + my $dbh = $form->dbconnect_noauto($myconfig); + my $sth; + my $wth; + my $serialnumber; + my $ship; + + my $employee_id; + ($null, $employee_id) = split /--/, $form->{employee}; + ($null, $employee_id) = $form->get_employee($dbh) if ! $employee_id; + + $query = qq|SELECT serialnumber, ship + FROM orderitems + WHERE trans_id = ? + AND id = ? + FOR UPDATE|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + $query = qq|SELECT sum(qty) + FROM inventory + WHERE parts_id = ? + AND warehouse_id = ?|; + $wth = $dbh->prepare($query) || $form->dberror($query); + + + for my $i (1 .. $form->{rowcount}) { + + $ship = (abs($form->{"ship_$i"}) > abs($form->{"qty_$i"})) ? $form->{"qty_$i"} : $form->{"ship_$i"}; + + if ($warehouse_id && $form->{type} eq 'ship_order') { + + $wth->execute($form->{"id_$i"}, $warehouse_id) || $form->dberror; + + ($qty) = $wth->fetchrow_array; + $wth->finish; + + if ($ship > $qty) { + $ship = $qty; + } + } + + + if ($ship != 0) { + + $ship *= $ml; + $query = qq|INSERT INTO inventory (parts_id, warehouse_id, + qty, oe_id, orderitems_id, shippingdate, employee_id) + VALUES ($form->{"id_$i"}, $warehouse_id, + $ship, $form->{"id"}, + $form->{"orderitems_id_$i"}, '$form->{shippingdate}', + $employee_id)|; + $dbh->do($query) || $form->dberror($query); + + # add serialnumber, ship to orderitems + $sth->execute($form->{id}, $form->{"orderitems_id_$i"}) || $form->dberror; + ($serialnumber, $ship) = $sth->fetchrow_array; + $sth->finish; + + $serialnumber .= " " if $serialnumber; + $serialnumber .= qq|$form->{"serialnumber_$i"}|; + $ship += $form->{"ship_$i"}; + + $query = qq|UPDATE orderitems SET + serialnumber = '$serialnumber', + ship = $ship, + reqdate = '$form->{shippingdate}' + WHERE trans_id = $form->{id} + AND id = $form->{"orderitems_id_$i"}|; + $dbh->do($query) || $form->dberror($query); + + + # update order with ship via + $query = qq|UPDATE oe SET + shippingpoint = '$form->{shippingpoint}', + shipvia = '$form->{shipvia}' + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + + # update onhand for parts + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $form->{"id_$i"}|, + $form->{"ship_$i"} * $ml); + + } + } + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +sub adj_onhand { + my ($dbh, $form, $ml) = @_; + + my $query = qq|SELECT oi.parts_id, oi.ship, p.inventory_accno_id, p.assembly + FROM orderitems oi + JOIN parts p ON (p.id = oi.parts_id) + WHERE oi.trans_id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $query = qq|SELECT sum(p.inventory_accno_id) + FROM parts p + JOIN assembly a ON (a.parts_id = p.id) + WHERE a.id = ?|; + my $ath = $dbh->prepare($query) || $form->dberror($query); + + my $ispa; + my $ref; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + if ($ref->{inventory_accno_id} || $ref->{assembly}) { + + # do not update if assembly consists of all services + if ($ref->{assembly}) { + $ath->execute($ref->{parts_id}) || $form->dberror($query); + + ($ispa) = $ath->fetchrow_array; + $ath->finish; + + next unless $ispa; + + } + + # adjust onhand in parts table + $form->update_balance($dbh, + "parts", + "onhand", + qq|id = $ref->{parts_id}|, + $ref->{ship} * $ml); + } + } + + $sth->finish; + +} + + +sub adj_inventory { + my ($dbh, $myconfig, $form) = @_; + + my %oid = ( 'Pg' => 'oid', + 'PgPP' => 'oid', + 'Oracle' => 'rowid', + 'DB2' => '1=1' + ); + + # increase/reduce qty in inventory table + my $query = qq|SELECT oi.id, oi.parts_id, oi.ship + FROM orderitems oi + WHERE oi.trans_id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + $query = qq|SELECT $oid{$myconfig->{dbdriver}} AS oid, qty, + (SELECT SUM(qty) FROM inventory + WHERE oe_id = $form->{id} + AND orderitems_id = ?) AS total + FROM inventory + WHERE oe_id = $form->{id} + AND orderitems_id = ?|; + my $ith = $dbh->prepare($query) || $form->dberror($query); + + my $qty; + my $ml = ($form->{type} =~ /(ship|sales)_order/) ? -1 : 1; + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + + $ith->execute($ref->{id}, $ref->{id}) || $form->dberror($query); + + while (my $inv = $ith->fetchrow_hashref(NAME_lc)) { + + if (($qty = (($inv->{total} * $ml) - $ref->{ship})) >= 0) { + $qty = $inv->{qty} if ($qty > ($inv->{qty} * $ml)); + + $form->update_balance($dbh, + "inventory", + "qty", + qq|$oid{$myconfig->{dbdriver}} = $inv->{oid}|, + $qty * -1 * $ml); + } + } + $ith->finish; + + } + $sth->finish; + + # delete inventory entries if qty = 0 + $query = qq|DELETE FROM inventory + WHERE oe_id = $form->{id} + AND qty = 0|; + $dbh->do($query) || $form->dberror($query); + +} + + +sub get_inventory { + my ($self, $myconfig, $form) = @_; + + my ($null, $warehouse_id) = split /--/, $form->{warehouse}; + $warehouse_id *= 1; + + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT p.id, p.partnumber, p.description, p.onhand, + pg.partsgroup + FROM parts p + LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id) + WHERE p.onhand > 0|; + + if ($form->{partnumber}) { + $var = $form->like(lc $form->{partnumber}); + $query .= " + AND lower(p.partnumber) LIKE '$var'"; + } + if ($form->{description}) { + $var = $form->like(lc $form->{description}); + $query .= " + AND lower(p.description) LIKE '$var'"; + } + if ($form->{partsgroup}) { + $var = $form->like(lc $form->{partsgroup}); + $query .= " + AND lower(pg.partsgroup) LIKE '$var'"; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + + $query = qq|SELECT sum(i.qty), w.description, w.id + FROM inventory i + LEFT JOIN warehouse w ON (w.id = i.warehouse_id) + WHERE i.parts_id = ? + AND i.warehouse_id != $warehouse_id + GROUP BY w.description, w.id|; + $wth = $dbh->prepare($query) || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + $wth->execute($ref->{id}) || $form->dberror; + + while (($qty, $warehouse, $warehouse_id) = $wth->fetchrow_array) { + push @{ $form->{all_inventory} }, {'id' => $ref->{id}, + 'partnumber' => $ref->{partnumber}, + 'description' => $ref->{description}, + 'partsgroup' => $ref->{partsgroup}, + 'qty' => $qty, + 'warehouse_id' => $warehouse_id, + 'warehouse' => $warehouse} if $qty > 0; + } + $wth->finish; + } + $sth->finish; + + $dbh->disconnect; + + # sort inventory + @{ $form->{all_inventory} } = sort { $a->{$form->{sort}} cmp $b->{$form->{sort}} } @{ $form->{all_inventory} }; + +} + + +sub transfer { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query = qq|INSERT INTO inventory + (warehouse_id, parts_id, qty, shippingdate, employee_id) + VALUES (?, ?, ?, ?, ?)|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + ($form->{employee}, $form->{employee_id}) = $form->get_employee($dbh); + + my @a = localtime; $a[5] += 1900; $a[4]++; + $shippingdate = "$a[5]-$a[4]-$a[3]"; + + for my $i (1 .. $form->{rowcount}) { + $qty = $form->parse_amount($myconfig, $form->{"transfer_$i"}); + + $qty = $form->{"qty_$i"} if ($qty > $form->{"qty_$i"}); + + if ($qty) { + # to warehouse + $sth->execute($form->{warehouse_id}, $form->{"id_$i"}, $qty, $shippingdate, $form->{employee_id}) || $form->dberror; + + $sth->finish; + + # from warehouse + $sth->execute($form->{"warehouse_id_$i"}, $form->{"id_$i"}, $qty * -1, $shippingdate, $form->{employee_id}) || $form->dberror; + + $sth->finish; + } + } + + my $rc = $dbh->commit; + $dbh->disconnect; + + $rc; + +} + + +1; + diff --git a/sql-ledger/SL/OP.pm b/sql-ledger/SL/OP.pm new file mode 100644 index 000000000..184566c14 --- /dev/null +++ b/sql-ledger/SL/OP.pm @@ -0,0 +1,118 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2003 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Overpayment function +# used in AR, AP, IS, IR, OE, CP +# +#====================================================================== + +package OP; + +sub overpayment { + my ($self, $myconfig, $form, $dbh, $amount, $ml) = @_; + + my $fxamount = $form->round_amount($amount * $form->{exchangerate}, 2); + my ($paymentaccno) = split /--/, $form->{account}; + + my $vc_id = "$form->{vc}_id"; + + my $uid = time; + $uid .= $form->{login}; + + # add AR/AP header transaction with a payment + $query = qq|INSERT INTO $form->{arap} (invnumber, employee_id) + VALUES ('$uid', (SELECT id FROM employee + WHERE login = '$form->{login}'))|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|SELECT id FROM $form->{arap} + WHERE invnumber = '$uid'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($uid) = $sth->fetchrow_array; + $sth->finish; + + my $invnumber = $form->{invnumber}; + if (! $invnumber) { + $invnumber = $form->update_defaults($myconfig, ($form->{arap} eq 'ar') ? "sinumber" : "vinumber", $dbh); + } + + $query = qq|UPDATE $form->{arap} set + invnumber = |.$dbh->quote($invnumber).qq|, + $vc_id = $form->{"$form->{vc}_id"}, + transdate = '$form->{datepaid}', + datepaid = '$form->{datepaid}', + duedate = '$form->{datepaid}', + netamount = 0, + amount = 0, + paid = $fxamount, + curr = '$form->{currency}', + department_id = $form->{department_id} + WHERE id = $uid|; + $dbh->do($query) || $form->dberror($query); + + # add AR/AP + ($accno) = split /--/, $form->{$form->{ARAP}}; + + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, amount) + VALUES ($uid, (SELECT id FROM chart + WHERE accno = '$accno'), + '$form->{datepaid}', $fxamount * $ml)|; + $dbh->do($query) || $form->dberror($query); + + # add payment + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, + amount, source, memo) + VALUES ($uid, (SELECT id FROM chart + WHERE accno = '$paymentaccno'), + '$form->{datepaid}', $amount * $ml * -1, | + .$dbh->quote($form->{source}).qq|, | + .$dbh->quote($form->{memo}).qq|)|; + $dbh->do($query) || $form->dberror($query); + + # add exchangerate difference + if ($fxamount != $amount) { + $query = qq|INSERT INTO acc_trans (trans_id, chart_id, transdate, + amount, cleared, fx_transaction) + VALUES ($uid, (SELECT id FROM chart + WHERE accno = '$paymentaccno'), + '$form->{datepaid}', ($fxamount - $amount) * $ml * -1, + '1', '1')|; + $dbh->do($query) || $form->dberror($query); + } + + my %audittrail = ( tablename => $form->{arap}, + reference => $invnumber, + formname => ($form->{arap} eq 'ar') ? 'deposit' : 'pre-payment', + action => 'posted', + id => $uid ); + + $form->audittrail($dbh, "", \%audittrail); + +} + + +1; + diff --git a/sql-ledger/SL/PE.pm b/sql-ledger/SL/PE.pm new file mode 100644 index 000000000..f0850a7cf --- /dev/null +++ b/sql-ledger/SL/PE.pm @@ -0,0 +1,639 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2003 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Project module +# also used for partsgroups +# +#====================================================================== + +package PE; + + +sub projects { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{sort} = "projectnumber" unless $form->{sort}; + my @a = ($form->{sort}); + my %ordinal = ( projectnumber => 2, + description => 3 ); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $query = qq|SELECT id, projectnumber, description + FROM project + WHERE 1 = 1|; + + if ($form->{projectnumber}) { + my $projectnumber = $form->like(lc $form->{projectnumber}); + $query .= " AND lower(projectnumber) LIKE '$projectnumber'"; + } + if ($form->{projectdescription}) { + my $description = $form->like(lc $form->{projectdescription}); + $query .= " AND lower(description) LIKE '$description'"; + } + if ($form->{status} eq 'orphaned') { + $query .= " AND id NOT IN (SELECT p.id + FROM project p, acc_trans a + WHERE p.id = a.project_id) + AND id NOT IN (SELECT p.id + FROM project p, invoice i + WHERE p.id = i.project_id) + AND id NOT IN (SELECT p.id + FROM project p, orderitems o + WHERE p.id = o.project_id)"; + } + + $query .= qq| + ORDER BY $sortorder|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $i = 0; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{project_list} }, $ref; + $i++; + } + + $sth->finish; + $dbh->disconnect; + + $i; + +} + + +sub get_project { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT * + FROM project + WHERE id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # check if it is orphaned + $query = qq|SELECT count(*) + FROM acc_trans + WHERE project_id = $form->{id} + UNION + SELECT count(*) + FROM invoice + WHERE project_id = $form->{id} + UNION + SELECT count(*) + FROM orderitems + WHERE project_id = $form->{id} + |; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($count) = $sth->fetchrow_array) { + $form->{orphaned} += $count; + } + $sth->finish; + $form->{orphaned} = !$form->{orphaned}; + + $dbh->disconnect; + +} + + +sub save_project { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + if ($form->{id}) { + $query = qq|UPDATE project SET + projectnumber = |.$dbh->quote($form->{projectnumber}).qq|, + description = |.$dbh->quote($form->{description}).qq| + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO project + (projectnumber, description) + VALUES (| + .$dbh->quote($form->{projectnumber}).qq|, | + .$dbh->quote($form->{description}).qq|)|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub partsgroups { + my ($self, $myconfig, $form) = @_; + + my $var; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{sort} = "partsgroup" unless $form->{partsgroup}; + my @a = (partsgroup); + my $sortorder = $form->sort_order(\@a); + + my $query = qq|SELECT g.* + FROM partsgroup g|; + + my $where = "1 = 1"; + + if ($form->{partsgroup}) { + $var = $form->like(lc $form->{partsgroup}); + $where .= " AND lower(partsgroup) LIKE '$var'"; + } + $query .= qq| + WHERE $where + ORDER BY $sortorder|; + + if ($form->{status} eq 'orphaned') { + $query = qq|SELECT g.* + FROM partsgroup g + LEFT JOIN parts p ON (p.partsgroup_id = g.id) + WHERE $where + EXCEPT + SELECT g.* + FROM partsgroup g + JOIN parts p ON (p.partsgroup_id = g.id) + WHERE $where + ORDER BY $sortorder|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $i = 0; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{item_list} }, $ref; + $i++; + } + + $sth->finish; + $dbh->disconnect; + + $i; + +} + + +sub save_partsgroup { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + if ($form->{id}) { + $query = qq|UPDATE partsgroup SET + partsgroup = |.$dbh->quote($form->{partsgroup}).qq| + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO partsgroup + (partsgroup) + VALUES (|.$dbh->quote($form->{partsgroup}).qq|)|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub get_partsgroup { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT * + FROM partsgroup + WHERE id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # check if it is orphaned + $query = qq|SELECT count(*) + FROM parts + WHERE partsgroup_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{orphaned}) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + + $sth->finish; + + $dbh->disconnect; + +} + + +sub pricegroups { + my ($self, $myconfig, $form) = @_; + + my $var; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $form->{sort} = "pricegroup" unless $form->{sort}; + my @a = (pricegroup); + my $sortorder = $form->sort_order(\@a); + + my $query = qq|SELECT g.* + FROM pricegroup g|; + + my $where = "1 = 1"; + + if ($form->{pricegroup}) { + $var = $form->like(lc $form->{pricegroup}); + $where .= " AND lower(pricegroup) LIKE '$var'"; + } + $query .= qq| + WHERE $where + ORDER BY $sortorder|; + + if ($form->{status} eq 'orphaned') { + $query = qq|SELECT g.* + FROM pricegroup g + WHERE $where + AND g.id NOT IN (SELECT DISTINCT pricegroup_id + FROM partscustomer) + ORDER BY $sortorder|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $i = 0; + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{item_list} }, $ref; + $i++; + } + + $sth->finish; + $dbh->disconnect; + + $i; + +} + + +sub save_pricegroup { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + if ($form->{id}) { + $query = qq|UPDATE pricegroup SET + pricegroup = |.$dbh->quote($form->{pricegroup}).qq| + WHERE id = $form->{id}|; + } else { + $query = qq|INSERT INTO pricegroup + (pricegroup) + VALUES (|.$dbh->quote($form->{pricegroup}).qq|)|; + } + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +sub get_pricegroup { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT * + FROM pricegroup + WHERE id = $form->{id}|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + + map { $form->{$_} = $ref->{$_} } keys %$ref; + + $sth->finish; + + # check if it is orphaned + $query = qq|SELECT count(*) + FROM partscustomer + WHERE pricegroup_id = $form->{id}|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + ($form->{orphaned}) = $sth->fetchrow_array; + $form->{orphaned} = !$form->{orphaned}; + + $sth->finish; + + $dbh->disconnect; + +} + + +sub delete_tuple { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + $query = qq|DELETE FROM $form->{type} + WHERE id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + if ($form->{type} !~ /pricegroup/) { + $query = qq|DELETE FROM translation + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + } + + $dbh->commit; + $dbh->disconnect; + +} + + +sub description_translations { + my ($self, $myconfig, $form) = @_; + + my $where = "1 = 1\n"; + my $var; + my $ref; + + map { $where .= "AND lower(p.$_) LIKE '".$form->like(lc $form->{$_})."'\n" if $form->{$_} } qw(partnumber description); + + $where .= " AND p.obsolete = '0'"; + $where .= " AND p.id = $form->{id}" if $form->{id}; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my %ordinal = ( 'partnumber' => 2, + 'description' => 3 + ); + + my @a = qw(partnumber description); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $query = qq|SELECT l.description AS language, t.description AS translation, + l.code + FROM translation t + JOIN language l ON (l.code = t.language_code) + WHERE trans_id = ? + ORDER BY 1|; + my $tth = $dbh->prepare($query); + + $query = qq|SELECT p.id, p.partnumber, p.description + FROM parts p + WHERE $where + ORDER BY $sortorder|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $tra; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{translations} }, $ref; + + # get translations for description + $tth->execute($ref->{id}) || $form->dberror; + + while ($tra = $tth->fetchrow_hashref(NAME_lc)) { + $form->{trans_id} = $ref->{id}; + $tra->{id} = $ref->{id}; + push @{ $form->{translations} }, $tra; + } + + } + $sth->finish; + + &get_language("", $dbh, $form) if $form->{id}; + + $dbh->disconnect; + +} + + +sub partsgroup_translations { + my ($self, $myconfig, $form) = @_; + + my $where = "1 = 1\n"; + my $ref; + + if ($form->{description}) { + $where .= "AND lower(p.partsgroup) LIKE '".$form->like(lc $form->{description})."'"; + } + $where .= " AND p.id = $form->{id}" if $form->{id}; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT l.description AS language, t.description AS translation, + l.code + FROM translation t + JOIN language l ON (l.code = t.language_code) + WHERE trans_id = ? + ORDER BY 1|; + my $tth = $dbh->prepare($query); + + $form->sort_order(); + + $query = qq|SELECT p.id, p.partsgroup AS description + FROM partsgroup p + WHERE $where + ORDER BY 2 $form->{direction}|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $tra; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{translations} }, $ref; + + # get translations for partsgroup + $tth->execute($ref->{id}) || $form->dberror; + + while ($tra = $tth->fetchrow_hashref(NAME_lc)) { + $form->{trans_id} = $ref->{id}; + push @{ $form->{translations} }, $tra; + } + + } + $sth->finish; + + &get_language("", $dbh, $form) if $form->{id}; + + $dbh->disconnect; + +} + + +sub project_translations { + my ($self, $myconfig, $form) = @_; + + my $where = "1 = 1\n"; + my $var; + my $ref; + + map { $where .= "AND lower(p.$_) LIKE '".$form->like(lc $form->{$_})."'\n" if $form->{$_} } qw(projectnumber description); + + $where .= " AND p.id = $form->{id}" if $form->{id}; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my %ordinal = ( 'projectnumber' => 2, + 'description' => 3 + ); + + my @a = qw(projectnumber description); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $query = qq|SELECT l.description AS language, t.description AS translation, + l.code + FROM translation t + JOIN language l ON (l.code = t.language_code) + WHERE trans_id = ? + ORDER BY 1|; + my $tth = $dbh->prepare($query); + + $query = qq|SELECT p.id, p.projectnumber, p.description + FROM project p + WHERE $where + ORDER BY $sortorder|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $tra; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{translations} }, $ref; + + # get translations for description + $tth->execute($ref->{id}) || $form->dberror; + + while ($tra = $tth->fetchrow_hashref(NAME_lc)) { + $form->{trans_id} = $ref->{id}; + $tra->{id} = $ref->{id}; + push @{ $form->{translations} }, $tra; + } + + } + $sth->finish; + + &get_language("", $dbh, $form) if $form->{id}; + + $dbh->disconnect; + +} + + +sub get_language { + my ($self, $dbh, $form) = @_; + + # get language + my $query = qq|SELECT * + FROM language + ORDER BY 2|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_language} }, $ref; + } + $sth->finish; + +} + + +sub save_translation { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query = qq|DELETE FROM translation + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $query = qq|INSERT INTO translation (trans_id, language_code, description) + VALUES ($form->{id}, ?, ?)|; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + foreach my $i (1 .. $form->{translation_rows}) { + if ($form->{"language_code_$i"}) { + $sth->execute($form->{"language_code_$i"}, $form->{"translation_$i"}); + $sth->finish; + } + } + $dbh->commit; + $dbh->disconnect; + +} + + +sub delete_translation { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + $query = qq|DELETE FROM translation + WHERE trans_id = $form->{id}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + +1; + diff --git a/sql-ledger/SL/RC.pm b/sql-ledger/SL/RC.pm new file mode 100644 index 000000000..2a8bf9410 --- /dev/null +++ b/sql-ledger/SL/RC.pm @@ -0,0 +1,474 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2002 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# Account reconciliation routines +# +#====================================================================== + +package RC; + + +sub paymentaccounts { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT accno, description + FROM chart + WHERE link LIKE '%_paid%' + AND (category = 'A' OR category = 'L') + ORDER BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{PR} }, $ref; + } + $sth->finish; + + $form->all_years($dbh, $myconfig); + + $dbh->disconnect; + +} + + +sub payment_transactions { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn AutoCommit off + my $dbh = $form->dbconnect_noauto($myconfig); + + my $query; + my $sth; + + $query = qq|SELECT category FROM chart + WHERE accno = '$form->{accno}'|; + ($form->{category}) = $dbh->selectrow_array($query); + + my $cleared; + + ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + my $transdate = qq| AND ac.transdate < date '$form->{fromdate}'|; + + if (! $form->{fromdate}) { + $cleared = qq| AND ac.cleared = '1'|; + $transdate = ""; + } + + # get beginning balance + $query = qq|SELECT sum(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE c.accno = '$form->{accno}' + $transdate + $cleared + |; + ($form->{beginningbalance}) = $dbh->selectrow_array($query); + + # fx balance + $query = qq|SELECT sum(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE c.accno = '$form->{accno}' + AND ac.fx_transaction = '1' + $transdate + $cleared + |; + ($form->{fx_balance}) = $dbh->selectrow_array($query); + + + $transdate = ""; + if ($form->{todate}) { + $transdate = qq| AND ac.transdate <= date '$form->{todate}'|; + } + + # get statement balance + $query = qq|SELECT sum(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE c.accno = '$form->{accno}' + $transdate + |; + ($form->{endingbalance}) = $dbh->selectrow_array($query); + + # fx balance + $query = qq|SELECT sum(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + WHERE c.accno = '$form->{accno}' + AND ac.fx_transaction = '1' + $transdate + |; + ($form->{fx_endingbalance}) = $dbh->selectrow_array($query); + + + $cleared = qq| AND ac.cleared = '0'| unless $form->{fromdate}; + + if ($form->{report}) { + $cleared = qq| AND NOT (ac.cleared = '0' OR ac.cleared = '1')|; + if ($form->{cleared}) { + $cleared = qq| AND ac.cleared = '1'|; + } + if ($form->{outstanding}) { + $cleared = ($form->{cleared}) ? "" : qq| AND ac.cleared = '0'|; + } + if (! $form->{fromdate}) { + $form->{beginningbalance} = 0; + $form->{fx_balance} = 0; + } + } + + + if ($form->{summary}) { + $query = qq|SELECT ac.transdate, ac.source, + sum(ac.amount) AS amount, ac.cleared + FROM acc_trans ac + JOIN chart ch ON (ac.chart_id = ch.id) + WHERE ch.accno = '$form->{accno}' + AND ac.amount >= 0 + AND ac.fx_transaction = '0' + $cleared|; + $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate}; + $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate}; + $query .= " GROUP BY ac.source, ac.transdate, ac.cleared"; + $query .= qq| + UNION + SELECT ac.transdate, ac.source, + sum(ac.amount) AS amount, ac.cleared + FROM acc_trans ac + JOIN chart ch ON (ac.chart_id = ch.id) + WHERE ch.accno = '$form->{accno}' + AND ac.amount < 0 + AND ac.fx_transaction = '0' + $cleared|; + $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate}; + $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate}; + $query .= " GROUP BY ac.source, ac.transdate, ac.cleared"; + + $query .= " ORDER BY 1,2"; + + } else { + + $query = qq|SELECT ac.transdate, ac.source, ac.fx_transaction, + ac.amount, ac.cleared, g.id, g.description + FROM acc_trans ac + JOIN chart ch ON (ac.chart_id = ch.id) + JOIN gl g ON (g.id = ac.trans_id) + WHERE ch.accno = '$form->{accno}' + AND ac.fx_transaction = '0' + $cleared|; + $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate}; + $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate}; + + $query .= qq| + UNION + SELECT ac.transdate, ac.source, ac.fx_transaction, + ac.amount, ac.cleared, a.id, n.name + FROM acc_trans ac + JOIN chart ch ON (ac.chart_id = ch.id) + JOIN ar a ON (a.id = ac.trans_id) + JOIN customer n ON (n.id = a.customer_id) + WHERE ch.accno = '$form->{accno}' + AND ac.fx_transaction = '0' + $cleared|; + $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate}; + $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate}; + + $query .= qq| + UNION + SELECT ac.transdate, ac.source, ac.fx_transaction, + ac.amount, ac.cleared, a.id, n.name + FROM acc_trans ac + JOIN chart ch ON (ac.chart_id = ch.id) + JOIN ap a ON (a.id = ac.trans_id) + JOIN vendor n ON (n.id = a.vendor_id) + WHERE ch.accno = '$form->{accno}' + AND ac.fx_transaction = '0' + $cleared|; + $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate}; + $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate}; + + $query .= " ORDER BY 1,2,3"; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $dr; + my $cr; + my $fxs; + + if ($form->{summary}) { + $query = qq|SELECT ac.amount, ac.cleared + FROM acc_trans ac + JOIN ar a ON (a.id = ac.trans_id) + JOIN customer n ON (n.id = a.customer_id) + WHERE ac.fx_transaction = '1' + AND n.name = ? + AND ac.transdate = ? + AND ac.trans_id IN (SELECT id FROM ar a + JOIN acc_trans ac ON (a.id = ac.trans_id) + WHERE ac.source = ?) + AND ac.cleared = ? + AND NOT + (ac.chart_id IN + (SELECT fxgain_accno_id FROM defaults + UNION + SELECT fxloss_accno_id FROM defaults)) + |; + + $query .= qq| + UNION + SELECT ac.amount, ac.cleared + FROM acc_trans ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN vendor n ON (n.id = a.vendor_id) + WHERE ac.fx_transaction = '1' + AND n.name = ? + AND ac.transdate = ? + AND ac.trans_id IN (SELECT id FROM ap a + JOIN acc_trans ac ON (a.id = ac.trans_id) + WHERE ac.source = ?) + AND ac.cleared = ? + AND NOT + (ac.chart_id IN + (SELECT fxgain_accno_id FROM defaults + UNION + SELECT fxloss_accno_id FROM defaults)) + |; + + } else { + + $query = qq|SELECT ac.amount, ac.cleared + FROM acc_trans ac + WHERE ac.trans_id = ? + AND ac.fx_transaction = '1' + $cleared + AND NOT + (ac.chart_id IN + (SELECT fxgain_accno_id FROM defaults + UNION + SELECT fxloss_accno_id FROM defaults)) + |; + + } + + $fxs = $dbh->prepare($query); + + + if ($form->{summary}) { + $query = qq|SELECT c.name + FROM customer c + JOIN ar a ON (c.id = a.customer_id) + JOIN acc_trans ac ON (a.id = ac.trans_id) + WHERE ac.transdate = ? + AND ac.source = ? + AND ac.amount > 0 + $cleared + UNION + SELECT v.name + FROM vendor v + JOIN ap a ON (v.id = a.vendor_id) + JOIN acc_trans ac ON (a.id = ac.trans_id) + WHERE ac.transdate = ? + AND ac.source = ? + AND ac.amount > 0 + $cleared + UNION + SELECT g.description + FROM gl g + JOIN acc_trans ac ON (g.id = ac.trans_id) + WHERE ac.transdate = ? + AND ac.source = ? + AND ac.amount > 0 + $cleared + |; + + $query .= " ORDER BY 1"; + $dr = $dbh->prepare($query); + + + $query = qq|SELECT c.name + FROM customer c + JOIN ar a ON (c.id = a.customer_id) + JOIN acc_trans ac ON (a.id = ac.trans_id) + WHERE ac.transdate = ? + AND ac.source = ? + AND ac.amount < 0 + $cleared + UNION + SELECT v.name + FROM vendor v + JOIN ap a ON (v.id = a.vendor_id) + JOIN acc_trans ac ON (a.id = ac.trans_id) + WHERE ac.transdate = ? + AND ac.source = ? + AND ac.amount < 0 + $cleared + UNION + SELECT g.description + FROM gl g + JOIN acc_trans ac ON (g.id = ac.trans_id) + WHERE ac.transdate = ? + AND ac.source = ? + AND ac.amount < 0 + $cleared + |; + + $query .= " ORDER BY 1"; + $cr = $dbh->prepare($query); + } + + + my $name; + my $ref; + my $xfref; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + + if ($form->{summary}) { + + if ($ref->{amount} > 0) { + $dr->execute($ref->{transdate}, $ref->{source}, $ref->{transdate}, $ref->{source}, $ref->{transdate}, $ref->{source}); + $ref->{oldcleared} = $ref->{cleared}; + $ref->{name} = (); + while (($name) = $dr->fetchrow_array) { + push @{ $ref->{name} }, $name; + } + $dr->finish; + } else { + + $cr->execute($ref->{transdate}, $ref->{source}, $ref->{transdate}, $ref->{source}, $ref->{transdate}, $ref->{source}); + $ref->{oldcleared} = $ref->{cleared}; + $ref->{name} = (); + while (($name) = $cr->fetchrow_array) { + push @{ $ref->{name} }, $name; + } + $cr->finish; + + } + + } else { + push @{ $ref->{name} }, $ref->{description}; + } + + push @{ $form->{PR} }, $ref; + + # include fx transactions + $amount = 0; + $addfx = 0; + $ref->{oldcleared} = $ref->{cleared}; + if ($form->{summary}) { + foreach $name (@{ $ref->{name} }) { + $fxs->execute($name, $ref->{transdate}, $ref->{source}, $ref->{cleared}, $name, $ref->{transdate}, $ref->{source}, $ref->{cleared}); + while ($fxref = $fxs->fetchrow_hashref(NAME_lc)) { + $addfx = 1; + $amount += $fxref->{amount}; + } + $fxs->finish; + } + } else { + $fxs->execute($ref->{id}); + while ($fxref = $fxs->fetchrow_hashref(NAME_lc)) { + $addfx = 1; + $amount += $fxref->{amount}; + } + $fxs->finish; + } + + if ($addfx) { + $fxref = (); + map { $fxref->{$_} = $ref->{$_} } keys %$ref; + $fxref->{fx_transaction} = 1; + $fxref->{name} = (); + $fxref->{source} = ""; + $fxref->{transdate} = ""; + $fxref->{amount} = $amount; + push @{ $form->{PR} }, $fxref; + } + + } + $sth->finish; + + $dbh->disconnect; + +} + + +sub reconcile { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT id FROM chart + WHERE accno = '$form->{accno}'|; + my ($chart_id) = $dbh->selectrow_array($query); + $chart_id *= 1; + + $query = qq|SELECT trans_id FROM acc_trans + WHERE source = ? + AND transdate = ? + AND cleared = '0'|; + my $sth = $dbh->prepare($query) || $form->dberror($query); + + my $i; + my $trans_id; + + $query = qq|UPDATE acc_trans SET cleared = '1' + WHERE cleared = '0' + AND trans_id = ? + AND transdate = ? + AND chart_id = $chart_id|; + my $tth = $dbh->prepare($query) || $form->dberror($query); + + # clear flags + for $i (1 .. $form->{rowcount}) { + if ($form->{"cleared_$i"} && ! $form->{"oldcleared_$i"}) { + if ($form->{summary}) { + $sth->execute($form->{"source_$i"}, $form->{"transdate_$i"}) || $form->dberror; + + while (($trans_id) = $sth->fetchrow_array) { + $tth->execute($trans_id, $form->{"transdate_$i"}) || $form->dberror; + $tth->finish; + } + $sth->finish; + + } else { + + $tth->execute($form->{"id_$i"}, $form->{"transdate_$i"}) || $form->dberror; + $tth->finish; + } + } + } + + $dbh->disconnect; + +} + +1; + diff --git a/sql-ledger/SL/RP.pm b/sql-ledger/SL/RP.pm new file mode 100644 index 000000000..791b22bba --- /dev/null +++ b/sql-ledger/SL/RP.pm @@ -0,0 +1,2551 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2001 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: Benjamin Lee <benjaminlee@consultant.com> +# Jim Rawlings <jim@your-dba.com> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#====================================================================== +# +# backend code for reports +# +#====================================================================== + +package RP; + + +sub yearend_statement { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # if todate < existing yearends, delete GL and yearends + my $query = qq|SELECT trans_id FROM yearend + WHERE transdate >= '$form->{todate}'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my @trans_id = (); + my $id; + while (($id) = $sth->fetchrow_array) { + push @trans_id, $id; + } + $sth->finish; + + $query = qq|DELETE FROM gl + WHERE id = ?|; + $sth = $dbh->prepare($query) || $form->dberror($query); + + $query = qq|DELETE FROM acc_trans + WHERE trans_id = ?|; + my $ath = $dbh->prepare($query) || $form->dberror($query); + + foreach $id (@trans_id) { + $sth->execute($id); + $ath->execute($id); + } + $sth->finish; + + + my $last_period = 0; + my @categories = qw(I E); + my $category; + + $form->{decimalplaces} *= 1; + + &get_accounts($dbh, 0, $form->{fromdate}, $form->{todate}, $form, \@categories); + + # disconnect + $dbh->disconnect; + + + # now we got $form->{I}{accno}{ } + # and $form->{E}{accno}{ } + + my %account = ( 'I' => { 'label' => 'income', + 'labels' => 'income', + 'ml' => 1 }, + 'E' => { 'label' => 'expense', + 'labels' => 'expenses', + 'ml' => -1 } + ); + + foreach $category (@categories) { + foreach $key (sort keys %{ $form->{$category} }) { + if ($form->{$category}{$key}{charttype} eq 'A') { + $form->{"total_$account{$category}{labels}_this_period"} += $form->{$category}{$key}{this} * $account{$category}{ml}; + } + } + } + + + # totals for income and expenses + $form->{total_income_this_period} = $form->round_amount($form->{total_income_this_period}, $form->{decimalplaces}); + $form->{total_expenses_this_period} = $form->round_amount($form->{total_expenses_this_period}, $form->{decimalplaces}); + + # total for income/loss + $form->{total_this_period} = $form->{total_income_this_period} - $form->{total_expenses_this_period}; + +} + + +sub income_statement { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $last_period = 0; + my @categories = qw(I E); + my $category; + + $form->{decimalplaces} *= 1; + + if (! ($form->{fromdate} || $form->{todate})) { + if ($form->{fromyear} && $form->{frommonth}) { + ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{fromyear}, $form->{frommonth}, $form->{interval}); + } + } + + &get_accounts($dbh, $last_period, $form->{fromdate}, $form->{todate}, $form, \@categories, 1); + + if (! ($form->{comparefromdate} || $form->{comparetodate})) { + if ($form->{compareyear} && $form->{comparemonth}) { + ($form->{comparefromdate}, $form->{comparetodate}) = $form->from_to($form->{compareyear}, $form->{comparemonth}, $form->{interval}); + } + } + + # if there are any compare dates + if ($form->{comparefromdate} || $form->{comparetodate}) { + $last_period = 1; + + &get_accounts($dbh, $last_period, $form->{comparefromdate}, $form->{comparetodate}, $form, \@categories, 1); + } + + + # disconnect + $dbh->disconnect; + + + # now we got $form->{I}{accno}{ } + # and $form->{E}{accno}{ } + + my %account = ( 'I' => { 'label' => 'income', + 'labels' => 'income', + 'ml' => 1 }, + 'E' => { 'label' => 'expense', + 'labels' => 'expenses', + 'ml' => -1 } + ); + + my $str; + + foreach $category (@categories) { + + foreach $key (sort keys %{ $form->{$category} }) { + # push description onto array + + $str = ($form->{l_heading}) ? $form->{padding} : ""; + + if ($form->{$category}{$key}{charttype} eq "A") { + $str .= ($form->{l_accno}) ? "$form->{$category}{$key}{accno} - $form->{$category}{$key}{description}" : "$form->{$category}{$key}{description}"; + } + if ($form->{$category}{$key}{charttype} eq "H") { + if ($account{$category}{subtotal} && $form->{l_subtotal}) { + $dash = "- "; + push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); + push(@{$form->{"$account{$category}{labels}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + + if ($last_period) { + push(@{$form->{"$account{$category}{labels}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + } + + } + + $str = "$form->{br}$form->{bold}$form->{$category}{$key}{description}$form->{endbold}"; + + $account{$category}{subthis} = $form->{$category}{$key}{this}; + $account{$category}{sublast} = $form->{$category}{$key}{last}; + $account{$category}{subdescription} = $form->{$category}{$key}{description}; + $account{$category}{subtotal} = 1; + + $form->{$category}{$key}{this} = 0; + $form->{$category}{$key}{last} = 0; + + next unless $form->{l_heading}; + + $dash = " "; + } + + push(@{$form->{"$account{$category}{label}_account"}}, $str); + + if ($form->{$category}{$key}{charttype} eq 'A') { + $form->{"total_$account{$category}{labels}_this_period"} += $form->{$category}{$key}{this} * $account{$category}{ml}; + $dash = "- "; + } + + push(@{$form->{"$account{$category}{labels}_this_period"}}, $form->format_amount($myconfig, $form->{$category}{$key}{this} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + + # add amount or - for last period + if ($last_period) { + $form->{"total_$account{$category}{labels}_last_period"} += $form->{$category}{$key}{last} * $account{$category}{ml}; + + push(@{$form->{"$account{$category}{labels}_last_period"}}, $form->format_amount($myconfig,$form->{$category}{$key}{last} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + } + } + + $str = ($form->{l_heading}) ? $form->{padding} : ""; + if ($account{$category}{subtotal} && $form->{l_subtotal}) { + push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); + push(@{$form->{"$account{$category}{labels}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + + if ($last_period) { + push(@{$form->{"$account{$category}{labels}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + } + } + + } + + + # totals for income and expenses + $form->{total_income_this_period} = $form->round_amount($form->{total_income_this_period}, $form->{decimalplaces}); + $form->{total_expenses_this_period} = $form->round_amount($form->{total_expenses_this_period}, $form->{decimalplaces}); + + # total for income/loss + $form->{total_this_period} = $form->{total_income_this_period} - $form->{total_expenses_this_period}; + + if ($last_period) { + # total for income/loss + $form->{total_last_period} = $form->format_amount($myconfig, $form->{total_income_last_period} - $form->{total_expenses_last_period}, $form->{decimalplaces}, "- "); + + # totals for income and expenses for last_period + $form->{total_income_last_period} = $form->format_amount($myconfig, $form->{total_income_last_period}, $form->{decimalplaces}, "- "); + $form->{total_expenses_last_period} = $form->format_amount($myconfig, $form->{total_expenses_last_period}, $form->{decimalplaces}, "- "); + + } + + + $form->{total_income_this_period} = $form->format_amount($myconfig,$form->{total_income_this_period}, $form->{decimalplaces}, "- "); + $form->{total_expenses_this_period} = $form->format_amount($myconfig,$form->{total_expenses_this_period}, $form->{decimalplaces}, "- "); + $form->{total_this_period} = $form->format_amount($myconfig,$form->{total_this_period}, $form->{decimalplaces}, "- "); + +} + + +sub balance_sheet { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $last_period = 0; + my @categories = qw(A C L Q); + + my $null; + + if (! $form->{asofdate}) { + if ($form->{asofyear} && $form->{asofmonth}) { + ($null, $form->{asofdate}) = $form->from_to($form->{asofyear}, $form->{asofmonth}); + } + } + + # if there are any dates construct a where + if ($form->{asofdate}) { + + $form->{this_period} = "$form->{asofdate}"; + $form->{period} = "$form->{asofdate}"; + + } + + $form->{decimalplaces} *= 1; + + &get_accounts($dbh, $last_period, "", $form->{asofdate}, $form, \@categories, 1); + + if (! $form->{compareasofdate}) { + if ($form->{compareasofyear} && $form->{compareasofmonth}) { + ($null, $form->{compareasofdate}) = $form->from_to($form->{compareasofyear}, $form->{compareasofmonth}); + } + } + + # if there are any compare dates + if ($form->{compareasofdate}) { + + $last_period = 1; + &get_accounts($dbh, $last_period, "", $form->{compareasofdate}, $form, \@categories, 1); + + $form->{last_period} = "$form->{compareasofdate}"; + + } + + + # disconnect + $dbh->disconnect; + + + # now we got $form->{A}{accno}{ } assets + # and $form->{L}{accno}{ } liabilities + # and $form->{Q}{accno}{ } equity + # build asset accounts + + my $str; + my $key; + + my %account = ( 'A' => { 'label' => 'asset', + 'labels' => 'assets', + 'ml' => -1 }, + 'L' => { 'label' => 'liability', + 'labels' => 'liabilities', + 'ml' => 1 }, + 'Q' => { 'label' => 'equity', + 'labels' => 'equity', + 'ml' => 1 } + ); + + foreach $category (grep { !/C/ } @categories) { + + foreach $key (sort keys %{ $form->{$category} }) { + + $str = ($form->{l_heading}) ? $form->{padding} : ""; + + if ($form->{$category}{$key}{charttype} eq "A") { + $str .= ($form->{l_accno}) ? "$form->{$category}{$key}{accno} - $form->{$category}{$key}{description}" : "$form->{$category}{$key}{description}"; + } + if ($form->{$category}{$key}{charttype} eq "H") { + if ($account{$category}{subtotal} && $form->{l_subtotal}) { + $dash = "- "; + push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); + push(@{$form->{"$account{$category}{label}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + + if ($last_period) { + push(@{$form->{"$account{$category}{label}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + } + } + + $str = "$form->{bold}$form->{$category}{$key}{description}$form->{endbold}"; + + $account{$category}{subthis} = $form->{$category}{$key}{this}; + $account{$category}{sublast} = $form->{$category}{$key}{last}; + $account{$category}{subdescription} = $form->{$category}{$key}{description}; + $account{$category}{subtotal} = 1; + + $form->{$category}{$key}{this} = 0; + $form->{$category}{$key}{last} = 0; + + next unless $form->{l_heading}; + + $dash = " "; + } + + # push description onto array + push(@{$form->{"$account{$category}{label}_account"}}, $str); + + if ($form->{$category}{$key}{charttype} eq 'A') { + $form->{"total_$account{$category}{labels}_this_period"} += $form->{$category}{$key}{this} * $account{$category}{ml}; + $dash = "- "; + } + + push(@{$form->{"$account{$category}{label}_this_period"}}, $form->format_amount($myconfig, $form->{$category}{$key}{this} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + + if ($last_period) { + $form->{"total_$account{$category}{labels}_last_period"} += $form->{$category}{$key}{last} * $account{$category}{ml}; + + push(@{$form->{"$account{$category}{label}_last_period"}}, $form->format_amount($myconfig, $form->{$category}{$key}{last} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + } + } + + $str = ($form->{l_heading}) ? $form->{padding} : ""; + if ($account{$category}{subtotal} && $form->{l_subtotal}) { + push(@{$form->{"$account{$category}{label}_account"}}, "$str$form->{bold}$account{$category}{subdescription}$form->{endbold}"); + push(@{$form->{"$account{$category}{label}_this_period"}}, $form->format_amount($myconfig, $account{$category}{subthis} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + + if ($last_period) { + push(@{$form->{"$account{$category}{label}_last_period"}}, $form->format_amount($myconfig, $account{$category}{sublast} * $account{$category}{ml}, $form->{decimalplaces}, $dash)); + } + } + + } + + + # totals for assets, liabilities + $form->{total_assets_this_period} = $form->round_amount($form->{total_assets_this_period}, $form->{decimalplaces}); + $form->{total_liabilities_this_period} = $form->round_amount($form->{total_liabilities_this_period}, $form->{decimalplaces}); + $form->{total_equity_this_period} = $form->round_amount($form->{total_equity_this_period}, $form->{decimalplaces}); + + # calculate earnings + $form->{earnings_this_period} = $form->{total_assets_this_period} - $form->{total_liabilities_this_period} - $form->{total_equity_this_period}; + + push(@{$form->{equity_this_period}}, $form->format_amount($myconfig, $form->{earnings_this_period}, $form->{decimalplaces}, "- ")); + + $form->{total_equity_this_period} = $form->round_amount($form->{total_equity_this_period} + $form->{earnings_this_period}, $form->{decimalplaces}); + + # add liability + equity + $form->{total_this_period} = $form->format_amount($myconfig, $form->{total_liabilities_this_period} + $form->{total_equity_this_period}, $form->{decimalplaces}, "- "); + + + if ($last_period) { + # totals for assets, liabilities + $form->{total_assets_last_period} = $form->round_amount($form->{total_assets_last_period}, $form->{decimalplaces}); + $form->{total_liabilities_last_period} = $form->round_amount($form->{total_liabilities_last_period}, $form->{decimalplaces}); + $form->{total_equity_last_period} = $form->round_amount($form->{total_equity_last_period}, $form->{decimalplaces}); + + # calculate retained earnings + $form->{earnings_last_period} = $form->{total_assets_last_period} - $form->{total_liabilities_last_period} - $form->{total_equity_last_period}; + + push(@{$form->{equity_last_period}}, $form->format_amount($myconfig,$form->{earnings_last_period}, $form->{decimalplaces}, "- ")); + + $form->{total_equity_last_period} = $form->round_amount($form->{total_equity_last_period} + $form->{earnings_last_period}, $form->{decimalplaces}); + + # add liability + equity + $form->{total_last_period} = $form->format_amount($myconfig, $form->{total_liabilities_last_period} + $form->{total_equity_last_period}, $form->{decimalplaces}, "- "); + + } + + + $form->{total_liabilities_last_period} = $form->format_amount($myconfig, $form->{total_liabilities_last_period}, $form->{decimalplaces}, "- ") if ($form->{total_liabilities_last_period} != 0); + + $form->{total_equity_last_period} = $form->format_amount($myconfig, $form->{total_equity_last_period}, $form->{decimalplaces}, "- ") if ($form->{total_equity_last_period} != 0); + + $form->{total_assets_last_period} = $form->format_amount($myconfig, $form->{total_assets_last_period}, $form->{decimalplaces}, "- ") if ($form->{total_assets_last_period} != 0); + + $form->{total_assets_this_period} = $form->format_amount($myconfig, $form->{total_assets_this_period}, $form->{decimalplaces}, "- "); + + $form->{total_liabilities_this_period} = $form->format_amount($myconfig, $form->{total_liabilities_this_period}, $form->{decimalplaces}, "- "); + + $form->{total_equity_this_period} = $form->format_amount($myconfig, $form->{total_equity_this_period}, $form->{decimalplaces}, "- "); + +} + + +sub get_accounts { + my ($dbh, $last_period, $fromdate, $todate, $form, $categories, $yearend) = @_; + + my $department_id; + my $project_id; + + ($null, $department_id) = split /--/, $form->{department}; + ($null, $project_id) = split /--/, $form->{projectnumber}; + + my $query; + my $dpt_where; + my $dpt_join; + my $project; + my $where = "1 = 1"; + my $glwhere = ""; + my $projectwhere = ""; + my $subwhere = ""; + my $yearendwhere = "1 = 1"; + my $item; + + my $category = "AND ("; + foreach $item (@{ $categories }) { + $category .= qq|c.category = '$item' OR |; + } + $category =~ s/OR $/\)/; + + + # get headings + $query = qq|SELECT accno, description, category + FROM chart c + WHERE c.charttype = 'H' + $category + ORDER by c.accno|; + + if ($form->{accounttype} eq 'gifi') + { + $query = qq|SELECT g.accno, g.description, c.category + FROM gifi g + JOIN chart c ON (c.gifi_accno = g.accno) + WHERE c.charttype = 'H' + $category + ORDER BY g.accno|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my @headingaccounts = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc)) + { + $form->{$ref->{category}}{$ref->{accno}}{description} = "$ref->{description}"; + $form->{$ref->{category}}{$ref->{accno}}{charttype} = "H"; + $form->{$ref->{category}}{$ref->{accno}}{accno} = $ref->{accno}; + + push @headingaccounts, $ref->{accno}; + } + + $sth->finish; + + + if ($fromdate) { + $where .= " AND ac.transdate >= '$fromdate'"; + $projectwhere .= " AND transdate >= '$fromdate'"; + if ($form->{method} eq 'cash') { + $subwhere .= " AND transdate >= '$fromdate'"; + $glwhere = " AND ac.transdate >= '$fromdate'"; + } + } + + if ($todate) { + $where .= " AND ac.transdate <= '$todate'"; + $projectwhere .= " AND transdate <= '$todate'"; + $subwhere .= " AND transdate <= '$todate'"; + $yearendwhere = "ac.transdate < '$todate'"; + } + + if ($yearend) { + $ywhere = " AND ac.trans_id NOT IN + (SELECT trans_id FROM yearend)"; + + if ($fromdate) { + $ywhere = " AND ac.trans_id NOT IN + (SELECT trans_id FROM yearend + WHERE transdate >= '$fromdate')"; + if ($todate) { + $ywhere = " AND ac.trans_id NOT IN + (SELECT trans_id FROM yearend + WHERE transdate >= '$fromdate' + AND transdate <= '$todate')"; + } + } + + if ($todate) { + $ywhere = " AND ac.trans_id NOT IN + (SELECT trans_id FROM yearend + WHERE transdate <= '$todate')"; + } + } + + if ($department_id) + { + $dpt_join = qq| + JOIN department t ON (a.department_id = t.id) + |; + $dpt_where = qq| + AND t.id = $department_id + |; + } + + if ($project_id) + { + $project = qq| + AND ac.project_id = $project_id + |; + } + + + if ($form->{accounttype} eq 'gifi') + { + + if ($form->{method} eq 'cash') + { + + $query = qq| + + SELECT g.accno, sum(ac.amount) AS amount, + g.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN ar a ON (a.id = ac.trans_id) + JOIN gifi g ON (g.accno = c.gifi_accno) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AR_paid%' + $subwhere + ) + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT '' AS accno, SUM(ac.amount) AS amount, + '' AS description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN ar a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + AND c.gifi_accno = '' + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AR_paid%' + $subwhere + ) + $project + GROUP BY c.category + + UNION ALL + + SELECT g.accno, sum(ac.amount) AS amount, + g.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN ap a ON (a.id = ac.trans_id) + JOIN gifi g ON (g.accno = c.gifi_accno) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT '' AS accno, SUM(ac.amount) AS amount, + '' AS description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN ap a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + AND c.gifi_accno = '' + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + $project + GROUP BY c.category + + UNION ALL + +-- add gl + + SELECT g.accno, sum(ac.amount) AS amount, + g.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN gifi g ON (g.accno = c.gifi_accno) + JOIN gl a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $glwhere + $dpt_where + $category + AND NOT (c.link = 'AR' OR c.link = 'AP') + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT '' AS accno, SUM(ac.amount) AS amount, + '' AS description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN gl a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $glwhere + $dpt_where + $category + AND c.gifi_accno = '' + AND NOT (c.link = 'AR' OR c.link = 'AP') + $project + GROUP BY c.category + |; + + if ($yearend) { + + # this is for the yearend + + $query .= qq| + + UNION ALL + + SELECT g.accno, sum(ac.amount) AS amount, + g.description, c.category + FROM yearend y + JOIN acc_trans ac ON (ac.trans_id = y.trans_id) + JOIN chart c ON (c.id = ac.chart_id) + JOIN gifi g ON (g.accno = c.accno) + $dpt_join + WHERE $yearendwhere + AND c.category = 'Q' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + |; + } + + if ($project_id) { + + $query .= qq| + + UNION ALL + + SELECT g.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + g.description AS description, c.category + FROM invoice ac + JOIN ar a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.income_accno_id = c.id) + JOIN gifi g ON (g.accno = c.gifi_accno) + $dpt_join + WHERE 1 = 1 $projectwhere + $ywhere + AND c.category = 'I' + $dpt_where + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AR_paid%' + $subwhere + ) + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT g.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + g.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + JOIN gifi g ON (g.accno = c.gifi_accno) + $dpt_join + WHERE 1 = 1 $projectwhere + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $ywhere + AND c.category = 'E' + $dpt_where + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT g.accno AS accno, SUM(ac.sellprice * ac.allocated) * -1 AS amount, + g.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + JOIN gifi g ON (g.accno = c.gifi_accno) + $dpt_join + WHERE 1 = 1 $projectwhere + AND ac.assemblyitem = '0' + $ywhere + AND c.category = 'E' + $dpt_where + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + $project + GROUP BY g.accno, g.description, c.category + |; + } + + } else { + + if ($department_id) + { + $dpt_join = qq| + JOIN dpt_trans t ON (t.trans_id = ac.trans_id) + |; + $dpt_where = qq| + AND t.department_id = $department_id + |; + + } + + $query = qq| + + SELECT g.accno, SUM(ac.amount) AS amount, + g.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE $where + $ywhere + $dpt_from + $category + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT '' AS accno, SUM(ac.amount) AS amount, + '' AS description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $ywhere + $dpt_from + $category + AND c.gifi_accno = '' + $project + GROUP BY c.category + |; + + if ($yearend) { + + # this is for the yearend + + $query .= qq| + + UNION ALL + + SELECT g.accno, sum(ac.amount) AS amount, + g.description, c.category + FROM yearend y + JOIN acc_trans ac ON (ac.trans_id = y.trans_id) + JOIN chart c ON (c.id = ac.chart_id) + JOIN gifi g ON (g.accno = c.accno) + $dpt_join + WHERE $yearendwhere + AND c.category = 'Q' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + |; + } + + if ($project_id) + { + + $query .= qq| + + UNION ALL + + SELECT g.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + g.description AS description, c.category + FROM invoice ac + JOIN ar a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.income_accno_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE 1 = 1 $projectwhere + $ywhere + AND c.category = 'I' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT g.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + g.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE 1 = 1 $projectwhere + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $ywhere + AND c.category = 'E' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + SELECT g.accno AS accno, SUM(ac.sellprice * ac.allocated) * -1 AS amount, + g.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE 1 = 1 $projectwhere + AND ac.assemblyitem = '0' + $ywhere + AND c.category = 'E' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + |; + } + + } + + } else { # standard account + + if ($form->{method} eq 'cash') + { + + $query = qq| + + SELECT c.accno, sum(ac.amount) AS amount, + c.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN ar a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AR_paid%' + $subwhere + ) + + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + SELECT c.accno, sum(ac.amount) AS amount, + c.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN ap a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + SELECT c.accno, sum(ac.amount) AS amount, + c.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN gl a ON (a.id = ac.trans_id) + $dpt_join + WHERE $where + $ywhere + $glwhere + $dpt_from + $category + AND NOT (c.link = 'AR' OR c.link = 'AP') + $project + GROUP BY c.accno, c.description, c.category + |; + + if ($yearend) { + + # this is for the yearend + + $query .= qq| + + UNION ALL + + SELECT c.accno, sum(ac.amount) AS amount, + c.description, c.category + FROM yearend y + JOIN acc_trans ac ON (ac.trans_id = y.trans_id) + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $yearendwhere + AND c.category = 'Q' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + |; + } + + + if ($project_id) + { + + $query .= qq| + + UNION ALL + + SELECT c.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + c.description AS description, c.category + FROM invoice ac + JOIN ar a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.income_accno_id = c.id) + $dpt_join + WHERE 1 = 1 $projectwhere + $ywhere + AND c.category = 'I' + $dpt_where + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AR_paid%' + $subwhere + ) + + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + SELECT c.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + c.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + $dpt_join + WHERE 1 = 1 $projectwhere + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $ywhere + AND c.category = 'E' + $dpt_where + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + SELECT c.accno AS accno, SUM(ac.sellprice * ac.allocated) * -1 AS amount, + c.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + $dpt_join + WHERE 1 = 1 $projectwhere + AND ac.assemblyitem = '0' + $ywhere + AND c.category = 'E' + $dpt_where + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%AP_paid%' + $subwhere + ) + + $project + GROUP BY c.accno, c.description, c.category + |; + } + + } else { + + if ($department_id) + { + $dpt_join = qq| + JOIN dpt_trans t ON (t.trans_id = ac.trans_id) + |; + $dpt_where = qq| + AND t.department_id = $department_id + |; + } + + + $query = qq| + + SELECT c.accno, sum(ac.amount) AS amount, + c.description, c.category + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $ywhere + $dpt_where + $category + $project + GROUP BY c.accno, c.description, c.category + |; + + if ($yearend) { + + # this is for the yearend + + $query .= qq| + + UNION ALL + + SELECT c.accno, sum(ac.amount) AS amount, + c.description, c.category + FROM yearend y + JOIN acc_trans ac ON (ac.trans_id = y.trans_id) + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $yearendwhere + AND c.category = 'Q' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + |; + } + + + if ($project_id) + { + + $query .= qq| + + UNION ALL + + SELECT c.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + c.description AS description, c.category + FROM invoice ac + JOIN ar a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.income_accno_id = c.id) + $dpt_join + WHERE 1 = 1 $projectwhere + $ywhere + AND c.category = 'I' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + SELECT c.accno AS accno, SUM(ac.sellprice * ac.qty) AS amount, + c.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + $dpt_join + WHERE 1 = 1 $projectwhere + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $ywhere + AND c.category = 'E' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + SELECT c.accno AS accno, SUM(ac.sellprice * ac.allocated) * -1 AS amount, + c.description AS description, c.category + FROM invoice ac + JOIN ap a ON (a.id = ac.trans_id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c on (p.expense_accno_id = c.id) + $dpt_join + WHERE 1 = 1 $projectwhere + AND ac.assemblyitem = '0' + $ywhere + AND c.category = 'E' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + |; + + } + } + } + + my @accno; + my $accno; + my $ref; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) + { + + if ($ref->{category} eq 'C') { + $ref->{category} = 'A'; + } + + # get last heading account + @accno = grep { $_ le "$ref->{accno}" } @headingaccounts; + $accno = pop @accno; + if ($accno && ($accno ne $ref->{accno}) ) { + if ($last_period) + { + $form->{$ref->{category}}{$accno}{last} += $ref->{amount}; + } else { + $form->{$ref->{category}}{$accno}{this} += $ref->{amount}; + } + } + + $form->{$ref->{category}}{$ref->{accno}}{accno} = $ref->{accno}; + $form->{$ref->{category}}{$ref->{accno}}{description} = $ref->{description}; + $form->{$ref->{category}}{$ref->{accno}}{charttype} = "A"; + + if ($last_period) + { + $form->{$ref->{category}}{$ref->{accno}}{last} += $ref->{amount}; + } else { + $form->{$ref->{category}}{$ref->{accno}}{this} += $ref->{amount}; + } + } + $sth->finish; + + + # remove accounts with zero balance + foreach $category (@{ $categories }) { + foreach $accno (keys %{ $form->{$category} }) { + $form->{$category}{$accno}{last} = $form->round_amount($form->{$category}{$accno}{last}, $form->{decimalplaces}); + $form->{$category}{$accno}{this} = $form->round_amount($form->{$category}{$accno}{this}, $form->{decimalplaces}); + + delete $form->{$category}{$accno} if ($form->{$category}{$accno}{this} == 0 && $form->{$category}{$accno}{last} == 0); + } + } + +} + + + +sub trial_balance { + my ($self, $myconfig, $form) = @_; + + my $dbh = $form->dbconnect($myconfig); + + my ($query, $sth, $ref); + my %balance = (); + my %trb = (); + my $null; + my $department_id; + my $project_id; + my @headingaccounts = (); + my $dpt_where; + my $dpt_join; + my $project; + + my $where = "1 = 1"; + my $invwhere = $where; + + ($null, $department_id) = split /--/, $form->{department}; + ($null, $project_id) = split /--/, $form->{projectnumber}; + + if ($department_id) { + $dpt_join = qq| + JOIN dpt_trans t ON (ac.trans_id = t.trans_id) + |; + $dpt_where = qq| + AND t.department_id = $department_id + |; + } + + + # project_id only applies to getting transactions + # it has nothing to do with a trial balance + # but we use the same function to collect information + + if ($project_id) { + $project = qq| + AND ac.project_id = $project_id + |; + } + + ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + # get beginning balances + if ($form->{fromdate}) { + + if ($form->{accounttype} eq 'gifi') { + + $query = qq|SELECT g.accno, c.category, SUM(ac.amount) AS amount, + g.description + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE ac.transdate < '$form->{fromdate}' + $dpt_where + $project + GROUP BY g.accno, c.category, g.description + |; + + } else { + + $query = qq|SELECT c.accno, c.category, SUM(ac.amount) AS amount, + c.description + FROM acc_trans ac + JOIN chart c ON (ac.chart_id = c.id) + $dpt_join + WHERE ac.transdate < '$form->{fromdate}' + $dpt_where + $project + GROUP BY c.accno, c.category, c.description + |; + + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $balance{$ref->{accno}} = $ref->{amount}; + + if ($ref->{amount} != 0 && $form->{all_accounts}) { + $trb{$ref->{accno}}{description} = $ref->{description}; + $trb{$ref->{accno}}{charttype} = 'A'; + $trb{$ref->{accno}}{category} = $ref->{category}; + } + + } + $sth->finish; + + } + + + # get headings + $query = qq|SELECT c.accno, c.description, c.category + FROM chart c + WHERE c.charttype = 'H' + ORDER by c.accno|; + + if ($form->{accounttype} eq 'gifi') + { + $query = qq|SELECT g.accno, g.description, c.category + FROM gifi g + JOIN chart c ON (c.gifi_accno = g.accno) + WHERE c.charttype = 'H' + ORDER BY g.accno|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) + { + $trb{$ref->{accno}}{description} = $ref->{description}; + $trb{$ref->{accno}}{charttype} = 'H'; + $trb{$ref->{accno}}{category} = $ref->{category}; + + push @headingaccounts, $ref->{accno}; + } + + $sth->finish; + + + if ($form->{fromdate} || $form->{todate}) { + if ($form->{fromdate}) { + $where .= " AND ac.transdate >= '$form->{fromdate}'"; + $invwhere .= " AND a.transdate >= '$form->{fromdate}'"; + } + if ($form->{todate}) { + $where .= " AND ac.transdate <= '$form->{todate}'"; + $invwhere .= " AND a.transdate <= '$form->{todate}'"; + } + } + + + if ($form->{accounttype} eq 'gifi') { + + $query = qq|SELECT g.accno, g.description, c.category, + SUM(ac.amount) AS amount + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE $where + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + |; + + if ($project_id) { + + $query .= qq| + + -- sold items + + UNION ALL + + SELECT g.accno, g.description, c.category, + SUM(ac.sellprice * ac.qty) AS amount + FROM invoice ac + JOIN ar a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.income_accno_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE $invwhere + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + + UNION ALL + + -- bought services + + SELECT g.accno, g.description, c.category, + SUM(ac.sellprice * ac.qty) AS amount + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE $invwhere + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + + -- COGS + + UNION ALL + + SELECT g.accno, g.description, c.category, + SUM(ac.sellprice * ac.allocated) * -1 AS amount + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + JOIN gifi g ON (c.gifi_accno = g.accno) + $dpt_join + WHERE $invwhere + AND ac.assemblyitem = '0' + $dpt_where + $project + GROUP BY g.accno, g.description, c.category + + |; + } + + $query .= qq| + ORDER BY accno|; + + } else { + + $query = qq|SELECT c.accno, c.description, c.category, + SUM(ac.amount) AS amount + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + |; + + if ($project_id) { + + $query .= qq| + + -- sold items + + UNION ALL + + SELECT c.accno, c.description, c.category, + SUM(ac.sellprice * ac.qty) AS amount + FROM invoice ac + JOIN ar a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.income_accno_id = c.id) + $dpt_join + WHERE $invwhere + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + + UNION ALL + + -- bought services + + SELECT c.accno, c.description, c.category, + SUM(ac.sellprice * ac.qty) AS amount + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + $dpt_join + WHERE $invwhere + AND p.inventory_accno_id IS NULL + AND p.assembly = '0' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + + -- cogs + + UNION ALL + + SELECT c.accno, c.description, c.category, + SUM(ac.sellprice * ac.allocated) * -1 AS amount + FROM invoice ac + JOIN ap a ON (ac.trans_id = a.id) + JOIN parts p ON (ac.parts_id = p.id) + JOIN chart c ON (p.expense_accno_id = c.id) + $dpt_join + WHERE $invwhere + AND ac.assemblyitem = '0' + $dpt_where + $project + GROUP BY c.accno, c.description, c.category + + |; + } + + $query .= qq| + ORDER BY accno|; + + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + # prepare query for each account + $query = qq|SELECT (SELECT SUM(ac.amount) * -1 + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $dpt_where + $project + AND ac.amount < 0 + AND c.accno = ?) AS debit, + + (SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $dpt_where + $project + AND ac.amount > 0 + AND c.accno = ?) AS credit + |; + + if ($form->{accounttype} eq 'gifi') { + + $query = qq|SELECT (SELECT SUM(ac.amount) * -1 + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $dpt_where + $project + AND ac.amount < 0 + AND c.gifi_accno = ?) AS debit, + + (SELECT SUM(ac.amount) + FROM acc_trans ac + JOIN chart c ON (c.id = ac.chart_id) + $dpt_join + WHERE $where + $dpt_where + $project + AND ac.amount > 0 + AND c.gifi_accno = ?) AS credit|; + + } + + $drcr = $dbh->prepare($query); + + # calculate debit and credit for the period + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $trb{$ref->{accno}}{description} = $ref->{description}; + $trb{$ref->{accno}}{charttype} = 'A'; + $trb{$ref->{accno}}{category} = $ref->{category}; + $trb{$ref->{accno}}{amount} += $ref->{amount}; + } + $sth->finish; + + my ($debit, $credit); + + foreach my $accno (sort keys %trb) { + $ref = (); + + $ref->{accno} = $accno; + map { $ref->{$_} = $trb{$accno}{$_} } qw(description category charttype amount); + + $ref->{balance} = $form->round_amount($balance{$ref->{accno}}, 2); + + if ($trb{$accno}{charttype} eq 'A') { + if ($project_id) { + + if ($ref->{amount} < 0) { + $ref->{debit} = $ref->{amount} * -1; + } else { + $ref->{credit} = $ref->{amount}; + } + next if $form->round_amount($ref->{amount}, 2) == 0; + + } else { + + # get DR/CR + $drcr->execute($ref->{accno}, $ref->{accno}); + + ($debit, $credit) = (0,0); + while (($debit, $credit) = $drcr->fetchrow_array) { + $ref->{debit} += $debit; + $ref->{credit} += $credit; + } + $drcr->finish; + + } + + $ref->{debit} = $form->round_amount($ref->{debit}, 2); + $ref->{credit} = $form->round_amount($ref->{credit}, 2); + + } + + # add subtotal + @accno = grep { $_ le "$ref->{accno}" } @headingaccounts; + $accno = pop @accno; + if ($accno) { + $trb{$accno}{debit} += $ref->{debit}; + $trb{$accno}{credit} += $ref->{credit}; + } + + push @{ $form->{TB} }, $ref; + + } + + $dbh->disconnect; + + # debits and credits for headings + foreach $accno (@headingaccounts) { + foreach $ref (@{ $form->{TB} }) { + if ($accno eq $ref->{accno}) { + $ref->{debit} = $trb{$accno}{debit}; + $ref->{credit} = $trb{$accno}{credit}; + } + } + } + +} + + +sub aging { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + my $invoice = ($form->{arap} eq 'ar') ? 'is' : 'ir'; + + ($null, $form->{todate}) = $form->from_to($form->{year}, $form->{month}) if $form->{year} && $form->{month}; + + $form->{todate} = $form->current_date($myconfig) unless ($form->{todate}); + + + my $where = "1 = 1"; + my $name; + my $null; + my $ref; + + if ($form->{"$form->{ct}_id"}) { + $where .= qq| AND ct.id = $form->{"$form->{ct}_id"}|; + } else { + if ($form->{$form->{ct}}) { + $name = $form->like(lc $form->{$form->{ct}}); + $where .= qq| AND lower(ct.name) LIKE '$name'| if $form->{$form->{ct}}; + } + } + + my $dpt_join; + if ($form->{department}) { + ($null, $department_id) = split /--/, $form->{department}; + $dpt_join = qq| + JOIN department d ON (a.department_id = d.id) + |; + + $where .= qq| AND a.department_id = $department_id|; + } + + # select outstanding vendors or customers, depends on $ct + my $query = qq|SELECT DISTINCT ct.id, ct.name, ct.language_code + FROM $form->{ct} ct + JOIN $form->{arap} a ON (a.$form->{ct}_id = ct.id) + $dpt_join + WHERE $where + AND a.paid != a.amount + AND (a.transdate <= '$form->{todate}') + ORDER BY ct.name|; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror; + + my $buysell = ($form->{arap} eq 'ar') ? 'buy' : 'sell'; + + my %interval = ( 'Pg' => { + 'c0' => "(date '$form->{todate}' - interval '0 days')", + 'c30' => "(date '$form->{todate}' - interval '30 days')", + 'c60' => "(date '$form->{todate}' - interval '60 days')", + 'c90' => "(date '$form->{todate}' - interval '90 days')" }, + 'DB2' => { + 'c0' => "(date ('$form->{todate}') - 0 days)", + 'c30' => "(date ('$form->{todate}') - 30 days)", + 'c60' => "(date ('$form->{todate}') - 60 days)", + 'c90' => "(date ('$form->{todate}') - 90 days)" } + ); + + $interval{Oracle} = $interval{PgPP} = $interval{Pg}; + + + # for each company that has some stuff outstanding + my $id; + while (($id, $null, $language_code) = $sth->fetchrow_array ) { + + $query = qq| + SELECT c.id AS ctid, c.name, + c.address1, c.address2, c.city, c.state, c.zipcode, c.country, + c.contact, c.email, + c.phone as customerphone, c.fax as customerfax, c.$form->{ct}number, + a.invnumber, a.transdate, a.till, a.ordnumber, a.notes, + (a.amount - a.paid) as c0, 0.00 as c30, 0.00 as c60, 0.00 as c90, + a.duedate, a.invoice, a.id, + (SELECT $buysell FROM exchangerate e + WHERE a.curr = e.curr + AND e.transdate = a.transdate) AS exchangerate + FROM $form->{arap} a + JOIN $form->{ct} c ON (a.$form->{ct}_id = c.id) + WHERE a.paid != a.amount + AND c.id = $id + AND ( + a.transdate <= $interval{$myconfig->{dbdriver}}{c0} + AND a.transdate >= $interval{$myconfig->{dbdriver}}{c30} + ) + + UNION + + SELECT c.id AS ctid, c.name, + c.address1, c.address2, c.city, c.state, c.zipcode, c.country, + c.contact, c.email, + c.phone as customerphone, c.fax as customerfax, c.$form->{ct}number, + a.invnumber, a.transdate, a.till, a.ordnumber, a.notes, + 0.00 as c0, (a.amount - a.paid) as c30, 0.00 as c60, 0.00 as c90, + a.duedate, a.invoice, a.id, + (SELECT $buysell FROM exchangerate e + WHERE a.curr = e.curr + AND e.transdate = a.transdate) AS exchangerate + FROM $form->{arap} a + JOIN $form->{ct} c ON (a.$form->{ct}_id = c.id) + WHERE a.paid != a.amount + AND c.id = $id + AND ( + a.transdate < $interval{$myconfig->{dbdriver}}{c30} + AND a.transdate >= $interval{$myconfig->{dbdriver}}{c60} + ) + + UNION + + SELECT c.id AS ctid, c.name, + c.address1, c.address2, c.city, c.state, c.zipcode, c.country, + c.contact, c.email, + c.phone as customerphone, c.fax as customerfax, c.$form->{ct}number, + a.invnumber, a.transdate, a.till, a.ordnumber, a.notes, + 0.00 as c0, 0.00 as c30, (a.amount - a.paid) as c60, 0.00 as c90, + a.duedate, a.invoice, a.id, + (SELECT $buysell FROM exchangerate e + WHERE a.curr = e.curr + AND e.transdate = a.transdate) AS exchangerate + FROM $form->{arap} a + JOIN $form->{ct} c ON (a.$form->{ct}_id = c.id) + WHERE a.paid != a.amount + AND c.id = $id + AND ( + a.transdate < $interval{$myconfig->{dbdriver}}{c60} + AND a.transdate >= $interval{$myconfig->{dbdriver}}{c90} + ) + + UNION + + SELECT c.id AS ctid, c.name, + c.address1, c.address2, c.city, c.state, c.zipcode, c.country, + c.contact, c.email, + c.phone as customerphone, c.fax as customerfax, c.$form->{ct}number, + a.invnumber, a.transdate, a.till, a.ordnumber, a.notes, + 0.00 as c0, 0.00 as c30, 0.00 as c60, (a.amount - a.paid) as c90, + a.duedate, a.invoice, a.id, + (SELECT $buysell FROM exchangerate e + WHERE a.curr = e.curr + AND e.transdate = a.transdate) AS exchangerate + FROM $form->{arap} a + JOIN $form->{ct} c ON (a.$form->{ct}_id = c.id) + WHERE a.paid != a.amount + AND c.id = $id + AND a.transdate < $interval{$myconfig->{dbdriver}}{c90} + + ORDER BY + + ctid, transdate, invnumber + + |; + + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror; + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{module} = ($ref->{invoice}) ? $invoice : $form->{arap}; + $ref->{module} = 'ps' if $ref->{till}; + $ref->{exchangerate} = 1 unless $ref->{exchangerate}; + $ref->{language_code} = $language_code; + push @{ $form->{AG} }, $ref; + } + + $sth->finish; + + } + $sth->finish; + + # get language + my $query = qq|SELECT * + FROM language + ORDER BY 2|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ($ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{all_language} }, $ref; + } + $sth->finish; + + # disconnect + $dbh->disconnect; + +} + + +sub get_customer { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my $query = qq|SELECT name, email, cc, bcc + FROM $form->{ct} ct + WHERE ct.id = $form->{"$form->{ct}_id"}|; + ($form->{$form->{ct}}, $form->{email}, $form->{cc}, $form->{bcc}) = $dbh->selectrow_array($query); + + $dbh->disconnect; + +} + + +sub get_taxaccounts { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + # get tax accounts + my $query = qq|SELECT c.accno, c.description, t.rate, c.link + FROM chart c, tax t + WHERE c.link LIKE '%CT_tax%' + AND c.id = t.chart_id + ORDER BY c.accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror; + + my $ref = (); + while ($ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{taxaccounts} }, $ref; + } + $sth->finish; + + # get gifi tax accounts + my $query = qq|SELECT DISTINCT g.accno, g.description, + sum(t.rate) AS rate + FROM gifi g, chart c, tax t + WHERE g.accno = c.gifi_accno + AND c.id = t.chart_id + AND c.link LIKE '%CT_tax%' + GROUP BY g.accno, g.description + ORDER BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror; + + while ($ref = $sth->fetchrow_hashref(NAME_lc) ) { + push @{ $form->{gifi_taxaccounts} }, $ref; + } + $sth->finish; + + $dbh->disconnect; + +} + + + +sub tax_report { + my ($self, $myconfig, $form) = @_; + + # connect to database + my $dbh = $form->dbconnect($myconfig); + + my ($null, $department_id) = split /--/, $form->{department}; + + # build WHERE + my $where = "1 = 1"; + my $cashwhere = ""; + + if ($department_id) { + $where .= qq| + AND a.department_id = $department_id + |; + } + + my $query; + my $sth; + my $accno; + my $rate; + + if ($form->{accno}) { + if ($form->{accno} =~ /^gifi_/) { + ($null, $accno) = split /_/, $form->{accno}; + $rate = $form->{"$form->{accno}_rate"}; + $accno = qq| AND ch.gifi_accno = '$accno'|; + } else { + $accno = $form->{accno}; + $rate = $form->{"$form->{accno}_rate"}; + $accno = qq| AND ch.accno = '$accno'|; + } + } + $rate *= 1; + + my $table; + my $ARAP; + + if ($form->{db} eq 'ar') { + $table = "customer"; + $ARAP = "AR"; + } + if ($form->{db} eq 'ap') { + $table = "vendor"; + $ARAP = "AP"; + } + + my $transdate = "a.transdate"; + + ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + # if there are any dates construct a where + if ($form->{fromdate} || $form->{todate}) { + if ($form->{fromdate}) { + $where .= " AND $transdate >= '$form->{fromdate}'"; + } + if ($form->{todate}) { + $where .= " AND $transdate <= '$form->{todate}'"; + } + } + + + if ($form->{method} eq 'cash') { + $transdate = "a.datepaid"; + + my $todate = ($form->{todate}) ? $form->{todate} : $form->current_date($myconfig); + + $cashwhere = qq| + AND ac.trans_id IN + ( + SELECT trans_id + FROM acc_trans + JOIN chart ON (chart_id = id) + WHERE link LIKE '%${ARAP}_paid%' + AND $transdate <= '$todate' + AND a.paid = a.amount + ) + |; + + } + + + my $ml = ($form->{db} eq 'ar') ? 1 : -1; + + my %ordinal = ( 'transdate' => 3, + 'invnumber' => 4, + 'name' => 5 + ); + + my @a = qw(transdate invnumber name); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + $rate = 1 unless $rate; + + if ($form->{summary}) { + + $query = qq|SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, + ac.amount * $ml AS tax, + a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN chart ch ON (ch.id = ac.chart_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE $where + $accno + AND a.invoice = '0' + $cashwhere + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + sum(ac.sellprice * ac.qty) * $ml AS netamount, + sum(ac.sellprice * ac.qty) * $rate * $ml AS tax, + a.till + FROM invoice ac + JOIN partstax pt ON (pt.parts_id = ac.parts_id) + JOIN chart ch ON (ch.id = pt.chart_id) + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + JOIN ${table}tax t ON (t.${table}_id = n.id AND t.chart_id = ch.id) + WHERE $where + $accno + AND a.invoice = '1' + $cashwhere + GROUP BY a.id, a.invoice, $transdate, a.invnumber, n.name, + a.till + |; + + if ($form->{fromdate}) { + # include open transactions from previous period + if ($cashwhere) { + $query .= qq| + UNION + + SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, + ac.amount * $ml AS tax, + a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN chart ch ON (ch.id = ac.chart_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE a.datepaid >= '$form->{fromdate}' + $accno + AND a.invoice = '0' + $cashwhere + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + sum(ac.sellprice * ac.qty) * $ml AS netamount, + sum(ac.sellprice * ac.qty) * $rate * $ml AS tax, + a.till + FROM invoice ac + JOIN partstax pt ON (pt.parts_id = ac.parts_id) + JOIN chart ch ON (ch.id = pt.chart_id) + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + JOIN ${table}tax t ON (t.${table}_id = n.id AND t.chart_id = ch.id) + WHERE a.datepaid >= '$form->{fromdate}' + $accno + AND a.invoice = '1' + $cashwhere + GROUP BY a.id, a.invoice, $transdate, a.invnumber, n.name, + a.till + |; + } + } + + + } else { + + $query = qq|SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, + ac.amount * $ml AS tax, + a.notes AS description, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN chart ch ON (ch.id = ac.chart_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE $where + $accno + AND a.invoice = '0' + $cashwhere + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + i.sellprice * i.qty * $ml AS netamount, + i.sellprice * i.qty * $rate * $ml AS tax, + i.description, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN chart ch ON (ch.id = ac.chart_id) + JOIN $table n ON (n.id = a.${table}_id) + JOIN ${table}tax t ON (t.${table}_id = n.id AND t.chart_id = ch.id) + JOIN invoice i ON (i.trans_id = a.id) + JOIN partstax pt ON (pt.parts_id = i.parts_id AND pt.chart_id = ch.id) + WHERE $where + $accno + AND a.invoice = '1' + $cashwhere + |; + + if ($form->{fromdate}) { + if ($cashwhere) { + $query .= qq| + UNION + + SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, + ac.amount * $ml AS tax, + a.notes AS description, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN chart ch ON (ch.id = ac.chart_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE a.datepaid >= '$form->{fromdate}' + $accno + AND a.invoice = '0' + $cashwhere + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + i.sellprice * i.qty * $ml AS netamount, + i.sellprice * i.qty * $rate * $ml AS tax, + i.description, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN chart ch ON (ch.id = ac.chart_id) + JOIN $table n ON (n.id = a.${table}_id) + JOIN ${table}tax t ON (t.${table}_id = n.id AND t.chart_id = ch.id) + JOIN invoice i ON (i.trans_id = a.id) + JOIN partstax pt ON (pt.parts_id = i.parts_id AND pt.chart_id = ch.id) + WHERE a.datepaid >= '$form->{fromdate}' + $accno + AND a.invoice = '1' + $cashwhere + |; + } + } + } + + + if ($form->{report} =~ /nontaxable/) { + + if ($form->{summary}) { + # only gather up non-taxable transactions + $query = qq|SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE $where + AND a.invoice = '0' + AND a.netamount = a.amount + $cashwhere + GROUP BY a.id, $transdate, a.invnumber, n.name, a.netamount, + a.till + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + sum(ac.sellprice * ac.qty) * $ml AS netamount, a.till + FROM invoice ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE $where + AND a.invoice = '1' + AND ( + a.${table}_id NOT IN ( + SELECT ${table}_id FROM ${table}tax t (${table}_id) + ) OR + ac.parts_id NOT IN ( + SELECT parts_id FROM partstax p (parts_id) + ) + ) + $cashwhere + GROUP BY a.id, a.invnumber, $transdate, n.name, a.till + |; + + if ($form->{fromdate}) { + if ($cashwhere) { + $query .= qq| + UNION + + SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE a.datepaid >= '$form->{fromdate}' + AND a.invoice = '0' + AND a.netamount = a.amount + $cashwhere + GROUP BY a.id, $transdate, a.invnumber, n.name, a.netamount, + a.till + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + sum(ac.sellprice * ac.qty) * $ml AS netamount, a.till + FROM invoice ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE a.datepaid >= '$form->{fromdate}' + AND a.invoice = '1' + AND ( + a.${table}_id NOT IN ( + SELECT ${table}_id FROM ${table}tax t (${table}_id) + ) OR + ac.parts_id NOT IN ( + SELECT parts_id FROM partstax p (parts_id) + ) + ) + $cashwhere + GROUP BY a.id, a.invnumber, $transdate, n.name, a.till + |; + } + } + + } else { + + # gather up details for non-taxable transactions + $query = qq|SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, + a.notes AS description, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE $where + AND a.invoice = '0' + AND a.netamount = a.amount + $cashwhere + GROUP BY a.id, $transdate, a.invnumber, n.name, a.netamount, + a.notes, a.till + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + sum(ac.sellprice * ac.qty) * $ml AS netamount, + ac.description, a.till + FROM invoice ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE $where + AND a.invoice = '1' + AND ( + a.${table}_id NOT IN ( + SELECT ${table}_id FROM ${table}tax t (${table}_id) + ) OR + ac.parts_id NOT IN ( + SELECT parts_id FROM partstax p (parts_id) + ) + ) + $cashwhere + GROUP BY a.id, a.invnumber, $transdate, n.name, + ac.description, a.till + |; + + if ($form->{fromdate}) { + if ($cashwhere) { + $query .= qq| + UNION + + SELECT a.id, '0' AS invoice, $transdate AS transdate, + a.invnumber, n.name, a.netamount, + a.notes AS description, a.till + FROM acc_trans ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE a.datepaid >= '$form->{fromdate}' + AND a.invoice = '0' + AND a.netamount = a.amount + $cashwhere + GROUP BY a.id, $transdate, a.invnumber, n.name, a.netamount, + a.notes, a.till + + UNION + + SELECT a.id, '1' AS invoice, $transdate AS transdate, + a.invnumber, n.name, + sum(ac.sellprice * ac.qty) * $ml AS netamount, + ac.description, a.till + FROM invoice ac + JOIN $form->{db} a ON (a.id = ac.trans_id) + JOIN $table n ON (n.id = a.${table}_id) + WHERE a.datepaid >= '$form->{fromdate}' + AND a.invoice = '1' + AND ( + a.${table}_id NOT IN ( + SELECT ${table}_id FROM ${table}tax t (${table}_id) + ) OR + ac.parts_id NOT IN ( + SELECT parts_id FROM partstax p (parts_id) + ) + ) + $cashwhere + GROUP BY a.id, a.invnumber, $transdate, n.name, + ac.description, a.till + |; + } + } + + } + } + + + $query .= qq| + ORDER by $sortorder|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while ( my $ref = $sth->fetchrow_hashref(NAME_lc)) { + $ref->{tax} = $form->round_amount($ref->{tax}, 2); + push @{ $form->{TR} }, $ref if $ref->{netamount} != 0; + } + + $sth->finish; + $dbh->disconnect; + +} + + +sub paymentaccounts { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn AutoCommit off + my $dbh = $form->dbconnect_noauto($myconfig); + + my $ARAP = uc $form->{db}; + + # get A(R|P)_paid accounts + my $query = qq|SELECT accno, description + FROM chart + WHERE link LIKE '%${ARAP}_paid%' + ORDER BY accno|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $ref = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{PR} }, $ref; + } + $sth->finish; + + $form->all_years($dbh, $myconfig); + + $dbh->disconnect; + +} + + +sub payments { + my ($self, $myconfig, $form) = @_; + + # connect to database, turn AutoCommit off + my $dbh = $form->dbconnect_noauto($myconfig); + + my $ml = 1; + if ($form->{db} eq 'ar') { + $table = 'customer'; + $ml = -1; + } + if ($form->{db} eq 'ap') { + $table = 'vendor'; + } + + + my $query; + my $sth; + my $dpt_join; + my $where; + my $var; + + if ($form->{department_id}) { + $dpt_join = qq| + JOIN dpt_trans t ON (t.trans_id = ac.trans_id) + |; + + $where = qq| + AND t.department_id = $form->{department_id} + |; + } + + ($form->{fromdate}, $form->{todate}) = $form->from_to($form->{year}, $form->{month}, $form->{interval}) if $form->{year} && $form->{month}; + + if ($form->{fromdate}) { + $where .= " AND ac.transdate >= '$form->{fromdate}'"; + } + if ($form->{todate}) { + $where .= " AND ac.transdate <= '$form->{todate}'"; + } + if (!$form->{fx_transaction}) { + $where .= " AND ac.fx_transaction = '0'"; + } + + if ($form->{description}) { + $var = $form->like(lc $form->{description}); + $where .= " AND lower(c.name) LIKE '$var'"; + } + if ($form->{source}) { + $var = $form->like(lc $form->{source}); + $where .= " AND lower(ac.source) LIKE '$var'"; + } + if ($form->{memo}) { + $var = $form->like(lc $form->{memo}); + $where .= " AND lower(ac.memo) LIKE '$var'"; + } + + my %ordinal = ( 'name' => 1, + 'transdate' => 2, + 'source' => 4, + 'employee' => 6, + 'till' => 7 + ); + + my @a = qw(name transdate employee); + my $sortorder = $form->sort_order(\@a, \%ordinal); + + my $glwhere = $where; + $glwhere =~ s/\(c.name\)/\(g.description\)/; + + # cycle through each id + foreach my $accno (split(/ /, $form->{paymentaccounts})) { + + $query = qq|SELECT id, accno, description + FROM chart + WHERE accno = '$accno'|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my $ref = $sth->fetchrow_hashref(NAME_lc); + push @{ $form->{PR} }, $ref; + $sth->finish; + + $query = qq|SELECT c.name, ac.transdate, sum(ac.amount) * $ml AS paid, + ac.source, ac.memo, e.name AS employee, a.till, a.curr + FROM acc_trans ac + JOIN $form->{db} a ON (ac.trans_id = a.id) + JOIN $table c ON (c.id = a.${table}_id) + LEFT JOIN employee e ON (a.employee_id = e.id) + $dpt_join + WHERE ac.chart_id = $ref->{id} + $where|; + + if ($form->{till}) { + $query .= " AND a.invoice = '1' + AND NOT a.till IS NULL"; + + if ($myconfig->{role} eq 'user') { + $query .= " AND e.login = '$form->{login}'"; + } + } + + $query .= qq| + GROUP BY c.name, ac.transdate, ac.source, ac.memo, + e.name, a.till, a.curr + |; + + if (! $form->{till}) { +# don't need gl for a till + + $query .= qq| + UNION + SELECT g.description, ac.transdate, sum(ac.amount) * $ml AS paid, ac.source, + ac.memo, e.name AS employee, '' AS till, '' AS curr + FROM acc_trans ac + JOIN gl g ON (g.id = ac.trans_id) + LEFT JOIN employee e ON (g.employee_id = e.id) + $dpt_join + WHERE ac.chart_id = $ref->{id} + $glwhere + AND (ac.amount * $ml) > 0 + GROUP BY g.description, ac.transdate, ac.source, ac.memo, e.name + |; + + } + + $query .= qq| + ORDER BY $sortorder|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my $pr = $sth->fetchrow_hashref(NAME_lc)) { + push @{ $form->{$ref->{id}} }, $pr; + } + $sth->finish; + + } + + $dbh->disconnect; + +} + + +1; + + diff --git a/sql-ledger/SL/User.pm b/sql-ledger/SL/User.pm new file mode 100644 index 000000000..e7e0b9cbc --- /dev/null +++ b/sql-ledger/SL/User.pm @@ -0,0 +1,925 @@ +#===================================================================== +# SQL-Ledger Accounting +# Copyright (C) 2000 +# +# Author: Dieter Simader +# Email: dsimader@sql-ledger.org +# Web: http://www.sql-ledger.org +# +# Contributors: Jim Rawlings <jim@your-dba.com> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +#===================================================================== +# +# user related functions +# +#===================================================================== + +package User; + + +sub new { + my ($type, $memfile, $login) = @_; + my $self = {}; + + if ($login ne "") { + &error("", "$memfile locked!") if (-f "${memfile}.LCK"); + + open(MEMBER, "$memfile") or &error("", "$memfile : $!"); + + while (<MEMBER>) { + if (/^\[$login\]/) { + while (<MEMBER>) { + last if /^\[/; + next if /^(#|\s)/; + + # remove comments + s/^\s*#.*//g; + + # remove any trailing whitespace + s/^\s*(.*?)\s*$/$1/; + + ($key, $value) = split /=/, $_, 2; + + $self->{$key} = $value; + } + + $self->{login} = $login; + + last; + } + } + close MEMBER; + } + + bless $self, $type; +} + + +sub country_codes { + + my %cc = (); + my @language = (); + + # scan the locale directory and read in the LANGUAGE files + opendir DIR, "locale"; + + my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR; + + foreach my $dir (@dir) { + next unless open(FH, "locale/$dir/LANGUAGE"); + @language = <FH>; + close FH; + + $cc{$dir} = "@language"; + } + + closedir(DIR); + + %cc; + +} + + +sub login { + my ($self, $form, $userspath) = @_; + + my $rc = -3; + + if ($self->{login}) { + + if ($self->{password}) { + my $password = crypt $form->{password}, substr($self->{login}, 0, 2); + if ($self->{password} ne $password) { + return -1; + } + } + + unless (-f "$userspath/$self->{login}.conf") { + $self->create_config("$userspath/$self->{login}.conf"); + } + + do "$userspath/$self->{login}.conf"; + $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; + + # check if database is down + my $dbh = DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd}) or $self->error($DBI::errstr); + + # we got a connection, check the version + my $query = qq|SELECT version FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($dbversion) = $sth->fetchrow_array; + $sth->finish; + + # add login to employee table if it does not exist + # no error check for employee table, ignore if it does not exist + my $login = $self->{login}; + $login =~ s/@.*//; + $query = qq|SELECT id FROM employee WHERE login = '$login'|; + $sth = $dbh->prepare($query); + $sth->execute; + + my ($id) = $sth->fetchrow_array; + $sth->finish; + + if (! $id) { + my ($employeenumber) = $form->update_defaults(\%myconfig, "employeenumber", $dbh); + + $query = qq|INSERT INTO employee (login, employeenumber, name, workphone, + role) + VALUES ('$login', '$employeenumber', '$myconfig{name}', + '$myconfig{tel}', '$myconfig{role}')|; + $dbh->do($query); + } + $dbh->disconnect; + + $rc = 0; + + + if ($form->{dbversion} ne $dbversion) { + $rc = -4; + $dbupdate = (calc_version($dbversion) < calc_version($form->{dbversion})); + } + + if ($dbupdate) { + $rc = -5; + + # if DB2 bale out + if ($myconfig{dbdriver} eq 'DB2') { + $rc = -2; + } + } + } + + $rc; + +} + + + +sub dbconnect_vars { + my ($form, $db) = @_; + + my %dboptions = ( + 'Pg' => { + 'yy-mm-dd' => 'set DateStyle to \'ISO\'', + 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', + 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'', + 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', + 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'', + 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' + }, + 'Oracle' => { + 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'', + 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'', + 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'', + 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'', + 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'', + 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'', + } + ); + + + $form->{dboptions} = $dboptions{$form->{dbdriver}}{$form->{dateformat}}; + + if ($form->{dbdriver} =~ /Pg/) { + $form->{dbconnect} = "dbi:$form->{dbdriver}:dbname=$db"; + } + + if ($form->{dbdriver} eq 'Oracle') { + $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}"; + } + + if ($form->{dbhost}) { + $form->{dbconnect} .= ";host=$form->{dbhost}"; + } + if ($form->{dbport}) { + $form->{dbconnect} .= ";port=$form->{dbport}"; + } + +} + + +sub dbdrivers { + + my @drivers = DBI->available_drivers(); + +# return (grep { /(Pg|Oracle|DB2)/ } @drivers); + return (grep { /Pg$/ } @drivers); + +} + + +sub dbsources { + my ($self, $form) = @_; + + my @dbsources = (); + my ($sth, $query); + + $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault}; + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars($form, $form->{dbdefault}); + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + + if ($form->{dbdriver} eq 'Pg') { + + $query = qq|SELECT datname FROM pg_database|; + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($db) = $sth->fetchrow_array) { + + if ($form->{only_acc_db}) { + + next if ($db =~ /^template/); + + &dbconnect_vars($form, $db); + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + $query = qq|SELECT tablename FROM pg_tables + WHERE tablename = 'defaults' + AND tableowner = '$form->{dbuser}'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + if ($sth->fetchrow_array) { + push @dbsources, $db; + } + $sth->finish; + $dbh->disconnect; + next; + } + push @dbsources, $db; + } + } + + if ($form->{dbdriver} eq 'Oracle') { + if ($form->{only_acc_db}) { + $query = qq|SELECT owner FROM dba_objects + WHERE object_name = 'DEFAULTS' + AND object_type = 'TABLE'|; + } else { + $query = qq|SELECT username FROM dba_users|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($db) = $sth->fetchrow_array) { + push @dbsources, $db; + } + } + + +# JJR + if ($form->{dbdriver} eq 'DB2') { + if ($form->{only_acc_db}) { + $query = qq|SELECT tabschema FROM syscat.tables WHERE tabname = 'DEFAULTS'|; + } else { + $query = qq|SELECT DISTINCT schemaname FROM syscat.schemata WHERE definer != 'SYSIBM' AND schemaname != 'NULLID'|; + } + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($db) = $sth->fetchrow_array) { + push @dbsources, $db; + } + } +# End JJR + +# the above is not used but leave it in for future reference +# DS, Oct. 28, 2003 + + + $sth->finish; + $dbh->disconnect; + + return @dbsources; + +} + + +sub dbcreate { + my ($self, $form) = @_; + + my %dbcreate = ( 'Pg' => qq|CREATE DATABASE "$form->{db}"|, + 'Oracle' => qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|); + + $dbcreate{Pg} .= " WITH ENCODING = '$form->{encoding}'" if $form->{encoding}; + + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars($form, $form->{dbdefault}); + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + my $query = qq|$dbcreate{$form->{dbdriver}}|; + $dbh->do($query) || $form->dberror($query); + + if ($form->{dbdriver} eq 'Oracle') { + $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|; + $dbh->do($query) || $form->dberror($query); + } + $dbh->disconnect; + + + # setup variables for the new database + if ($form->{dbdriver} eq 'Oracle') { + $form->{dbuser} = $form->{db}; + $form->{dbpasswd} = $form->{db}; + } + + + &dbconnect_vars($form, $form->{db}); + + $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + # create the tables + my $dbdriver = ($form->{dbdriver} =~ /Pg/) ? 'Pg' : $form->{dbdriver}; + + my $filename = qq|sql/${dbdriver}-tables.sql|; + $self->process_query($form, $dbh, $filename); + + # create functions + $filename = qq|sql/${dbdriver}-functions.sql|; + $self->process_query($form, $dbh, $filename); + + # load gifi + ($filename) = split /_/, $form->{chart}; + $filename =~ s/_//; + $self->process_query($form, $dbh, "sql/${filename}-gifi.sql"); + + # load chart of accounts + $filename = qq|sql/$form->{chart}-chart.sql|; + $self->process_query($form, $dbh, $filename); + + # create indices + $filename = qq|sql/${dbdriver}-indices.sql|; + $self->process_query($form, $dbh, $filename); + + # create custom tables and functions + my $item; + foreach $item (qw(tables functions)) { + $filename = "sql/${dbdriver}-custom_${item}.sql"; + if (-f "$filename") { + $self->process_query($form, $dbh, $filename); + } + } + + $dbh->disconnect; + +} + + + +sub process_query { + my ($self, $form, $dbh, $filename) = @_; + + return unless (-f $filename); + + open(FH, "$filename") or $form->error("$filename : $!\n"); + my $query = ""; + my $loop = 0; + my $sth; + + + while (<FH>) { + + if ($loop && /^--\s*end\s*(procedure|function|trigger)/i) { + $loop = 0; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + $sth->finish; + + $query = ""; + next; + } + + if ($loop || /^create *(or replace)? *(procedure|function|trigger)/i) { + $loop = 1; + next if /^(--.*|\s+)$/; + + $query .= $_; + next; + } + + # don't add comments or empty lines + next if /^(--.*|\s+)$/; + + # anything else, add to query + $query .= $_; + + if (/;\s*$/) { + # strip ;... Oracle doesn't like it + $query =~ s/;\s*$//; + $query =~ s/\\'/''/g; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + $sth->finish; + + $query = ""; + } + + } + close FH; + +} + + + +sub dbdelete { + my ($self, $form) = @_; + + my %dbdelete = ( 'Pg' => qq|DROP DATABASE "$form->{db}"|, + 'Oracle' => qq|DROP USER $form->{db} CASCADE| + ); + + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars($form, $form->{dbdefault}); + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + my $query = qq|$dbdelete{$form->{dbdriver}}|; + $dbh->do($query) || $form->dberror($query); + + $dbh->disconnect; + +} + + + +sub dbsources_unused { + my ($self, $form, $memfile) = @_; + + my @dbexcl = (); + my @dbsources = (); + + $form->error("$memfile locked!") if (-f "${memfile}.LCK"); + + # open members file + open(FH, "$memfile") or $form->error("$memfile : $!"); + + while (<FH>) { + if (/^dbname=/) { + my ($null,$item) = split /=/; + push @dbexcl, $item; + } + } + + close FH; + + $form->{only_acc_db} = 1; + my @db = &dbsources("", $form); + + push @dbexcl, $form->{dbdefault}; + + foreach $item (@db) { + unless (grep /$item$/, @dbexcl) { + push @dbsources, $item; + } + } + + return @dbsources; + +} + + +sub dbneedsupdate { + my ($self, $form) = @_; + + my %dbsources = (); + my $query; + + $form->{sid} = $form->{dbdefault}; + &dbconnect_vars($form, $form->{dbdefault}); + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + if ($form->{dbdriver} =~ /Pg/) { + + $query = qq|SELECT d.datname FROM pg_database d, pg_user u + WHERE d.datdba = u.usesysid + AND u.usename = '$form->{dbuser}'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($db) = $sth->fetchrow_array) { + + next if ($db =~ /^template/); + + &dbconnect_vars($form, $db); + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + $query = qq|SELECT tablename FROM pg_tables + WHERE tablename = 'defaults'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + if ($sth->fetchrow_array) { + $query = qq|SELECT version FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute; + + if (my ($version) = $sth->fetchrow_array) { + $dbsources{$db} = $version; + } + $sth->finish; + } + $sth->finish; + $dbh->disconnect; + } + $sth->finish; + } + + + if ($form->{dbdriver} eq 'Oracle') { + $query = qq|SELECT owner FROM dba_objects + WHERE object_name = 'DEFAULTS' + AND object_type = 'TABLE'|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($db) = $sth->fetchrow_array) { + + $form->{dbuser} = $db; + &dbconnect_vars($form, $db); + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + $query = qq|SELECT version FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute; + + if (my ($version) = $sth->fetchrow_array) { + $dbsources{$db} = $version; + } + $sth->finish; + $dbh->disconnect; + } + $sth->finish; + } + + +# JJR + if ($form->{dbdriver} eq 'DB2') { + $query = qq|SELECT tabschema FROM syscat.tables WHERE tabname = 'DEFAULTS'|; + + $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + while (my ($db) = $sth->fetchrow_array) { + + &dbconnect_vars($form, $db); + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + $query = qq|SELECT version FROM defaults|; + my $sth = $dbh->prepare($query); + $sth->execute; + + if (my ($version) = $sth->fetchrow_array) { + $dbsources{$db} = $version; + } + $sth->finish; + $dbh->disconnect; + } + $sth->finish; + } +# End JJR + +# code for DB2 is not used, keep for future reference +# DS, Oct. 28, 2003 + + $dbh->disconnect; + + %dbsources; + +} + + +sub dbupdate { + my ($self, $form) = @_; + + $form->{sid} = $form->{dbdefault}; + + my @upgradescripts = (); + my $query; + my $rc = -2; + + if ($form->{dbupdate}) { + # read update scripts into memory + opendir SQLDIR, "sql/." or $form->error($!); + @upgradescripts = sort script_version grep /$form->{dbdriver}-upgrade-.*?\.sql$/, readdir SQLDIR; + closedir SQLDIR; + } + + + foreach my $db (split / /, $form->{dbupdate}) { + + next unless $form->{$db}; + + # strip db from dataset + $db =~ s/^db//; + &dbconnect_vars($form, $db); + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + + # check version + $query = qq|SELECT version FROM defaults|; + my $sth = $dbh->prepare($query); + # no error check, let it fall through + $sth->execute; + + my $version = $sth->fetchrow_array; + $sth->finish; + + next unless $version; + + $version = calc_version($version); + my $dbversion = calc_version($form->{dbversion}); + + foreach my $upgradescript (@upgradescripts) { + my $a = $upgradescript; + $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g; + + my ($mindb, $maxdb) = split /-/, $a; + $mindb = calc_version($mindb); + $maxdb = calc_version($maxdb); + + next if ($version >= $maxdb); + + # exit if there is no upgrade script or version == mindb + last if ($version < $mindb || $version >= $dbversion); + + # apply upgrade + $self->process_query($form, $dbh, "sql/$upgradescript"); + + $version = $maxdb; + + } + + $rc = 0; + $dbh->disconnect; + + } + + $rc; + +} + + +sub calc_version { + + my @v = split /\./, $_[0]; + my $version = 0; + my $i; + + for ($i = 0; $i <= $#v; $i++) { + $version *= 1000; + $version += $v[$i]; + } + + return $version; + +} + + +sub script_version { + my ($my_a, $my_b) = ($a, $b); + + my ($a_from, $a_to, $b_from, $b_to); + my ($res_a, $res_b, $i); + + $my_a =~ s/.*-upgrade-//; + $my_a =~ s/.sql$//; + $my_b =~ s/.*-upgrade-//; + $my_b =~ s/.sql$//; + ($a_from, $a_to) = split(/-/, $my_a); + ($b_from, $b_to) = split(/-/, $my_b); + + $res_a = calc_version($a_from); + $res_b = calc_version($b_from); + + if ($res_a == $res_b) { + $res_a = calc_version($a_to); + $res_b = calc_version($b_to); + } + + return $res_a <=> $res_b; + +} + + +sub create_config { + my ($self, $filename) = @_; + + + @config = &config_vars; + + open(CONF, ">$filename") or $self->error("$filename : $!"); + + # create the config file + print CONF qq|# configuration file for $self->{login} + +\%myconfig = ( +|; + + foreach $key (sort @config) { + $self->{$key} =~ s/\\/\\\\/g; + $self->{$key} =~ s/'/\\'/g; + print CONF qq| $key => '$self->{$key}',\n|; + } + + + print CONF qq|);\n\n|; + + close CONF; + +} + + +sub save_member { + my ($self, $memberfile, $userspath) = @_; + + # format dbconnect and dboptions string + &dbconnect_vars($self, $self->{dbname}); + + $self->error("$memberfile locked!") if (-f "${memberfile}.LCK"); + open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!"); + close(FH); + + if (! open(CONF, "+<$memberfile")) { + unlink "${memberfile}.LCK"; + $self->error("$memberfile : $!"); + } + + @config = <CONF>; + + seek(CONF, 0, 0); + truncate(CONF, 0); + + while ($line = shift @config) { + last if ($line =~ /^\[$self->{login}\]/); + print CONF $line; + } + + # remove everything up to next login or EOF + while ($line = shift @config) { + last if ($line =~ /^\[/); + } + + # this one is either the next login or EOF + print CONF $line; + + while ($line = shift @config) { + print CONF $line; + } + + print CONF qq|[$self->{login}]\n|; + + if ($self->{root}) { + $self->{dbpasswd} = pack 'u', $self->{dbpasswd}; + chop $self->{dbpasswd}; + } + + if ($self->{password} ne $self->{old_password}) { + $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2) if $self->{password}; + } + + if ($self->{'root login'}) { + @config = ("password"); + } else { + @config = &config_vars; + } + + # replace \r\n with \n + map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature); + + foreach $key (sort @config) { + print CONF qq|$key=$self->{$key}\n|; + } + + print CONF "\n"; + close CONF; + unlink "${memberfile}.LCK"; + + # create conf file + if (! $self->{'root login'}) { + $self->create_config("$userspath/$self->{login}.conf"); + + $self->{dbpasswd} =~ s/\\'/'/g; + $self->{dbpasswd} =~ s/\\\\/\\/g; + $self->{dbpasswd} = unpack 'u', $self->{dbpasswd}; + + # check if login is in database + my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, {AutoCommit => 0}) or $self->error($DBI::errstr); + + # add login to employee table if it does not exist + # no error check for employee table, ignore if it does not exist + my $login = $self->{login}; + $login =~ s/@.*//; + my $query = qq|SELECT id FROM employee WHERE login = '$login'|; + my $sth = $dbh->prepare($query); + $sth->execute; + + my ($id) = $sth->fetchrow_array; + $sth->finish; + + if ($id) { + $query = qq|UPDATE employee SET + role = '$self->{role}', + email = '$self->{email}', + name = '$self->{name}' + WHERE login = '$login'|; + + } else { + my ($employeenumber) = Form::update_defaults("", \%$self, "employeenumber", $dbh); + $query = qq|INSERT INTO employee (login, employeenumber, name, workphone, + role, email) + VALUES ('$login', '$employeenumber', '$self->{name}', + '$self->{tel}', '$self->{role}', '$self->{email}')|; + } + + $dbh->do($query); + $dbh->commit; + $dbh->disconnect; + + } + +} + + +sub delete_login { + my ($self, $form) = @_; + + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, {AutoCommit} => 0) or $form->dberror; + + my $login = $form->{login}; + $login =~ s/@.*//; + my $query = qq|SELECT id FROM employee + WHERE login = '$login'|; + my $sth = $dbh->prepare($query); + $sth->execute || $form->dberror($query); + + my ($id) = $sth->fetchrow_array; + $sth->finish; + + my $query = qq|UPDATE employee + login = NULL + WHERE login = '$login'|; + $dbh->do($query); + + $dbh->commit; + $dbh->disconnect; + +} + + +sub config_vars { + + my @conf = qw(acs address businessnumber charset company countrycode + currency dateformat dbconnect dbdriver dbhost dbport dboptions + dbname dbuser dbpasswd email fax name numberformat password + printer role sid signature stylesheet tel templates vclimit + menuwidth timeout); + + @conf; + +} + + +sub error { + my ($self, $msg) = @_; + + if ($ENV{HTTP_USER_AGENT}) { + print qq|Content-Type: text/html + +<body bgcolor=ffffff> + +<h2><font color=red>Error!</font></h2> +<p><b>$msg</b>|; + + } + + die "Error: $msg\n"; + +} + + +1; + |