summaryrefslogtreecommitdiff
path: root/sql-ledger/SL
diff options
context:
space:
mode:
Diffstat (limited to 'sql-ledger/SL')
-rw-r--r--sql-ledger/SL/AM.pm694
-rw-r--r--sql-ledger/SL/AP.pm381
-rw-r--r--sql-ledger/SL/AR.pm381
-rw-r--r--sql-ledger/SL/CA.pm262
-rw-r--r--sql-ledger/SL/CP.pm308
-rw-r--r--sql-ledger/SL/CT.pm447
-rw-r--r--sql-ledger/SL/Form.pm1397
-rw-r--r--sql-ledger/SL/GL.pm462
-rw-r--r--sql-ledger/SL/IC.pm936
-rw-r--r--sql-ledger/SL/IR.pm995
-rw-r--r--sql-ledger/SL/IS.pm1231
-rw-r--r--sql-ledger/SL/Inifile.pm87
-rw-r--r--sql-ledger/SL/Mailer.pm147
-rw-r--r--sql-ledger/SL/Menu.pm117
-rw-r--r--sql-ledger/SL/Num2text.pm162
-rw-r--r--sql-ledger/SL/OE.pm674
-rw-r--r--sql-ledger/SL/PE.pm276
-rw-r--r--sql-ledger/SL/RC.pm186
-rw-r--r--sql-ledger/SL/RP.pm1310
-rw-r--r--sql-ledger/SL/User.pm692
20 files changed, 0 insertions, 11145 deletions
diff --git a/sql-ledger/SL/AM.pm b/sql-ledger/SL/AM.pm
deleted file mode 100644
index d691b3ce6..000000000
--- a/sql-ledger/SL/AM.pm
+++ /dev/null
@@ -1,694 +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.
-#======================================================================
-#
-# 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"};
- }
-
- $sth->finish;
-
-
- # 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;
- $dbh->disconnect;
-
-}
-
-
-sub save_account {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database, turn off AutoCommit
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- # sanity check, can't have AR with AR_...
- if ($form->{AR} || $form->{AP} || $form->{IC}) {
- map { delete $form->{$_} } qw(AR_amount AR_tax AR_paid AP_amount AP_tax AP_paid IC_sale IC_cogs IC_taxpart IC_income IC_expense IC_taxservice);
- }
-
- $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};
-
- # if we have an id then replace the old record
- $form->{description} =~ s/'/''/g;
-
- # strip blanks from accno
- map { $form->{$_} =~ s/ //g; } qw(accno gifi_accno);
-
- my ($query, $sth);
-
- if ($form->{id}) {
- $query = qq|UPDATE chart SET
- accno = '$form->{accno}',
- description = '$form->{description}',
- 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}', '$form->{description}',
- '$form->{charttype}', '$form->{gifi_accno}',
- '$form->{category}', '$form->{link}')|;
- }
- $dbh->do($query) || $form->dberror($query);
-
-
- if ($form->{IC_taxpart} || $form->{IC_taxservice} || $form->{CT_tax}) {
-
- my $chart_id = $form->{id};
-
- unless ($form->{id}) {
- # get id from chart
- $query = qq|SELECT id
- FROM chart
- WHERE accno = '$form->{accno}'|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($chart_id) = $sth->fetchrow_array;
- $sth->finish;
- }
-
- # add account if it doesn't exist in tax
- $query = qq|SELECT chart_id
- FROM tax
- WHERE chart_id = $chart_id|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($tax_id) = $sth->fetchrow_array;
- $sth->finish;
-
- # 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);
-
- # 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;
- }
-
- $sth->finish;
- $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}'|;
- 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_gifi {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- $form->{description} =~ s/'/''/g;
- $form->{accno} =~ s/ //g;
-
- # id is the old account number!
- if ($form->{id}) {
- $query = qq|UPDATE gifi SET
- accno = '$form->{accno}',
- description = '$form->{description}'
- WHERE accno = '$form->{id}'|;
- } else {
- $query = qq|INSERT INTO gifi
- (accno, description)
- VALUES ('$form->{accno}', '$form->{description}')|;
- }
- $dbh->do($query) || $form->dberror($query);
-
- $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 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) = @_;
-
- 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);
-
- # these defaults are database wide
- # user specific variables are in 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}'),
- invnumber = '$form->{invnumber}',
- sonumber = '$form->{sonumber}',
- ponumber = '$form->{ponumber}',
- yearend = '$form->{yearend}',
- curr = '$form->{curr}',
- weightunit = '$form->{weightunit}',
- businessnumber = '$form->{businessnumber}'
- |;
- $dbh->do($query) || $form->dberror($query);
-
- # update name
- my $name = $form->{name};
- $name =~ s/'/''/g;
- $query = qq|UPDATE employee
- SET name = '$name'
- WHERE login = '$form->{login}'|;
- $dbh->do($query) || $form->dberror($query);
-
- foreach my $item (split / /, $form->{taxaccounts}) {
- $query = qq|UPDATE tax
- SET rate = |.($form->{$item} / 100).qq|,
- taxnumber = '$form->{"taxnumber_$item"}'
- WHERE chart_id = $item|;
- $dbh->do($query) || $form->dberror($query);
- }
-
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- # save first currency in myconfig
- $form->{currency} = substr($form->{curr},0,3);
-
- my $myconfig = new User "$memberfile", "$form->{login}";
-
- foreach my $item (keys %$form) {
- $myconfig->{$item} = $form->{$item};
- }
-
- $myconfig->save_member($memberfile, $userspath);
-
- $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 || $self->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 || $self->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 || $self->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) = @_;
-
- my ($tmpfile, $out, $mail);
-
- if ($form->{media} eq 'email') {
-
- my $boundary = time;
- $tmpfile = "$userspath/$boundary.$myconfig->{dbname}-$form->{dbversion}.sql";
- $out = $form->{OUT};
- $form->{OUT} = ">$tmpfile";
-
- 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}.sql";
- @{ $mail->{attachments} } = ($tmpfile);
- $mail->{version} = $form->{version};
- $mail->{fileid} = "$boundary.";
-
- $myconfig->{signature} =~ s/\\n/\r\n/g;
- $mail->{message} = "--\n$myconfig->{signature}";
-
- }
-
- if ($form->{OUT}) {
- open(OUT, "$form->{OUT}") or $form->error("$form->{OUT} : $!");
- } else {
- open(OUT, ">-") or $form->error("STDOUT : $!");
- }
-
- if ($form->{media} eq 'file') {
- print OUT qq|Content-Type: Application/File;
-Content-Disposition: filename="$myconfig->{dbname}-$form->{dbversion}.sql"\n\n|;
- }
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- # get all the tables
- my @tables = $dbh->tables;
-
- 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
---
--- set options
-$myconfig->{dboptions};
---
-|;
-
- foreach $table (@tables) {
- my $query = qq|SELECT * FROM $table|;
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $query = qq|INSERT INTO $table (|;
- map { $query .= qq|$sth->{NAME}->[$_],| } (0 .. $sth->{NUM_OF_FIELDS} - 1);
- chop $query;
-
- $query .= qq|) VALUES|;
-
- print OUT qq|--
-DELETE FROM $table;
-|;
- while (my @arr = $sth->fetchrow_array) {
-
- $fields = "(";
- foreach my $item (@arr) {
- if (defined $item) {
- $item =~ s/'/''/g;
- $fields .= qq|'$item',|;
- } else {
- $fields .= 'NULL,';
- }
- }
-
- chop $fields;
- $fields .= ")";
-
- print OUT qq|$query $fields;\n|;
- }
-
- $sth->finish;
- }
-
- $query = qq|SELECT last_value FROM id|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($id) = $sth->fetchrow_array;
- $sth->finish;
-
- print OUT qq|--
-DROP SEQUENCE id;
-CREATE SEQUENCE id START $id;
-|;
-
- close(OUT);
-
- $dbh->disconnect;
-
- if ($form->{media} eq 'email') {
- my $err = $mail->send($out);
- $_ = $tmpfile;
- unlink;
- }
-
-}
-
-
-sub closedto {
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- my $query = qq|SELECT closedto, revtrans FROM defaults|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{closedto}, $form->{revtrans}) = $sth->fetchrow_array;
-
- $sth->finish;
-
- $dbh->disconnect;
-
-}
-
-
-sub closebooks {
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($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'|;
- }
- }
-
- # set close in defaults
- $dbh->do($query) || $form->dberror($query);
-
- $dbh->disconnect;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/AP.pm b/sql-ledger/SL/AP.pm
deleted file mode 100644
index e1870f872..000000000
--- a/sql-ledger/SL/AP.pm
+++ /dev/null
@@ -1,381 +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.
-#======================================================================
-#
-# 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, $taxrate, $amount);
- my $exchangerate = 0;
-
- # split and store id numbers in link accounts
- ($form->{AP}{payables}) = split(/--/, $form->{AP});
- map { ($form->{AP}{"amount_$_"}) = split(/--/, $form->{"AP_amount_$_"}) } (1 .. $form->{rowcount});
-
- 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);
- $amount += ($form->{"amount_$i"} * -1);
- }
-
- # this is for ap
- $form->{amount} = $amount;
-
- # taxincluded doesn't make sense if there is no amount
- $form->{taxincluded} = 0 if ($form->{amount} == 0);
-
- for my $item (split / /, $form->{taxaccounts}) {
- $form->{AP}{"tax_$item"} = $item;
-
- $amount = $form->round_amount($form->parse_amount($myconfig, $form->{"tax_$item"}), 2);
-
- $form->{"tax_$item"} = $form->round_amount($amount * $form->{exchangerate}, 2) * -1;
- $form->{total_tax} += ($form->{"tax_$item"} * -1);
- }
-
-
- # adjust paidaccounts if there is no date in the last row
- $form->{paidaccounts}-- unless ($form->{"datepaid_$form->{paidaccounts}"});
-
- $form->{invpaid} = 0;
- # add payments
- for my $i (1 .. $form->{paidaccounts}) {
- $form->{"paid_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"paid_$i"}), 2);
-
- $form->{invpaid} += $form->{"paid_$i"};
- $form->{datepaid} = $form->{"datepaid_$i"};
-
- }
-
- $form->{invpaid} = $form->round_amount($form->{invpaid} * $form->{exchangerate}, 2);
-
- if ($form->{taxincluded} *= 1) {
- for $i (1 .. $form->{rowcount}) {
- $tax = $form->{total_tax} * $form->{"amount_$i"} / $form->{amount};
- $amount = $form->{"amount_$i"} - $tax;
- $form->{"amount_$i"} = $form->round_amount($amount, 2);
- $diff += $amount - $form->{"amount_$i"};
- }
-
- # deduct taxes from amount
- $form->{amount} -= $form->{total_tax};
- # deduct difference from amount_1
- $form->{amount_1} += $form->round_amount($diff, 2);
- }
-
- $form->{netamount} = $form->{amount};
-
- # store invoice total, this goes into ap table
- $form->{invtotal} = $form->{amount} + $form->{total_tax};
-
- # amount for total AP
- $form->{payables} = $form->{invtotal};
-
-
- my ($query, $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'|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{id}) = $sth->fetchrow_array;
- $sth->finish;
-
- }
-
- # escape '
- $form->{notes} =~ s/'/''/g;
-
- $form->{datepaid} = $form->{transdate} unless ($form->{datepaid});
- my $datepaid = ($form->{invpaid} != 0) ? qq|'$form->{datepaid}'| : 'NULL';
-
- $query = qq|UPDATE ap SET
- invnumber = '$form->{invnumber}',
- transdate = '$form->{transdate}',
- ordnumber = '$form->{ordnumber}',
- vendor_id = $form->{vendor_id},
- taxincluded = '$form->{taxincluded}',
- amount = $form->{invtotal},
- duedate = '$form->{duedate}',
- paid = $form->{invpaid},
- datepaid = $datepaid,
- netamount = $form->{netamount},
- curr = '$form->{currency}',
- notes = '$form->{notes}'
- WHERE id = $form->{id}
- |;
- $dbh->do($query) || $form->dberror($query);
-
-
- # 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} }) {
- if ($form->{$item} != 0) {
- $project_id = 'NULL';
- if ($item =~ /amount_/) {
- if ($form->{"project_id_$'"} && $form->{"projectnumber_$'"}) {
- $project_id = $form->{"project_id_$'"};
- }
- }
-
- # 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}{$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->{invtotal} == 0) {
- $form->{payables} = $form->{invpaid};
- }
-
- # add paid transactions
- for my $i (1 .. $form->{paidaccounts}) {
- if ($form->{"paid_$i"} != 0) {
-
- $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"});
- }
-
-
- # get paid account
- ($form->{AP}{"paid_$i"}) = split(/--/, $form->{"AP_paid_$i"});
- $form->{"datepaid_$i"} = $form->{transdate} unless ($form->{"datepaid_$i"});
-
- # if there is no amount and invtotal is zero there is no exchangerate
- if ($form->{amount} == 0 && $form->{invtotal} == 0) {
- $form->{exchangerate} = $form->{"exchangerate_$i"};
- }
-
- $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} * -1, 2);
- if ($form->{payables}) {
- $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount,
- transdate)
- VALUES ($form->{id},
- (SELECT id FROM chart
- WHERE accno = '$form->{AP}{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)
- VALUES ($form->{id},
- (SELECT id FROM chart
- WHERE accno = '$form->{AP}{"paid_$i"}'),
- $form->{"paid_$i"}, '$form->{"datepaid_$i"}',
- '$form->{"source_$i"}')|;
- $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}{"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"});
- }
- }
- }
-
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-
-sub delete_transaction {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- # check for other foreign currency transactions
- $form->delete_exchangerate($dbh) if ($form->{currency} ne $form->{defaultcurrency});
-
- 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);
-
- # commit and redirect
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-
-sub ap_transactions {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $incemp = qq|, (SELECT e.name FROM employee e
- WHERE a.employee_id = e.id) AS employee
- | if ($form->{l_employee});
-
- my $query = qq|SELECT a.id, a.invnumber, a.transdate, a.duedate,
- a.amount, a.paid, a.ordnumber, v.name, a.invoice,
- a.netamount, a.datepaid, a.notes
-
- $incemp
-
- FROM ap a, vendor v
- WHERE a.vendor_id = v.id|;
-
- if ($form->{vendor_id}) {
- $query .= " AND a.vendor_id = $form->{vendor_id}";
- } else {
- if ($form->{vendor}) {
- my $vendor = $form->like(lc $form->{vendor});
- $query .= " AND lower(v.name) LIKE '$vendor'";
- }
- }
- if ($form->{invnumber}) {
- my $invnumber = $form->like(lc $form->{invnumber});
- $query .= " AND lower(a.invnumber) LIKE '$invnumber'";
- }
- if ($form->{ordnumber}) {
- my $ordnumber = $form->like(lc $form->{ordnumber});
- $query .= " AND lower(a.ordnumber) LIKE '$ordnumber'";
- }
- if ($form->{notes}) {
- my $notes = $form->like(lc $form->{notes});
- $query .= " AND lower(a.notes) LIKE '$notes'";
- }
-
- $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom};
- $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto};
- if ($form->{open} || $form->{closed}) {
- unless ($form->{open} && $form->{closed}) {
- $query .= " AND a.amount <> a.paid" if ($form->{open});
- $query .= " AND a.amount = a.paid" if ($form->{closed});
- }
- }
-
- my @a = (transdate, invnumber, name);
- push @a, "employee" if $self->{l_employee};
- my $sortorder = join ', ', $form->sort_columns(@a);
- $sortorder = $form->{sort} unless $sortorder;
-
- $query .= " ORDER by $sortorder";
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ap = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{AP} }, $ap;
- }
-
- $sth->finish;
- $dbh->disconnect;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/AR.pm b/sql-ledger/SL/AR.pm
deleted file mode 100644
index 4ea3d82c3..000000000
--- a/sql-ledger/SL/AR.pm
+++ /dev/null
@@ -1,381 +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.
-#======================================================================
-#
-# Accounts Receivable module backend routines
-#
-#======================================================================
-
-package AR;
-
-
-sub post_transaction {
- my ($self, $myconfig, $form) = @_;
-
- my ($null, $taxrate, $amount, $tax, $diff);
- my $exchangerate = 0;
- my $i;
-
- # split and store id numbers in link accounts
- map { ($form->{AR}{"amount_$_"}) = split(/--/, $form->{"AR_amount_$_"}) } (1 .. $form->{rowcount});
- ($form->{AR}{receivables}) = split(/--/, $form->{AR});
-
- 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);
- $amount += $form->{"amount_$i"};
- }
-
- # this is for ar
- $form->{amount} = $amount;
-
- # taxincluded doesn't make sense if there is no amount
- $form->{taxincluded} = 0 if ($form->{amount} == 0);
-
- foreach my $item (split / /, $form->{taxaccounts}) {
- $form->{AR}{"tax_$item"} = $item;
-
- $amount = $form->round_amount($form->parse_amount($myconfig, $form->{"tax_$item"}), 2);
-
- $form->{"tax_$item"} = $form->round_amount($amount * $form->{exchangerate}, 2);
- $form->{total_tax} += $form->{"tax_$item"};
-
- }
-
- # adjust paidaccounts if there is no date in the last row
- $form->{paidaccounts}-- unless ($form->{"datepaid_$form->{paidaccounts}"});
-
- $form->{invpaid} = 0;
- # add payments
- for $i (1 .. $form->{paidaccounts}) {
- $form->{"paid_$i"} = $form->round_amount($form->parse_amount($myconfig, $form->{"paid_$i"}), 2);
-
- $form->{invpaid} += $form->{"paid_$i"};
- $form->{datepaid} = $form->{"datepaid_$i"};
-
- # reverse payment
- $form->{"paid_$i"} *= -1;
-
- }
-
- $form->{invpaid} = $form->round_amount($form->{invpaid} * $form->{exchangerate}, 2);
-
- if ($form->{taxincluded} *= 1) {
- for $i (1 .. $form->{rowcount}) {
- $tax = $form->{total_tax} * $form->{"amount_$i"} / $form->{amount};
- $amount = $form->{"amount_$i"} - $tax;
- $form->{"amount_$i"} = $form->round_amount($amount, 2);
- $diff += $amount - $form->{"amount_$i"};
- }
-
- $form->{amount} -= $form->{total_tax};
- # deduct difference from amount_1
- $form->{amount_1} += $form->round_amount($diff, 2);
- }
-
- # store invoice total, this goes into ar table
- $form->{invtotal} = $form->{amount} + $form->{total_tax};
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my ($query, $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 ar (invnumber, employee_id)
- VALUES ('$uid', (SELECT id FROM employee
- WHERE login = '$form->{login}') )|;
- $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;
-
- }
-
- # escape '
- $form->{notes} =~ s/'/''/g;
-
- # record last payment date in ar table
- $form->{datepaid} = $form->{transdate} unless $form->{datepaid};
- my $datepaid = ($form->{invpaid} != 0) ? qq|'$form->{datepaid}'| : 'NULL';
-
- $query = qq|UPDATE ar set
- invnumber = '$form->{invnumber}',
- ordnumber = '$form->{ordnumber}',
- transdate = '$form->{transdate}',
- customer_id = $form->{customer_id},
- taxincluded = '$form->{taxincluded}',
- amount = $form->{invtotal},
- duedate = '$form->{duedate}',
- paid = $form->{invpaid},
- datepaid = $datepaid,
- netamount = $form->{amount},
- curr = '$form->{currency}',
- notes = '$form->{notes}'
- WHERE id = $form->{id}|;
- $dbh->do($query) || $form->dberror($query);
-
-
- # amount for AR account
- $form->{receivables} = $form->round_amount($form->{invtotal} * -1, 2);
-
-
- # 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} }) {
- if ($form->{$item} != 0) {
- $project_id = 'NULL';
- if ($item =~ /amount_/) {
- if ($form->{"project_id_$'"} && $form->{"projectnumber_$'"}) {
- $project_id = $form->{"project_id_$'"};
- }
- }
-
- # 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}{$item}'),
- $form->{$item}, '$form->{transdate}', $project_id)|;
- $dbh->do($query) || $form->dberror($query);
- }
- }
-
- # if there is no amount but a payment record a receivables
- if ($form->{amount} == 0 && $form->{invtotal} == 0) {
- $form->{receivables} = $form->{invpaid} * -1;
- }
-
- # add paid transactions
- for my $i (1 .. $form->{paidaccounts}) {
- if ($form->{"paid_$i"} != 0) {
-
- ($form->{AR}{"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 and invtotal is zero there is no exchangerate
- if ($form->{amount} == 0 && $form->{invtotal} == 0) {
- $form->{exchangerate} = $form->{"exchangerate_$i"};
- }
-
- # receivables amount
- $amount = $form->round_amount($form->{"paid_$i"} * $form->{exchangerate} * -1, 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}{receivables}'),
- $amount, '$form->{"datepaid_$i"}')|;
- $dbh->do($query) || $form->dberror($query);
- }
- $form->{receivables} = $amount;
-
- # add payment
- $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount,
- transdate, source)
- VALUES ($form->{id},
- (SELECT id FROM chart
- WHERE accno = '$form->{AR}{"paid_$i"}'),
- $form->{"paid_$i"}, '$form->{"datepaid_$i"}',
- '$form->{"source_$i"}')|;
- $dbh->do($query) || $form->dberror($query);
-
-
- # exchangerate difference for payment
- $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->{AR}{"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 exchangerate record
- if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) {
- $form->update_exchangerate($dbh, $form->{currency}, $form->{"datepaid_$i"}, $form->{"exchangerate_$i"}, 0);
- }
- }
- }
-
-
- 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);
-
- # check for other foreign currency transactions
- $form->delete_exchangerate($dbh) if ($form->{currency} ne $form->{defaultcurrency});
-
- 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);
-
- # commit
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-sub ar_transactions {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $incemp = qq|, (SELECT e.name FROM employee e
- WHERE a.employee_id = e.id) AS employee
- | if ($form->{l_employee});
-
- my $query = qq|SELECT a.id, a.invnumber, a.ordnumber, a.transdate,
- a.duedate, a.netamount, a.amount, a.paid, c.name,
- a.invoice, a.datepaid, a.terms, a.notes, a.shippingpoint
-
- $incemp
-
- FROM ar a, customer c
- WHERE a.customer_id = c.id|;
-
- if ($form->{customer_id}) {
- $query .= " AND a.customer_id = $form->{customer_id}";
- } else {
- if ($form->{customer}) {
- my $customer = $form->like(lc $form->{customer});
- $query .= " AND lower(c.name) LIKE '$customer'";
- }
- }
- if ($form->{invnumber}) {
- my $invnumber = $form->like(lc $form->{invnumber});
- $query .= " AND lower(a.invnumber) LIKE '$invnumber'";
- }
- if ($form->{ordnumber}) {
- my $ordnumber = $form->like(lc $form->{ordnumber});
- $query .= " AND lower(a.ordnumber) LIKE '$ordnumber'";
- }
- if ($form->{notes}) {
- my $notes = $form->like(lc $form->{notes});
- $query .= " AND lower(a.notes) LIKE '$notes'";
- }
-
- $query .= " AND a.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom};
- $query .= " AND a.transdate <= '$form->{transdateto}'" if $form->{transdateto};
- if ($form->{open} || $form->{closed}) {
- unless ($form->{open} && $form->{closed}) {
- $query .= " AND a.amount <> a.paid" if ($form->{open});
- $query .= " AND a.amount = a.paid" if ($form->{closed});
- }
- }
-
- my @a = (transdate, invnumber, name);
- push @a, "employee" if $form->{l_employee};
- my $sortorder = join ', ', $form->sort_columns(@a);
- $sortorder = $form->{sort} unless $sortorder;
-
- $query .= " ORDER by $sortorder";
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ar = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{AR} }, $ar;
- }
-
- $sth->finish;
- $dbh->disconnect;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/CA.pm b/sql-ledger/SL/CA.pm
deleted file mode 100644
index b71749d7c..000000000
--- a/sql-ledger/SL/CA.pm
+++ /dev/null
@@ -1,262 +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
-#
-# CHANGE LOG:
-# DS. 2000-07-04 Created
-#
-#======================================================================
-
-
-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 $where = '1 = 1';
- # build WHERE clause from dates if any
- if ($form->{fromdate}) {
- $where .= " AND ac.transdate >= '$form->{fromdate}'";
- }
- if ($form->{todate}) {
- $where .= " AND ac.transdate <= '$form->{todate}'";
- }
-
- my $sortorder = join ', ', $form->sort_columns(qw(transdate reference description));
- my $false = ($myconfig->{dbdriver} eq 'Pg') ? FALSE : q|'0'|;
-
- # Oracle workaround, use ordinal positions
- my %ordinal = ( transdate => 4,
- reference => 2,
- description => 3 );
- map { $sortorder =~ s/$_/$ordinal{$_}/ } keys %ordinal;
-
-
- if ($form->{accno}) {
- # get category for account
- $query = qq|SELECT category
- FROM chart
- WHERE accno = '$form->{accno}'|;
- $sth = $dbh->prepare($query);
-
- $sth->execute || $form->dberror($query);
- ($form->{category}) = $sth->fetchrow_array;
- $sth->finish;
-
- if ($form->{fromdate}) {
- # get beginning balance
- $query = qq|SELECT SUM(ac.amount)
- FROM acc_trans ac, chart c
- WHERE ac.chart_id = c.id
- AND c.accno = '$form->{accno}'
- AND ac.transdate < date '$form->{fromdate}'
- |;
- $sth = $dbh->prepare($query);
-
- $sth->execute || $form->dberror($query);
- ($form->{balance}) = $sth->fetchrow_array;
- $sth->finish;
- }
- }
-
- if ($form->{accounttype} eq 'gifi' && $form->{gifi_accno}) {
- # get category for account
- $query = qq|SELECT category
- FROM chart
- WHERE gifi_accno = '$form->{gifi_accno}'|;
- $sth = $dbh->prepare($query);
-
- $sth->execute || $form->dberror($query);
- ($form->{category}) = $sth->fetchrow_array;
- $sth->finish;
-
- if ($form->{fromdate}) {
- # get beginning balance
- $query = qq|SELECT SUM(ac.amount)
- FROM acc_trans ac, chart c
- WHERE ac.chart_id = c.id
- AND c.gifi_accno = '$form->{gifi_accno}'
- AND ac.transdate < date '$form->{fromdate}'
- |;
- $sth = $dbh->prepare($query);
-
- $sth->execute || $form->dberror($query);
- ($form->{balance}) = $sth->fetchrow_array;
- $sth->finish;
- }
- }
-
- $query = "";
-
- foreach my $id (@id) {
-
- # get all transactions
- $query .= qq|
- SELECT g.id, g.reference, g.description, ac.transdate,
- $false AS invoice,
- ac.amount, 'gl' as charttype
- FROM gl g, acc_trans ac
- WHERE $where
- AND ac.chart_id = $id
- AND ac.trans_id = g.id
- UNION ALL
- SELECT a.id, a.invnumber, c.name, ac.transdate,
- a.invoice,
- ac.amount, 'ar' as charttype
- FROM ar a, acc_trans ac, customer c
- WHERE $where
- AND ac.chart_id = $id
- AND ac.trans_id = a.id
- AND a.customer_id = c.id
- UNION ALL
- SELECT a.id, a.invnumber, v.name, ac.transdate,
- a.invoice,
- ac.amount, 'ap' as charttype
- FROM ap a, acc_trans ac, vendor v
- WHERE $where
- AND ac.chart_id = $id
- AND ac.trans_id = a.id
- AND a.vendor_id = v.id
- UNION ALL|;
- }
-
- $query =~ s/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->{charttype} eq "gl") {
- $ca->{module} = "gl";
- }
-
- # ap
- if ($ca->{charttype} eq "ap") {
- $ca->{module} = ($ca->{invoice}) ? 'ir' : 'ap';
- }
-
- # ar
- if ($ca->{charttype} eq "ar") {
- $ca->{module} = ($ca->{invoice}) ? 'is' : 'ar';
- }
-
- 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 f84bd1594..000000000
--- a/sql-ledger/SL/CP.pm
+++ /dev/null
@@ -1,308 +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.
-#======================================================================
-#
-# 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
- FROM chart
- WHERE link LIKE '%$form->{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;
-
- # get currencies and closedto
- $query = qq|SELECT curr, closedto
- FROM defaults|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{currencies}, $form->{closedto}) = $sth->fetchrow_array;
- $sth->finish;
-
- $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 $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
- my ($count) = $sth->fetchrow_array;
- $sth->finish;
-
- # 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 (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{"all_$form->{vc}"} }, $ref;
- }
-
- $sth->finish;
-
- }
-
- $dbh->disconnect;
-
-}
-
-
-sub get_openinvoices {
- my ($self, $myconfig, $form) = @_;
-
- return unless $form->{"$form->{vc}_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 NOT amount = paid|;
-
- if ($form->{transdatefrom}) {
- $where .= " AND transdate >= '$form->{transdatefrom}'";
- }
- if ($form->{transdateto}) {
- $where .= " AND transdate <= '$form->{transdateto}'";
- }
-
- my ($arap, $buysell);
- if ($form->{vc} eq 'customer') {
- $arap = "ar";
- $buysell = "buy";
- } else {
- $arap = "ap";
- $buysell = "sell";
- }
-
- my $query = qq|SELECT id, invnumber, transdate, amount, paid, curr
- FROM $arap
- $where
- ORDER BY id|;
- 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 ($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 $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($fxgain_accno_id, $fxloss_accno_id) = $sth->fetchrow_array;
- $sth->finish;
-
- my ($ARAP, $arap, $buysell);
-
- if ($form->{vc} eq 'customer') {
- $ARAP = "AR";
- $arap = "ar";
- $buysell = "buy";
- } else {
- $ARAP = "AP";
- $arap = "ap";
- $buysell = "sell";
- }
-
- # go through line by line
- for my $i (1 .. $form->{rowcount}) {
-
- if ($form->{"paid_$i"}) {
-
- $form->{"paid_$i"} = $form->parse_amount($myconfig, $form->{"paid_$i"});
-
- # get exchangerate for original
- $query = qq|SELECT $buysell FROM exchangerate e, $arap a
- WHERE e.curr = '$form->{currency}'
- AND a.transdate = e.transdate
- AND a.id = $form->{"id_$i"}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($exchangerate) = $sth->fetchrow_array;
- $sth->finish;
-
- $exchangerate = 1 unless $exchangerate;
-
- $query = qq|SELECT c.id FROM chart c, acc_trans a
- WHERE a.chart_id = c.id
- AND c.link = '$ARAP'
- AND a.trans_id = $form->{"id_$i"}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($id) = $sth->fetchrow_array;
- $sth->finish;
-
- my $amount = $form->round_amount($form->{"paid_$i"} * $exchangerate * -1, 2);
- $ml = ($ARAP eq 'AR') ? -1 : 1;
- # 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)
- VALUES ($form->{"id_$i"},
- (SELECT id FROM chart
- WHERE accno = '$paymentaccno'),
- '$form->{datepaid}', $form->{"paid_$i"} * $ml,
- '$form->{source}')|;
- $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, '0', '1')|;
- $dbh->do($query) || $form->dberror($query);
-
- # gain/loss
-
- $amount = $form->round_amount($form->{"paid_$i"} * ($exchangerate - $form->{exchangerate}) * $ml, 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);
-
- # update AR/AP transaction
- $query = qq|UPDATE $arap set
- paid = paid + $form->{"paid_$i"},
- datepaid = '$form->{datepaid}'
- WHERE id = $form->{"id_$i"}|;
- $dbh->do($query) || $form->dberror($query);
- }
- }
-
- 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 7c42cb843..000000000
--- a/sql-ledger/SL/CT.pm
+++ /dev/null
@@ -1,447 +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.
-#======================================================================
-#
-# backend code for customers and vendors
-#
-# CHANGE LOG:
-# DS. 2000-07-04 Created
-#
-#======================================================================
-
-package CT;
-
-
-sub get_tuple {
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
- my $query = qq|SELECT *
- FROM $form->{db}
- 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;
-
-
- # get ship to
- $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 tax labels
- $query = qq|SELECT accno, description
- FROM chart, tax
- WHERE link LIKE '%CT_tax%'
- AND chart.id = tax.chart_id
- ORDER BY 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 taxes for customer/vendor
- $query = qq|SELECT chart_id, accno
- FROM $form->{db}tax, chart
- WHERE chart_id = chart.id
- AND $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;
-
-
- $dbh->disconnect;
-
-}
-
-
-sub taxaccounts {
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- # get tax labels
- my $query = qq|SELECT accno, description
- FROM chart, tax
- WHERE link LIKE '%CT_tax%'
- AND chart.id = tax.chart_id
- ORDER BY accno|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $taxref = $sth->fetchrow_hashref(NAME_lc)) {
- $form->{taxaccounts} .= "$taxref->{accno} ";
- $form->{tax}{$taxref->{accno}}{description} = $taxref->{description};
- }
- $sth->finish;
- chop $form->{taxaccounts};
-
- $dbh->disconnect;
-
-}
-
-
-sub delete_customer {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database, turn AutoCommit off
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my $query = qq|SELECT id FROM ar
- WHERE customer_id = $form->{id}
- UNION
- SELECT id FROM oe
- WHERE customer_id = $form->{id}|;
- my $sth = $dbh->prepare($query) || $form->dberror($query);
- $sth->execute;
-
- my ($rc) = $sth->fetchrow_array;
- $sth->finish;
-
- if ($rc) {
- $dbh->disconnect;
- $rc = -1;
- } else {
-
- # delete customer
- $query = qq|DELETE FROM customer
- WHERE 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);
-
- $query = qq|DELETE FROM customertax
- WHERE customer_id = $form->{id}|;
- $dbh->do($query) || $form->dberror($query);
-
- # commit and redirect
- $rc = $dbh->commit;
- $dbh->disconnect;
-
- }
-
- $rc;
-
-}
-
-
-sub save_customer {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- # escape '
- map { $form->{$_} =~ s/'/''/g } qw(customernumber name addr1 addr2 addr3 addr4 contact notes);
-
- # assign value discount, terms, creditlimit
- $form->{discount} /= 100;
- $form->{terms} *= 1;
- $form->{taxincluded} *= 1;
- $form->{creditlimit} = $form->parse_amount($myconfig, $form->{creditlimit});
-
- my ($query, $sth);
-
- 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);
- } 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;
-
- }
-
- $query = qq|UPDATE customer SET
- customernumber = '$form->{customernumber}',
- name = '$form->{name}',
- addr1 = '$form->{addr1}',
- addr2 = '$form->{addr2}',
- addr3 = '$form->{addr3}',
- addr4 = '$form->{addr4}',
- contact = '$form->{contact}',
- phone = '$form->{phone}',
- fax = '$form->{fax}',
- email = '$form->{email}',
- cc = '$form->{cc}',
- bcc = '$form->{bcc}',
- notes = '$form->{notes}',
- discount = $form->{discount},
- creditlimit = $form->{creditlimit},
- terms = $form->{terms},
- taxincluded = '$form->{taxincluded}'
- 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->disconnect;
-
-}
-
-
-sub save_vendor {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- # escape '
- map { $form->{$_} =~ s/'/''/g } qw(vendornumber name addr1 addr2 addr3 addr4 contact notes);
-
- $form->{terms} *= 1;
- $form->{taxincluded} *= 1;
-
- my $query;
-
- 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;
-
- }
-
-
- $query = qq|UPDATE vendor SET
- vendornumber = '$form->{vendornumber}',
- name = '$form->{name}',
- addr1 = '$form->{addr1}',
- addr2 = '$form->{addr2}',
- addr3 = '$form->{addr3}',
- addr4 = '$form->{addr4}',
- contact = '$form->{contact}',
- phone = '$form->{phone}',
- fax = '$form->{fax}',
- email = '$form->{email}',
- cc = '$form->{cc}',
- bcc = '$form->{bcc}',
- notes = '$form->{notes}',
- terms = $form->{terms},
- taxincluded = '$form->{taxincluded}'
- 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->disconnect;
-
-}
-
-
-
-sub delete_vendor {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database, turn AutoCommit off
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- # check if there are any transactions on file
- my $query = qq|SELECT id FROM ap
- WHERE vendor_id = $form->{id}
- UNION
- SELECT id FROM oe
- WHERE vendor_id = $form->{id}|;
- my $sth = $dbh->prepare($query) || $form->dberror($query);
- $sth->execute;
-
- my ($rc) = $sth->fetchrow_array;
- $sth->finish;
-
- if ($rc) {
- $dbh->disconnect;
- $rc = -1;
- } else {
-
- # delete vendor
- $query = qq|DELETE FROM vendor
- WHERE 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);
-
- $query = qq|DELETE FROM vendortax
- WHERE vendor_id = $form->{id}|;
- $dbh->do($query) || $form->dberror($query);
-
- # commit and redirect
- $rc = $dbh->commit;
- $dbh->disconnect;
-
- }
-
- $rc;
-
-}
-
-
-sub search {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $where = "1 = 1";
- $form->{sort} = "name" unless ($form->{sort});
-
- if ($form->{"$form->{db}number"}) {
- my $companynumber = $form->like(lc $form->{"$form->{db}number"});
- $where .= " AND lower($form->{db}number) LIKE '$companynumber'";
- }
- if ($form->{name}) {
- my $name = $form->like(lc $form->{name});
- $where .= " AND lower(name) LIKE '$name'";
- }
- if ($form->{contact}) {
- my $contact = $form->like(lc $form->{contact});
- $where .= " AND lower(contact) LIKE '$contact'";
- }
- if ($form->{email}) {
- my $email = $form->like(lc $form->{email});
- $where .= " AND lower(email) LIKE '$email'";
- }
-
- if ($form->{status} eq 'orphaned') {
- $where .= qq| AND id NOT IN (SELECT o.$form->{db}_id
- FROM oe o, $form->{db} ct
- WHERE ct.id = o.$form->{db}_id)|;
- if ($form->{db} eq 'customer') {
- $where .= qq| AND id NOT IN (SELECT a.customer_id
- FROM ar a, customer ct
- WHERE ct.id = a.customer_id)|;
- }
- if ($form->{db} eq 'vendor') {
- $where .= qq| AND id NOT IN (SELECT a.vendor_id
- FROM ap a, vendor ct
- WHERE ct.id = a.vendor_id)|;
- }
- }
-
- my $query = qq~SELECT id, name, $form->{db}number,
- addr1 || ' ' || addr2 || ' ' || addr3 || ' ' || addr4 AS address,
- contact, phone, fax, email, cc, terms
- FROM $form->{db}
- WHERE $where
- ORDER BY $form->{sort}~;
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{CT} }, $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 ef5f2ca81..000000000
--- a/sql-ledger/SL/Form.pm
+++ /dev/null
@@ -1,1397 +0,0 @@
-#=====================================================================
-# SQL-Ledger Accounting
-# Copyright (C) 1998-2003
-#
-# 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 code)
-#
-# 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.
-#======================================================================
-# Utilities for parsing forms
-# and supporting routines for linking account numbers
-# used in AR, AP and IS, IR modules
-#
-#======================================================================
-
-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->{action} = lc $self->{action};
- $self->{action} =~ s/( |-|,)/_/g;
-
- $self->{version} = "2.0.8";
- $self->{dbversion} = "2.0.8";
-
- 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_SOFTWARE} =~ /Apache\/2/) && !$beenthere) {
- $str = $self->escape($str, 1);
- }
-
- $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 error {
- my ($self, $msg) = @_;
-
- if ($ENV{HTTP_USER_AGENT}) {
- $msg =~ s/\n/<br>/g;
-
- print qq|Content-Type: text/html
-
- <body bgcolor=ffffff>
-
- <h2><font color=red>Error!</font></h2>
-
- <p><b>$msg</b>
-
- </body>
- </html>
- |;
-
- die "Error: $msg\n";
-
- } 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;
-
- if (!$self->{header}) {
- $self->header;
- print qq|
- <body>|;
- }
-
- print qq|
-
- <p><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;
-
- map { $rows += int ((length $_)/$cols) + 1 } (split /\r/, $str);
-
- $rows = $maxrows if (defined $maxrows && ($rows > $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) = @_;
-
- my ($nocache, $stylesheet, $charset);
-
- # use expire tag to prevent caching
-# $nocache = qq|<META HTTP-EQUIV="Expires" CONTENT="Tue, 01 Jan 1980 1:00:00 GMT">
-# <META HTTP-EQUIV="Pragma" CONTENT="no-cache">
-#|;
-
- if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) {
- $stylesheet = qq|<LINK REL="stylesheet" HREF="css/$self->{stylesheet}" TYPE="text/css" TITLE="SQL-Ledger style sheet">
-|;
- }
-
- if ($self->{charset}) {
- $charset = qq|<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$self->{charset}">
-|;
- }
-
- $self->{titlebar} = ($self->{title}) ? "$self->{title} - $self->{titlebar}" : $self->{titlebar};
-
- print qq|Content-Type: text/html
-
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
-<head>
- <title>$self->{titlebar}</title>
- $nocache
- $stylesheet
- $charset
-</head>
-
-|;
-
-}
-
-
-sub redirect {
- my ($self, $msg) = @_;
-
- if ($self->{callback}) {
-
- ($script, $argv) = split(/\?/, $self->{callback});
-
- exec ("perl", "$script", $argv);
-
- } else {
-
- if ($ENV{HTTP_USER_AGENT}) {
- $msg =~ s/\n/<br>/g;
-
- print qq|Content-Type: text/html
-
-<body bgcolor=ffffff>
-
-<h2>$msg</h2>
-
-</body>
-</html>
-|;
-
- } else {
- print "$msg\n";
- }
-
- exit;
-
- }
-
-}
-
-
-sub sort_columns {
- my ($self, @columns) = @_;
-
- @columns = grep !/^$self->{sort}$/, @columns;
- splice @columns, 0, 0, $self->{sort};
-
- @columns;
-
-}
-
-
-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 '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/,/\./;
- }
-
- $amount =~ s/,//g;
-
- return ($amount * 1);
-
-}
-
-
-sub round_amount {
- my ($self, $amount, $places) = @_;
-
-# $places = 3 if $places == 2;
-
- if (($places * 1) >= 0) {
- # compensate for perl behaviour, 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) = @_;
-
- # { Moritz Bunkus
- # Some variables used for page breaks
- 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;
- # } Moritz Bunkus
-
- 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;
- $self->{tmpfile} = "$userspath/${fileid}.$self->{IN}";
- 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 = $_;
-
-
- # { Moritz Bunkus
- # detect pagebreak block and its parameters
- if (/<%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 (/<\%end pagebreak%>/);
- $pagebreak .= $_;
- }
- }
- # } Moritz Bunkus
-
-
- if (/<%foreach /) {
-
- # this one we need for the count
- chomp $var;
- $var =~ s/<%foreach (.+?)%>/$1/;
- while ($_ = shift) {
- last if (/<%end /);
-
- # store line in $par
- $par .= $_;
- }
-
- # display contents of $self->{number}[] array
- for $i (0 .. $#{ $self->{$var} }) {
-
- # { Moritz Bunkus
- # 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]);
- # } Moritz Bunkus
-
-
- # don't parse par, we need it for each line
- $_ = $par;
- s/<%(.+?)%>/$self->{$1}[$i]/mg;
- print OUT;
- }
- next;
- }
-
- # if not comes before if!
- if (/<%if not /) {
- # check if it is not set and display
- chop;
- s/<%if not (.+?)%>/$1/;
-
- unless ($self->{$_}) {
- while ($_ = shift) {
- last if (/<%end /);
-
- # store line in $par
- $par .= $_;
- }
-
- $_ = $par;
-
- } else {
- while ($_ = shift) {
- last if (/<%end /);
- }
- next;
- }
- }
-
- if (/<%if /) {
- # check if it is set and display
- chop;
- s/<%if (.+?)%>/$1/;
-
- if ($self->{$_}) {
- while ($_ = shift) {
- last if (/<%end /);
-
- # store line in $par
- $par .= $_;
- }
-
- $_ = $par;
-
- } else {
- while ($_ = shift) {
- last if (/<%end /);
- }
- next;
- }
- }
-
- # check for <%include filename%>
- if (/<%include /) {
-
- # get the filename
- chomp $var;
- $var =~ s/<%include (.+?)%>/$1/;
-
- # mangle filename if someone tries to be cute
- $var =~ s/\///g;
-
- # prevent the infinite loop!
- next if ($self->{"$var"});
-
- open(INC, "$self->{templates}/$var") or $self->error($self->cleanup."$self->{templates}/$var : $!");
- unshift(@_, <INC>);
- close(INC);
-
- $self->{"$var"} = 1;
-
- next;
- }
-
- s/<%(.+?)%>/$self->{$1}/g;
- print OUT;
- }
-
- close(OUT);
-
-
- # { Moritz Bunkus
- # Convert the tex file to postscript
- if ($self->{format} =~ /(postscript|pdf)/) {
-
- use Cwd;
- $self->{cwd} = cwd();
- chdir("$userspath") or $self->error($self->cleanup."chdir : $!");
-
- $self->{tmpfile} =~ s/$userspath\///g;
-
- # DS. added screen and email option in addition to printer
- # screen
- 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 > /dev/null");
- $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;
-
- $self->{email} =~ s/,/>,</g;
-
- map { $mail->{$_} = $self->{$_} } qw(cc bcc subject message version format charset);
- $mail->{to} = qq|"$self->{name}" <$self->{email}>|;
- $mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
- $mail->{fileid} = "$fileid.";
-
- # if we send html or plain text inline
- if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
- $mail->{contenttype} = "text/html";
-
- $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>";
-
- open(IN, $self->{tmpfile}) or $self->error($self->cleanup."$self->{tmpfile} : $!");
- 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}";
-
- }
-
- my $err = $mail->send($out);
- $self->error($self->cleanup."$err") if ($err);
-
- } else {
-
- $self->{OUT} = $out;
- open(IN, $self->{tmpfile}) or $self->error($self->cleanup."$self->{tmpfile} : $!");
-
- $self->{copies} = 1 unless $self->{media} eq 'printer';
-
- for my $i (1 .. $self->{copies}) {
-
- if ($self->{OUT}) {
- open(OUT, $self->{OUT}) or $self->error($self->cleanup."$self->{OUT} : $!");
- } else {
- open(OUT, ">-") or $self->error($self->cleanup."$!: STDOUT");
-
- # launch application
- print qq|Content-Type: application/$self->{format}; name="$self->{tmpfile}"
- Content-Disposition: filename="$self->{tmpfile}"
-
- |;
- }
-
- while (<IN>) {
- print OUT $_;
- }
- close(OUT);
- seek IN, 0, 0;
- }
-
- close(IN);
- }
-
- $self->cleanup;
-
- }
- # } Moritz Bunkus
-
-}
-
-
-sub cleanup {
- my $self = shift;
-
- 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'), ' ' ],
- 'tex' => [ '&', quotemeta('\n'), ' ',
- '\$', '%', '_', '#', quotemeta('^'),
- '{', '}', '<', '>', '£' ] },
- 'html' => {
- quotemeta('\n') => '<br>', ' ' => '<br>'
- },
- 'tex' => {
- '&' => '\&', '\$' => '\$', '%' => '\%', '_' => '\_',
- '#' => '\#', quotemeta('^') => '\^\\', '{' => '\{', '}' => '\}',
- '<' => '$<$', '>' => '$>$',
- quotemeta('\n') => '\newline ', ' ' => '\newline ',
- '£' => '\pounds ',
- }
- );
-
- foreach my $key (@{ $replace{order}{$format} }) {
- map { $self->{$_} =~ s/$key/$replace{$format}{$key}/g; } @fields;
- }
-
-}
-
-
-sub datetonum {
- my ($self, $date, $myconfig) = @_;
-
- if ($date) {
- # get separator
- my $spc = $myconfig->{dateformat};
- $spc =~ s/\w//g;
- $spc = substr($spc, 1, 1);
-
- if ($spc eq '.') {
- $spc = '\.';
- }
- if ($spc eq '/') {
- $spc = '\/';
- }
-
- if ($myconfig->{dateformat} =~ /^yy/) {
- ($yy, $mm, $dd) = split /$spc/, $date;
- }
- if ($myconfig->{dateformat} =~ /^mm/) {
- ($mm, $dd, $yy) = split /$spc/, $date;
- }
- if ($myconfig->{dateformat} =~ /^dd/) {
- ($dd, $mm, $yy) = split /$spc/, $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}) || $self->dberror($myconfig->{dboptions});
- }
-
- $dbh;
-
-}
-
-
-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";
- my $sth = $dbh->prepare($query);
-
- $sth->execute || $self->dberror($query);
- my ($balance) = $sth->fetchrow_array;
- $sth->finish;
-
- $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'|;
- 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 get_exchangerate {
- my ($self, $dbh, $curr, $transdate, $fld) = @_;
-
- my $query = qq|SELECT $fld FROM exchangerate
- WHERE curr = '$curr'
- AND transdate = '$transdate'|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- my ($exchangerate) = $sth->fetchrow_array;
- $sth->finish;
-
- $exchangerate;
-
-}
-
-
-sub delete_exchangerate {
- my ($self, $dbh) = @_;
-
- my @transdate = ();
- my $transdate;
-
- my $query = qq|SELECT DISTINCT transdate
- FROM acc_trans
- WHERE trans_id = $self->{id}|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- while ($transdate = $sth->fetchrow_array) {
- push @transdate, $transdate;
- }
- $sth->finish;
-
- $query = qq|SELECT transdate FROM acc_trans
- WHERE ar.id = trans_id
- AND ar.curr = '$self->{currency}'
- AND transdate IN
- (SELECT transdate FROM acc_trans
- WHERE trans_id = $self->{id})
- AND trans_id != $self->{id}
- UNION SELECT transdate FROM acc_trans
- WHERE ap.id = trans_id
- AND ap.curr = '$self->{currency}'
- AND transdate IN
- (SELECT transdate FROM acc_trans
- WHERE trans_id = $self->{id})
- AND trans_id != $self->{id}
- UNION SELECT transdate FROM oe
- WHERE oe.curr = '$self->{currency}'
- AND transdate IN
- (SELECT transdate FROM acc_trans
- WHERE trans_id = $self->{id})|;
- $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- while ($transdate = $sth->fetchrow_array) {
- @transdate = grep !/^$transdate$/, @transdate;
- }
- $sth->finish;
-
- foreach $transdate (@transdate) {
- $query = qq|DELETE FROM exchangerate
- WHERE curr = '$self->{currency}'
- AND transdate = '$transdate'|;
- $dbh->do($query) || $self->dberror($query);
- }
-
-}
-
-
-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 $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- my ($exchangerate) = $sth->fetchrow_array;
- $sth->finish;
- $dbh->disconnect;
-
- $exchangerate;
-
-}
-
-
-sub add_shipto {
- my ($self, $dbh, $id) = @_;
-
- my $shipto;
- foreach my $item (qw(name addr1 addr2 addr3 addr4 contact phone fax email)) {
- if ($self->{"shipto$item"}) {
- $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
- }
- $self->{"shipto$item"} =~ s/'/''/g;
- }
-
- if ($shipto) {
- my $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptoaddr1,
- shiptoaddr2, shiptoaddr3, shiptoaddr4, shiptocontact,
- shiptophone, shiptofax, shiptoemail) VALUES ($id,
- '$self->{shiptoname}', '$self->{shiptoaddr1}',
- '$self->{shiptoaddr2}', '$self->{shiptoaddr3}',
- '$self->{shiptoaddr4}', '$self->{shiptocontact}',
- '$self->{shiptophone}', '$self->{shiptofax}',
- '$self->{shiptoemail}')|;
- $dbh->do($query) || $self->dberror($query);
- }
-
-}
-
-
-sub get_employee {
- my ($self, $dbh) = @_;
-
- my $query = qq|SELECT name FROM employee
- WHERE login = '$self->{login}'|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- ($self->{employee}) = $sth->fetchrow_array;
- $sth->finish;
-
-}
-
-
-# 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 id, name,
- addr1 || ' ' || addr2 || ' ' || addr3 || ' ' || addr4 AS address
- FROM $table
- WHERE lower(name) LIKE '$name'
- ORDER BY name~;
- my $sth = $dbh->prepare($query);
-
- $sth->execute || $self->dberror($query);
-
- my $i = 0;
- 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) = @_;
-
- my $dbh = $self->dbconnect($myconfig);
-
- my $query = qq|SELECT count(*) FROM $table|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
- my ($count) = $sth->fetchrow_array;
- $sth->finish;
-
- # build selection list
- if ($count < $myconfig->{vclimit}) {
- $query = qq|SELECT id, name
- FROM $table
- ORDER BY name|;
- $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $self->{"all_$table"} }, $ref;
- }
-
- $sth->finish;
-
- }
-
- $dbh->disconnect;
-
-}
-
-
-sub create_links {
- my ($self, $module, $myconfig, $table) = @_;
-
- $self->all_vc($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, c.name AS $table,
- a.amount AS oldinvtotal, a.paid AS oldtotalpaid
- FROM $arap a, $table c
- WHERE a.${table}_id = c.id
- AND 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 amounts from individual entries
- $query = qq|SELECT c.accno, c.description, a.source, a.amount,
- 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 (a.project_id = p.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';
- # get exchangerate for currency
- $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"}) {
- # only setup currency
- ($self->{currency}) = split /:/, $self->{currencies};
-
- } else {
-
- $self->lastname_used($dbh, $myconfig, $table, $module);
-
- my $fld = ($table eq 'customer') ? 'buy' : 'sell';
- # get exchangerate for currency
- $self->{exchangerate} = $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
-
- }
-
- }
-
- $dbh->disconnect;
-
-}
-
-
-sub lastname_used {
- my ($self, $dbh, $myconfig, $table, $module) = @_;
-
- my $arap = ($table eq 'customer') ? "ar" : "ap";
- $arap = 'oe' if ($self->{type} =~ /_order/);
-
- my $query = qq|SELECT id FROM $arap
- WHERE id IN (SELECT MAX(id) FROM $arap
- WHERE ${table}_id > 0)|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- my ($trans_id) = $sth->fetchrow_array;
- $sth->finish;
-
- $trans_id *= 1;
- $query = qq|SELECT ct.name, a.curr, a.${table}_id,
- current_date + ct.terms AS duedate
- FROM $arap a
- JOIN $table ct ON (a.${table}_id = ct.id)
- WHERE a.id = $trans_id|;
- $sth = $dbh->prepare($query);
- $sth->execute || $self->dberror($query);
-
- ($self->{$table}, $self->{currency}, $self->{"${table}_id"}, $self->{duedate}) = $sth->fetchrow_array;
- $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};
- $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
-
- $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, $string) = @_;
-
- unless ($string =~ /%/) {
- $string = "%$string%";
- }
-
- $string =~ s/'/''/g;
- $string;
-
-}
-
-
-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};
- }
-
-}
-
-
-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, 1, 1);
-
- if ($spc eq '.') {
- $spc = '\.';
- }
- if ($spc eq '/') {
- $spc = '\/';
- }
-
- if ($myconfig->{dateformat} =~ /^yy/) {
- ($yy, $mm, $dd) = split /$spc/, $date;
- }
- if ($myconfig->{dateformat} =~ /^mm/) {
- ($mm, $dd, $yy) = split /$spc/, $date;
- }
- if ($myconfig->{dateformat} =~ /^dd/) {
- ($dd, $mm, $yy) = split /$spc/, $date;
- }
-
- $dd *= 1;
- $mm--;
- $yy = ($yy < 70) ? $yy + 2000 : $yy;
- $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
-
- if ($myconfig->{dateformat} =~ /^dd/) {
- $longdate = "$dd. ".&text($self, $self->{$longmonth}[$mm])." $yy";
- } else {
- $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 5bceb078a..000000000
--- a/sql-ledger/SL/GL.pm
+++ /dev/null
@@ -1,462 +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.
-#======================================================================
-#
-# General ledger backend code
-#
-# CHANGE LOG:
-# DS. 2000-07-04 Created
-# DS. 2001-06-12 Changed relations from accno to chart_id
-#
-#======================================================================
-
-package GL;
-
-
-sub delete_transaction {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- 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 ($debit, $credit) = (0, 0);
- my $project_id;
-
- my $i;
- # check if debit and credit balances
- for $i (1 .. $form->{rowcount}) {
- if ($form->{"debit_$i"} && $form->{"credit_$i"}) {
- return -1;
- }
-
- $form->{"debit_$i"} = $form->parse_amount($myconfig, $form->{"debit_$i"});
- $form->{"credit_$i"} = $form->parse_amount($myconfig, $form->{"credit_$i"});
-
- $debit += $form->{"debit_$i"};
- $credit += $form->{"credit_$i"};
- }
-
- $debit = $form->round_amount($debit, 2);
- $credit = $form->round_amount($credit, 2);
-
- if ($debit != $credit) {
- return -2;
- }
-
- if (($debit + $credit) == 0) {
- return -3;
- }
-
- # 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
-
- # escape '
- map { $form->{$_} =~ s/'/''/g } qw(reference description);
-
-
- my ($query, $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;
-
- }
-
- $query = qq|UPDATE gl SET
- reference = '$form->{reference}',
- description = '$form->{description}',
- notes = '$form->{notes}',
- transdate = '$form->{transdate}'
- WHERE id = $form->{id}|;
-
- $dbh->do($query) || $form->dberror($query);
-
-
- # insert acc_trans transactions
- for $i (1 .. $form->{rowcount}) {
- # extract accno
- ($accno) = split(/--/, $form->{"accno_$i"});
- my $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) {
- $project_id = ($form->{"project_id_$i"}) ? $form->{"project_id_$i"} : 'NULL';
- $query = qq|INSERT INTO acc_trans (trans_id, chart_id, amount, transdate,
- source, project_id)
- VALUES
- ($form->{id}, (SELECT id
- FROM chart
- WHERE accno = '$accno'),
- $amount, '$form->{transdate}', '$form->{reference}',
- $project_id)|;
-
- $dbh->do($query) || $form->dberror($query);
- }
- }
-
- # 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 ($glwhere, $arwhere, $apwhere) = ("1 = 1", "1 = 1", "1 = 1");
-
- if ($form->{reference}) {
- my $source = $form->like(lc $form->{reference});
- $glwhere .= " AND lower(g.reference) LIKE '$source'";
- $arwhere .= " AND lower(a.invnumber) LIKE '$source'";
- $apwhere .= " AND lower(a.invnumber) LIKE '$source'";
- }
- if ($form->{source}) {
- my $source = $form->like(lc $form->{source});
- $glwhere .= " AND lower(ac.source) LIKE '$source'";
- $arwhere .= " AND lower(ac.source) LIKE '$source'";
- $apwhere .= " AND lower(ac.source) LIKE '$source'";
- }
- 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->{description}) {
- my $description = $form->like(lc $form->{description});
- $glwhere .= " AND lower(g.description) LIKE '$description'";
- $arwhere .= " AND lower(ct.name) LIKE '$description'";
- $apwhere .= " AND lower(ct.name) LIKE '$description'";
- }
- if ($form->{notes}) {
- my $notes = $form->like(lc $form->{notes});
- $glwhere .= " AND lower(g.notes) LIKE '$notes'";
- $arwhere .= " AND lower(a.notes) LIKE '$notes'";
- $apwhere .= " AND lower(a.notes) LIKE '$notes'";
- }
- 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
- FROM chart
- WHERE accno = '$form->{accno}'|;
- $sth = $dbh->prepare($query);
-
- $sth->execute || $form->dberror($query);
- ($form->{ml}) = $sth->fetchrow_array;
- $sth->finish;
-
- if ($form->{datefrom}) {
- $query = qq|SELECT SUM(ac.amount)
- FROM acc_trans ac, chart c
- WHERE ac.chart_id = c.id
- AND c.accno = '$form->{accno}'
- AND ac.transdate < date '$form->{datefrom}'
- |;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{balance}) = $sth->fetchrow_array;
- $sth->finish;
- }
- }
-
- if ($form->{gifi_accno}) {
- # get category for account
- $query = qq|SELECT category
- FROM chart
- WHERE gifi_accno = '$form->{gifi_accno}'|;
- $sth = $dbh->prepare($query);
-
- $sth->execute || $form->dberror($query);
- ($form->{ml}) = $sth->fetchrow_array;
- $sth->finish;
-
- if ($form->{datefrom}) {
- $query = qq|SELECT SUM(ac.amount)
- FROM acc_trans ac, chart c
- WHERE ac.chart_id = c.id
- AND c.gifi_accno = '$form->{gifi_accno}'
- AND ac.transdate < date '$form->{datefrom}'
- |;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{balance}) = $sth->fetchrow_array;
- $sth->finish;
- }
- }
-
- my $false = ($myconfig->{dbdriver} eq 'Pg') ? FALSE : q|'0'|;
-
- my $sortorder = join ', ', $form->sort_columns(qw(transdate reference source description accno));
- my %ordinal = ( transdate => 6,
- reference => 4,
- source => 7,
- description => 5 );
- map { $sortorder =~ s/$_/$ordinal{$_}/ } keys %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
- 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
- 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
- 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} = "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);
-
- # 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 = "SELECT reference, description, notes, transdate
- FROM gl
- WHERE id = $form->{id}";
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{reference}, $form->{description}, $form->{notes}, $form->{transdate}) = $sth->fetchrow_array;
- $sth->finish;
-
- # retrieve individual rows
- $query = "SELECT c.accno, a.amount, project_id,
- (SELECT p.projectnumber FROM project p
- WHERE a.project_id = p.id) AS projectnumber
- FROM acc_trans a, chart c
- WHERE a.chart_id = c.id
- AND a.trans_id = $form->{id}
- ORDER BY accno";
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- 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;
-
- # get chart of accounts
- $query = qq|SELECT accno,description
- FROM chart
- WHERE charttype = 'A'
- 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;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/IC.pm b/sql-ledger/SL/IC.pm
deleted file mode 100644
index f4a2f75ff..000000000
--- a/sql-ledger/SL/IC.pm
+++ /dev/null
@@ -1,936 +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.
-#======================================================================
-#
-# Inventory Control backend
-#
-#======================================================================
-
-package IC;
-
-
-sub get_part {
- my ($self, $myconfig, $form) = @_;
-
- # connect to db
- my $dbh = $form->dbconnect($myconfig);
-
- 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',
- 'Oracle' => 'a.rowid'
- );
-
-
- # part or service item
- $form->{item} = ($form->{inventory_accno}) ? 'part' : 'service';
- 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, p.unit,
- pg.partsgroup
- 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} ne 'service') {
- # get makes
- if ($form->{makemodel}) {
- $query = qq|SELECT name FROM makemodel
- WHERE parts_id = $form->{id}|;
-
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my $i = 1;
- while (($form->{"make_$i"}, $form->{"model_$i"}) = split(/:/, $sth->fetchrow_array)) {
- $i++;
- }
- $sth->finish;
- $form->{makemodel_rows} = $i - 1;
-
- }
- }
-
- # 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;
-
- $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
-
- # escape '
- map { $form->{$_} =~ s/'/''/g } qw(partnumber description notes unit bin);
-
- # undo amount formatting
- map { $form->{$_} = $form->parse_amount($myconfig, $form->{$_}) } qw(rop weight listprice sellprice lastcost stock);
-
- # set date to NULL if nothing entered
- $form->{priceupdate} = ($form->{priceupdate}) ? qq|'$form->{priceupdate}'| : "NULL";
-
- $form->{makemodel} = (($form->{make_1}) || ($form->{model_1})) ? 1 : 0;
-
- $form->{alternate} = 0;
- $form->{assembly} = ($form->{item} eq 'assembly') ? 1 : 0;
- $form->{obsolete} *= 1;
- $form->{onhand} *= 1;
-
- my ($query, $sth);
-
- if ($form->{id}) {
-
- # get old price
- $query = qq|SELECT sellprice, weight
- FROM parts
- WHERE id = $form->{id}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($sellprice, $weight) = $sth->fetchrow_array;
- $sth->finish;
-
- # if item is part of an assembly adjust all assemblies
- $query = qq|SELECT id, qty
- FROM assembly
- WHERE parts_id = $form->{id}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my ($id, $qty) = $sth->fetchrow_array) {
- &update_assembly($dbh, $form, $id, $qty * 1, $sellprice * 1, $weight * 1);
- }
- $sth->finish;
-
-
- if ($form->{item} ne 'service') {
- # 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 only
- $query = qq|UPDATE assembly
- SET bom = ?
- WHERE id = ?
- AND parts_id = ?|;
- $sth = $dbh->prepare($query);
-
- for $i (1 .. $form->{assembly_rows} - 1) {
- $sth->execute(($form->{"bom_$i"}) ? '1' : '0', $form->{id}, $form->{"id_$i"}) || $form->dberror($query);
- }
- $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);
-
- } 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 = 0;
- if ($form->{partsgroup}) {
- my $partsgroup = lc $form->{partsgroup};
- $query = qq|SELECT DISTINCT id FROM partsgroup
- WHERE lower(partsgroup) = '$partsgroup'|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($partsgroup_id) = $sth->fetchrow_array;
- $sth->finish;
-
- if (!$partsgroup_id) {
- $query = qq|INSERT INTO partsgroup (partsgroup)
- VALUES ('$form->{partsgroup}')|;
- $dbh->do($query) || $form->dberror($query);
-
- $query = qq|SELECT id FROM partsgroup
- WHERE partsgroup = '$form->{partsgroup}'|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($partsgroup_id) = $sth->fetchrow_array;
- $sth->finish;
- }
- }
-
-
- $query = qq|UPDATE parts SET
- partnumber = '$form->{partnumber}',
- description = '$form->{description}',
- makemodel = '$form->{makemodel}',
- alternate = '$form->{alternate}',
- assembly = '$form->{assembly}',
- listprice = $form->{listprice},
- sellprice = $form->{sellprice},
- lastcost = $form->{lastcost},
- weight = $form->{weight},
- priceupdate = $form->{priceupdate},
- unit = '$form->{unit}',
- notes = '$form->{notes}',
- rop = $form->{rop},
- bin = '$form->{bin}',
- 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
- unless ($form->{item} eq 'service') {
- for my $i (1 .. $form->{makemodel_rows}) {
- # put make and model together
- if (($form->{"make_$i"}) || ($form->{"model_$i"})) {
- map { $form->{"${_}_$i"} =~ s/'/''/g } qw(make model);
-
- $query = qq|INSERT INTO makemodel (parts_id, name)
- VALUES ($form->{id},
- '$form->{"make_$i"}:$form->{"model_$i"}')|;
- $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 my $i (1 .. $form->{assembly_rows}) {
- $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
-
- if ($form->{"qty_$i"} != 0) {
- $form->{"bom_$i"} *= 1;
- $query = qq|INSERT INTO assembly (id, parts_id, qty, bom)
- VALUES ($form->{id}, $form->{"id_$i"},
- $form->{"qty_$i"}, '$form->{"bom_$i"}')|;
- $dbh->do($query) || $form->dberror($query);
- }
- }
- }
-
- # adjust onhand for the assembly
- if ($form->{onhand} != 0) {
- &adjust_inventory($dbh, $form, $form->{id}, $form->{onhand});
- }
-
- }
-
-
- # commit
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-sub update_assembly {
- my ($dbh, $form, $id, $qty, $sellprice, $weight) = @_;
-
- my $query = qq|SELECT id, qty
- FROM assembly
- WHERE parts_id = $id|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my ($pid, $aqty) = $sth->fetchrow_array) {
- &update_assembly($dbh, $form, $pid, $aqty * $qty, $sellprice, $weight);
- }
- $sth->finish;
-
- $query = qq|UPDATE parts
- SET sellprice = sellprice +
- $qty * ($form->{sellprice} - $sellprice),
- weight = weight +
- $qty * ($form->{weight} - $weight)
- WHERE id = $id|;
- $dbh->do($query) || $form->dberror($query);
-
-}
-
-
-
-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'";
-
- # 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'|;
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{assembly_items} }, $ref if $ref->{inventory};
- }
- $sth->finish;
-
- $dbh->disconnect;
-
-}
-
-
-sub restock_assemblies {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- 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"});
- }
-
- }
-
- 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
- JOIN assembly a 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 $allocate = $qty * $ref->{qty};
-
- # is it a service item, then loop
- $ref->{inventory_accno_id} *= 1;
- next if (($ref->{inventory_accno_id} == 0) && !$ref->{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);
-
- if ($form->{item} eq 'assembly' && $form->{onhand} != 0) {
- # adjust onhand for the assembly
- &adjust_inventory($dbh, $form, $form->{id}, $form->{onhand} * -1);
- }
-
- 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);
-
- # check if it is a part, assembly or service
- if ($form->{item} eq 'part') {
- $query = qq|DELETE FROM makemodel
- WHERE parts_id = $form->{id}|;
- $dbh->do($query) || $form->dberror($query);
- }
-
- if ($form->{item} eq 'assembly') {
- $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);
- }
-
- # commit
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-sub assembly_item {
- my ($self, $myconfig, $form) = @_;
-
- my $i = $form->{assembly_rows};
- my $var;
- my $where = "1 = 1";
-
- 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"}) {
- $var = $form->like(lc $form->{"partsgroup_$i"});
- $where .= " AND lower(pg.partsgroup) LIKE '$var'";
- }
-
- if ($form->{id}) {
- $where .= " AND NOT 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,
- pg.partsgroup
- 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 $var;
-
- foreach my $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}) {
- $var = $form->like(lc $form->{description});
- $where .= " AND lower(p.description) LIKE '$var'";
- }
- }
-
- if ($form->{searchitems} eq 'part') {
- $where .= " AND p.inventory_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 NOT p.assembly = '1'";
- # irrelevant for services
- $form->{make} = $form->{model} = "";
- }
-
- # items which were never bought, sold or on an order
- if ($form->{itemstatus} eq 'orphaned') {
- $form->{onhand} = $form->{short} = 0;
- $form->{bought} = $form->{sold} = 0;
- $form->{onorder} = $form->{ordered} = 0;
- $form->{transdatefrom} = $form->{transdateto} = "";
-
- $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'";
- $form->{onhand} = $form->{short} = 0;
- }
- if ($form->{itemstatus} eq 'onhand') {
- $where .= " AND p.onhand > 0";
- }
- if ($form->{itemstatus} eq 'short') {
- $where .= " AND p.onhand < 0";
- }
-
- if ($form->{make}) {
- $var = $form->like(lc $form->{make}).":%";
- $where .= " AND p.id IN (SELECT DISTINCT ON (m.parts_id) m.parts_id
- FROM makemodel m WHERE lower(m.name) LIKE '$var')";
- }
- if ($form->{model}) {
- $var = "%:".$form->like($form->{model});
- $where .= " AND p.id IN (SELECT DISTINCT ON (m.parts_id) m.parts_id
- FROM makemodel m WHERE lower(m.name) LIKE '$var')";
- }
- if ($form->{partsgroup}) {
- $var = $form->like(lc $form->{partsgroup});
- $where .= " AND lower(pg.partsgroup) LIKE '$var'";
-
- }
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
-
- my $sortorder = join ', ', $form->sort_columns(qw(partnumber description bin priceupdate partsgroup));
- $sortorder = $form->{sort} unless $sortorder;
-
- my $query = qq|SELECT 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,
- pg.partsgroup
- FROM parts p
- LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
- WHERE $where
- ORDER BY $sortorder|;
-
- # rebuild query for bought and sold items
- if ($form->{bought} || $form->{sold} || $form->{onorder} || $form->{ordered}) {
-
- my $union = "";
- $query = "";
-
- if ($form->{bought} || $form->{sold}) {
-
- my $invwhere = "$where";
- $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'";
- }
-
- my $flds = qq|p.id, p.partnumber, i.description,
- 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,
- pg.partsgroup,
- a.invnumber, a.ordnumber, i.trans_id|;
-
- if ($form->{bought}) {
- $query = qq|
- SELECT $flds, 'ir' AS module, '' AS type,
- 1 AS exchangerate
- FROM parts p
- JOIN invoice i ON (i.parts_id = p.id)
- JOIN ap a ON (i.trans_id = a.id)
- LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
- WHERE $invwhere|;
- $union = "
- UNION";
- }
-
- if ($form->{sold}) {
- $query .= qq|$union
- SELECT $flds, 'is' AS module, '' AS type,
- 1 As exchangerate
- FROM parts p
- JOIN invoice i ON (i.parts_id = p.id)
- JOIN ar a ON (i.trans_id = a.id)
- LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
- WHERE $invwhere|;
- $union = "
- UNION";
- }
- }
-
- if ($form->{onorder} || $form->{ordered}) {
- my $ordwhere = "$where";
- $ordwhere .= " AND o.closed = '0'" unless $form->{closed};
-
- $ordwhere .= " AND o.transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom};
- $ordwhere .= " AND o.transdate <= '$form->{transdateto}'" if $form->{transdateto};
-
- if ($form->{description}) {
- $var = $form->like(lc $form->{description});
- $ordwhere .= " AND lower(oi.description) LIKE '$var'";
- }
-
- $flds = qq|p.id, p.partnumber, oi.description,
- oi.qty AS onhand, oi.unit, p.bin, oi.sellprice,
- p.listprice, p.lastcost, p.rop, p.weight,
- p.priceupdate, p.image, p.drawing, p.microfiche,
- pg.partsgroup,
- '' AS invnumber, o.ordnumber, oi.trans_id|;
-
- if ($form->{ordered}) {
- $query .= qq|$union
- SELECT $flds, 'oe' AS module, 'sales_order' AS type,
- (SELECT buy FROM exchangerate ex
- WHERE ex.curr = o.curr
- AND ex.transdate = o.transdate) AS exchangerate
- FROM parts p
- JOIN orderitems oi ON (oi.parts_id = p.id)
- JOIN oe o ON (oi.trans_id = o.id)
- LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
- WHERE $ordwhere
- AND o.customer_id > 0|;
- $union = "
- UNION";
- }
-
- if ($form->{onorder}) {
- $flds = qq|p.id, p.partnumber, oi.description,
- oi.qty * -1 AS onhand, oi.unit, p.bin, oi.sellprice,
- p.listprice, p.lastcost, p.rop, p.weight,
- p.priceupdate, p.image, p.drawing, p.microfiche,
- pg.partsgroup,
- '' AS invnumber, o.ordnumber, oi.trans_id|;
-
- $query .= qq|$union
- SELECT $flds, 'oe' AS module, 'purchase_order' AS type,
- (SELECT sell FROM exchangerate ex
- WHERE ex.curr = o.curr
- AND ex.transdate = o.transdate) AS exchangerate
- FROM parts p
- JOIN orderitems oi ON (oi.parts_id = p.id)
- JOIN oe o ON (oi.trans_id = o.id)
- LEFT JOIN partsgroup pg ON (p.partsgroup_id = pg.id)
- WHERE $ordwhere
- AND o.vendor_id > 0|;
- }
-
- }
-
- $query .= qq|
- ORDER BY $sortorder|;
-
- }
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{parts} }, $ref;
- }
-
- $sth->finish;
-
-
- # include individual items for assemblies
- if ($form->{searchitems} eq 'assembly' && $form->{bom}) {
- foreach $item (@{ $form->{parts} }) {
- push @assemblies, $item;
- $query = qq|SELECT 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
- FROM parts p
- JOIN assembly a ON (p.id = a.parts_id)
- WHERE a.id = $item->{id}|;
-
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{assemblyitem} = 1;
- push @assemblies, $ref;
- }
- $sth->finish;
-
- push @assemblies, {id => $item->{id}};
-
- }
-
- # copy assemblies to $form->{parts}
- @{ $form->{parts} } = @assemblies;
-
- }
-
- $dbh->disconnect;
-
-}
-
-
-sub create_links {
- my ($self, $module, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- 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 (my $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->{id}) {
- $query = qq|SELECT weightunit
- FROM defaults|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{weightunit}) = $sth->fetchrow_array;
- $sth->finish;
-
- } else {
- $query = qq|SELECT weightunit, current_date
- FROM defaults|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{weightunit}, $form->{priceupdate}) = $sth->fetchrow_array;
- $sth->finish;
- }
-
- $dbh->disconnect;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/IR.pm b/sql-ledger/SL/IR.pm
deleted file mode 100644
index 357533e17..000000000
--- a/sql-ledger/SL/IR.pm
+++ /dev/null
@@ -1,995 +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.
-#======================================================================
-#
-# 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, $sth, $null, $project_id);
- my $exchangerate = 0;
-
- 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;
- }
-
- map { $form->{$_} =~ s/'/''/g } qw(invnumber ordnumber);
-
- 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) {
-
- map { $form->{"${_}_$i"} =~ s/'/''/g } qw(partnumber description unit);
-
- my ($allocated, $taxrate) = (0, 0);
- my $taxamount;
-
- $form->{"sellprice_$i"} = $form->parse_amount($myconfig, $form->{"sellprice_$i"});
- my $fxsellprice = $form->{"sellprice_$i"};
-
- my ($dec) = ($fxsellprice =~ /\.(\d+)/);
- $dec = length $dec;
- my $decimalplaces = ($dec > 2) ? $dec : 2;
-
-
- map { $taxrate += $form->{"${_}_rate"} } split / /, $form->{"taxaccounts_$i"};
-
- 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 ($taxamount != 0) {
- map { $form->{amount}{$form->{id}}{$_} -= $taxamount * $form->{"${_}_rate"} / $taxrate } split / /, $form->{"taxaccounts_$i"};
- }
-
- # 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
- $query = qq|UPDATE parts SET
- lastcost = $form->{"sellprice_$i"},
- onhand = onhand + $form->{"qty_$i"}
- WHERE id = $form->{"id_$i"}|;
- $dbh->do($query) || $form->dberror($query);
-
-
- # 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 ($taxamount != 0) {
- map { $form->{amount}{$form->{id}}{$_} -= $taxamount * $form->{"${_}_rate"} / $taxrate } split / /, $form->{"taxaccounts_$i"};
- }
-
- $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);
-
- # update lastcost
- $query = qq|UPDATE parts SET
- lastcost = $form->{"sellprice_$i"}
- WHERE id = $form->{"id_$i"}|;
- $dbh->do($query) || $form->dberror($query);
-
- }
-
- $project_id = 'NULL';
- if ($form->{"project_id_$i"}) {
- $project_id = $form->{"project_id_$i"};
- }
- $deliverydate = ($form->{"deliverydate_$i"}) ? qq|'$form->{"deliverydate_$i"}'| : "NULL";
-
- # save detail record in invoice table
- $query = qq|INSERT INTO invoice (trans_id, parts_id, description, qty,
- sellprice, fxsellprice, allocated, unit, deliverydate)
- VALUES ($form->{id}, $form->{"id_$i"},
- '$form->{"description_$i"}', |. ($form->{"qty_$i"} * -1) .qq|,
- $form->{"sellprice_$i"}, $fxsellprice, $allocated,
- '$form->{"unit_$i"}', $deliverydate)|;
- $dbh->do($query) || $form->dberror($query);
-
- }
- }
-
-
- $form->{datepaid} = $form->{invdate};
-
- # all amounts are in natural state, netamount includes the taxes
- # if tax is included, netamount is rounded to 2 decimal places,
- # taxes are not
-
- # 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 my $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->{invdate}, 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->{invdate}')|;
- $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->{invdate} 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)
- VALUES ($form->{id}, (SELECT id FROM chart
- WHERE accno = '$accno'),
- $form->{"paid_$i"}, '$form->{"datepaid_$i"}',
- '$form->{"source_$i"}')|;
- $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->{"paid_$i"} * $form->{exchangerate}) - ($form->{"paid_$i"} * $form->{"exchangerate_$i"});
- 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;
- my $datepaid = ($form->{paid}) ? qq|'$form->{datepaid}'| : "NULL";
- my $duedate = ($form->{duedate}) ? qq|'$form->{duedate}'| : "NULL";
-
- # save AP record
- $query = qq|UPDATE ap set
- invnumber = '$form->{invnumber}',
- ordnumber = '$form->{ordnumber}',
- transdate = '$form->{invdate}',
- vendor_id = $form->{vendor_id},
- amount = $amount,
- netamount = $netamount,
- paid = $form->{paid},
- datepaid = $datepaid,
- duedate = $duedate,
- invoice = '1',
- taxincluded = '$form->{taxincluded}',
- notes = '$form->{notes}',
- curr = '$form->{currency}'
- 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});
-
- # delete zero entries
- $query = qq|DELETE FROM acc_trans
- WHERE amount = 0|;
- $dbh->do($query) || $form->dberror($query);
-
- 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);
-
- 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);
-
- # check for other foreign currency transactions
- $form->delete_exchangerate($dbh) if ($form->{currency} ne $form->{defaultcurrency});
-
- &reverse_invoice($dbh, $form);
-
- # delete zero entries
- my $query = qq|DELETE FROM acc_trans
- WHERE amount = 0|;
- $dbh->do($query) || $form->dberror($query);
-
- # 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.ponumber AS invnumber, d.curr AS currencies,
- current_date AS invdate
- 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 AS invdate, a.duedate,
- a.ordnumber, a.paid, a.taxincluded, a.notes, a.curr AS currency
- 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;
-
- $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, "sell");
-
- # 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 AS sellprice,
- i.parts_id AS id, i.unit, p.bin, i.deliverydate,
- pr.projectnumber,
- i.project_id,
- pg.partsgroup
- 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)
- WHERE trans_id = $form->{id}
- ORDER BY i.id|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
-
- # get tax rates for part
- $query = qq|SELECT c.accno
- FROM chart c, partstax pt
- WHERE pt.chart_id = c.id
- AND pt.parts_id = $ref->{id}|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $ref->{taxaccounts} = "";
- my $taxrate = 0;
-
- while (my $ptref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{taxaccounts} .= "$ptref->{accno} ";
- $taxrate += $form->{"$ptref->{accno}_rate"};
- }
-
- $sth->finish;
- chop $ref->{taxaccounts};
-
- $ref->{qty} *= -1;
-
- push @{ $form->{invoice_details} }, $ref;
-
- }
-
- $sth->finish;
-
- } else {
-
- # up invoice number by 1
- $form->{invnumber}++;
-
- # save the new number
- $query = qq|UPDATE defaults
- SET ponumber = '$form->{invnumber}'|;
- $dbh->do($query) || $form->dberror($query);
-
- }
-
-
- 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};
- $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
-
- my $duedate = ($form->{invdate}) ? "to_date('$form->{invdate}', '$dateformat')" : "current_date";
-
- $form->{vendor_id} *= 1;
- # get vendor
- my $query = qq|SELECT taxincluded, terms, email, cc, bcc,
- addr1, addr2, addr3, addr4,
- $duedate + terms AS duedate
- 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;
-
- # get shipto if we do not convert an order or invoice
- if (!$form->{shipto}) {
- map { delete $form->{$_} } qw(shiptoname shiptoaddr1 shiptoaddr2 shiptoaddr3 shiptoaddr4 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, vendortax v
- WHERE v.chart_id = c.id
- AND 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
- FROM chart c, tax t
- WHERE c.id = t.chart_id
- AND 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->{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/) {
- # setup last accounts used
- $query = qq|SELECT c.accno, c.description, c.link, c.category
- FROM chart c
- JOIN acc_trans ac ON (ac.chart_id = c.id)
- JOIN ap a ON (a.id = ac.trans_id)
- WHERE a.vendor_id = $form->{vendor_id}
- AND NOT (c.link LIKE '%_tax%' OR c.link LIKE '%_paid%')
- 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)) {
- if ($ref->{category} eq 'E') {
- $i++;
- $form->{"AP_amount_$i"} = "$ref->{accno}--$ref->{description}";
- }
- 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 $var;
-
- # don't include assemblies or obsolete parts
- my $where = "NOT p.assembly = '1' AND NOT p.obsolete = '1'";
-
- 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"}) {
- $var = $form->like(lc $form->{"partsgroup_$i"});
- $where .= " AND lower(pg.partsgroup) LIKE '$var'";
- }
-
- if ($form->{"description_$i"}) {
- $where .= " ORDER BY description";
- } else {
- $where .= " ORDER BY partnumber";
- }
-
- # 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
- 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)
- WHERE $where|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- # get 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 = $ref->{id}|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $ref->{taxaccounts} = "";
- while (my $ptref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{taxaccounts} .= "$ptref->{accno} ";
- }
- $sth->finish;
- chop $ref->{taxaccounts};
-
- push @{ $form->{item_list} }, $ref;
- }
-
- $sth->finish;
- $dbh->disconnect;
-
-}
-
-
-
-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, addr1, addr2, addr3, addr4,
- contact, phone as vendorphone, fax as vendorfax, vendornumber
- 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 dc11e3677..000000000
--- a/sql-ledger/SL/IS.pm
+++ /dev/null
@@ -1,1231 +0,0 @@
-#=====================================================================
-# SQL-Ledger Accounting
-# Copyright (C) 1998-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.
-#======================================================================
-#
-# Inventory invoicing module
-#
-#======================================================================
-
-package IS;
-
-
-sub invoice_details {
- my ($self, $myconfig, $form) = @_;
-
- $form->{duedate} = $form->{invdate} unless ($form->{duedate});
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $query = qq|SELECT date '$form->{duedate}' - date '$form->{invdate}'
- AS terms
- FROM defaults|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{terms}) = $sth->fetchrow_array;
- $sth->finish;
-
- my $tax = 0;
- my $item;
- my $i;
- my @partsgroup = ();
- my $partsgroup;
- my %oid = ( 'Pg' => 'oid',
- 'Oracle' => 'rowid' );
-
- # sort items by partsgroup
- for $i (1 .. $form->{rowcount}) {
- $partsgroup = "";
- if ($form->{"partsgroup_$i"} && $form->{groupitems}) {
- $form->format_string("partsgroup_$i");
- $partsgroup = $form->{"partsgroup_$i"};
- }
- push @partsgroup, [ $i, $partsgroup ];
- }
-
- my $sameitem = "";
- foreach $item (sort { $a->[1] cmp $b->[1] } @partsgroup) {
- $i = $item->[0];
-
- if ($item->[1] ne $sameitem) {
- push(@{ $form->{description} }, qq|$item->[1]|);
- $sameitem = $item->[1];
-
- map { push(@{ $form->{$_} }, "") } qw(runningnumber number bin qty unit deliverydate sellprice listprice netprice discount linetotal);
- }
-
- $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
-
- if ($form->{"qty_$i"} != 0) {
-
- # add number, description and qty to $form->{number}, ....
- push(@{ $form->{runningnumber} }, $i);
- push(@{ $form->{number} }, qq|$form->{"partnumber_$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->{sellprice} }, $form->{"sellprice_$i"});
-
- # listprice
- push(@{ $form->{listprice} }, $form->{"listprice_$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);
-
- $form->{total} += $linetotal;
-
- push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2));
-
- my $taxrate = 0;
- my ($taxamount, $taxbase);
-
- map { $taxrate += $form->{"${_}_rate"} } split / /, $form->{"taxaccounts_$i"};
-
- if ($form->{taxincluded}) {
- # calculate tax
- $taxamount = $linetotal * ($taxrate / (1 + $taxrate));
- $taxbase = $linetotal - $taxamount;
- } else {
- $taxamount = $linetotal * $taxrate;
- $taxbase = $linetotal;
- }
-
- if ($taxamount != 0) {
- foreach my $item (split / /, $form->{"taxaccounts_$i"}) {
- $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate;
- $taxbase{$item} += $taxbase;
- }
- }
-
- if ($form->{"assembly_$i"}) {
- $sameitem = "";
-
- # 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
- 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->{groupitems} && $ref->{partsgroup} ne $sameitem) {
- map { push(@{ $form->{$_} }, "") } qw(runningnumber number unit qty bin sellprice listprice netprice discount linetotal);
- $sameitem = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--";
- push(@{ $form->{description} }, $sameitem);
- }
-
- push(@{ $form->{number} }, qq|$ref->{partnumber}|);
- push(@{ $form->{description} }, qq|$ref->{description}|);
- push(@{ $form->{unit} }, qq|$ref->{unit}|);
- push(@{ $form->{qty} }, $form->format_amount($myconfig, $ref->{qty} * $form->{"qty_$i"}));
-
- map { push(@{ $form->{$_} }, "") } qw(runningnumber bin sellprice listprice netprice discount linetotal);
-
- }
- $sth->finish;
- }
-
- }
- }
-
-
- 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"});
-
- $form->{paid} += $form->parse_amount($myconfig, $form->{"paid_$i"});
- }
- }
-
- $form->{subtotal} = $form->format_amount($myconfig, $form->{total}, 2);
- $form->{invtotal} = ($form->{taxincluded}) ? $form->{total} : $form->{total} + $tax;
- $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);
-
- # myconfig variables
- map { $form->{$_} = $myconfig->{$_} } (qw(company address tel fax signature businessnumber));
- $form->{username} = $myconfig->{name};
-
- $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, addr1, addr2, addr3, addr4,
- phone as customerphone, fax as customerfax, contact
- 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, $sth, $null, $project_id, $deliverydate);
- my $exchangerate = 0;
-
- if ($form->{id}) {
-
- &reverse_invoice($dbh, $form);
-
- } else {
- my $uid = time;
- $uid .= $form->{login};
-
- $query = qq|INSERT INTO ar (invnumber, employee_id)
- VALUES ('$uid', (SELECT id FROM employee
- WHERE login = '$form->{login}') )|;
- $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;
- }
-
-
- map { $form->{$_} =~ s/'/''/g } (qw(invnumber shippingpoint notes message));
-
- 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) {
-
- map { $form->{"${_}_$i"} =~ s/'/''/g } (qw(partnumber description unit));
-
- # 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 ($taxamount != 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, assembly a
- WHERE a.parts_id = p.id
- AND 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);
- }
- $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);
-
- $allocated = &cogs($dbh, $form, $form->{"id_$i"}, $form->{"qty_$i"});
- }
- }
-
- $project_id = 'NULL';
- if ($form->{"project_id_$i"}) {
- $project_id = $form->{"project_id_$i"};
- }
- $deliverydate = ($form->{"deliverydate_$i"}) ? qq|'$form->{"deliverydate_$i"}'| : "NULL";
-
- # 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)
- VALUES ($form->{id}, $form->{"id_$i"},
- '$form->{"description_$i"}', $form->{"qty_$i"},
- $form->{"sellprice_$i"}, $fxsellprice,
- $form->{"discount_$i"}, $allocated, 'f',
- '$form->{"unit_$i"}', $deliverydate, $project_id)|;
- $dbh->do($query) || $form->dberror($query);
-
- }
- }
-
-
- $form->{datepaid} = $form->{invdate};
-
- # total payments, don't move we need it here
- 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};
- }
- }
-
-
- $form->{amount}{$form->{id}}{$form->{AR}} = $netamount + $tax;
-
- if ($form->{paid} != 0) {
- $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->{invdate}, $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->{invdate}')|;
- $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}} = 1 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->{invdate} unless ($form->{"datepaid_$i"});
- $form->{datepaid} = $form->{"datepaid_$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)
- VALUES ($form->{id}, (SELECT id FROM chart
- WHERE accno = '$accno'),
- $form->{"paid_$i"}, '$form->{"datepaid_$i"}',
- '$form->{"source_$i"}')|;
- $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"}, 'buy');
-
- $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) + $diff;
-
-
- # gain/loss
- $amount = $form->{"paid_$i"} * $form->{exchangerate} - $form->{"paid_$i"} * $form->{"exchangerate_$i"};
- 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;
- my $datepaid = ($form->{paid}) ? qq|'$form->{datepaid}'| : "NULL";
- my $duedate = ($form->{duedate}) ? qq|'$form->{duedate}'| : "NULL";
-
- # fill in subject if there is none
- $form->{subject} = qq|$form->{label} $form->{invnumber}| unless $form->{subject};
- # if there is a message stuff it into the notes
- my $cc = "Cc: $form->{cc}\\r\n" if $form->{cc};
- my $bcc = "Bcc: $form->{bcc}\\r\n" if $form->{bcc};
- $form->{notes} .= qq|\r
-\r
-[email]\r
-To: $form->{email}\r
-$cc${bcc}Subject: $form->{subject}\r
-\r
-Message: $form->{message}\r| if $form->{message};
-
- # save AR record
- $query = qq|UPDATE ar set
- invnumber = '$form->{invnumber}',
- ordnumber = '$form->{ordnumber}',
- transdate = '$form->{invdate}',
- customer_id = $form->{customer_id},
- amount = $amount,
- netamount = $netamount,
- paid = $form->{paid},
- datepaid = $datepaid,
- duedate = $duedate,
- invoice = '1',
- shippingpoint = '$form->{shippingpoint}',
- terms = $form->{terms},
- notes = '$form->{notes}',
- taxincluded = '$form->{taxincluded}',
- curr = '$form->{currency}'
- 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});
-
- 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, parts p
- 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 $allocated = 0;
-
- $ref->{inventory_accno_id} *= 1;
- $ref->{expense_accno_id} *= 1;
-
- map { $ref->{$_} =~ s/'/''/g } (qw(partnumber description unit));
-
- # 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}, '$ref->{description}',
- $ref->{parts_id}, $ref->{qty}, 0, 0, $allocated, 't',
- '$ref->{unit}')|;
- $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, parts p
- WHERE i.parts_id = p.id
- AND 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
- unless ($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) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- # check for other foreign currency transactions
- $form->delete_exchangerate($dbh) if ($form->{currency} ne $form->{defaultcurrency});
-
- &reverse_invoice($dbh, $form);
-
- # delete AR record
- my $query = qq|DELETE FROM ar
- 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.invnumber, d.curr AS currencies, current_date AS invdate
- 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.transdate AS invdate, a.paid,
- a.shippingpoint, a.terms, a.notes, a.duedate, a.taxincluded,
- a.curr AS currency, (SELECT e.name FROM employee e
- WHERE e.id = a.employee_id) AS employee
- FROM ar a
- 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;
-
- $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{invdate}, "buy");
-
- # 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,
- i.description, i.qty, i.fxsellprice AS sellprice,
- i.discount, i.parts_id AS id, i.unit, i.deliverydate,
- pr.projectnumber,
- i.project_id,
- p.partnumber, p.assembly, p.bin,
- pg.partsgroup
- 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 (p.partsgroup_id = pg.id)
- WHERE i.trans_id = $form->{id}
- AND NOT i.assemblyitem = '1'
- ORDER BY i.id|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
- # get taxes
- $query = qq|SELECT c.accno
- FROM chart c, partstax pt
- WHERE pt.chart_id = c.id
- AND pt.parts_id = $ref->{id}|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $ref->{taxaccounts} = "";
- my $taxrate = 0;
-
- while (my $ptref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{taxaccounts} .= "$ptref->{accno} ";
- $taxrate += $form->{"$ptref->{accno}_rate"};
- }
- $sth->finish;
- chop $ref->{taxaccounts};
-
- push @{ $form->{invoice_details} }, $ref;
- }
- $sth->finish;
-
- } else {
-
- $form->{shippingpoint} = $myconfig->{shippingpoint} unless $form->{shippingpoint};
-
- # up invoice number by 1
- $form->{invnumber}++;
-
- # save the new number
- $query = qq|UPDATE defaults
- SET invnumber = '$form->{invnumber}'|;
- $dbh->do($query) || $form->dberror($query);
-
- $form->get_employee($dbh);
-
- }
-
-
- 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};
- $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
-
- my $duedate = ($form->{invdate}) ? "to_date('$form->{invdate}', '$dateformat')" : "current_date";
-
- $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.addr1, c.addr2, c.addr3, c.addr4,
- $duedate + c.terms AS duedate
- FROM customer c
- WHERE c.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;
-
- $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.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 shiptoaddr1 shiptoaddr2 shiptoaddr3 shiptoaddr4 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, customertax ct
- WHERE ct.chart_id = c.id
- AND 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, tax t
- WHERE c.id = t.chart_id
- AND 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/) {
- $query = qq|SELECT c.accno, c.description, c.link, c.category
- FROM chart c
- JOIN acc_trans ac ON (ac.chart_id = c.id)
- JOIN ar a ON (a.id = ac.trans_id)
- WHERE a.customer_id = $form->{customer_id}
- AND NOT (c.link LIKE '%_tax%' OR c.link LIKE '%_paid%')
- 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)) {
- if ($ref->{category} eq 'I') {
- $i++;
- $form->{"AR_amount_$i"} = "$ref->{accno}--$ref->{description}";
- }
- 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) = @_;
-
- my $i = $form->{rowcount};
- my $var;
- my $where = "NOT obsolete = '1'";
-
- 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"}) {
- $var = $form->like(lc $form->{"partsgroup_$i"});
- $where .= " AND lower(pg.partsgroup) LIKE '$var'";
- }
-
- if ($form->{"description_$i"}) {
- $where .= " ORDER BY description";
- } else {
- $where .= " ORDER BY partnumber";
- }
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $query = qq|SELECT p.id, p.partnumber, p.description, p.sellprice,
- p.listprice,
- c1.accno AS inventory_accno,
- c2.accno AS income_accno,
- c3.accno AS expense_accno,
- p.unit, p.assembly, p.bin, p.onhand, p.makemodel,
- 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 (pg.id = p.partsgroup_id)
- WHERE $where|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
-
- # get taxes for part
- $query = qq|SELECT c.accno
- FROM chart c
- JOIN partstax pt ON (c.id = pt.chart_id)
- WHERE pt.parts_id = $ref->{id}|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $ref->{taxaccounts} = "";
- while (my $ptref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{taxaccounts} .= "$ptref->{accno} ";
- }
- $sth->finish;
- chop $ref->{taxaccounts};
-
- # get makemodel
- if ($ref->{makemodel}) {
- $query = qq|SELECT name
- FROM makemodel
- WHERE parts_id = $ref->{id}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- $ref->{makemodel} = "";
- while (my $ptref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{makemodel} .= "$ptref->{name}:";
- }
- $sth->finish;
- chop $ref->{makemodel};
- }
-
- push @{ $form->{item_list} }, $ref;
-
- }
-
- $sth->finish;
- $dbh->disconnect;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/Inifile.pm b/sql-ledger/SL/Inifile.pm
deleted file mode 100644
index e9de47a8f..000000000
--- a/sql-ledger/SL/Inifile.pm
+++ /dev/null
@@ -1,87 +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.
-#=====================================================================
-#
-# 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;
-
- $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 934ad3690..000000000
--- a/sql-ledger/SL/Mailer.pm
+++ /dev/null
@@ -1,147 +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.
-#======================================================================
-
-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};
-
- 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"
-
---${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 661d35408..000000000
--- a/sql-ledger/SL/Menu.pm
+++ /dev/null
@@ -1,117 +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.
-#=====================================================================
-#
-# routines for menu items
-#
-#=====================================================================
-
-package Menu;
-
-
-sub new {
- my ($type, $menufile, $level) = @_;
-
- use SL::Inifile;
- my $self = Inifile->new($menufile, $level);
-
- bless $self, $type;
-
-}
-
-
-sub menuitem {
- my ($self, $myconfig, $form, $item) = @_;
-
- 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};
- }
-
- my $level = $form->escape($item);
- my $str = qq|<a href=$module?path=$form->{path}&action=$action&level=$level&login=$form->{login}&password=$form->{password}|;
- 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;
-
-
- # add other params
- foreach my $key (keys %{ $self->{$item} }) {
- $str .= "&".$form->escape($key,1)."=";
- ($value, $conf) = split /=/, $self->{$item}{$key}, 2;
- $value = $myconfig->{$value}."/$conf" if ($conf);
- $str .= $form->escape($value, 1);
- }
-
- if ($target) {
- $str .= qq| target=$target|;
- }
-
- $str .= ">";
-
-}
-
-
-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 f09121c23..000000000
--- a/sql-ledger/SL/Num2text.pm
+++ /dev/null
@@ -1,162 +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.
-#=====================================================================
-#
-# 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 //, $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 a742ca7a2..000000000
--- a/sql-ledger/SL/OE.pm
+++ /dev/null
@@ -1,674 +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
-#
-#======================================================================
-
-package OE;
-
-
-sub transactions {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $query;
-
- my $rate = ($form->{vc} eq 'customer') ? 'buy' : 'sell';
-
- my $query = qq|SELECT o.id, o.ordnumber, o.transdate, o.reqdate,
- o.amount, ct.name, o.netamount, o.$form->{vc}_id,
- (SELECT $rate FROM exchangerate ex
- WHERE ex.curr = o.curr
- AND ex.transdate = o.transdate) AS exchangerate,
- o.closed
- FROM oe o, $form->{vc} ct
- WHERE o.$form->{vc}_id = ct.id|;
-
- my $ordnumber = $form->like(lc $form->{ordnumber});
-
- if ($form->{"$form->{vc}_id"}) {
- $query .= qq| AND o.$form->{vc}_id = $form->{"$form->{vc}_id"}|;
- } else {
- if ($form->{$form->{vc}}) {
- my $name = $form->like(lc $form->{$form->{vc}});
- $query .= " AND lower(name) LIKE '$name'";
- }
- }
- unless ($form->{open} && $form->{closed}) {
- $query .= ($form->{open}) ? " AND o.closed = '0'" : " AND o.closed = '1'";
- }
-
- my $sortorder = join ', ', $form->sort_columns(qw(transdate ordnumber name));
- $sortorder = $form->{sort} unless $sortorder;
-
- $query .= " AND lower(ordnumber) LIKE '$ordnumber'" if $form->{ordnumber};
- $query .= " AND transdate >= '$form->{transdatefrom}'" if $form->{transdatefrom};
- $query .= " AND transdate <= '$form->{transdateto}'" if $form->{transdateto};
- $query .= " ORDER by $sortorder";
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $oe = $sth->fetchrow_hashref(NAME_lc)) {
- $oe->{exchangerate} = 1 unless $oe->{exchangerate};
- push @{ $form->{OE} }, $oe;
- }
-
- $sth->finish;
- $dbh->disconnect;
-
-}
-
-
-sub save_order {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database, turn off autocommit
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my ($query, $sth);
- my $exchangerate = 0;
-
- if ($form->{id}) {
-
- $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', (SELECT id FROM employee
- WHERE login = '$form->{login}') )|;
- $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;
- }
-
- map { $form->{$_} =~ s/'/''/g } qw(ordnumber shippingpoint notes message);
-
- my ($amount, $linetotal, $discount, $project_id, $reqdate);
- my ($taxrate, $taxamount, $fxsellprice);
- my %taxbase = ();
- my %taxaccounts = ();
- my ($netamount, $tax) = (0, 0);
-
- for my $i (1 .. $form->{rowcount}) {
-
- $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
-
- if ($form->{"qty_$i"} != 0) {
-
- map { $form->{"${_}_$i"} =~ s/'/''/g } qw(partnumber description unit);
-
- # set values to 0 if nothing entered
- $form->{"discount_$i"} = $form->parse_amount($myconfig, $form->{"discount_$i"}) / 100;
-
- $form->{"sellprice_$i"} = $form->parse_amount($myconfig, $form->{"sellprice_$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);
-
- $linetotal = $form->round_amount($form->{"sellprice_$i"} * $form->{"qty_$i"}, 2);
- $taxrate = 0;
- map { $taxrate += $form->{"${_}_rate"} } split / /, $form->{"taxaccounts_$i"};
-
- 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 ($taxamount != 0) {
- foreach my $item (split / /, $form->{"taxaccounts_$i"}) {
- $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate;
- $taxbase{$item} += $taxbase;
- }
- }
-
- $netamount += $form->{"sellprice_$i"} * $form->{"qty_$i"};
-
- $project_id = 'NULL';
- if ($form->{"project_id_$i"}) {
- $project_id = $form->{"project_id_$i"};
- }
- $reqdate = ($form->{"reqdate_$i"}) ? qq|'$form->{"reqdate_$i"}'| : "NULL";
-
- # save detail record in orderitems table
- $query = qq|INSERT INTO orderitems
- (trans_id, parts_id, description, qty, sellprice, discount,
- unit, reqdate, project_id) VALUES (
- $form->{id}, $form->{"id_$i"}, '$form->{"description_$i"}',
- $form->{"qty_$i"}, $fxsellprice, $form->{"discount_$i"},
- '$form->{"unit_$i"}', $reqdate, $project_id)|;
- $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);
-
- $reqdate = ($form->{reqdate}) ? qq|'$form->{reqdate}'| : "NULL";
-
- # add up the tax
- foreach my $item (sort keys %taxaccounts) {
- $taxamount = $form->round_amount($taxaccounts{$item}, 2);
- $tax += $taxamount;
- }
-
- $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});
-
- # fill in subject if there is none
- $form->{subject} = qq|$form->{label} $form->{ordnumber}| unless $form->{subject};
- # if there is a message stuff it into the notes
- my $cc = "Cc: $form->{cc}\\r\n" if $form->{cc};
- my $bcc = "Bcc: $form->{bcc}\\r\n" if $form->{bcc};
- $form->{notes} .= qq|\r
-\r
-[email]\r
-To: $form->{email}\r
-$cc${bcc}Subject: $form->{subject}\r
-\r
-Message: $form->{message}\r| if $form->{message};
-
- # save OE record
- $query = qq|UPDATE oe set
- ordnumber = '$form->{ordnumber}',
- transdate = '$form->{orddate}',
- vendor_id = $form->{vendor_id},
- customer_id = $form->{customer_id},
- amount = $amount,
- netamount = $netamount,
- reqdate = $reqdate,
- taxincluded = '$form->{taxincluded}',
- shippingpoint = '$form->{shippingpoint}',
- notes = '$form->{notes}',
- curr = '$form->{currency}',
- closed = '$form->{closed}'
- 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});
-
- if (($form->{currency} ne $form->{defaultcurrency}) && !$exchangerate) {
- if ($form->{vc} eq 'customer') {
- $form->update_exchangerate($dbh, $form->{currency}, $form->{orddate}, $form->{exchangerate}, 0);
- }
- if ($form->{vc} eq 'vendor') {
- $form->update_exchangerate($dbh, $form->{currency}, $form->{orddate}, 0, $form->{exchangerate});
- }
- }
-
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-sub delete_order {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my $query;
-
- # can't use $form->delete_exchangerate
- if ($form->{currency} ne $form->{defaultcurrency}) {
- $query = qq|SELECT transdate FROM acc_trans
- WHERE ar.id = trans_id
- AND ar.curr = '$form->{currency}'
- AND transdate = '$form->{orddate}'
- UNION SELECT transdate FROM acc_trans
- WHERE ap.id = trans_id
- AND ap.curr = '$form->{currency}'
- AND transdate = '$form->{orddate}'|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- my ($transdate) = $sth->fetchrow_array;
- $sth->finish;
-
- if (!$transdate) {
- $query = qq|DELETE FROM exchangerate
- WHERE curr = '$form->{currency}'
- AND transdate = '$form->{orddate}'|;
- $dbh->do($query) || $self->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 $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-sub retrieve_order {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my $query;
-
- 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 {
- my $ordnumber = ($form->{vc} eq 'customer') ? 'sonumber' : 'ponumber';
- $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,
- $ordnumber AS ordnumber, d.curr AS currencies,
- current_date AS orddate, current_date AS reqdate
- 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;
-
- ($form->{currency}) = split /:/, $form->{currencies};
-
- if ($form->{id}) {
-
- # retrieve order
- $query = qq|SELECT o.ordnumber, o.transdate AS orddate, o.reqdate,
- o.taxincluded, o.shippingpoint, o.notes, o.curr AS currency,
- (SELECT name FROM employee e
- WHERE e.id = o.employee_id) AS employee,
- o.$form->{vc}_id, cv.name AS $form->{vc}, o.amount AS invtotal,
- o.closed, o.reqdate
- FROM oe o, $form->{vc} cv
- WHERE o.$form->{vc}_id = cv.id
- AND 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;
-
- my %oid = ( 'Pg' => 'oid',
- 'Oracle' => 'rowid',
- 'DB2' => '' );
-
- # retrieve individual items
- $query = qq|SELECT 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,
- pr.projectnumber,
- pg.partsgroup
- 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)
- WHERE trans_id = $form->{id}
- ORDER BY o.$oid{$myconfig->{dbdriver}}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
-
- # get tax rates for part
- $query = qq|SELECT c.accno
- FROM chart c, partstax pt
- WHERE pt.chart_id = c.id
- AND pt.parts_id = $ref->{id}|;
- my $pth = $dbh->prepare($query);
- $pth->execute || $form->dberror($query);
-
- $ref->{taxaccounts} = "";
- my $taxrate = 0;
-
- while (my $ptref = $pth->fetchrow_hashref(NAME_lc)) {
- $ref->{taxaccounts} .= "$ptref->{accno} ";
- $taxrate += $form->{"$ptref->{accno}_rate"};
- }
- $pth->finish;
- chop $ref->{taxaccounts};
-
- push @{ $form->{order_details} }, $ref;
-
- }
- $sth->finish;
-
- } else {
-
- my $ordnumber = ($form->{vc} eq 'customer') ? 'sonumber' : 'ponumber';
- # up order number by 1
- $form->{ordnumber}++;
-
- # save the new number
- $query = qq|UPDATE defaults
- SET $ordnumber = '$form->{ordnumber}'|;
- $dbh->do($query) || $form->dberror($query);
-
- $form->get_employee($dbh);
-
- # get last name used
- $form->lastname_used($dbh, $myconfig, $form->{vc}) unless $form->{"$form->{vc}_id"};
-
- }
-
- $form->{exchangerate} = $form->get_exchangerate($dbh, $form->{currency}, $form->{orddate}, ($form->{vc} eq 'customer') ? "buy" : "sell");
-
- my $rc = $dbh->commit;
- $dbh->disconnect;
-
- $rc;
-
-}
-
-
-
-sub order_details {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $tax = 0;
- my $item;
- my $i;
- my @partsgroup = ();
- my $partsgroup;
- my %oid = ( 'Pg' => 'oid',
- 'Oracle' => 'rowid' );
-
- # sort items by partsgroup
- for $i (1 .. $form->{rowcount}) {
- $partsgroup = "";
- if ($form->{"partsgroup_$i"} && $form->{groupitems}) {
- $form->format_string("partsgroup_$i");
- $partsgroup = $form->{"partsgroup_$i"};
- }
- push @partsgroup, [ $i, $partsgroup ];
- }
-
- my $sameitem = "";
- foreach $item (sort { $a->[1] cmp $b->[1] } @partsgroup) {
- $i = $item->[0];
-
- if ($item->[1] ne $sameitem) {
- push(@{ $form->{description} }, qq|$item->[1]|);
- $sameitem = $item->[1];
-
- map { push(@{ $form->{$_} }, "") } qw(runningnumber number bin qty unit reqdate sellprice listprice netprice discount linetotal);
- }
-
- $form->{"qty_$i"} = $form->parse_amount($myconfig, $form->{"qty_$i"});
-
- if ($form->{"qty_$i"} != 0) {
-
- # add number, description and qty to $form->{number}, ....
- push(@{ $form->{runningnumber} }, $i);
- push(@{ $form->{number} }, qq|$form->{"partnumber_$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->{reqdate} }, qq|$form->{"reqdate_$i"}|);
-
- push(@{ $form->{sellprice} }, $form->{"sellprice_$i"});
-
- push(@{ $form->{listprice} }, $form->{"listprice_$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);
-
- $form->{ordtotal} += $linetotal;
-
- push(@{ $form->{linetotal} }, $form->format_amount($myconfig, $linetotal, 2));
-
- my ($taxamount, $taxbase);
- my $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 ($taxamount != 0) {
- foreach my $item (split / /, $form->{"taxaccounts_$i"}) {
- $taxaccounts{$item} += $taxamount * $form->{"${item}_rate"} / $taxrate;
- $taxbase{$item} += $taxbase;
- }
- }
-
- if ($form->{"assembly_$i"}) {
- $sameitem = "";
-
- # 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
- 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->{groupitems} && $ref->{partsgroup} ne $sameitem) {
- map { push(@{ $form->{$_} }, "") } qw(runningnumber number unit bin qty sellprice listprice netprice discount linetotal);
- $sameitem = ($ref->{partsgroup}) ? $ref->{partsgroup} : "--";
- push(@{ $form->{description} }, $sameitem);
- }
-
- push(@{ $form->{number} }, qq|$ref->{partnumber}|);
- push(@{ $form->{description} }, qq|$ref->{description}|);
- push(@{ $form->{unit} }, qq|$ref->{unit}|);
- push(@{ $form->{qty} }, $form->format_amount($myconfig, $ref->{qty} * $form->{"qty_$i"}));
-
- map { push(@{ $form->{$_} }, "") } qw(runningnumber bin sellprice listprice netprice discount linetotal);
-
- }
- $sth->finish;
- }
-
- }
- }
-
-
- foreach $item (sort keys %taxaccounts) {
- if ($form->round_amount($taxaccounts{$item}, 2) != 0) {
- push(@{ $form->{taxbase} }, $form->format_amount($myconfig, $taxbase{$item}, 2));
-
- $taxamount = $form->round_amount($taxaccounts{$item}, 2);
- $tax += $taxamount;
-
- 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"});
- }
- }
-
-
- $form->{subtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2);
- $form->{ordtotal} = ($form->{taxincluded}) ? $form->{ordtotal} : $form->{ordtotal} + $tax;
-
- # format amounts
- $form->{ordtotal} = $form->format_amount($myconfig, $form->{ordtotal}, 2);
-
- # myconfig variables
- map { $form->{$_} = $myconfig->{$_} } (qw(company address tel fax signature businessnumber));
- $form->{username} = $myconfig->{name};
-
- $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;
-
- $_;
-
-}
-
-
-1;
-
diff --git a/sql-ledger/SL/PE.pm b/sql-ledger/SL/PE.pm
deleted file mode 100644
index dec04bb4f..000000000
--- a/sql-ledger/SL/PE.pm
+++ /dev/null
@@ -1,276 +0,0 @@
-#=====================================================================
-# SQL-Ledger Accounting
-# Copyright (C) 1998-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.
-#======================================================================
-#
-# Project module
-# also used for partsgroups
-#
-#======================================================================
-
-package PE;
-
-
-sub projects {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $sortorder = ($form->{sort}) ? $form->{sort} : "projectnumber";
-
- 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}|;
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{orphaned}) = $sth->fetchrow_array;
- $form->{orphaned} = !$form->{orphaned};
-
- $sth->finish;
-
- $dbh->disconnect;
-
-}
-
-
-sub save_project {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- map { $form->{$_} =~ s/'/''/g } (projectnumber, description);
-
- if ($form->{id}) {
- $query = qq|UPDATE project SET
- projectnumber = '$form->{projectnumber}',
- description = '$form->{description}'
- WHERE id = $form->{id}|;
- } else {
- $query = qq|INSERT INTO project
- (projectnumber, description)
- VALUES ('$form->{projectnumber}', '$form->{description}')|;
- }
- $dbh->do($query) || $form->dberror($query);
-
- $dbh->disconnect;
-
-}
-
-
-sub partsgroups {
- my ($self, $myconfig, $form) = @_;
-
- my $var;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my $sortorder = ($form->{sort}) ? $form->{sort} : "partsgroup";
-
- 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);
-
- map { $form->{$_} =~ s/'/''/g } (partsgroup);
-
-
- if ($form->{id}) {
- $query = qq|UPDATE partsgroup SET
- partsgroup = '$form->{partsgroup}'
- WHERE id = $form->{id}|;
- } else {
- $query = qq|INSERT INTO partsgroup
- (partsgroup)
- VALUES ('$form->{partsgroup}')|;
- }
- $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 delete_tuple {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- $query = qq|DELETE FROM $form->{type}
- WHERE 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 9957d7349..000000000
--- a/sql-ledger/SL/RC.pm
+++ /dev/null
@@ -1,186 +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'
- 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;
- $dbh->disconnect;
-
-}
-
-
-sub payment_transactions {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database, turn AutoCommit off
- my $dbh = $form->dbconnect_noauto($myconfig);
-
- my ($query, $sth);
-
- # get cleared balance
- if ($form->{fromdate}) {
- $query = qq|SELECT sum(a.amount)
- FROM acc_trans a, chart c
- WHERE a.transdate < date '$form->{fromdate}'
- AND a.cleared = '1'
- AND c.id = a.chart_id
- AND c.accno = '$form->{accno}'
- |;
- } else {
- $query = qq|SELECT sum(a.amount)
- FROM acc_trans a, chart c
- WHERE a.cleared = '1'
- AND c.id = a.chart_id
- AND c.accno = '$form->{accno}'
- |;
- }
-
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- ($form->{beginningbalance}) = $sth->fetchrow_array;
-
- $sth->finish;
-
- my %oid = ( 'Pg' => 'ac.oid',
- 'Oracle' => 'ac.rowid');
-
- $query = qq|SELECT c.name, ac.source, ac.transdate, ac.cleared,
- ac.fx_transaction, ac.amount, a.id,
- $oid{$myconfig->{dbdriver}} AS oid
- FROM customer c, acc_trans ac, ar a, chart ch
- WHERE c.id = a.customer_id
- AND ac.cleared = '0'
- AND ac.trans_id = a.id
- AND ac.chart_id = ch.id
- AND ch.accno = '$form->{accno}'
- |;
-
- $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate};
- $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate};
-
-
- $query .= qq|
-
- UNION
- SELECT v.name, ac.source, ac.transdate, ac.cleared,
- ac.fx_transaction, ac.amount, a.id,
- $oid{$myconfig->{dbdriver}} AS oid
- FROM vendor v, acc_trans ac, ap a, chart ch
- WHERE v.id = a.vendor_id
- AND ac.cleared = '0'
- AND ac.trans_id = a.id
- AND ac.chart_id = ch.id
- AND ch.accno = '$form->{accno}'
- |;
-
- $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate};
- $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate};
-
- $query .= qq|
-
- UNION
- SELECT g.description, ac.source, ac.transdate, ac.cleared,
- ac.fx_transaction, ac.amount, g.id,
- $oid{$myconfig->{dbdriver}} AS oid
- FROM gl g, acc_trans ac, chart ch
- WHERE g.id = ac.trans_id
- AND ac.cleared = '0'
- AND ac.trans_id = g.id
- AND ac.chart_id = ch.id
- AND ch.accno = '$form->{accno}'
- |;
-
- $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate};
- $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate};
-
- $query .= " ORDER BY 3,7,8";
-
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $pr = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{PR} }, $pr;
- }
- $sth->finish;
-
- $dbh->disconnect;
-
-}
-
-
-sub reconcile {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- my ($query, $i);
- my %oid = ( 'Pg' => 'oid',
- 'Oracle' => 'rowid');
-
- # clear flags
- for $i (1 .. $form->{rowcount}) {
- if ($form->{"cleared_$i"}) {
- $query = qq|UPDATE acc_trans SET cleared = '1'
- WHERE $oid{$myconfig->{dbdriver}} = $form->{"oid_$i"}|;
- $dbh->do($query) || $form->dberror($query);
-
- # clear fx_transaction
- if ($form->{"fxoid_$i"}) {
- $query = qq|UPDATE acc_trans SET cleared = '1'
- WHERE $oid{$myconfig->{dbdriver}} = $form->{"fxoid_$i"}|;
- $dbh->do($query) || $form->dberror($query);
- }
- }
- }
-
- $dbh->disconnect;
-
-}
-
-1;
-
diff --git a/sql-ledger/SL/RP.pm b/sql-ledger/SL/RP.pm
deleted file mode 100644
index 3f07bb525..000000000
--- a/sql-ledger/SL/RP.pm
+++ /dev/null
@@ -1,1310 +0,0 @@
-#=====================================================================
-# SQL-Ledger Accounting
-# Copyright (C) 1998-2002
-#
-# Author: Dieter Simader
-# Email: dsimader@sql-ledger.org
-# Web: http://www.sql-ledger.org
-#
-# Contributors: Benjamin Lee <benjaminlee@consultant.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 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;
-
- &get_accounts($dbh, $last_period, $form->{fromdate}, $form->{todate}, $form, \@categories);
-
- # 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);
- }
-
-
- # 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 L Q);
-
- # 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);
-
- # if there are any compare dates
- if ($form->{compareasofdate}) {
-
- $last_period = 1;
- &get_accounts($dbh, $last_period, "", $form->{compareasofdate}, $form, \@categories);
-
- $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' => 'equities',
- 'ml' => 1 }
- );
-
- foreach $category (@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});
-
-
- # calculate retained 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});
-
-
- # 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) = @_;
-
- my $query;
- my $where = "WHERE 1 = 1";
- my $subwhere;
- 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;
-
-
- $where .= " AND ac.transdate >= '$fromdate'" if $fromdate;
-
- if ($todate) {
- $where .= " AND ac.transdate <= '$todate'";
- $subwhere = " AND transdate <= '$todate'";
- }
-
-
- if ($form->{project_id})
- {
- $project = qq|
- AND ac.project_id = $form->{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)
- $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
-
- 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)
- $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
-
- 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)
- $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
-
- 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)
- $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
-
--- 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)
- $where
- $category
- AND NOT (c.link = 'AR' OR c.link = 'AP')
- $project
- GROUP BY g.accno, g.description, c.category
-
- UNION
-
- 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)
- $where
- $category
- AND c.gifi_accno = ''
- AND NOT (c.link = 'AR' OR c.link = 'AP')
- $project
- GROUP BY c.category
- |;
-
- } else {
-
- $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)
- $where
- $category
- $project
- GROUP BY g.accno, g.description, c.category
-
- UNION
-
- 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)
- $where
- $category
- AND c.gifi_accno = ''
- $project
- GROUP by c.category
- |;
-
- }
-
- } else {
-
- 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)
- $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
-
- 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)
- $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
-
- 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)
- $where
- $category
- AND NOT (c.link = 'AR' OR c.link = 'AP')
- $project
- GROUP BY c.accno, c.description, c.category
- |;
-
- } else {
-
- $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)
- $where
- $category
- $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) {
- 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_details {
- my ($self, $myconfig, $form) = @_;
-
- my $dbh = $form->dbconnect($myconfig);
-
- my ($query, $sth, $ref);
- my %balance = ();
- my %trb = ();
-
- my $where = "WHERE 1 = 1";
-
- if ($form->{project_id}) {
- $where .= qq|
- AND a.project_id = $form->{project_id}
- |;
- }
-
- # get beginning balances
- if ($form->{fromdate}) {
-
- if ($form->{accounttype} eq 'gifi') {
-
- $query = qq|SELECT g.accno, c.category, SUM(a.amount) AS amount,
- g.description
- FROM acc_trans a
- JOIN chart c ON (a.chart_id = c.id)
- JOIN gifi g ON (c.gifi_accno = g.accno)
- $where
- AND a.transdate < '$form->{fromdate}'
- GROUP BY g.accno, c.category, g.description
- |;
-
- } else {
-
- $query = qq|SELECT c.accno, c.category, SUM(a.amount) AS amount,
- c.description
- FROM acc_trans a
- JOIN chart c ON (a.chart_id = c.id)
- $where
- AND a.transdate < '$form->{fromdate}'
- 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);
-
- my @headingaccounts = ();
- 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 a.transdate >= '$form->{fromdate}'";
- }
- if ($form->{todate}) {
- $where .= " AND a.transdate <= '$form->{todate}'";
- }
- }
-
-
- if ($form->{accounttype} eq 'gifi') {
-
- $query = qq|SELECT g.accno, g.description, c.category,
- SUM(a.amount) AS amount
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- JOIN gifi g ON (c.gifi_accno = g.accno)
- $where
- GROUP BY g.accno, g.description, c.category
-
- UNION
-
- SELECT '' AS accno, '' AS description, c.category,
- SUM(a.amount) AS amount
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- $where
- AND c.gifi_accno = ''
- GROUP BY c.category
- ORDER BY accno|;
-
- } else {
-
- $query = qq|SELECT c.accno, c.description, c.category,
- SUM(a.amount) AS amount
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- $where
- GROUP BY c.accno, c.description, c.category
- ORDER BY accno|;
-
- }
-
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
-
- # prepare query for each account
-
- $query = qq|SELECT (SELECT SUM(a.amount) * -1
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- $where
- AND a.amount < 0
- AND c.accno = ?) AS debit,
- (SELECT SUM(a.amount)
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- $where
- AND a.amount > 0
- AND c.accno = ?) AS credit
- |;
-
- if ($form->{accounttype} eq 'gifi') {
-
- $query = qq|SELECT (SELECT SUM(a.amount) * -1
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- $where
- AND a.amount < 0
- AND c.gifi_accno = ?) AS debit,
- (SELECT SUM(a.amount)
- FROM acc_trans a
- JOIN chart c ON (c.id = a.chart_id)
- $where
- AND a.amount > 0
- AND c.gifi_accno = ?) AS credit|;
-
- }
-
- $drcr = $dbh->prepare($query);
-
- # calculate the debit and credit in 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') {
- # get DR/CR
- $drcr->execute($ref->{accno}, $ref->{accno}) || $form->dberror($query);
-
- ($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';
-
- $form->{todate} = $form->current_date($myconfig) unless ($form->{todate});
-
- my $where = "1 = 1";
- my $name;
-
- 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}};
- }
- }
-
- # select outstanding vendors or customers, depends on $ct
- my $query = qq|SELECT DISTINCT ct.id, ct.name
- FROM $form->{ct} ct, $form->{arap} a
- WHERE $where
- AND a.$form->{ct}_id = ct.id
- 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';
-
- # for each company that has some stuff outstanding
- while ( my ($id) = $sth->fetchrow_array ) {
-
- $query = qq|
-
--- between 0-30 days
-
- SELECT $form->{ct}.id AS ctid, $form->{ct}.name,
- addr1, addr2, addr3, addr4, contact,
- phone as customerphone, fax as customerfax, $form->{ct}number,
- "invnumber", "transdate",
- (amount - paid) as "c0", 0.00 as "c30", 0.00 as "c60", 0.00 as "c90",
- "duedate", invoice, $form->{arap}.id,
- (SELECT $buysell FROM exchangerate
- WHERE $form->{arap}.curr = exchangerate.curr
- AND exchangerate.transdate = $form->{arap}.transdate) AS exchangerate
- FROM $form->{arap}, $form->{ct}
- WHERE paid != amount
- AND $form->{arap}.$form->{ct}_id = $form->{ct}.id
- AND $form->{ct}.id = $id
- AND (
- transdate <= (date '$form->{todate}' - interval '0 days')
- AND transdate >= (date '$form->{todate}' - interval '30 days')
- )
-
- UNION
-
--- between 31-60 days
-
- SELECT $form->{ct}.id AS ctid, $form->{ct}.name,
- addr1, addr2, addr3, addr4, contact,
- phone as customerphone, fax as customerfax, $form->{ct}number,
- "invnumber", "transdate",
- 0.00 as "c0", (amount - paid) as "c30", 0.00 as "c60", 0.00 as "c90",
- "duedate", invoice, $form->{arap}.id,
- (SELECT $buysell FROM exchangerate
- WHERE $form->{arap}.curr = exchangerate.curr
- AND exchangerate.transdate = $form->{arap}.transdate) AS exchangerate
- FROM $form->{arap}, $form->{ct}
- WHERE paid != amount
- AND $form->{arap}.$form->{ct}_id = $form->{ct}.id
- AND $form->{ct}.id = $id
- AND (
- transdate < (date '$form->{todate}' - interval '30 days')
- AND transdate >= (date '$form->{todate}' - interval '60 days')
- )
-
- UNION
-
--- between 61-90 days
-
- SELECT $form->{ct}.id AS ctid, $form->{ct}.name,
- addr1, addr2, addr3, addr4, contact,
- phone as customerphone, fax as customerfax, $form->{ct}number,
- "invnumber", "transdate",
- 0.00 as "c0", 0.00 as "c30", (amount - paid) as "c60", 0.00 as "c90",
- "duedate", invoice, $form->{arap}.id,
- (SELECT $buysell FROM exchangerate
- WHERE $form->{arap}.curr = exchangerate.curr
- AND exchangerate.transdate = $form->{arap}.transdate) AS exchangerate
- FROM $form->{arap}, $form->{ct}
- WHERE paid != amount
- AND $form->{arap}.$form->{ct}_id = $form->{ct}.id
- AND $form->{ct}.id = $id
- AND (
- transdate < (date '$form->{todate}' - interval '60 days')
- AND transdate >= (date '$form->{todate}' - interval '90 days')
- )
-
- UNION
-
--- over 90 days
-
- SELECT $form->{ct}.id AS ctid, $form->{ct}.name,
- addr1, addr2, addr3, addr4, contact,
- phone as customerphone, fax as customerfax, $form->{ct}number,
- "invnumber", "transdate",
- 0.00 as "c0", 0.00 as "c30", 0.00 as "c60", (amount - paid) as "c90",
- "duedate", invoice, $form->{arap}.id,
- (SELECT $buysell FROM exchangerate
- WHERE $form->{arap}.curr = exchangerate.curr
- AND exchangerate.transdate = $form->{arap}.transdate) AS exchangerate
- FROM $form->{arap}, $form->{ct}
- WHERE paid != amount
- AND $form->{arap}.$form->{ct}_id = $form->{ct}.id
- AND $form->{ct}.id = $id
- AND transdate < (date '$form->{todate}' - interval '90 days')
-
- ORDER BY
-
- ctid, invnumber, transdate
-
- |;
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror;
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- $ref->{module} = ($ref->{invoice}) ? $invoice : $form->{arap};
- $ref->{exchangerate} = 1 unless $ref->{exchangerate};
- push @{ $form->{AG} }, $ref;
- }
-
- $sth->finish;
-
- }
-
- $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"}|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror;
-
- ($form->{$form->{ct}}, $form->{email}, $form->{cc}, $form->{bcc}) = $sth->fetchrow_array;
- $sth->finish;
- $dbh->disconnect;
-
-}
-
-
-sub get_taxaccounts {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- # get tax accounts
- my $query = qq|SELECT accno, description
- FROM chart
- WHERE link LIKE '%CT_tax%'
- ORDER BY accno|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror;
-
- while ( my ($accno, $description) = $sth->fetchrow_array ) {
- push @{ $form->{taxaccounts} }, "$accno--$description";
- }
- $sth->finish;
-
- # get gifi tax accounts
- my $query = qq|SELECT DISTINCT ON (g.accno) g.accno, g.description
- FROM gifi g, chart c
- WHERE g.accno = c.gifi_accno
- AND c.link LIKE '%CT_tax%'
- ORDER BY accno|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror;
-
- while ( my ($accno, $description) = $sth->fetchrow_array ) {
- push @{ $form->{gifi_taxaccounts} }, "$accno--$description";
- }
- $sth->finish;
-
- $dbh->disconnect;
-
-}
-
-
-
-sub tax_report {
- my ($self, $myconfig, $form) = @_;
-
- # connect to database
- my $dbh = $form->dbconnect($myconfig);
-
- # build WHERE
- my $where = qq|WHERE ac.trans_id = a.id
- AND ac.chart_id = ch.id|;
-
-
- if ($form->{accno} =~ /^gifi_/) {
- my ($null, $accno) = split /_/, $form->{accno};
- $where .= qq| AND ch.gifi_accno = '$accno'|;
- } else {
- $where .= qq| AND ch.accno = '$form->{accno}'|;
- }
-
- my $table;
-
- if ($form->{db} eq 'ar') {
- $where .= " AND n.id = a.customer_id";
- $table = "customer";
- }
- if ($form->{db} eq 'ap') {
- $where .= " AND n.id = a.vendor_id";
- $table = "vendor";
- }
-
- my $transdate = ($form->{cashbased}) ? "a.datepaid" : "ac.transdate";
- if ($form->{cashbased}) {
- $where .= " AND a.amount = a.paid";
- }
-
- # 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}'";
- }
- }
-
- my $query = qq|SELECT a.id, a.invoice, $transdate AS transdate, a.invnumber,
- n.name, a.netamount,|;
- my $sortorder = join ', ', $form->sort_columns(qw(transdate invnumber name));
- $sortorder = $form->{sort} unless $sortorder;
-
- if ($form->{db} eq 'ar') {
- $query .= " ac.amount AS tax";
- }
- if ($form->{db} eq 'ap') {
- $query .= " ac.amount * -1 AS tax";
- }
-
- $query .= qq|
- FROM acc_trans ac, "$form->{db}" a, "$table" n, chart ch
- $where
- ORDER by $sortorder|;
-
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while ( my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{TR} }, $ref;
- }
-
- $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};
- $arap .= "_paid";
-
- # get A(R|P)_paid accounts
- my $query = qq|SELECT accno, description
- FROM chart
- WHERE link LIKE '%$arap%'|;
- my $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
- push @{ $form->{PR} }, $ref;
- }
-
- $sth->finish;
- $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, $sth);
-
- # 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, a.invnumber, a.ordnumber,
- ac.transdate,
- ac.amount * $ml AS paid, ac.source, a.invoice, a.id,
- '$form->{db}' AS module
- FROM $table c, acc_trans ac, $form->{db} a
- WHERE c.id = a.${table}_id
- AND ac.trans_id = a.id
- AND ac.chart_id = $ref->{id}|;
-
- $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate};
- $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate};
-
- $query .= qq|
- UNION
- SELECT g.description, g.reference, NULL AS ordnumber,
- ac.transdate,
- ac.amount * $ml AS paid, ac.source, '0' as invoice, g.id,
- 'gl' AS module
- FROM gl g, acc_trans ac
- WHERE g.id = ac.trans_id
- AND ac.chart_id = $ref->{id}
- AND (ac.amount * $ml) > 0
- |;
-
- $query .= " AND ac.transdate >= '$form->{fromdate}'" if $form->{fromdate};
- $query .= " AND ac.transdate <= '$form->{todate}'" if $form->{todate};
-
-
- my $sortorder = join ', ', $form->sort_columns(qw(name invnumber ordnumber transdate source));
-
- $query .= " 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 d9b463d6b..000000000
--- a/sql-ledger/SL/User.pm
+++ /dev/null
@@ -1,692 +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.
-#=====================================================================
-#
-# user related functions
-#
-#=====================================================================
-
-package User;
-
-
-sub new {
- my ($type, $memfile, $login) = @_;
- my $self = {};
-
- if ($login ne "") {
- # check if the file is locked
- &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) = @_;
-
-
- if ($self->{login}) {
-
- if ($self->{password}) {
- $form->{password} = crypt $form->{password}, substr($self->{login}, 0, 2);
- if ($self->{password} ne $form->{password}) {
- return -1;
- }
- }
-
- unless (-e "$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
- $query = qq|SELECT id FROM employee WHERE login = '$self->{login}'|;
- $sth = $dbh->prepare($query);
- $sth->execute;
-
- my ($login) = $sth->fetchrow_array;
- $sth->finish;
-
- if (!$login) {
- $query = qq|INSERT INTO employee (login, name, workphone)
- VALUES ('$self->{login}', '$myconfig{name}', '$myconfig{tel}')|;
- $dbh->do($query);
- }
- $dbh->disconnect;
-
- if ($form->{dbversion} ne $dbversion) {
- return -2;
- }
-
- } else {
- return -3;
- }
-
-}
-
-
-
-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} eq 'Pg') {
- $form->{dbconnect} = "dbi:Pg: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)$/ } @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;
- }
- }
-
- $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 $filename = qq|sql/$form->{dbdriver}-tables.sql|;
- $self->processquery($form, $dbh, $filename);
-
- # load gifi
- ($filename) = split /_/, $form->{chart};
- $filename =~ s/_//;
- $self->processquery($form, $dbh, "sql/${filename}-gifi.sql");
-
- # load chart of accounts
- $filename = qq|sql/$form->{chart}-chart.sql|;
- $self->processquery($form, $dbh, $filename);
-
- # create indices
- $filename = qq|sql/$form->{dbdriver}-indices.sql|;
- $self->processquery($form, $dbh, $filename);
-
- $dbh->disconnect;
-
-}
-
-
-
-sub processquery {
- my ($self, $form, $dbh, $filename) = @_;
-
- return unless (-f $filename);
-
- open(FH, "$filename") or $form->error("$filename : $!\n");
- my $query = "";
-
- while (<FH>) {
- $query .= $_;
-
- if (/;\s*$/) {
- # strip ;... Oracle doesn't like it
- $query =~ s/;\s*$//;
- $dbh->do($query) || $form->dberror($query);
- $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('File 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} eq '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;
- }
-
- $dbh->disconnect;
-
- %dbsources;
-
-}
-
-
-sub dbupdate {
- my ($self, $form) = @_;
-
- $form->{sid} = $form->{dbdefault};
-
- my @upgradescripts = ();
- my $query;
-
- if ($form->{dbupdate}) {
- # read update scripts into memory
- opendir SQLDIR, "sql/." or $form-error($!);
- @upgradescripts = sort 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;
-
- foreach my $upgradescript (@upgradescripts) {
- my $a = $upgradescript;
- $a =~ s/(^$form->{dbdriver}-upgrade-|\.sql$)//g;
-
- my ($mindb, $maxdb) = split /-/, $a;
-
- next if ($version ge $maxdb);
-
- # if there is no upgrade script exit
- last if ($version lt $mindb);
-
- # apply upgrade
- $self->processquery($form, $dbh, "sql/$upgradescript");
-
- $version = $maxdb;
-
- }
-
- $dbh->disconnect;
-
- }
-}
-
-
-
-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;
- print CONF qq| $key => '$self->{$key}',\n|;
- }
-
-
- print CONF qq|);\n\n|;
-
- close CONF;
-
-}
-
-
-sub save_member {
- my ($self, $memberfile, $userspath) = @_;
-
- my $newmember = 1;
-
- # format dbconnect and dboptions string
- map { $self->{$_} = lc $self->{$_} } qw(dbname host);
- &dbconnect_vars($self, $self->{dbname});
-
- $self->error('File locked!') if (-f "${memberfile}.LCK");
- open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
- close(FH);
-
- open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
-
- @config = <CONF>;
-
- seek(CONF, 0, 0);
- truncate(CONF, 0);
-
- while ($line = shift @config) {
- if ($line =~ /^\[$self->{login}\]/) {
- $newmember = 0;
- last;
- }
- 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->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember) && $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
- $self->{address} =~ s/\r\n/\\n/g if $self->{address};
- $self->{signature} =~ s/\r\n/\\n/g if $self->{signature};
-
- foreach $key (sort @config) {
- print CONF qq|$key=$self->{$key}\n|;
- }
-
- print CONF "\n";
- close CONF;
- unlink "${memberfile}.LCK";
-
- # create conf file
- $self->create_config("$userspath/$self->{login}.conf") unless $self->{'root login'};
-
-}
-
-
-sub config_vars {
-
- my @conf = qw(acs address admin businessnumber charset company countrycode
- currency dateformat dbconnect dbdriver dbhost dbport dboptions
- dbname dbuser dbpasswd email fax name numberformat password
- printer sid shippingpoint signature stylesheet tel templates
- vclimit);
-
- @conf;
-
-}
-
-
-sub error {
- my ($self, $msg) = @_;
-
- if ($ENV{HTTP_USER_AGENT}) {
- print qq|Content-Type: text/html
-
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
-
-<body bgcolor=ffffff>
-
-<h2><font color=red>Error!</font></h2>
-<p><b>$msg</b>|;
-
- }
-
- die "Error: $msg\n";
-
-}
-
-
-1;
-
generated by cgit v1.2.1 (git 2.18.0) at 2025-10-31 05:16:20 +0000