kivitendo/SL/AM.pm @ de06210f
d319704a | Moritz Bunkus | #=====================================================================
|
||
# LX-Office ERP
|
||||
# Copyright (C) 2004
|
||||
# Based on SQL-Ledger Version 2.1.9
|
||||
# Web http://www.lx-office.org
|
||||
#
|
||||
#=====================================================================
|
||||
# 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;
|
||||
8c7e4493 | Moritz Bunkus | use Carp;
|
||
54e4131e | Moritz Bunkus | use Data::Dumper;
|
||
d05eb259 | Moritz Bunkus | use SL::DBUtils;
|
||
54e4131e | Moritz Bunkus | |||
d319704a | Moritz Bunkus | sub get_account {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
bd34eaea | Udo Spallek | my $query = qq{
|
||
SELECT c.accno, c.description, c.charttype, c.category,
|
||||
a3057d3f | Moritz Bunkus | c.link, c.pos_bilanz, c.pos_eur, c.new_chart_id, c.valid_from,
|
||
bd34eaea | Udo Spallek | c.pos_bwa, datevautomatik,
|
||
tk.taxkey_id, tk.pos_ustva, tk.tax_id,
|
||||
tk.tax_id || '--' || tk.taxkey_id AS tax, tk.startdate
|
||||
a3057d3f | Moritz Bunkus | FROM chart c
|
||
LEFT JOIN taxkeys tk
|
||||
ON (c.id=tk.chart_id AND tk.id =
|
||||
(SELECT id FROM taxkeys
|
||||
WHERE taxkeys.chart_id = c.id AND startdate <= current_date
|
||||
ORDER BY startdate DESC LIMIT 1))
|
||||
bd34eaea | Udo Spallek | WHERE c.id = ?
|
||
};
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | $main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||
d319704a | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
a00ef54b | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
d319704a | Moritz Bunkus | |||
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|;
|
||||
bd34eaea | Udo Spallek | $main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||
d319704a | Moritz Bunkus | $sth = $dbh->prepare($query);
|
||
$sth->execute || $form->dberror($query);
|
||||
$ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %ref;
|
||||
$sth->finish;
|
||||
bd34eaea | Udo Spallek | |||
d319704a | Moritz Bunkus | # get taxkeys and description
|
||
bd34eaea | Udo Spallek | $query = qq{
|
||
a3057d3f | Moritz Bunkus | SELECT
|
||
id,
|
||||
bd34eaea | Udo Spallek | (SELECT accno FROM chart WHERE id=tax.chart_id) AS chart_accno,
|
||
taxkey,
|
||||
a3057d3f | Moritz Bunkus | id||'--'||taxkey AS tax,
|
||
taxdescription,
|
||||
bd34eaea | Udo Spallek | rate
|
||
FROM tax ORDER BY taxkey
|
||||
};
|
||||
$main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||||
d319704a | Moritz Bunkus | $sth = $dbh->prepare($query);
|
||
$sth->execute || $form->dberror($query);
|
||||
d05eb259 | Moritz Bunkus | |||
bc6ceee1 | Philip Reetz | $form->{TAXKEY} = [];
|
||
d05eb259 | Moritz Bunkus | |||
d319704a | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
push @{ $form->{TAXKEY} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
54e4131e | Moritz Bunkus | if ($form->{id}) {
|
||
# get new accounts
|
||||
$query = qq|SELECT id, accno,description
|
||||
a3057d3f | Moritz Bunkus | FROM chart
|
||
WHERE link = ?
|
||||
bd34eaea | Udo Spallek | ORDER BY accno|;
|
||
$main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||||
54e4131e | Moritz Bunkus | $sth = $dbh->prepare($query);
|
||
a00ef54b | Moritz Bunkus | $sth->execute($form->{link}) || $form->dberror($query . " ($form->{link})");
|
||
d05eb259 | Moritz Bunkus | |||
a00ef54b | Moritz Bunkus | $form->{NEWACCOUNT} = [];
|
||
54e4131e | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
push @{ $form->{NEWACCOUNT} }, $ref;
|
||||
}
|
||||
d05eb259 | Moritz Bunkus | |||
54e4131e | Moritz Bunkus | $sth->finish;
|
||
bd34eaea | Udo Spallek | |||
# get the taxkeys of account
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | $query = qq{
|
||
SELECT
|
||||
tk.id,
|
||||
tk.chart_id,
|
||||
c.accno,
|
||||
tk.tax_id,
|
||||
t.taxdescription,
|
||||
t.rate,
|
||||
a3057d3f | Moritz Bunkus | tk.taxkey_id,
|
||
tk.pos_ustva,
|
||||
bd34eaea | Udo Spallek | tk.startdate
|
||
FROM taxkeys tk
|
||||
LEFT JOIN tax t ON (t.id = tk.tax_id)
|
||||
LEFT JOIN chart c ON (c.id = t.chart_id)
|
||||
WHERE tk.chart_id = ?
|
||||
a3057d3f | Moritz Bunkus | ORDER BY startdate DESC
|
||
bd34eaea | Udo Spallek | };
|
||
$main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||||
$sth = $dbh->prepare($query);
|
||||
$sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||||
$form->{ACCOUNT_TAXKEYS} = [];
|
||||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||||
push @{ $form->{ACCOUNT_TAXKEYS} }, $ref;
|
||||
}
|
||||
a3057d3f | Moritz Bunkus | $sth->finish;
|
||
bd34eaea | Udo Spallek | |||
54e4131e | Moritz Bunkus | }
|
||
d319704a | Moritz Bunkus | # check if we have any transactions
|
||
$query = qq|SELECT a.trans_id FROM acc_trans a
|
||||
a00ef54b | Moritz Bunkus | WHERE a.chart_id = ?|;
|
||
bd34eaea | Udo Spallek | $main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||
d319704a | Moritz Bunkus | $sth = $dbh->prepare($query);
|
||
a00ef54b | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
d319704a | Moritz Bunkus | |||
($form->{orphaned}) = $sth->fetchrow_array;
|
||||
$form->{orphaned} = !$form->{orphaned};
|
||||
$sth->finish;
|
||||
54e4131e | Moritz Bunkus | # check if new account is active
|
||
$form->{new_chart_valid} = 0;
|
||||
if ($form->{new_chart_id}) {
|
||||
$query = qq|SELECT current_date-valid_from FROM chart
|
||||
a00ef54b | Moritz Bunkus | WHERE id = ?|;
|
||
bd34eaea | Udo Spallek | $main::lxdebug->message(LXDebug::QUERY, "\$query=\n $query");
|
||
a00ef54b | Moritz Bunkus | my ($count) = selectrow_query($form, $dbh, $query, $form->{id});
|
||
54e4131e | Moritz Bunkus | if ($count >=0) {
|
||
$form->{new_chart_valid} = 1;
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
d319704a | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_account {
|
||||
$main::lxdebug->enter_sub();
|
||||
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 CT_tax);
|
||||
}
|
||||
$form->{link} = "";
|
||||
foreach my $item ($form->{AR}, $form->{AR_amount},
|
||||
$form->{AR_tax}, $form->{AR_paid},
|
||||
$form->{AP}, $form->{AP_amount},
|
||||
$form->{AP_tax}, $form->{AP_paid},
|
||||
$form->{IC}, $form->{IC_sale},
|
||||
$form->{IC_cogs}, $form->{IC_taxpart},
|
||||
$form->{IC_income}, $form->{IC_expense},
|
||||
$form->{IC_taxservice}, $form->{CT_tax}
|
||||
) {
|
||||
$form->{link} .= "${item}:" if ($item);
|
||||
}
|
||||
chop $form->{link};
|
||||
# strip blanks from accno
|
||||
map { $form->{$_} =~ s/ //g; } qw(accno);
|
||||
my ($query, $sth);
|
||||
if ($form->{id} eq "NULL") {
|
||||
$form->{id} = "";
|
||||
}
|
||||
a00ef54b | Moritz Bunkus | my @values;
|
||
88bc69df | Moritz Bunkus | if ($form->{id}) {
|
||
d319704a | Moritz Bunkus | $query = qq|UPDATE chart SET
|
||
a3057d3f | Moritz Bunkus | accno = ?,
|
||
description = ?,
|
||||
bd34eaea | Udo Spallek | charttype = ?,
|
||
a3057d3f | Moritz Bunkus | category = ?,
|
||
bd34eaea | Udo Spallek | link = ?,
|
||
a3057d3f | Moritz Bunkus | pos_bwa = ?,
|
||
bd34eaea | Udo Spallek | pos_bilanz = ?,
|
||
a3057d3f | Moritz Bunkus | pos_eur = ?,
|
||
new_chart_id = ?,
|
||||
bd34eaea | Udo Spallek | valid_from = ?,
|
||
datevautomatik = ?
|
||||
9d679693 | Moritz Bunkus | WHERE id = ?|;
|
||
a3057d3f | Moritz Bunkus | |||
@values = (
|
||||
$form->{accno},
|
||||
$form->{description},
|
||||
bd34eaea | Udo Spallek | $form->{charttype},
|
||
a3057d3f | Moritz Bunkus | $form->{category},
|
||
bd34eaea | Udo Spallek | $form->{link},
|
||
conv_i($form->{pos_bwa}),
|
||||
a3057d3f | Moritz Bunkus | conv_i($form->{pos_bilanz}),
|
||
bd34eaea | Udo Spallek | conv_i($form->{pos_eur}),
|
||
conv_i($form->{new_chart_id}),
|
||||
conv_date($form->{valid_from}),
|
||||
($form->{datevautomatik} eq 'T') ? 'true':'false',
|
||||
$form->{id},
|
||||
);
|
||||
a3057d3f | Moritz Bunkus | }
|
||
bd34eaea | Udo Spallek | elsif ($form->{id} && !$form->{new_chart_valid}) {
|
||
$query = qq|
|
||||
a3057d3f | Moritz Bunkus | UPDATE chart
|
||
SET new_chart_id = ?,
|
||||
bd34eaea | Udo Spallek | valid_from = ?
|
||
WHERE id = ?
|
||||
|;
|
||||
a3057d3f | Moritz Bunkus | |||
@values = (
|
||||
conv_i($form->{new_chart_id}),
|
||||
bd34eaea | Udo Spallek | conv_date($form->{valid_from}),
|
||
$form->{id}
|
||||
);
|
||||
a3057d3f | Moritz Bunkus | }
|
||
bd34eaea | Udo Spallek | else {
|
||
$query = qq|
|
||||
INSERT INTO chart (
|
||||
a3057d3f | Moritz Bunkus | accno,
|
||
description,
|
||||
bd34eaea | Udo Spallek | charttype,
|
||
a3057d3f | Moritz Bunkus | category,
|
||
bd34eaea | Udo Spallek | link,
|
||
a3057d3f | Moritz Bunkus | pos_bwa,
|
||
pos_bilanz,
|
||||
bd34eaea | Udo Spallek | pos_eur,
|
||
a3057d3f | Moritz Bunkus | new_chart_id,
|
||
bd34eaea | Udo Spallek | valid_from,
|
||
datevautomatik )
|
||||
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
|
||||
|;
|
||||
@values = (
|
||||
a3057d3f | Moritz Bunkus | $form->{accno},
|
||
$form->{description},
|
||||
bd34eaea | Udo Spallek | $form->{charttype},
|
||
$form->{category}, $form->{link},
|
||||
conv_i($form->{pos_bwa}),
|
||||
conv_i($form->{pos_bilanz}), conv_i($form->{pos_eur}),
|
||||
conv_i($form->{new_chart_id}),
|
||||
conv_date($form->{valid_from}),
|
||||
($form->{datevautomatik} eq 'T') ? 'true':'false',
|
||||
);
|
||||
a00ef54b | Moritz Bunkus | |||
d319704a | Moritz Bunkus | }
|
||
a3057d3f | Moritz Bunkus | |||
a00ef54b | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
d319704a | Moritz Bunkus | |||
bd34eaea | Udo Spallek | #Save Taxkeys
|
||
my @taxkeys = ();
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | my $MAX_TRIES = 10; # Maximum count of taxkeys in form
|
||
my $tk_count;
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | READTAXKEYS:
|
||
for $tk_count (0 .. $MAX_TRIES) {
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | # Loop control
|
||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | # Check if the account already exists, else cancel
|
||
last READTAXKEYS if ( $form->{'id'} == 0);
|
||||
# check if there is a startdate
|
||||
if ( $form->{"taxkey_startdate_$tk_count"} eq '' ) {
|
||||
$tk_count++;
|
||||
next READTAXKEYS;
|
||||
}
|
||||
a00ef54b | Moritz Bunkus | |||
bd34eaea | Udo Spallek | # Add valid taxkeys into the array
|
||
a3057d3f | Moritz Bunkus | push @taxkeys ,
|
||
bd34eaea | Udo Spallek | {
|
||
id => ($form->{"taxkey_id_$tk_count"} eq 'NEW') ? conv_i('') : conv_i($form->{"taxkey_id_$tk_count"}),
|
||||
tax_id => conv_i($form->{"taxkey_tax_$tk_count"}),
|
||||
startdate => conv_date($form->{"taxkey_startdate_$tk_count"}),
|
||||
chart_id => conv_i($form->{"id"}),
|
||||
468e86a6 | Moritz Bunkus | pos_ustva => conv_i($form->{"taxkey_pos_ustva_$tk_count"}),
|
||
bd34eaea | Udo Spallek | delete => ( $form->{"taxkey_del_$tk_count"} eq 'delete' ) ? '1' : '',
|
||
};
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | $tk_count++;
|
||
}
|
||||
TAXKEY:
|
||||
for my $j (0 .. $#taxkeys){
|
||||
if ( defined $taxkeys[$j]{'id'} ){
|
||||
# delete Taxkey?
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | if ($taxkeys[$j]{'delete'}){
|
||
$query = qq{
|
||||
DELETE FROM taxkeys WHERE id = ?
|
||||
};
|
||||
@values = ($taxkeys[$j]{'id'});
|
||||
do_query($form, $dbh, $query, @values);
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | next TAXKEY;
|
||
}
|
||||
# UPDATE Taxkey
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | $query = qq{
|
||
UPDATE taxkeys
|
||||
SET taxkey_id = (SELECT taxkey FROM tax WHERE tax.id = ?),
|
||||
chart_id = ?,
|
||||
tax_id = ?,
|
||||
pos_ustva = ?,
|
||||
startdate = ?
|
||||
WHERE id = ?
|
||||
a3057d3f | Moritz Bunkus | };
|
||
bd34eaea | Udo Spallek | @values = (
|
||
$taxkeys[$j]{'tax_id'},
|
||||
$taxkeys[$j]{'chart_id'},
|
||||
a3057d3f | Moritz Bunkus | $taxkeys[$j]{'tax_id'},
|
||
bd34eaea | Udo Spallek | $taxkeys[$j]{'pos_ustva'},
|
||
a3057d3f | Moritz Bunkus | $taxkeys[$j]{'startdate'},
|
||
$taxkeys[$j]{'id'},
|
||||
bd34eaea | Udo Spallek | );
|
||
do_query($form, $dbh, $query, @values);
|
||||
}
|
||||
else {
|
||||
# INSERT Taxkey
|
||||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | $query = qq{
|
||
INSERT INTO taxkeys (
|
||||
taxkey_id,
|
||||
chart_id,
|
||||
tax_id,
|
||||
pos_ustva,
|
||||
startdate
|
||||
)
|
||||
VALUES ((SELECT taxkey FROM tax WHERE tax.id = ?), ?, ?, ?, ?)
|
||||
a3057d3f | Moritz Bunkus | };
|
||
bd34eaea | Udo Spallek | @values = (
|
||
a3057d3f | Moritz Bunkus | $taxkeys[$j]{'tax_id'},
|
||
$taxkeys[$j]{'chart_id'},
|
||||
$taxkeys[$j]{'tax_id'},
|
||||
bd34eaea | Udo Spallek | $taxkeys[$j]{'pos_ustva'},
|
||
a3057d3f | Moritz Bunkus | $taxkeys[$j]{'startdate'},
|
||
bd34eaea | Udo Spallek | );
|
||
a3057d3f | Moritz Bunkus | |||
bd34eaea | Udo Spallek | do_query($form, $dbh, $query, @values);
|
||
}
|
||||
a3057d3f | Moritz Bunkus | |||
d319704a | Moritz Bunkus | }
|
||
# commit
|
||||
my $rc = $dbh->commit;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
return $rc;
|
||||
}
|
||||
sub delete_account {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database, turn off AutoCommit
|
||||
my $dbh = $form->dbconnect_noauto($myconfig);
|
||||
my $query = qq|SELECT count(*) FROM acc_trans a
|
||||
a00ef54b | Moritz Bunkus | WHERE a.chart_id = ?|;
|
||
my ($count) = selectrow_query($form, $dbh, $query, $form->{id});
|
||||
d319704a | Moritz Bunkus | |||
a00ef54b | Moritz Bunkus | if ($count) {
|
||
d319704a | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
return;
|
||||
}
|
||||
# set inventory_accno_id, income_accno_id, expense_accno_id to defaults
|
||||
a00ef54b | Moritz Bunkus | foreach my $type (qw(inventory income expense)) {
|
||
$query =
|
||||
qq|UPDATE parts | .
|
||||
qq|SET ${type}_accno_id = (SELECT ${type}_accno_id FROM defaults) | .
|
||||
qq|WHERE ${type}_accno_id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
}
|
||||
54e4131e | Moritz Bunkus | |||
foreach my $table (qw(partstax customertax vendortax tax)) {
|
||||
$query = qq|DELETE FROM $table
|
||||
a00ef54b | Moritz Bunkus | WHERE chart_id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
54e4131e | Moritz Bunkus | }
|
||
a00ef54b | Moritz Bunkus | # delete chart of account record
|
||
$query = qq|DELETE FROM chart
|
||||
WHERE id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
bd34eaea | Udo Spallek | # delete account taxkeys
|
||
$query = qq|DELETE FROM taxkeys
|
||||
WHERE chart_id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
54e4131e | Moritz Bunkus | # commit and redirect
|
||
my $rc = $dbh->commit;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
return $rc;
|
||||
}
|
||||
sub departments {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query = qq|SELECT d.id, d.description, d.role
|
||||
FROM department d
|
||||
9d679693 | Moritz Bunkus | ORDER BY 2|;
|
||
54e4131e | Moritz Bunkus | |||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
9d679693 | Moritz Bunkus | $form->{ALL} = [];
|
||
54e4131e | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
push @{ $form->{ALL} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_department {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query = qq|SELECT d.description, d.role
|
||||
FROM department d
|
||||
9d679693 | Moritz Bunkus | WHERE d.id = ?|;
|
||
54e4131e | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
9d679693 | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
54e4131e | Moritz Bunkus | |||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
# see if it is in use
|
||||
$query = qq|SELECT count(*) FROM dpt_trans d
|
||||
9d679693 | Moritz Bunkus | WHERE d.department_id = ?|;
|
||
($form->{orphaned}) = selectrow_query($form, $dbh, $query, $form->{id});
|
||||
54e4131e | Moritz Bunkus | |||
$form->{orphaned} = !$form->{orphaned};
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_department {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
9d679693 | Moritz Bunkus | my @values = ($form->{description}, $form->{role});
|
||
54e4131e | Moritz Bunkus | if ($form->{id}) {
|
||
$query = qq|UPDATE department SET
|
||||
9d679693 | Moritz Bunkus | description = ?, role = ?
|
||
WHERE id = ?|;
|
||||
push(@values, $form->{id});
|
||||
54e4131e | Moritz Bunkus | } else {
|
||
$query = qq|INSERT INTO department
|
||||
(description, role)
|
||||
9d679693 | Moritz Bunkus | VALUES (?, ?)|;
|
||
54e4131e | Moritz Bunkus | }
|
||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
54e4131e | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_department {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
$query = qq|DELETE FROM department
|
||||
9d679693 | Moritz Bunkus | WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
54e4131e | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
501107ad | Holger Lindemann | sub lead {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query = qq|SELECT id, lead
|
||||
FROM leads
|
||||
9d679693 | Moritz Bunkus | ORDER BY 2|;
|
||
501107ad | Holger Lindemann | |||
$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;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_lead {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query =
|
||||
9d679693 | Moritz Bunkus | qq|SELECT l.id, l.lead | .
|
||
qq|FROM leads l | .
|
||||
qq|WHERE l.id = ?|;
|
||||
501107ad | Holger Lindemann | my $sth = $dbh->prepare($query);
|
||
9d679693 | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
501107ad | Holger Lindemann | |||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_lead {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
9d679693 | Moritz Bunkus | my @values = ($form->{description});
|
||
501107ad | Holger Lindemann | # id is the old record
|
||
if ($form->{id}) {
|
||||
$query = qq|UPDATE leads SET
|
||||
9d679693 | Moritz Bunkus | lead = ?
|
||
WHERE id = ?|;
|
||||
puhs(@values, $form->{id});
|
||||
501107ad | Holger Lindemann | } else {
|
||
$query = qq|INSERT INTO leads
|
||||
(lead)
|
||||
9d679693 | Moritz Bunkus | VALUES (?)|;
|
||
501107ad | Holger Lindemann | }
|
||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
501107ad | Holger Lindemann | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_lead {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
$query = qq|DELETE FROM leads
|
||||
9d679693 | Moritz Bunkus | WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
501107ad | Holger Lindemann | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub business {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
0acf0e35 | Moritz Bunkus | my $query = qq|SELECT id, description, discount, customernumberinit
|
||
54e4131e | Moritz Bunkus | FROM business
|
||
9d679693 | Moritz Bunkus | ORDER BY 2|;
|
||
54e4131e | Moritz Bunkus | |||
$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;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_business {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query =
|
||||
0acf0e35 | Moritz Bunkus | qq|SELECT b.description, b.discount, b.customernumberinit
|
||
9d679693 | Moritz Bunkus | FROM business b
|
||
WHERE b.id = ?|;
|
||||
54e4131e | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
9d679693 | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
54e4131e | Moritz Bunkus | |||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_business {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
9d679693 | Moritz Bunkus | my @values = ($form->{description}, $form->{discount},
|
||
0acf0e35 | Moritz Bunkus | $form->{customernumberinit});
|
||
54e4131e | Moritz Bunkus | # id is the old record
|
||
if ($form->{id}) {
|
||||
$query = qq|UPDATE business SET
|
||||
9d679693 | Moritz Bunkus | description = ?,
|
||
discount = ?,
|
||||
0acf0e35 | Moritz Bunkus | customernumberinit = ?
|
||
9d679693 | Moritz Bunkus | WHERE id = ?|;
|
||
push(@values, $form->{id});
|
||||
54e4131e | Moritz Bunkus | } else {
|
||
$query = qq|INSERT INTO business
|
||||
0acf0e35 | Moritz Bunkus | (description, discount, customernumberinit)
|
||
VALUES (?, ?, ?)|;
|
||||
54e4131e | Moritz Bunkus | }
|
||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
54e4131e | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_business {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
$query = qq|DELETE FROM business
|
||||
9d679693 | Moritz Bunkus | WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
54e4131e | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub language {
|
||||
$main::lxdebug->enter_sub();
|
||||
af853490 | Moritz Bunkus | my ($self, $myconfig, $form, $return_list) = @_;
|
||
54e4131e | Moritz Bunkus | |||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
08882e8c | Moritz Bunkus | my $query =
|
||
"SELECT id, description, template_code, article_code, " .
|
||||
" output_numberformat, output_dateformat, output_longdates " .
|
||||
"FROM language ORDER BY description";
|
||||
54e4131e | Moritz Bunkus | |||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
af853490 | Moritz Bunkus | my $ary = [];
|
||
54e4131e | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
af853490 | Moritz Bunkus | push(@{ $ary }, $ref);
|
||
54e4131e | Moritz Bunkus | }
|
||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
af853490 | Moritz Bunkus | |||
if ($return_list) {
|
||||
return @{$ary};
|
||||
} else {
|
||||
$form->{ALL} = $ary;
|
||||
}
|
||||
54e4131e | Moritz Bunkus | }
|
||
sub get_language {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query =
|
||||
08882e8c | Moritz Bunkus | "SELECT description, template_code, article_code, " .
|
||
" output_numberformat, output_dateformat, output_longdates " .
|
||||
"FROM language WHERE id = ?";
|
||||
54e4131e | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
08882e8c | Moritz Bunkus | $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
|
||
54e4131e | Moritz Bunkus | |||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
08882e8c | Moritz Bunkus | sub get_language_details {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $id) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query =
|
||||
"SELECT template_code, " .
|
||||
" output_numberformat, output_dateformat, output_longdates " .
|
||||
"FROM language WHERE id = ?";
|
||||
9d679693 | Moritz Bunkus | my @res = selectrow_query($form, $dbh, $query, $id);
|
||
08882e8c | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
return @res;
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub save_language {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
08882e8c | Moritz Bunkus | my (@values, $query);
|
||
54e4131e | Moritz Bunkus | |||
08882e8c | Moritz Bunkus | map({ push(@values, $form->{$_}); }
|
||
qw(description template_code article_code
|
||||
output_numberformat output_dateformat output_longdates));
|
||||
54e4131e | Moritz Bunkus | |||
# id is the old record
|
||||
if ($form->{id}) {
|
||||
08882e8c | Moritz Bunkus | $query =
|
||
"UPDATE language SET " .
|
||||
" description = ?, template_code = ?, article_code = ?, " .
|
||||
" output_numberformat = ?, output_dateformat = ?, " .
|
||||
" output_longdates = ? " .
|
||||
"WHERE id = ?";
|
||||
push(@values, $form->{id});
|
||||
54e4131e | Moritz Bunkus | } else {
|
||
08882e8c | Moritz Bunkus | $query =
|
||
"INSERT INTO language (" .
|
||||
" description, template_code, article_code, " .
|
||||
" output_numberformat, output_dateformat, output_longdates" .
|
||||
") VALUES (?, ?, ?, ?, ?, ?)";
|
||||
54e4131e | Moritz Bunkus | }
|
||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
54e4131e | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_language {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
32d33e11 | Moritz Bunkus | my $dbh = $form->dbconnect_noauto($myconfig);
|
||
dcef6ec7 | Moritz Bunkus | foreach my $table (qw(translation_payment_terms units_language)) {
|
||
my $query = qq|DELETE FROM $table WHERE language_id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{"id"});
|
||||
}
|
||||
54e4131e | Moritz Bunkus | |||
32d33e11 | Moritz Bunkus | $query = "DELETE FROM language WHERE id = ?";
|
||
dcef6ec7 | Moritz Bunkus | do_query($form, $dbh, $query, $form->{"id"});
|
||
d319704a | Moritz Bunkus | |||
32d33e11 | Moritz Bunkus | $dbh->commit();
|
||
d319704a | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | |||
sub buchungsgruppe {
|
||||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
88153712 | Moritz Bunkus | my $query = qq|SELECT id, description,
|
||
inventory_accno_id,
|
||||
(SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
|
||||
income_accno_id_0,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
|
||||
expense_accno_id_0,
|
||||
(SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
|
||||
income_accno_id_1,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
|
||||
expense_accno_id_1,
|
||||
(SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
|
||||
income_accno_id_2,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
|
||||
expense_accno_id_2,
|
||||
(select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
|
||||
income_accno_id_3,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
|
||||
expense_accno_id_3,
|
||||
(SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
|
||||
FROM buchungsgruppen
|
||||
c98a426e | Moritz Bunkus | ORDER BY sortkey|;
|
||
d319704a | Moritz Bunkus | |||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
88153712 | Moritz Bunkus | $form->{ALL} = [];
|
||
d319704a | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
push @{ $form->{ALL} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub get_buchungsgruppe {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
29795499 | Sven Schöling | my $query;
|
||
d319704a | Moritz Bunkus | |||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
54e4131e | Moritz Bunkus | if ($form->{id}) {
|
||
29795499 | Sven Schöling | $query =
|
||
d05eb259 | Moritz Bunkus | qq|SELECT description, inventory_accno_id,
|
||
(SELECT accno FROM chart WHERE id = inventory_accno_id) AS inventory_accno,
|
||||
income_accno_id_0,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_0) AS income_accno_0,
|
||||
expense_accno_id_0,
|
||||
(SELECT accno FROM chart WHERE id = expense_accno_id_0) AS expense_accno_0,
|
||||
income_accno_id_1,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_1) AS income_accno_1,
|
||||
expense_accno_id_1,
|
||||
(SELECT accno FROM chart WHERE id = expense_accno_id_1) AS expense_accno_1,
|
||||
income_accno_id_2,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_2) AS income_accno_2,
|
||||
expense_accno_id_2,
|
||||
(select accno FROM chart WHERE id = expense_accno_id_2) AS expense_accno_2,
|
||||
income_accno_id_3,
|
||||
(SELECT accno FROM chart WHERE id = income_accno_id_3) AS income_accno_3,
|
||||
expense_accno_id_3,
|
||||
(SELECT accno FROM chart WHERE id = expense_accno_id_3) AS expense_accno_3
|
||||
FROM buchungsgruppen
|
||||
WHERE id = ?|;
|
||||
54e4131e | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
d05eb259 | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
54e4131e | Moritz Bunkus | my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||
d05eb259 | Moritz Bunkus | |||
54e4131e | Moritz Bunkus | map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||
d05eb259 | Moritz Bunkus | |||
54e4131e | Moritz Bunkus | $sth->finish;
|
||
d319704a | Moritz Bunkus | |||
29795499 | Sven Schöling | $query =
|
||
d05eb259 | Moritz Bunkus | qq|SELECT count(id) = 0 AS orphaned
|
||
FROM parts
|
||||
WHERE buchungsgruppen_id = ?|;
|
||||
be47ce7f | Moritz Bunkus | ($form->{orphaned}) = selectrow_query($form, $dbh, $query, $form->{id});
|
||
54e4131e | Moritz Bunkus | }
|
||
1beff66b | Moritz Bunkus | |||
62f99e30 | Moritz Bunkus | $query = "SELECT inventory_accno_id, income_accno_id, expense_accno_id ".
|
||
"FROM defaults";
|
||||
($form->{"std_inventory_accno_id"}, $form->{"std_income_accno_id"},
|
||||
be47ce7f | Moritz Bunkus | $form->{"std_expense_accno_id"}) = selectrow_query($form, $dbh, $query);
|
||
1beff66b | Moritz Bunkus | |||
54e4131e | Moritz Bunkus | my $module = "IC";
|
||
$query = qq|SELECT c.accno, c.description, c.link, c.id,
|
||||
d.inventory_accno_id, d.income_accno_id, d.expense_accno_id
|
||||
FROM chart c, defaults d
|
||||
WHERE c.link LIKE '%$module%'
|
||||
ORDER BY c.accno|;
|
||||
d319704a | Moritz Bunkus | |||
54e4131e | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
d319704a | Moritz Bunkus | $sth->execute || $form->dberror($query);
|
||
54e4131e | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
b65d3ea9 | Moritz Bunkus | foreach my $key (split(/:/, $ref->{link})) {
|
||
1beff66b | Moritz Bunkus | if (!$form->{"std_inventory_accno_id"} && ($key eq "IC")) {
|
||
$form->{"std_inventory_accno_id"} = $ref->{"id"};
|
||||
}
|
||||
54e4131e | Moritz Bunkus | if ($key =~ /$module/) {
|
||
if ( ($ref->{id} eq $ref->{inventory_accno_id})
|
||||
|| ($ref->{id} eq $ref->{income_accno_id})
|
||||
|| ($ref->{id} eq $ref->{expense_accno_id})) {
|
||||
push @{ $form->{"${module}_links"}{$key} },
|
||||
{ accno => $ref->{accno},
|
||||
description => $ref->{description},
|
||||
selected => "selected",
|
||||
id => $ref->{id} };
|
||||
a36907a0 | Moritz Bunkus | } else {
|
||
54e4131e | Moritz Bunkus | push @{ $form->{"${module}_links"}{$key} },
|
||
{ accno => $ref->{accno},
|
||||
description => $ref->{description},
|
||||
selected => "",
|
||||
id => $ref->{id} };
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
d319704a | Moritz Bunkus | $sth->finish;
|
||
54e4131e | Moritz Bunkus | |||
d319704a | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub save_buchungsgruppe {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
d05eb259 | Moritz Bunkus | my @values = ($form->{description}, $form->{inventory_accno_id},
|
||
$form->{income_accno_id_0}, $form->{expense_accno_id_0},
|
||||
$form->{income_accno_id_1}, $form->{expense_accno_id_1},
|
||||
$form->{income_accno_id_2}, $form->{expense_accno_id_2},
|
||||
$form->{income_accno_id_3}, $form->{expense_accno_id_3});
|
||||
54e4131e | Moritz Bunkus | |||
c98a426e | Moritz Bunkus | my $query;
|
||
54e4131e | Moritz Bunkus | # id is the old record
|
||
d319704a | Moritz Bunkus | if ($form->{id}) {
|
||
54e4131e | Moritz Bunkus | $query = qq|UPDATE buchungsgruppen SET
|
||
d05eb259 | Moritz Bunkus | description = ?, inventory_accno_id = ?,
|
||
income_accno_id_0 = ?, expense_accno_id_0 = ?,
|
||||
income_accno_id_1 = ?, expense_accno_id_1 = ?,
|
||||
income_accno_id_2 = ?, expense_accno_id_2 = ?,
|
||||
income_accno_id_3 = ?, expense_accno_id_3 = ?
|
||||
WHERE id = ?|;
|
||||
push(@values, $form->{id});
|
||||
d319704a | Moritz Bunkus | } else {
|
||
c9928d5d | Moritz Bunkus | $query = qq|SELECT COALESCE(MAX(sortkey) + 1, 1) FROM buchungsgruppen|;
|
||
c98a426e | Moritz Bunkus | my ($sortkey) = $dbh->selectrow_array($query);
|
||
$form->dberror($query) if ($dbh->err);
|
||||
push(@values, $sortkey);
|
||||
54e4131e | Moritz Bunkus | $query = qq|INSERT INTO buchungsgruppen
|
||
d05eb259 | Moritz Bunkus | (description, inventory_accno_id,
|
||
income_accno_id_0, expense_accno_id_0,
|
||||
income_accno_id_1, expense_accno_id_1,
|
||||
income_accno_id_2, expense_accno_id_2,
|
||||
c98a426e | Moritz Bunkus | income_accno_id_3, expense_accno_id_3,
|
||
sortkey)
|
||||
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
|
||||
d319704a | Moritz Bunkus | }
|
||
d05eb259 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
d319704a | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub delete_buchungsgruppe {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
d05eb259 | Moritz Bunkus | $query = qq|DELETE FROM buchungsgruppen WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
d319704a | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
652397fc | Moritz Bunkus | sub swap_sortkeys {
|
||
c98a426e | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
652397fc | Moritz Bunkus | my ($self, $myconfig, $form, $table) = @_;
|
||
c98a426e | Moritz Bunkus | |||
# connect to database
|
||||
6e7e76c8 | Moritz Bunkus | my $dbh = $form->get_standard_dbh($myconfig);
|
||
c98a426e | Moritz Bunkus | |||
my $query =
|
||||
qq|SELECT
|
||||
652397fc | Moritz Bunkus | (SELECT sortkey FROM $table WHERE id = ?) AS sortkey1,
|
||
(SELECT sortkey FROM $table WHERE id = ?) AS sortkey2|;
|
||||
6e7e76c8 | Moritz Bunkus | my @values = ($form->{"id1"}, $form->{"id2"});
|
||
c98a426e | Moritz Bunkus | my @sortkeys = selectrow_query($form, $dbh, $query, @values);
|
||
6e7e76c8 | Moritz Bunkus | $query = qq|UPDATE $table SET sortkey = ? WHERE id = ?|;
|
||
my $sth = prepare_query($form, $dbh, $query);
|
||||
do_statement($form, $sth, $query, $sortkeys[1], $form->{"id1"});
|
||||
do_statement($form, $sth, $query, $sortkeys[0], $form->{"id2"});
|
||||
c98a426e | Moritz Bunkus | $sth->finish();
|
||
$dbh->commit();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub printer {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
54e4131e | Moritz Bunkus | my $query = qq|SELECT id, printer_description, template_code, printer_command
|
||
FROM printers
|
||||
9d679693 | Moritz Bunkus | ORDER BY 2|;
|
||
d319704a | Moritz Bunkus | |||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
9e89e92f | Moritz Bunkus | $form->{"ALL"} = [];
|
||
d319704a | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
push @{ $form->{ALL} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub get_printer {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
54e4131e | Moritz Bunkus | my $query =
|
||
qq|SELECT p.printer_description, p.template_code, p.printer_command
|
||||
9d679693 | Moritz Bunkus | FROM printers p
|
||
WHERE p.id = ?|;
|
||||
d319704a | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
9d679693 | Moritz Bunkus | $sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||
d319704a | Moritz Bunkus | |||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub save_printer {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
9d679693 | Moritz Bunkus | my @values = ($form->{printer_description},
|
||
$form->{template_code},
|
||||
$form->{printer_command});
|
||||
d319704a | Moritz Bunkus | |||
54e4131e | Moritz Bunkus | # id is the old record
|
||
d319704a | Moritz Bunkus | if ($form->{id}) {
|
||
54e4131e | Moritz Bunkus | $query = qq|UPDATE printers SET
|
||
9d679693 | Moritz Bunkus | printer_description = ?, template_code = ?, printer_command = ?
|
||
WHERE id = ?|;
|
||||
push(@values, $form->{id});
|
||||
d319704a | Moritz Bunkus | } else {
|
||
54e4131e | Moritz Bunkus | $query = qq|INSERT INTO printers
|
||
(printer_description, template_code, printer_command)
|
||||
9d679693 | Moritz Bunkus | VALUES (?, ?, ?)|;
|
||
d319704a | Moritz Bunkus | }
|
||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
d319704a | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub delete_printer {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
54e4131e | Moritz Bunkus | $query = qq|DELETE FROM printers
|
||
9d679693 | Moritz Bunkus | WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
d319704a | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub payment {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
828bd683 | Moritz Bunkus | my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
|
||
d319704a | Moritz Bunkus | |||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
828bd683 | Moritz Bunkus | $form->{ALL} = [];
|
||
d05eb259 | Moritz Bunkus | while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||
d319704a | Moritz Bunkus | push @{ $form->{ALL} }, $ref;
|
||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub get_payment {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
828bd683 | Moritz Bunkus | my $query = qq|SELECT * FROM payment_terms WHERE id = ?|;
|
||
d319704a | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
828bd683 | Moritz Bunkus | $sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
|
||
d319704a | Moritz Bunkus | |||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
dcef6ec7 | Moritz Bunkus | $sth->finish();
|
||
$query =
|
||||
qq|SELECT t.language_id, t.description_long, l.description AS language | .
|
||||
qq|FROM translation_payment_terms t | .
|
||||
qq|LEFT JOIN language l ON t.language_id = l.id | .
|
||||
qq|WHERE t.payment_terms_id = ? | .
|
||||
qq|UNION | .
|
||||
qq|SELECT l.id AS language_id, NULL AS description_long, | .
|
||||
9d679693 | Moritz Bunkus | qq| l.description AS language | .
|
||
dcef6ec7 | Moritz Bunkus | qq|FROM language l|;
|
||
$sth = $dbh->prepare($query);
|
||||
$sth->execute($form->{"id"}) || $form->dberror($query . " ($form->{id})");
|
||||
d319704a | Moritz Bunkus | |||
dcef6ec7 | Moritz Bunkus | my %mapping;
|
||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||||
$mapping{ $ref->{"language_id"} } = $ref
|
||||
unless (defined($mapping{ $ref->{"language_id"} }));
|
||||
}
|
||||
d319704a | Moritz Bunkus | $sth->finish;
|
||
dcef6ec7 | Moritz Bunkus | $form->{"TRANSLATION"} = [sort({ $a->{"language"} cmp $b->{"language"} }
|
||
values(%mapping))];
|
||||
d319704a | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub save_payment {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
dcef6ec7 | Moritz Bunkus | my $dbh = $form->dbconnect_noauto($myconfig);
|
||
d319704a | Moritz Bunkus | |||
dcef6ec7 | Moritz Bunkus | my $query;
|
||
if (!$form->{id}) {
|
||||
c9928d5d | Moritz Bunkus | $query = qq|SELECT nextval('id'), COALESCE(MAX(sortkey) + 1, 1) | .
|
||
qq|FROM payment_terms|;
|
||||
dcef6ec7 | Moritz Bunkus | my $sortkey;
|
||
($form->{id}, $sortkey) = selectrow_query($form, $dbh, $query);
|
||||
$query = qq|INSERT INTO payment_terms (id, sortkey) VALUES (?, ?)|;
|
||||
do_query($form, $dbh, $query, $form->{id}, $sortkey);
|
||||
} else {
|
||||
$query =
|
||||
qq|DELETE FROM translation_payment_terms | .
|
||||
qq|WHERE payment_terms_id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{"id"});
|
||||
}
|
||||
$query = qq|UPDATE payment_terms SET
|
||||
description = ?, description_long = ?,
|
||||
terms_netto = ?, terms_skonto = ?,
|
||||
percent_skonto = ?
|
||||
WHERE id = ?|;
|
||||
828bd683 | Moritz Bunkus | my @values = ($form->{description}, $form->{description_long},
|
||
$form->{terms_netto} * 1, $form->{terms_skonto} * 1,
|
||||
dcef6ec7 | Moritz Bunkus | $form->{percent_skonto} * 1,
|
||
$form->{id});
|
||||
do_query($form, $dbh, $query, @values);
|
||||
d319704a | Moritz Bunkus | |||
dcef6ec7 | Moritz Bunkus | $query = qq|SELECT id FROM language|;
|
||
my @language_ids;
|
||||
my $sth = $dbh->prepare($query);
|
||||
$sth->execute() || $form->dberror($query);
|
||||
while (my ($id) = $sth->fetchrow_array()) {
|
||||
push(@language_ids, $id);
|
||||
d319704a | Moritz Bunkus | }
|
||
dcef6ec7 | Moritz Bunkus | $sth->finish();
|
||
d319704a | Moritz Bunkus | |||
dcef6ec7 | Moritz Bunkus | $query =
|
||
qq|INSERT INTO translation_payment_terms | .
|
||||
qq|(language_id, payment_terms_id, description_long) | .
|
||||
qq|VALUES (?, ?, ?)|;
|
||||
$sth = $dbh->prepare($query);
|
||||
foreach my $language_id (@language_ids) {
|
||||
do_statement($form, $sth, $query, $language_id, $form->{"id"},
|
||||
$form->{"description_long_${language_id}"});
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->commit();
|
||||
d319704a | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub delete_payment {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
dcef6ec7 | Moritz Bunkus | my $dbh = $form->dbconnect_noauto($myconfig);
|
||
d319704a | Moritz Bunkus | |||
deb816a5 | Moritz Bunkus | my $query =
|
||
qq|DELETE FROM translation_payment_terms WHERE payment_terms_id = ?|;
|
||||
828bd683 | Moritz Bunkus | do_query($form, $dbh, $query, $form->{"id"});
|
||
d319704a | Moritz Bunkus | |||
deb816a5 | Moritz Bunkus | $query = qq|DELETE FROM payment_terms WHERE id = ?|;
|
||
dcef6ec7 | Moritz Bunkus | do_query($form, $dbh, $query, $form->{"id"});
|
||
$dbh->commit();
|
||||
d319704a | Moritz Bunkus | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
b12e8d14 | Moritz Bunkus | |||
sub prepare_template_filename {
|
||||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
b12e8d14 | Moritz Bunkus | my ($self, $myconfig, $form) = @_;
|
||
my ($filename, $display_filename);
|
||||
if ($form->{type} eq "stylesheet") {
|
||||
$filename = "css/$myconfig->{stylesheet}";
|
||||
$display_filename = $myconfig->{stylesheet};
|
||||
} else {
|
||||
$filename = $form->{formname};
|
||||
if ($form->{language}) {
|
||||
my ($id, $template_code) = split(/--/, $form->{language});
|
||||
$filename .= "_${template_code}";
|
||||
}
|
||||
d319704a | Moritz Bunkus | |||
b12e8d14 | Moritz Bunkus | if ($form->{printer}) {
|
||
my ($id, $template_code) = split(/--/, $form->{printer});
|
||||
$filename .= "_${template_code}";
|
||||
}
|
||||
d319704a | Moritz Bunkus | |||
b12e8d14 | Moritz Bunkus | $filename .= "." . ($form->{format} eq "html" ? "html" : "tex");
|
||
$filename =~ s|.*/||;
|
||||
$display_filename = $filename;
|
||||
$filename = "$myconfig->{templates}/$filename";
|
||||
d319704a | Moritz Bunkus | }
|
||
b12e8d14 | Moritz Bunkus | $main::lxdebug->leave_sub();
|
||
return ($filename, $display_filename);
|
||||
}
|
||||
sub load_template {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $filename) = @_;
|
||||
my ($content, $lines) = ("", 0);
|
||||
local *TEMPLATE;
|
||||
if (open(TEMPLATE, $filename)) {
|
||||
while (<TEMPLATE>) {
|
||||
$content .= $_;
|
||||
$lines++;
|
||||
}
|
||||
close(TEMPLATE);
|
||||
}
|
||||
d319704a | Moritz Bunkus | |||
$main::lxdebug->leave_sub();
|
||||
b12e8d14 | Moritz Bunkus | |||
return ($content, $lines);
|
||||
d319704a | Moritz Bunkus | }
|
||
sub save_template {
|
||||
$main::lxdebug->enter_sub();
|
||||
b12e8d14 | Moritz Bunkus | my ($self, $filename, $content) = @_;
|
||
d319704a | Moritz Bunkus | |||
b12e8d14 | Moritz Bunkus | local *TEMPLATE;
|
||
d319704a | Moritz Bunkus | |||
b12e8d14 | Moritz Bunkus | my $error = "";
|
||
d319704a | Moritz Bunkus | |||
b12e8d14 | Moritz Bunkus | if (open(TEMPLATE, ">$filename")) {
|
||
$content =~ s/\r\n/\n/g;
|
||||
print(TEMPLATE $content);
|
||||
close(TEMPLATE);
|
||||
} else {
|
||||
$error = $!;
|
||||
}
|
||||
d319704a | Moritz Bunkus | |||
$main::lxdebug->leave_sub();
|
||||
b12e8d14 | Moritz Bunkus | |||
return $error;
|
||||
d319704a | Moritz Bunkus | }
|
||
e549422f | Moritz Bunkus | sub save_defaults {
|
||
d319704a | Moritz Bunkus | $main::lxdebug->enter_sub();
|
||
e549422f | Moritz Bunkus | my $self = shift;
|
||
my %params = @_;
|
||||
d319704a | Moritz Bunkus | |||
e549422f | Moritz Bunkus | my $myconfig = \%main::myconfig;
|
||
my $form = $main::form;
|
||||
d319704a | Moritz Bunkus | |||
e549422f | Moritz Bunkus | my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||
d319704a | Moritz Bunkus | |||
e549422f | Moritz Bunkus | my %accnos;
|
||
map { ($accnos{$_}) = split(m/--/, $form->{$_}) } qw(inventory_accno income_accno expense_accno fxgain_accno fxloss_accno);
|
||||
$form->{curr} =~ s/ //g;
|
||||
my @currencies = grep { $_ ne '' } split m/:/, $form->{curr};
|
||||
my $currency = join ':', @currencies;
|
||||
d319704a | Moritz Bunkus | |||
# these defaults are database wide
|
||||
e549422f | Moritz Bunkus | |||
9d679693 | Moritz Bunkus | my $query =
|
||
e549422f | Moritz Bunkus | qq|UPDATE defaults SET
|
||
inventory_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?),
|
||||
income_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?),
|
||||
expense_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?),
|
||||
fxgain_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?),
|
||||
fxloss_accno_id = (SELECT c.id FROM chart c WHERE c.accno = ?),
|
||||
invnumber = ?,
|
||||
cnnumber = ?,
|
||||
sonumber = ?,
|
||||
ponumber = ?,
|
||||
sqnumber = ?,
|
||||
rfqnumber = ?,
|
||||
customernumber = ?,
|
||||
vendornumber = ?,
|
||||
articlenumber = ?,
|
||||
servicenumber = ?,
|
||||
yearend = ?,
|
||||
curr = ?,
|
||||
businessnumber = ?|;
|
||||
my @values = ($accnos{inventory_accno}, $accnos{income_accno}, $accnos{expense_accno},
|
||||
$accnos{fxgain_accno}, $accnos{fxloss_accno},
|
||||
$form->{invnumber}, $form->{cnnumber},
|
||||
$form->{sonumber}, $form->{ponumber},
|
||||
$form->{sqnumber}, $form->{rfqnumber},
|
||||
$form->{customernumber}, $form->{vendornumber},
|
||||
$form->{articlenumber}, $form->{servicenumber},
|
||||
$form->{yearend}, $currency,
|
||||
9d679693 | Moritz Bunkus | $form->{businessnumber});
|
||
do_query($form, $dbh, $query, @values);
|
||||
d319704a | Moritz Bunkus | |||
e549422f | Moritz Bunkus | $dbh->commit();
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_preferences {
|
||||
$main::lxdebug->enter_sub();
|
||||
8c7e4493 | Moritz Bunkus | my ($self, $myconfig, $form, $webdav) = @_;
|
||
e549422f | Moritz Bunkus | |||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my ($currency, $businessnumber) = selectrow_query($form, $dbh, qq|SELECT curr, businessnumber FROM defaults|);
|
||||
d319704a | Moritz Bunkus | # update name
|
||
e549422f | Moritz Bunkus | my $query = qq|UPDATE employee SET name = ? WHERE login = ?|;
|
||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, $form->{name}, $form->{login});
|
||
d319704a | Moritz Bunkus | |||
e549422f | Moritz Bunkus | my $rc = $dbh->commit();
|
||
d319704a | Moritz Bunkus | |||
# save first currency in myconfig
|
||||
e549422f | Moritz Bunkus | $currency =~ s/:.*//;
|
||
$form->{currency} = $currency;
|
||||
$form->{businessnumber} = $businessnumber;
|
||||
d319704a | Moritz Bunkus | |||
8c7e4493 | Moritz Bunkus | my $myconfig = new User($form->{login});
|
||
d319704a | Moritz Bunkus | |||
foreach my $item (keys %$form) {
|
||||
$myconfig->{$item} = $form->{$item};
|
||||
}
|
||||
8c7e4493 | Moritz Bunkus | $myconfig->save_member($memberfile);
|
||
my $auth = $main::auth;
|
||||
if ($auth->can_change_password()
|
||||
&& defined $form->{new_password}
|
||||
&& ($form->{new_password} ne '********')) {
|
||||
$auth->change_password($form->{login}, $form->{new_password});
|
||||
$form->{password} = $form->{new_password};
|
||||
$auth->set_session_value('password', $form->{password});
|
||||
$auth->create_or_refresh_session();
|
||||
}
|
||||
d319704a | Moritz Bunkus | |||
if ($webdav) {
|
||||
@webdavdirs =
|
||||
qw(angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen);
|
||||
foreach $directory (@webdavdirs) {
|
||||
$file = "webdav/" . $directory . "/webdav-user";
|
||||
if ($myconfig->{$directory}) {
|
||||
open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
|
||||
while (<HTACCESS>) {
|
||||
($login, $password) = split(/:/, $_);
|
||||
if ($login ne $form->{login}) {
|
||||
$newfile .= $_;
|
||||
}
|
||||
}
|
||||
close(HTACCESS);
|
||||
open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
|
||||
$newfile .= $myconfig->{login} . ":" . $myconfig->{password} . "\n";
|
||||
print(HTACCESS $newfile);
|
||||
close(HTACCESS);
|
||||
} else {
|
||||
$form->{$directory} = 0;
|
||||
open(HTACCESS, "$file") or die "cannot open webdav-user $!\n";
|
||||
while (<HTACCESS>) {
|
||||
($login, $password) = split(/:/, $_);
|
||||
if ($login ne $form->{login}) {
|
||||
$newfile .= $_;
|
||||
}
|
||||
}
|
||||
close(HTACCESS);
|
||||
open(HTACCESS, "> $file") or die "cannot open webdav-user $!\n";
|
||||
print(HTACCESS $newfile);
|
||||
close(HTACCESS);
|
||||
}
|
||||
}
|
||||
}
|
||||
$main::lxdebug->leave_sub();
|
||||
return $rc;
|
||||
}
|
||||
sub defaultaccounts {
|
||||
$main::lxdebug->enter_sub();
|
||||
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 c.id, c.accno, c.description, c.link
|
||||
FROM chart c
|
||||
WHERE c.link LIKE '%IC%'
|
||||
ORDER BY c.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 c.id, c.accno, c.description
|
||||
FROM chart c
|
||||
9d679693 | Moritz Bunkus | WHERE c.category = 'I'
|
||
AND c.charttype = 'A'
|
||||
d319704a | Moritz Bunkus | ORDER BY c.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 c.id, c.accno, c.description
|
||||
FROM chart c
|
||||
9d679693 | Moritz Bunkus | WHERE c.category = 'E'
|
||
AND c.charttype = 'A'
|
||||
d319704a | Moritz Bunkus | ORDER BY c.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 c.id, c.accno, c.description,
|
||||
t.rate * 100 AS rate, t.taxnumber
|
||||
FROM chart c, tax t
|
||||
9d679693 | Moritz Bunkus | WHERE c.id = t.chart_id|;
|
||
d319704a | Moritz Bunkus | |||
$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;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub closedto {
|
||||
$main::lxdebug->enter_sub();
|
||||
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;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub closebooks {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
9d679693 | Moritz Bunkus | my ($query, @values);
|
||
d319704a | Moritz Bunkus | if ($form->{revtrans}) {
|
||
9d679693 | Moritz Bunkus | $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '1'|;
|
||
d319704a | Moritz Bunkus | |||
a36907a0 | Moritz Bunkus | } elsif ($form->{closedto}) {
|
||
9d679693 | Moritz Bunkus | $query = qq|UPDATE defaults SET closedto = ?, revtrans = '0'|;
|
||
@values = (conv_date($form->{closedto}));
|
||||
d319704a | Moritz Bunkus | |||
a36907a0 | Moritz Bunkus | } else {
|
||
9d679693 | Moritz Bunkus | $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '0'|;
|
||
d319704a | Moritz Bunkus | }
|
||
# set close in defaults
|
||||
9d679693 | Moritz Bunkus | do_query($form, $dbh, $query, @values);
|
||
d319704a | Moritz Bunkus | |||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub get_base_unit {
|
||
my ($self, $units, $unit_name, $factor) = @_;
|
||||
$factor = 1 unless ($factor);
|
||||
my $unit = $units->{$unit_name};
|
||||
if (!defined($unit) || !$unit->{"base_unit"} ||
|
||||
($unit_name eq $unit->{"base_unit"})) {
|
||||
return ($unit_name, $factor);
|
||||
}
|
||||
return AM->get_base_unit($units, $unit->{"base_unit"}, $factor * $unit->{"factor"});
|
||||
}
|
||||
sub retrieve_units {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $type, $prefix) = @_;
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
my $query = "SELECT *, base_unit AS original_base_unit FROM units";
|
||||
my @values;
|
||||
if ($type) {
|
||||
$query .= " WHERE (type = ?)";
|
||||
@values = ($type);
|
||||
}
|
||||
my $sth = $dbh->prepare($query);
|
||||
$sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
|
||||
my $units = {};
|
||||
while (my $ref = $sth->fetchrow_hashref()) {
|
||||
$units->{$ref->{"name"}} = $ref;
|
||||
}
|
||||
$sth->finish();
|
||||
af853490 | Moritz Bunkus | my $query_lang = "SELECT id, template_code FROM language ORDER BY description";
|
||
$sth = $dbh->prepare($query_lang);
|
||||
$sth->execute() || $form->dberror($query_lang);
|
||||
my @languages;
|
||||
while ($ref = $sth->fetchrow_hashref()) {
|
||||
push(@languages, $ref);
|
||||
}
|
||||
$sth->finish();
|
||||
$query_lang = "SELECT ul.localized, ul.localized_plural, l.id, l.template_code " .
|
||||
"FROM units_language ul " .
|
||||
"LEFT JOIN language l ON ul.language_id = l.id " .
|
||||
"WHERE ul.unit = ?";
|
||||
$sth = $dbh->prepare($query_lang);
|
||||
foreach my $unit (values(%{$units})) {
|
||||
($unit->{"${prefix}base_unit"}, $unit->{"${prefix}factor"}) = AM->get_base_unit($units, $unit->{"name"});
|
||||
$unit->{"LANGUAGES"} = {};
|
||||
foreach my $lang (@languages) {
|
||||
$unit->{"LANGUAGES"}->{$lang->{"template_code"}} = { "template_code" => $lang->{"template_code"} };
|
||||
}
|
||||
$sth->execute($unit->{"name"}) || $form->dberror($query_lang . " (" . $unit->{"name"} . ")");
|
||||
while ($ref = $sth->fetchrow_hashref()) {
|
||||
map({ $unit->{"LANGUAGES"}->{$ref->{"template_code"}}->{$_} = $ref->{$_} } keys(%{$ref}));
|
||||
}
|
||||
54e4131e | Moritz Bunkus | }
|
||
af853490 | Moritz Bunkus | $sth->finish();
|
||
54e4131e | Moritz Bunkus | |||
$dbh->disconnect();
|
||||
$main::lxdebug->leave_sub();
|
||||
return $units;
|
||||
}
|
||||
8c7e4493 | Moritz Bunkus | sub retrieve_all_units {
|
||
$main::lxdebug->enter_sub();
|
||||
my $self = shift;
|
||||
if (!$main::all_units) {
|
||||
$main::all_units = $self->retrieve_units(\%main::myconfig, $main::form);
|
||||
}
|
||||
$main::lxdebug->leave_sub();
|
||||
return $main::all_units;
|
||||
}
|
||||
af853490 | Moritz Bunkus | sub translate_units {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $form, $template_code, $unit, $amount) = @_;
|
||||
my $units = $self->retrieve_units(\%main::myconfig, $form);
|
||||
my $h = $units->{$unit}->{"LANGUAGES"}->{$template_code};
|
||||
my $new_unit = $unit;
|
||||
if ($h) {
|
||||
if (($amount != 1) && $h->{"localized_plural"}) {
|
||||
$new_unit = $h->{"localized_plural"};
|
||||
} elsif ($h->{"localized"}) {
|
||||
$new_unit = $h->{"localized"};
|
||||
}
|
||||
}
|
||||
$main::lxdebug->leave_sub();
|
||||
return $new_unit;
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub units_in_use {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $units) = @_;
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
9d679693 | Moritz Bunkus | map({ $_->{"in_use"} = 0; } values(%{$units}));
|
||
54e4131e | Moritz Bunkus | foreach my $unit (values(%{$units})) {
|
||
my $base_unit = $unit->{"original_base_unit"};
|
||||
while ($base_unit) {
|
||||
9d679693 | Moritz Bunkus | $units->{$base_unit}->{"in_use"} = 1;
|
||
54e4131e | Moritz Bunkus | $units->{$base_unit}->{"DEPENDING_UNITS"} = [] unless ($units->{$base_unit}->{"DEPENDING_UNITS"});
|
||
push(@{$units->{$base_unit}->{"DEPENDING_UNITS"}}, $unit->{"name"});
|
||||
$base_unit = $units->{$base_unit}->{"original_base_unit"};
|
||||
}
|
||||
}
|
||||
foreach my $unit (values(%{$units})) {
|
||||
map({ $_ = $dbh->quote($_); } @{$unit->{"DEPENDING_UNITS"}});
|
||||
foreach my $table (qw(parts invoice orderitems)) {
|
||||
my $query = "SELECT COUNT(*) FROM $table WHERE unit ";
|
||||
if (0 == scalar(@{$unit->{"DEPENDING_UNITS"}})) {
|
||||
$query .= "= " . $dbh->quote($unit->{"name"});
|
||||
} else {
|
||||
9d679693 | Moritz Bunkus | $query .= "IN (" . $dbh->quote($unit->{"name"}) . "," .
|
||
join(",", map({ $dbh->quote($_) } @{$unit->{"DEPENDING_UNITS"}})) . ")";
|
||||
54e4131e | Moritz Bunkus | }
|
||
my ($count) = $dbh->selectrow_array($query);
|
||||
$form->dberror($query) if ($dbh->err);
|
||||
if ($count) {
|
||||
$unit->{"in_use"} = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
$dbh->disconnect();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
8c7e4493 | Moritz Bunkus | sub convertible_units {
|
||
$main::lxdebug->enter_sub();
|
||||
my $self = shift;
|
||||
my $units = shift;
|
||||
my $filter_unit = shift;
|
||||
my $not_smaller = shift;
|
||||
my $conv_units = [];
|
||||
$filter_unit = $units->{$filter_unit};
|
||||
foreach my $name (sort { lc $a cmp lc $b } keys %{ $units }) {
|
||||
my $unit = $units->{$name};
|
||||
if (($unit->{base_unit} eq $filter_unit->{base_unit}) &&
|
||||
(!$not_smaller || ($unit->{factor} >= $filter_unit->{factor}))) {
|
||||
push @{$conv_units}, $unit;
|
||||
}
|
||||
}
|
||||
my @sorted = sort { $b->{factor} <=> $a->{factor} } @{ $conv_units };
|
||||
$main::lxdebug->leave_sub();
|
||||
return \@sorted;
|
||||
}
|
||||
b6dc5623 | Sven Schöling | # if $a is translatable to $b, return the factor between them.
|
||
# else return 1
|
||||
sub convert_unit {
|
||||
$main::lxdebug->enter_sub(2);
|
||||
($this, $a, $b, $all_units) = @_;
|
||||
$main::lxdebug->leave_sub(2) and return 0 unless $all_units->{$a} && $all_units->{$b};
|
||||
$main::lxdebug->leave_sub(2) and return 0 unless $all_units->{$a}{base_unit} eq $all_units->{$b}{base_unit};
|
||||
$main::lxdebug->leave_sub(2) and return $all_units->{$a}{factor} / $all_units->{$b}{factor};
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub unit_select_data {
|
||
$main::lxdebug->enter_sub();
|
||||
8c7e4493 | Moritz Bunkus | my ($self, $units, $selected, $empty_entry, $convertible_into) = @_;
|
||
54e4131e | Moritz Bunkus | |||
my $select = [];
|
||||
if ($empty_entry) {
|
||||
push(@{$select}, { "name" => "", "base_unit" => "", "factor" => "", "selected" => "" });
|
||||
}
|
||||
292502ec | Moritz Bunkus | foreach my $unit (sort({ $units->{$a}->{"sortkey"} <=> $units->{$b}->{"sortkey"} } keys(%{$units}))) {
|
||
8c7e4493 | Moritz Bunkus | if (!$convertible_into ||
|
||
($units->{$convertible_into} &&
|
||||
($units->{$convertible_into}->{base_unit} eq $units->{$unit}->{base_unit}))) {
|
||||
push @{$select}, { "name" => $unit,
|
||||
"base_unit" => $units->{$unit}->{"base_unit"},
|
||||
"factor" => $units->{$unit}->{"factor"},
|
||||
"selected" => ($unit eq $selected) ? "selected" : "" };
|
||||
}
|
||||
54e4131e | Moritz Bunkus | }
|
||
$main::lxdebug->leave_sub();
|
||||
return $select;
|
||||
}
|
||||
sub unit_select_html {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $units, $name, $selected, $convertible_into) = @_;
|
||||
my $select = "<select name=${name}>";
|
||||
292502ec | Moritz Bunkus | foreach my $unit (sort({ $units->{$a}->{"sortkey"} <=> $units->{$b}->{"sortkey"} } keys(%{$units}))) {
|
||
54e4131e | Moritz Bunkus | if (!$convertible_into ||
|
||
($units->{$convertible_into} &&
|
||||
($units->{$convertible_into}->{"base_unit"} eq $units->{$unit}->{"base_unit"}))) {
|
||||
$select .= "<option" . (($unit eq $selected) ? " selected" : "") . ">${unit}</option>";
|
||||
}
|
||||
}
|
||||
$select .= "</select>";
|
||||
$main::lxdebug->leave_sub();
|
||||
return $select;
|
||||
}
|
||||
8c7e4493 | Moritz Bunkus | sub sum_with_unit {
|
||
$main::lxdebug->enter_sub();
|
||||
my $self = shift;
|
||||
my $units = $self->retrieve_all_units();
|
||||
my $sum = 0;
|
||||
my $base_unit;
|
||||
while (2 <= scalar(@_)) {
|
||||
my $qty = shift(@_);
|
||||
my $unit = $units->{shift(@_)};
|
||||
croak "No unit defined with name $unit" if (!defined $unit);
|
||||
if (!$base_unit) {
|
||||
$base_unit = $unit->{base_unit};
|
||||
} elsif ($base_unit ne $unit->{base_unit}) {
|
||||
croak "Adding values with incompatible base units $base_unit/$unit->{base_unit}";
|
||||
}
|
||||
$sum += $qty * $unit->{factor};
|
||||
}
|
||||
$main::lxdebug->leave_sub();
|
||||
return wantarray ? ($sum, $baseunit) : $sum;
|
||||
}
|
||||
54e4131e | Moritz Bunkus | sub add_unit {
|
||
$main::lxdebug->enter_sub();
|
||||
af853490 | Moritz Bunkus | my ($self, $myconfig, $form, $name, $base_unit, $factor, $type, $languages) = @_;
|
||
54e4131e | Moritz Bunkus | |||
af853490 | Moritz Bunkus | my $dbh = $form->dbconnect_noauto($myconfig);
|
||
54e4131e | Moritz Bunkus | |||
eaf4d483 | Moritz Bunkus | my $query = qq|SELECT COALESCE(MAX(sortkey), 0) + 1 FROM units|;
|
||
my ($sortkey) = selectrow_query($form, $dbh, $query);
|
||||
$query = "INSERT INTO units (name, base_unit, factor, type, sortkey) " .
|
||||
"VALUES (?, ?, ?, ?, ?)";
|
||||
do_query($form, $dbh, $query, $name, $base_unit, $factor, $type, $sortkey);
|
||||
af853490 | Moritz Bunkus | |||
if ($languages) {
|
||||
$query = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
|
||||
my $sth = $dbh->prepare($query);
|
||||
foreach my $lang (@{$languages}) {
|
||||
my @values = ($name, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
|
||||
$sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
|
||||
}
|
||||
$sth->finish();
|
||||
}
|
||||
$dbh->commit();
|
||||
54e4131e | Moritz Bunkus | $dbh->disconnect();
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_units {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $type, $units, $delete_units) = @_;
|
||||
my $dbh = $form->dbconnect_noauto($myconfig);
|
||||
my ($base_unit, $unit, $sth, $query);
|
||||
af853490 | Moritz Bunkus | $query = "DELETE FROM units_language";
|
||
$dbh->do($query) || $form->dberror($query);
|
||||
54e4131e | Moritz Bunkus | if ($delete_units && (0 != scalar(@{$delete_units}))) {
|
||
68c90376 | Moritz Bunkus | $query = "DELETE FROM units WHERE name IN (";
|
||
af853490 | Moritz Bunkus | map({ $query .= "?," } @{$delete_units});
|
||
substr($query, -1, 1) = ")";
|
||||
68c90376 | Moritz Bunkus | $dbh->do($query, undef, @{$delete_units}) ||
|
||
$form->dberror($query . " (" . join(", ", @{$delete_units}) . ")");
|
||||
54e4131e | Moritz Bunkus | }
|
||
$query = "UPDATE units SET name = ?, base_unit = ?, factor = ? WHERE name = ?";
|
||||
$sth = $dbh->prepare($query);
|
||||
af853490 | Moritz Bunkus | my $query_lang = "INSERT INTO units_language (unit, language_id, localized, localized_plural) VALUES (?, ?, ?, ?)";
|
||
my $sth_lang = $dbh->prepare($query_lang);
|
||||
54e4131e | Moritz Bunkus | foreach $unit (values(%{$units})) {
|
||
$unit->{"depth"} = 0;
|
||||
my $base_unit = $unit;
|
||||
while ($base_unit->{"base_unit"}) {
|
||||
$unit->{"depth"}++;
|
||||
$base_unit = $units->{$base_unit->{"base_unit"}};
|
||||
}
|
||||
}
|
||||
foreach $unit (sort({ $a->{"depth"} <=> $b->{"depth"} } values(%{$units}))) {
|
||||
af853490 | Moritz Bunkus | if ($unit->{"LANGUAGES"}) {
|
||
foreach my $lang (@{$unit->{"LANGUAGES"}}) {
|
||||
next unless ($lang->{"id"} && $lang->{"localized"});
|
||||
my @values = ($unit->{"name"}, $lang->{"id"}, $lang->{"localized"}, $lang->{"localized_plural"});
|
||||
$sth_lang->execute(@values) || $form->dberror($query_lang . " (" . join(", ", @values) . ")");
|
||||
}
|
||||
}
|
||||
54e4131e | Moritz Bunkus | next if ($unit->{"unchanged_unit"});
|
||
my @values = ($unit->{"name"}, $unit->{"base_unit"}, $unit->{"factor"}, $unit->{"old_name"});
|
||||
$sth->execute(@values) || $form->dberror($query . " (" . join(", ", @values) . ")");
|
||||
}
|
||||
$sth->finish();
|
||||
af853490 | Moritz Bunkus | $sth_lang->finish();
|
||
54e4131e | Moritz Bunkus | $dbh->commit();
|
||
$dbh->disconnect();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
eaf4d483 | Moritz Bunkus | sub swap_units {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form, $dir, $name_1, $unit_type) = @_;
|
||||
my $dbh = $form->dbconnect_noauto($myconfig);
|
||||
my $query;
|
||||
$query = qq|SELECT sortkey FROM units WHERE name = ?|;
|
||||
my ($sortkey_1) = selectrow_query($form, $dbh, $query, $name_1);
|
||||
$query =
|
||||
qq|SELECT sortkey FROM units | .
|
||||
qq|WHERE sortkey | . ($dir eq "down" ? ">" : "<") . qq| ? AND type = ? | .
|
||||
qq|ORDER BY sortkey | . ($dir eq "down" ? "ASC" : "DESC") . qq| LIMIT 1|;
|
||||
my ($sortkey_2) = selectrow_query($form, $dbh, $query, $sortkey_1, $unit_type);
|
||||
if (defined($sortkey_1)) {
|
||||
$query = qq|SELECT name FROM units WHERE sortkey = ${sortkey_2}|;
|
||||
my ($name_2) = selectrow_query($form, $dbh, $query);
|
||||
if (defined($name_2)) {
|
||||
$query = qq|UPDATE units SET sortkey = ? WHERE name = ?|;
|
||||
my $sth = $dbh->prepare($query);
|
||||
do_statement($form, $sth, $query, $sortkey_1, $name_2);
|
||||
do_statement($form, $sth, $query, $sortkey_2, $name_1);
|
||||
}
|
||||
}
|
||||
$dbh->commit();
|
||||
$dbh->disconnect();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
d38be021 | Udo Spallek | sub taxes {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
a3057d3f | Moritz Bunkus | my $query = qq|SELECT
|
||
d38be021 | Udo Spallek | t.id,
|
||
t.taxkey,
|
||||
t.taxdescription,
|
||||
a3057d3f | Moritz Bunkus | round(t.rate * 100, 2) AS rate,
|
||
7e0ea1c2 | Udo Spallek | (SELECT accno FROM chart WHERE id = chart_id) AS taxnumber,
|
||
(SELECT description FROM chart WHERE id = chart_id) AS account_description
|
||||
d38be021 | Udo Spallek | FROM tax t
|
||
ORDER BY taxkey|;
|
||||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
$form->{TAX} = [];
|
||||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||||
push @{ $form->{TAX} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_tax_accounts {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
# get Accounts from chart
|
||||
a3057d3f | Moritz Bunkus | my $query = qq{ SELECT
|
||
d38be021 | Udo Spallek | id,
|
||
9c548b6f | Moritz Bunkus | accno || ' - ' || description AS taxaccount
|
||
d38be021 | Udo Spallek | FROM chart
|
||
WHERE link LIKE '%_tax%'
|
||||
a3057d3f | Moritz Bunkus | ORDER BY accno
|
||
d38be021 | Udo Spallek | };
|
||
$sth = $dbh->prepare($query);
|
||||
$sth->execute || $form->dberror($query);
|
||||
$form->{ACCOUNTS} = [];
|
||||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||||
push @{ $form->{ACCOUNTS} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_tax {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
a3057d3f | Moritz Bunkus | my $query = qq|SELECT
|
||
d38be021 | Udo Spallek | taxkey,
|
||
taxdescription,
|
||||
a3057d3f | Moritz Bunkus | round(rate * 100, 2) AS rate,
|
||
d38be021 | Udo Spallek | chart_id
|
||
FROM tax
|
||||
WHERE id = ? |;
|
||||
a3057d3f | Moritz Bunkus | |||
d38be021 | Udo Spallek | my $sth = $dbh->prepare($query);
|
||
$sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||||
my $ref = $sth->fetchrow_hashref(NAME_lc);
|
||||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
# see if it is used by a taxkey
|
||||
$query = qq|SELECT count(*) FROM taxkeys
|
||||
7e0ea1c2 | Udo Spallek | WHERE tax_id = ? AND chart_id >0|;
|
||
a3057d3f | Moritz Bunkus | |||
d38be021 | Udo Spallek | ($form->{orphaned}) = selectrow_query($form, $dbh, $query, $form->{id});
|
||
$form->{orphaned} = !$form->{orphaned};
|
||||
$sth->finish;
|
||||
a3057d3f | Moritz Bunkus | |||
d38be021 | Udo Spallek | if (!$form->{orphaned} ) {
|
||
$query = qq|SELECT DISTINCT c.id, c.accno
|
||||
FROM taxkeys tk
|
||||
7e0ea1c2 | Udo Spallek | JOIN tax t ON (t.id = tk.tax_id)
|
||
JOIN chart c ON (c.id = tk.chart_id)
|
||||
d38be021 | Udo Spallek | WHERE tk.tax_id = ?|;
|
||
a3057d3f | Moritz Bunkus | |||
d38be021 | Udo Spallek | $sth = $dbh->prepare($query);
|
||
$sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||||
$form->{TAXINUSE} = [];
|
||||
while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
|
||||
push @{ $form->{TAXINUSE} }, $ref;
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
a3057d3f | Moritz Bunkus | |||
d38be021 | Udo Spallek | $dbh->disconnect;
|
||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_tax {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
a3057d3f | Moritz Bunkus | my $dbh = $form->get_standard_dbh($myconfig);
|
||
d38be021 | Udo Spallek | |||
$form->{rate} = $form->{rate} / 100;
|
||||
f8dc549f | Udo Spallek | my @values = ($form->{taxkey}, $form->{taxdescription}, $form->{rate}, $form->{chart_id}, $form->{chart_id} );
|
||
7e0ea1c2 | Udo Spallek | if ($form->{id} ne "") {
|
||
f8dc549f | Udo Spallek | $query = qq|UPDATE tax SET
|
||
d38be021 | Udo Spallek | taxkey = ?,
|
||
taxdescription = ?,
|
||||
rate = ?,
|
||||
f8dc549f | Udo Spallek | chart_id = ?,
|
||
taxnumber = (SELECT accno FROM chart WHERE id= ? )
|
||||
d38be021 | Udo Spallek | WHERE id = ?|;
|
||
push(@values, $form->{id});
|
||||
a3057d3f | Moritz Bunkus | |||
} else {
|
||||
d38be021 | Udo Spallek | #ok
|
||
f8dc549f | Udo Spallek | $query = qq|INSERT INTO tax (
|
||
d38be021 | Udo Spallek | taxkey,
|
||
taxdescription,
|
||||
rate,
|
||||
f8dc549f | Udo Spallek | chart_id,
|
||
taxnumber
|
||||
d38be021 | Udo Spallek | )
|
||
f8dc549f | Udo Spallek | VALUES (?, ?, ?, ?, (SELECT accno FROM chart WHERE id = ?) )|;
|
||
d38be021 | Udo Spallek | }
|
||
do_query($form, $dbh, $query, @values);
|
||||
a3057d3f | Moritz Bunkus | $dbh->commit();
|
||
d38be021 | Udo Spallek | |||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_tax {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
a3057d3f | Moritz Bunkus | my $dbh = $form->get_standard_dbh($myconfig);
|
||
d38be021 | Udo Spallek | |||
f8dc549f | Udo Spallek | $query = qq|DELETE FROM tax
|
||
d38be021 | Udo Spallek | WHERE id = ?|;
|
||
do_query($form, $dbh, $query, $form->{id});
|
||||
a3057d3f | Moritz Bunkus | $dbh->commit();
|
||
d38be021 | Udo Spallek | |||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
1e251313 | Moritz Bunkus | sub save_price_factor {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my $query;
|
||||
my @values = ($form->{description}, conv_i($form->{factor}));
|
||||
if ($form->{id}) {
|
||||
$query = qq|UPDATE price_factors SET description = ?, factor = ? WHERE id = ?|;
|
||||
push @values, conv_i($form->{id});
|
||||
} else {
|
||||
$query = qq|INSERT INTO price_factors (description, factor, sortkey) VALUES (?, ?, (SELECT COALESCE(MAX(sortkey), 0) + 1 FROM price_factors))|;
|
||||
}
|
||||
do_query($form, $dbh, $query, @values);
|
||||
$dbh->commit();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_all_price_factors {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
$form->{PRICE_FACTORS} = selectall_hashref_query($form, $dbh, qq|SELECT * FROM price_factors ORDER BY sortkey|);
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_price_factor {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my $query = qq|SELECT description, factor,
|
||||
((SELECT COUNT(*) FROM parts WHERE price_factor_id = ?) +
|
||||
(SELECT COUNT(*) FROM invoice WHERE price_factor_id = ?) +
|
||||
(SELECT COUNT(*) FROM orderitems WHERE price_factor_id = ?)) = 0 AS orphaned
|
||||
FROM price_factors WHERE id = ?|;
|
||||
($form->{description}, $form->{factor}, $form->{orphaned}) = selectrow_query($form, $dbh, $query, (conv_i($form->{id})) x 4);
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_price_factor {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
do_query($form, $dbh, qq|DELETE FROM price_factors WHERE id = ?|, conv_i($form->{id}));
|
||||
$dbh->commit();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
d38be021 | Udo Spallek | |||
83914eeb | Moritz Bunkus | sub save_warehouse {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my ($query, @values, $sth);
|
||||
if (!$form->{id}) {
|
||||
$query = qq|SELECT nextval('id')|;
|
||||
($form->{id}) = selectrow_query($form, $dbh, $query);
|
||||
$query = qq|INSERT INTO warehouse (id, sortkey) VALUES (?, (SELECT COALESCE(MAX(sortkey), 0) + 1 FROM warehouse))|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
}
|
||||
do_query($form, $dbh, qq|UPDATE warehouse SET description = ?, invalid = ? WHERE id = ?|,
|
||||
$form->{description}, $form->{invalid} ? 't' : 'f', conv_i($form->{id}));
|
||||
if (0 < $form->{number_of_new_bins}) {
|
||||
$query = qq|INSERT INTO bin (warehouse_id, description) VALUES (?, ?)|;
|
||||
$sth = prepare_query($form, $dbh, $query);
|
||||
foreach my $i (1..$form->{number_of_new_bins}) {
|
||||
do_statement($form, $sth, $query, conv_i($form->{id}), "$form->{prefix}${i}");
|
||||
}
|
||||
$sth->finish();
|
||||
}
|
||||
$dbh->commit();
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_bins {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my ($query, @values, $commit_necessary, $sth);
|
||||
@values = map { $form->{"id_${_}"} } grep { $form->{"delete_${_}"} } (1..$form->{rowcount});
|
||||
if (@values) {
|
||||
$query = qq|DELETE FROM bin WHERE id IN (| . join(', ', ('?') x scalar(@values)) . qq|)|;
|
||||
do_query($form, $dbh, $query, @values);
|
||||
$commit_necessary = 1;
|
||||
}
|
||||
$query = qq|UPDATE bin SET description = ? WHERE id = ?|;
|
||||
$sth = prepare_query($form, $dbh, $query);
|
||||
foreach my $row (1..$form->{rowcount}) {
|
||||
next if ($form->{"delete_${row}"});
|
||||
do_statement($form, $sth, $query, $form->{"description_${row}"}, conv_i($form->{"id_${row}"}));
|
||||
$commit_necessary = 1;
|
||||
}
|
||||
$sth->finish();
|
||||
$dbh->commit() if ($commit_necessary);
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_warehouse {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my $id = conv_i($form->{id});
|
||||
my $query = qq|SELECT i.bin_id FROM inventory i WHERE i.bin_id IN (SELECT b.id FROM bin b WHERE b.warehouse_id = ?) LIMIT 1|;
|
||||
my ($count) = selectrow_query($form, $dbh, $query, $id);
|
||||
if ($count) {
|
||||
$main::lxdebug->leave_sub();
|
||||
return 0;
|
||||
}
|
||||
do_query($form, $dbh, qq|DELETE FROM warehouse_access WHERE warehouse_id = ?|, conv_i($form->{id}));
|
||||
do_query($form, $dbh, qq|DELETE FROM bin WHERE warehouse_id = ?|, conv_i($form->{id}));
|
||||
do_query($form, $dbh, qq|DELETE FROM warehouse WHERE id = ?|, conv_i($form->{id}));
|
||||
$dbh->commit();
|
||||
$main::lxdebug->leave_sub();
|
||||
return 1;
|
||||
}
|
||||
sub get_all_warehouses {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
d6e36f9c | Moritz Bunkus | my $query = qq|SELECT w.id, w.description, w.invalid,
|
||
a10943b5 | Moritz Bunkus | (SELECT COUNT(b.description) FROM bin b WHERE b.warehouse_id = w.id) AS number_of_bins
|
||
83914eeb | Moritz Bunkus | FROM warehouse w
|
||
ORDER BY w.sortkey|;
|
||||
$form->{WAREHOUSES} = selectall_hashref_query($form, $dbh, $query);
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub get_warehouse {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
# connect to database
|
||||
my $dbh = $form->get_standard_dbh($myconfig);
|
||||
my $id = conv_i($form->{id});
|
||||
my $query = qq|SELECT w.description, w.invalid
|
||||
FROM warehouse w
|
||||
WHERE w.id = ?|;
|
||||
d157848a | Moritz Bunkus | my $ref = selectfirst_hashref_query($form, $dbh, $query, $id);
|
||
83914eeb | Moritz Bunkus | |||
map { $form->{$_} = $ref->{$_} } keys %{ $ref };
|
||||
$query = qq|SELECT b.*, EXISTS
|
||||
(SELECT i.warehouse_id
|
||||
FROM inventory i
|
||||
WHERE i.bin_id = b.id
|
||||
LIMIT 1)
|
||||
AS in_use
|
||||
FROM bin b
|
||||
WHERE b.warehouse_id = ?|;
|
||||
$form->{BINS} = selectall_hashref_query($form, $dbh, $query, conv_i($form->{id}));
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
d38be021 | Udo Spallek | |||
d319704a | Moritz Bunkus | 1;
|