kivitendo/SL/AM.pm @ 79b7fc43
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;
|
||
8c051f47 | Moritz Bunkus | use Encode;
|
||
d851523e | Bernd Bleßmann | use List::MoreUtils qw(any);
|
||
d05eb259 | Moritz Bunkus | use SL::DBUtils;
|
||
6f398b35 | Moritz Bunkus | use SL::DB::AuthUser;
|
||
2e66dde5 | Moritz Bunkus | use SL::DB::Default;
|
||
6f398b35 | Moritz Bunkus | use SL::DB::Employee;
|
||
e90048c8 | Bernd Bleßmann | use SL::GenericTranslations;
|
||
54e4131e | Moritz Bunkus | |||
80f6efd0 | Sven Schöling | use strict;
|
||
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 | |||
5c285a79 | Sven Schöling | $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 | |||
5c285a79 | Sven Schöling | my $ref = $sth->fetchrow_hashref("NAME_lc");
|
||
d319704a | Moritz Bunkus | |||
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|;
|
||||
5c285a79 | Sven Schöling | $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
|
||
d319704a | Moritz Bunkus | $sth = $dbh->prepare($query);
|
||
$sth->execute || $form->dberror($query);
|
||||
5c285a79 | Sven Schöling | $ref = $sth->fetchrow_hashref("NAME_lc");
|
||
d319704a | Moritz Bunkus | |||
5c285a79 | Sven Schöling | map { $form->{$_} = $ref->{$_} } keys %{ $ref };
|
||
d319704a | Moritz Bunkus | |||
$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
|
||||
};
|
||||
5c285a79 | Sven Schöling | $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 | |||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
d319704a | Moritz Bunkus | 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|;
|
||
5c285a79 | Sven Schöling | $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} = [];
|
||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
54e4131e | Moritz Bunkus | 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 | };
|
||
5c285a79 | Sven Schöling | $main::lxdebug->message(LXDebug->QUERY(), "\$query=\n $query");
|
||
bd34eaea | Udo Spallek | $sth = $dbh->prepare($query);
|
||
$sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||||
$form->{ACCOUNT_TAXKEYS} = [];
|
||||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
bd34eaea | Udo Spallek | 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 = ?|;
|
||
5c285a79 | Sven Schöling | $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 = ?|;
|
||
5c285a79 | Sven Schöling | $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();
|
||||
2a10bda6 | Geoffrey Richardson | # TODO: it should be forbidden to change an account to a heading if there
|
||
# have been bookings to this account in the past
|
||||
d319704a | Moritz Bunkus | my ($self, $myconfig, $form) = @_;
|
||
# connect to database, turn off AutoCommit
|
||||
my $dbh = $form->dbconnect_noauto($myconfig);
|
||||
8058448b | Niclas Zimmermann | for (qw(AR_include_in_dropdown AP_include_in_dropdown summary_account)) {
|
||
b254ba33 | Niclas Zimmermann | $form->{$form->{$_}} = $form->{$_} if $form->{$_};
|
||
d319704a | Moritz Bunkus | }
|
||
4d1bc299 | Niclas Zimmermann | # sanity check, can't have AR with AR_...
|
||
if ($form->{AR} || $form->{AP} || $form->{IC}) {
|
||||
d851523e | Bernd Bleßmann | if (any { $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->error($::locale->text('It is not allowed that a summary account occurs in a drop-down menu!'));
|
||||
4d1bc299 | Niclas Zimmermann | }
|
||
2828d156 | Bernd Bleßmann | }
|
||
d319704a | Moritz Bunkus | $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},
|
||||
9a194d6a | Geoffrey Richardson | $form->{IC_taxservice}
|
||
d319704a | Moritz Bunkus | ) {
|
||
$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} = "";
|
||||
}
|
||||
0e494483 | Niclas Zimmermann | $query = '
|
||
f72c4ff4 | Thomas Heck | SELECT accno
|
||
0e494483 | Niclas Zimmermann | FROM chart
|
||
WHERE accno = ?';
|
||||
f72c4ff4 | Thomas Heck | |||
my @values = ($form->{accno});
|
||||
if ( $form->{id} ) {
|
||||
$query .= ' AND NOT id = ?';
|
||||
push(@values, $form->{id});
|
||||
}
|
||||
my ($accno) = selectrow_query($form, $dbh, $query, @values);
|
||||
0e494483 | Niclas Zimmermann | |||
if ($accno) {
|
||||
$form->error($::locale->text('Account number not unique!'));
|
||||
}
|
||||
42ed89f3 | Philip Reetz | if (!$form->{id} || $form->{id} eq "") {
|
||
$query = qq|SELECT nextval('id')|;
|
||||
($form->{"id"}) = selectrow_query($form, $dbh, $query);
|
||||
7d52ebe6 | Niclas Zimmermann | $query = qq|INSERT INTO chart (id, accno, link) VALUES (?, ?, ?)|;
|
||
do_query($form, $dbh, $query, $form->{"id"}, $form->{"accno"}, '');
|
||||
42ed89f3 | Philip Reetz | }
|
||
fbcef9f2 | Sven Schöling | @values = ();
|
||
a00ef54b | Moritz Bunkus | |||
2a10bda6 | Geoffrey Richardson | |||
88bc69df | Moritz Bunkus | if ($form->{id}) {
|
||
2a10bda6 | Geoffrey Richardson | |||
# if charttype is heading make sure certain values are empty
|
||||
# specifically, if charttype is changed from an existing account, empty the
|
||||
2ff2f6c9 | Moritz Bunkus | # fields unnecessary for headings, so that e.g. heading doesn't appear in
|
||
2a10bda6 | Geoffrey Richardson | # drop-down menues due to still having a valid "link" entry
|
||
if ( $form->{charttype} eq 'H' ) {
|
||||
$form->{link} = '';
|
||||
$form->{pos_bwa} = '';
|
||||
$form->{pos_bilanz} = '';
|
||||
$form->{pos_eur} = '';
|
||||
$form->{new_chart_id} = '';
|
||||
$form->{valid_from} = '';
|
||||
};
|
||||
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},
|
||||
);
|
||||
2a10bda6 | Geoffrey Richardson | |||
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
|
||
42ed89f3 | Philip Reetz | |||
print(STDERR "Keine Taxkeys weil ID =: $form->{id}\n");
|
||||
bd34eaea | Udo Spallek | 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 | }
|
||
90221504 | Moritz Bunkus | # Update chart.taxkey_id to the latest from taxkeys for this chart.
|
||
$query = <<SQL;
|
||||
UPDATE chart
|
||||
SET taxkey_id = (
|
||||
SELECT taxkey_id
|
||||
FROM taxkeys
|
||||
WHERE taxkeys.chart_id = chart.id
|
||||
ORDER BY startdate DESC
|
||||
LIMIT 1
|
||||
)
|
||||
WHERE id = ?
|
||||
SQL
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
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 | |||
9f07753b | Moritz Bunkus | $query = qq|DELETE FROM tax
|
||
WHERE chart_id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
54e4131e | Moritz Bunkus | |||
bd34eaea | Udo Spallek | # delete account taxkeys
|
||
$query = qq|DELETE FROM taxkeys
|
||||
WHERE chart_id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
6dd6719d | Jan Büren | |||
# delete chart of account record
|
||||
# last step delete chart, because we have a constraint
|
||||
# to taxkeys
|
||||
$query = qq|DELETE FROM chart
|
||||
WHERE id = ?|;
|
||||
do_query($form, $dbh, $query, $form->{id});
|
||||
bd34eaea | Udo Spallek | |||
54e4131e | Moritz Bunkus | # commit and redirect
|
||
my $rc = $dbh->commit;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
return $rc;
|
||||
}
|
||||
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 | |||
5c285a79 | Sven Schöling | my $sth = $dbh->prepare($query);
|
||
501107ad | Holger Lindemann | $sth->execute || $form->dberror($query);
|
||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
501107ad | Holger Lindemann | 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 | |||
5c285a79 | Sven Schöling | my $ref = $sth->fetchrow_hashref("NAME_lc");
|
||
501107ad | Holger Lindemann | |||
map { $form->{$_} = $ref->{$_} } keys %$ref;
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub save_lead {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
5c285a79 | Sven Schöling | my ($query);
|
||
501107ad | Holger Lindemann | |||
# 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 = ?|;
|
||||
bf8db146 | Sven Schöling | push(@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) = @_;
|
||||
5c285a79 | Sven Schöling | my ($query);
|
||
501107ad | Holger Lindemann | |||
# 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 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 | |||
5c285a79 | Sven Schöling | my $sth = $dbh->prepare($query);
|
||
54e4131e | Moritz Bunkus | $sth->execute || $form->dberror($query);
|
||
af853490 | Moritz Bunkus | my $ary = [];
|
||
5c285a79 | Sven Schöling | 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 | |||
5c285a79 | Sven Schöling | my $ref = $sth->fetchrow_hashref("NAME_lc");
|
||
54e4131e | Moritz Bunkus | |||
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) = @_;
|
||||
5c285a79 | Sven Schöling | my $query;
|
||
54e4131e | Moritz Bunkus | |||
# connect to database
|
||||
32d33e11 | Moritz Bunkus | my $dbh = $form->dbconnect_noauto($myconfig);
|
||
dbbf8923 | Moritz Bunkus | foreach my $table (qw(generic_translations units_language)) {
|
||
5c285a79 | Sven Schöling | $query = qq|DELETE FROM $table WHERE language_id = ?|;
|
||
dcef6ec7 | Moritz Bunkus | 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();
|
||||
}
|
||||
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");
|
||
ef888d16 | Bernd Bleßmann | if ($form->{"formname"} =~ m|\.\.| || $form->{"formname"} =~ m|^/|) {
|
||
$filename =~ s|.*/||;
|
||||
}
|
||||
b12e8d14 | Moritz Bunkus | $display_filename = $filename;
|
||
2e66dde5 | Moritz Bunkus | $filename = SL::DB::Default->get->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 | |||
dbda14c2 | Moritz Bunkus | $content = Encode::decode('utf-8-strict', $content);
|
||
8c051f47 | Moritz Bunkus | |||
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 | |||
7274f9c8 | Sven Schöling | if (open(TEMPLATE, ">", $filename)) {
|
||
dbda14c2 | Moritz Bunkus | $content = Encode::encode('utf-8-strict', $content);
|
||
b12e8d14 | Moritz Bunkus | $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_preferences {
|
||
$main::lxdebug->enter_sub();
|
||||
6f398b35 | Moritz Bunkus | my ($self, $form) = @_;
|
||
d319704a | Moritz Bunkus | |||
4bd1e2f8 | Sven Schöling | my $employee = SL::DB::Manager::Employee->find_by(login => $::myconfig{login});
|
||
6f398b35 | Moritz Bunkus | $employee->update_attributes(name => $form->{name});
|
||
d319704a | Moritz Bunkus | |||
4bd1e2f8 | Sven Schöling | my $user = SL::DB::Manager::AuthUser->find_by(login => $::myconfig{login});
|
||
6f398b35 | Moritz Bunkus | $user->update_attributes(
|
||
config_values => {
|
||||
bc7681a9 | Moritz Bunkus | %{ $user->config_values },
|
||
cd417762 | Moritz Bunkus | map { ($_ => $form->{$_}) } SL::DB::AuthUser::CONFIG_VARS(),
|
||
6f398b35 | Moritz Bunkus | });
|
||
8c7e4493 | Moritz Bunkus | |||
d319704a | Moritz Bunkus | $main::lxdebug->leave_sub();
|
||
6f398b35 | Moritz Bunkus | return 1;
|
||
d319704a | Moritz Bunkus | }
|
||
c14aab2d | Moritz Bunkus | sub get_defaults {
|
||
$main::lxdebug->enter_sub();
|
||||
my $self = shift;
|
||||
my %params = @_;
|
||||
my $myconfig = \%main::myconfig;
|
||||
my $form = $main::form;
|
||||
my $dbh = $params{dbh} || $form->get_standard_dbh($myconfig);
|
||||
my $defaults = selectfirst_hashref_query($form, $dbh, qq|SELECT * FROM defaults|) || {};
|
||||
$defaults->{weightunit} ||= 'kg';
|
||||
$main::lxdebug->leave_sub();
|
||||
return $defaults;
|
||||
}
|
||||
d319704a | Moritz Bunkus | sub closedto {
|
||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
my $dbh = $form->dbconnect($myconfig);
|
||||
a11d7a85 | Jan Büren | my $query = qq|SELECT closedto, max_future_booking_interval, revtrans FROM defaults|;
|
||
d319704a | Moritz Bunkus | my $sth = $dbh->prepare($query);
|
||
$sth->execute || $form->dberror($query);
|
||||
a11d7a85 | Jan Büren | ($form->{closedto}, $form->{max_future_booking_interval}, $form->{revtrans}) = $sth->fetchrow_array;
|
||
d319704a | Moritz Bunkus | |||
$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);
|
||
8e97a740 | Jan Büren | # is currently NEVER trueish (no more hidden revtrans in $form)
|
||
# if ($form->{revtrans}) {
|
||||
# $query = qq|UPDATE defaults SET closedto = NULL, revtrans = '1'|;
|
||||
# -> therefore you can only set this to false (which is already the default)
|
||||
# and this flag is currently only checked in gl.pl. TOOD Can probably be removed
|
||||
d319704a | Moritz Bunkus | |||
a11d7a85 | Jan Büren | $query = qq|UPDATE defaults SET closedto = ?, max_future_booking_interval = ?, revtrans = '0'|;
|
||
8e97a740 | Jan Büren | @values = (conv_date($form->{closedto}), conv_i($form->{max_future_booking_interval}));
|
||
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();
|
||||
07948c34 | Moritz Bunkus | my ($self, $myconfig, $form, $prefix) = @_;
|
||
e2922ed5 | Sven Schöling | $prefix ||= '';
|
||
54e4131e | Moritz Bunkus | |||
6aa467fa | Sven Schöling | my $dbh = $form->get_standard_dbh;
|
||
54e4131e | Moritz Bunkus | |||
my $query = "SELECT *, base_unit AS original_base_unit FROM units";
|
||||
07948c34 | Moritz Bunkus | my $sth = prepare_execute_query($form, $dbh, $query);
|
||
54e4131e | Moritz Bunkus | |||
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;
|
||||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref()) {
|
||
af853490 | Moritz Bunkus | 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"} . ")");
|
||||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref()) {
|
||
af853490 | Moritz Bunkus | map({ $unit->{"LANGUAGES"}->{$ref->{"template_code"}}->{$_} = $ref->{$_} } keys(%{$ref}));
|
||
}
|
||||
54e4131e | Moritz Bunkus | }
|
||
6aa467fa | Sven Schöling | $sth->finish;
|
||
54e4131e | Moritz Bunkus | |||
$main::lxdebug->leave_sub();
|
||||
return $units;
|
||||
}
|
||||
8c7e4493 | Moritz Bunkus | sub retrieve_all_units {
|
||
$main::lxdebug->enter_sub();
|
||||
my $self = shift;
|
||||
a064deaf | Sven Schöling | if (!$::request->{cache}{all_units}) {
|
||
$::request->{cache}{all_units} = $self->retrieve_units(\%main::myconfig, $main::form);
|
||||
8c7e4493 | Moritz Bunkus | }
|
||
$main::lxdebug->leave_sub();
|
||||
a064deaf | Sven Schöling | return $::request->{cache}{all_units};
|
||
8c7e4493 | Moritz Bunkus | }
|
||
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);
|
||||
5c285a79 | Sven Schöling | my ($this, $a, $b, $all_units) = @_;
|
||
b6dc5623 | Sven Schöling | |||
23551aa6 | Sven Schöling | if (!$all_units) {
|
||
$all_units = $this->retrieve_all_units;
|
||||
}
|
||||
90daea72 | Sven Schöling | $main::lxdebug->leave_sub(2) and return 0 unless $a && $b;
|
||
b6dc5623 | Sven Schöling | $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};
|
||||
90daea72 | Sven Schöling | $main::lxdebug->leave_sub(2) and return $all_units->{$a}{factor} / $all_units->{$b}{factor};
|
||
b6dc5623 | Sven Schöling | }
|
||
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();
|
||||
b8ede741 | Sven Schöling | return $sum;
|
||
8c7e4493 | Moritz Bunkus | }
|
||
54e4131e | Moritz Bunkus | sub add_unit {
|
||
$main::lxdebug->enter_sub();
|
||||
07948c34 | Moritz Bunkus | my ($self, $myconfig, $form, $name, $base_unit, $factor, $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);
|
||||
07948c34 | Moritz Bunkus | $query = "INSERT INTO units (name, base_unit, factor, sortkey) " .
|
||
"VALUES (?, ?, ?, ?)";
|
||||
do_query($form, $dbh, $query, $name, $base_unit, $factor, $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();
|
||||
07948c34 | Moritz Bunkus | my ($self, $myconfig, $form, $units, $delete_units) = @_;
|
||
54e4131e | Moritz Bunkus | |||
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();
|
||||
}
|
||||
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
|
||
99d05c2c | Niclas Zimmermann | ORDER BY taxkey, rate|;
|
||
d38be021 | Udo Spallek | |||
5c285a79 | Sven Schöling | my $sth = $dbh->prepare($query);
|
||
d38be021 | Udo Spallek | $sth->execute || $form->dberror($query);
|
||
$form->{TAX} = [];
|
||||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
d38be021 | Udo Spallek | 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 | };
|
||
5c285a79 | Sven Schöling | my $sth = $dbh->prepare($query);
|
||
d38be021 | Udo Spallek | $sth->execute || $form->dberror($query);
|
||
$form->{ACCOUNTS} = [];
|
||||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
d38be021 | Udo Spallek | 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,
|
||
9f07753b | Moritz Bunkus | chart_id,
|
||
e82db1a7 | Niclas Zimmermann | chart_categories,
|
||
9f07753b | Moritz Bunkus | (id IN (SELECT tax_id
|
||
1672583a | Niclas Zimmermann | FROM acc_trans)) AS tax_already_used
|
||
d38be021 | Udo Spallek | FROM tax
|
||
WHERE id = ? |;
|
||||
a3057d3f | Moritz Bunkus | |||
d38be021 | Udo Spallek | my $sth = $dbh->prepare($query);
|
||
$sth->execute($form->{id}) || $form->dberror($query . " ($form->{id})");
|
||||
5c285a79 | Sven Schöling | my $ref = $sth->fetchrow_hashref("NAME_lc");
|
||
d38be021 | Udo Spallek | |||
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} = [];
|
||||
5c285a79 | Sven Schöling | while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
|
||
d38be021 | Udo Spallek | 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) = @_;
|
||||
5c285a79 | Sven Schöling | my $query;
|
||
d38be021 | Udo Spallek | |||
# connect to database
|
||||
a3057d3f | Moritz Bunkus | my $dbh = $form->get_standard_dbh($myconfig);
|
||
d38be021 | Udo Spallek | |||
$form->{rate} = $form->{rate} / 100;
|
||||
e82db1a7 | Niclas Zimmermann | my $chart_categories = '';
|
||
$chart_categories .= 'A' if $form->{asset};
|
||||
$chart_categories .= 'L' if $form->{liability};
|
||||
$chart_categories .= 'Q' if $form->{equity};
|
||||
$chart_categories .= 'I' if $form->{revenue};
|
||||
$chart_categories .= 'E' if $form->{expense};
|
||||
$chart_categories .= 'C' if $form->{costs};
|
||||
27665214 | Niclas Zimmermann | my @values = ($form->{taxkey}, $form->{taxdescription}, $form->{rate}, conv_i($form->{chart_id}), conv_i($form->{chart_id}), $chart_categories);
|
||
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 = ?,
|
||
e82db1a7 | Niclas Zimmermann | taxnumber = (SELECT accno FROM chart WHERE id= ? ),
|
||
chart_categories = ?
|
||||
d38be021 | Udo Spallek | WHERE id = ?|;
|
||
a3057d3f | Moritz Bunkus | |||
} else {
|
||||
d38be021 | Udo Spallek | #ok
|
||
e90048c8 | Bernd Bleßmann | ($form->{id}) = selectfirst_array_query($form, $dbh, qq|SELECT nextval('id')|);
|
||
f8dc549f | Udo Spallek | $query = qq|INSERT INTO tax (
|
||
d38be021 | Udo Spallek | taxkey,
|
||
taxdescription,
|
||||
rate,
|
||||
f8dc549f | Udo Spallek | chart_id,
|
||
e82db1a7 | Niclas Zimmermann | taxnumber,
|
||
e90048c8 | Bernd Bleßmann | chart_categories,
|
||
id
|
||||
d38be021 | Udo Spallek | )
|
||
e90048c8 | Bernd Bleßmann | VALUES (?, ?, ?, ?, (SELECT accno FROM chart WHERE id = ?), ?, ?)|;
|
||
d38be021 | Udo Spallek | }
|
||
e90048c8 | Bernd Bleßmann | push(@values, $form->{id});
|
||
d38be021 | Udo Spallek | do_query($form, $dbh, $query, @values);
|
||
27665214 | Niclas Zimmermann | |||
e90048c8 | Bernd Bleßmann | foreach my $language_id (keys %{ $form->{translations} }) {
|
||
GenericTranslations->save('dbh' => $dbh,
|
||||
'translation_type' => 'SL::DB::Tax/taxdescription',
|
||||
'translation_id' => $form->{id},
|
||||
'language_id' => $language_id,
|
||||
'translation' => $form->{translations}->{$language_id});
|
||||
}
|
||||
d38be021 | Udo Spallek | |||
a3057d3f | Moritz Bunkus | $dbh->commit();
|
||
d38be021 | Udo Spallek | |||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
sub delete_tax {
|
||||
$main::lxdebug->enter_sub();
|
||||
my ($self, $myconfig, $form) = @_;
|
||||
5c285a79 | Sven Schöling | my $query;
|
||
d38be021 | Udo Spallek | |||
# 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}) {
|
||||
5ea712a2 | Moritz Bunkus | my ($num_existing_bins) = selectfirst_array_query($form, $dbh, qq|SELECT COUNT(*) FROM bin WHERE warehouse_id = ?|, $form->{id});
|
||
83914eeb | Moritz Bunkus | $query = qq|INSERT INTO bin (warehouse_id, description) VALUES (?, ?)|;
|
||
$sth = prepare_query($form, $dbh, $query);
|
||||
foreach my $i (1..$form->{number_of_new_bins}) {
|
||||
5ea712a2 | Moritz Bunkus | do_statement($form, $sth, $query, conv_i($form->{id}), "$form->{prefix}" . ($i + $num_existing_bins));
|
||
83914eeb | Moritz Bunkus | }
|
||
$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;
|
||||
}
|
||||
696aad9c | Moritz Bunkus | 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}));
|
||||
83914eeb | Moritz Bunkus | |||
$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 };
|
||||
af6756b8 | Moritz Bunkus | $query = <<SQL;
|
||
SELECT b.*,
|
||||
( EXISTS(SELECT i.bin_id FROM inventory i WHERE i.bin_id = b.id LIMIT 1)
|
||||
OR EXISTS(SELECT p.bin_id FROM parts p WHERE p.bin_id = b.id LIMIT 1))
|
||||
AS in_use
|
||||
FROM bin b
|
||||
WHERE b.warehouse_id = ?
|
||||
SQL
|
||||
83914eeb | Moritz Bunkus | |||
$form->{BINS} = selectall_hashref_query($form, $dbh, $query, conv_i($form->{id}));
|
||||
$main::lxdebug->leave_sub();
|
||||
}
|
||||
d38be021 | Udo Spallek | |||
d319704a | Moritz Bunkus | 1;
|