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, 0 insertions, 19333 deletions
diff --git a/sql-ledger/SL/AM.pm b/sql-ledger/SL/AM.pm deleted file mode 100644 index dbdd61111..000000000 --- a/sql-ledger/SL/AM.pm +++ /dev/null @@ -1,1478 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 05bc77a3a..000000000 --- a/sql-ledger/SL/AP.pm +++ /dev/null @@ -1,464 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 80487e406..000000000 --- a/sql-ledger/SL/AR.pm +++ /dev/null @@ -1,492 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index d85077db2..000000000 --- a/sql-ledger/SL/BP.pm +++ /dev/null @@ -1,371 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 2ae78bd5c..000000000 --- a/sql-ledger/SL/CA.pm +++ /dev/null @@ -1,486 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 539ff6d9a..000000000 --- a/sql-ledger/SL/CP.pm +++ /dev/null @@ -1,396 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index bfcc2196a..000000000 --- a/sql-ledger/SL/CT.pm +++ /dev/null @@ -1,1008 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index c722b4417..000000000 --- a/sql-ledger/SL/Form.pm +++ /dev/null @@ -1,2357 +0,0 @@ -#================================================================= -# 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 deleted file mode 100644 index 221f71726..000000000 --- a/sql-ledger/SL/GL.pm +++ /dev/null @@ -1,514 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 6e1bae850..000000000 --- a/sql-ledger/SL/HR.pm +++ /dev/null @@ -1,558 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index cf70b06ca..000000000 --- a/sql-ledger/SL/IC.pm +++ /dev/null @@ -1,1513 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 79a619be8..000000000 --- a/sql-ledger/SL/IR.pm +++ /dev/null @@ -1,1243 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 788dd9568..000000000 --- a/sql-ledger/SL/IS.pm +++ /dev/null @@ -1,1632 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 8ccf4334d..000000000 --- a/sql-ledger/SL/Inifile.pm +++ /dev/null @@ -1,88 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 712b1d727..000000000 --- a/sql-ledger/SL/Mailer.pm +++ /dev/null @@ -1,162 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 0df3067aa..000000000 --- a/sql-ledger/SL/Menu.pm +++ /dev/null @@ -1,121 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 06eee7183..000000000 --- a/sql-ledger/SL/Num2text.pm +++ /dev/null @@ -1,162 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index dfa424c31..000000000 --- a/sql-ledger/SL/OE.pm +++ /dev/null @@ -1,1581 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 184566c14..000000000 --- a/sql-ledger/SL/OP.pm +++ /dev/null @@ -1,118 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index f0850a7cf..000000000 --- a/sql-ledger/SL/PE.pm +++ /dev/null @@ -1,639 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 2a8bf9410..000000000 --- a/sql-ledger/SL/RC.pm +++ /dev/null @@ -1,474 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index 791b22bba..000000000 --- a/sql-ledger/SL/RP.pm +++ /dev/null @@ -1,2551 +0,0 @@ -#===================================================================== -# 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 deleted file mode 100644 index e7e0b9cbc..000000000 --- a/sql-ledger/SL/User.pm +++ /dev/null @@ -1,925 +0,0 @@ -#===================================================================== -# 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; - |