Projekt

Allgemein

Profil

Herunterladen (113 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/SL/Form.pm @ c45403f9

0f9adc27 Jan Büren
#=====================================================================
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) 1998-2002
#
# Author: Dieter Simader
# Email: dsimader@sql-ledger.org
# Web: http://www.sql-ledger.org
#
# Contributors: Thomas Bayen <bayen@gmx.de>
# Antti Kaihola <akaihola@siba.fi>
# Moritz Bunkus (tex code)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
f7b15d43 Christian Wittmer
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1335, USA.
d319704a Moritz Bunkus
#======================================================================
# Utilities for parsing forms
# and supporting routines for linking account numbers
# used in AR, AP and IS, IR modules
#
#======================================================================

package Form;
b8da8785 Sven Schöling
ade02f1e Moritz Bunkus
use Carp;
54e4131e Moritz Bunkus
use Data::Dumper;
d319704a Moritz Bunkus
c2bb1ff4 Moritz Bunkus
use Carp;
8c7e4493 Moritz Bunkus
use CGI;
use Cwd;
753b82ff Moritz Bunkus
use Encode;
9c6337f3 Moritz Bunkus
use File::Copy;
dc8ffeaa Moritz Bunkus
use File::Temp ();
eff7e112 Moritz Bunkus
use IO::File;
ed531c37 Moritz Bunkus
use Math::BigInt;
cbb1f3f2 Jan Büren
use Params::Validate qw(:all);
3afca6ae Moritz Bunkus
use POSIX qw(strftime);
8c7e4493 Moritz Bunkus
use SL::Auth;
use SL::Auth::DB;
use SL::Auth::LDAP;
use SL::AM;
use SL::Common;
06ebdd6a Moritz Bunkus
use SL::CVar;
use SL::DB;
22c02125 Moritz Bunkus
use SL::DBConnect;
54a4321b Moritz Bunkus
use SL::DBUtils;
00177fae Moritz Bunkus
use SL::DB::AdditionalBillingAddress;
ade02f1e Moritz Bunkus
use SL::DB::Customer;
c1551e49 Moritz Bunkus
use SL::DB::CustomVariableConfig;
2e66dde5 Moritz Bunkus
use SL::DB::Default;
ade02f1e Moritz Bunkus
use SL::DB::PaymentTerm;
use SL::DB::Vendor;
06ebdd6a Moritz Bunkus
use SL::DO;
58b97f84 Moritz Bunkus
use SL::Helper::Flash qw();
6d8fc7da Moritz Bunkus
use SL::IC;
06ebdd6a Moritz Bunkus
use SL::IS;
b6fd15a8 Sven Schöling
use SL::Layout::Dispatcher;
00f9b4aa Wulf Coulmann
use SL::Locale;
61cbd09d Jan Büren
use SL::Locale::String;
2584d83b Moritz Bunkus
use SL::Mailer;
d1c335e9 Moritz Bunkus
use SL::Menu;
48abd6c9 Sven Schöling
use SL::MoreCommon qw(uri_encode uri_decode);
06ebdd6a Moritz Bunkus
use SL::OE;
f50ddd66 Moritz Bunkus
use SL::PrefixedNumber;
48abd6c9 Sven Schöling
use SL::Request;
8c7e4493 Moritz Bunkus
use SL::Template;
afe8a81b Moritz Bunkus
use SL::User;
88dea78e Moritz Bunkus
use SL::Util;
6627c9eb Sven Schöling
use SL::Version;
27ffa16a Moritz Bunkus
use SL::X;
8c7e4493 Moritz Bunkus
use Template;
ad9563c8 Moritz Bunkus
use URI;
d707f7ac Moritz Bunkus
use List::Util qw(first max min sum);
06ebdd6a Moritz Bunkus
use List::MoreUtils qw(all any apply);
0e68056c Geoffrey Richardson
use SL::DB::Tax;
0bfbcce6 Martin Helmling
use SL::Helper::File qw(:all);
a967d2a4 Sven Schöling
use SL::Helper::Number;
0bfbcce6 Martin Helmling
use SL::Helper::CreatePDF qw(merge_pdfs);
99ccfeab Moritz Bunkus
c510d88b Sven Schöling
use strict;

d3160c04 Moritz Bunkus
sub read_version {
6627c9eb Sven Schöling
SL::Version->get_version;
d3160c04 Moritz Bunkus
}

d319704a Moritz Bunkus
sub new {
$main::lxdebug->enter_sub();

my $type = shift;

my $self = {};

2cd68ea4 Sven Schöling
no warnings 'once';
e7191bc2 Moritz Bunkus
if ($LXDebug::watch_form) {
require SL::Watchdog;
tie %{ $self }, 'SL::Watchdog';
}

570abc83 Moritz Bunkus
bless $self, $type;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

e5478aea Moritz Bunkus
return $self;
d319704a Moritz Bunkus
}

777bf75c Moritz Bunkus
sub _flatten_variables_rec {
$main::lxdebug->enter_sub(2);

my $self = shift;
my $curr = shift;
my $prefix = shift;
my $key = shift;

my @result;

if ('' eq ref $curr->{$key}) {
@result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} });

} elsif ('HASH' eq ref $curr->{$key}) {
foreach my $hash_key (sort keys %{ $curr->{$key} }) {
push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key);
}

} else {
foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) {
my $first_array_entry = 1;

a45d8cbe Sven Schöling
my $element = $curr->{$key}[$idx];

if ('HASH' eq ref $element) {
foreach my $hash_key (sort keys %{ $element }) {
push @result, $self->_flatten_variables_rec($element, $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key);
$first_array_entry = 0;
}
} else {
9096031d Sven Schöling
push @result, { 'key' => $prefix . $key . '[]', 'value' => $element };
777bf75c Moritz Bunkus
}
}
}

$main::lxdebug->leave_sub(2);

return @result;
}

sub flatten_variables {
$main::lxdebug->enter_sub(2);

my $self = shift;
my @keys = @_;

my @variables;

foreach (@keys) {
push @variables, $self->_flatten_variables_rec($self, '', $_);
}

$main::lxdebug->leave_sub(2);

return @variables;
}

8c7e4493 Moritz Bunkus
sub flatten_standard_variables {
$main::lxdebug->enter_sub(2);

my $self = shift;
d90b14b1 Sven Schöling
my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar), @_);
8c7e4493 Moritz Bunkus
my @variables;

foreach (grep { ! $skip_keys{$_} } keys %{ $self }) {
push @variables, $self->_flatten_variables_rec($self, '', $_);
}

$main::lxdebug->leave_sub(2);

return @variables;
}
777bf75c Moritz Bunkus
d319704a Moritz Bunkus
sub escape {
ef17e41a Moritz Bunkus
my ($self, $str) = @_;
d319704a Moritz Bunkus
48abd6c9 Sven Schöling
return uri_encode($str);
d319704a Moritz Bunkus
}

sub unescape {
my ($self, $str) = @_;

48abd6c9 Sven Schöling
return uri_decode($str);
d319704a Moritz Bunkus
}

3aaf323a Stephan Köhler
sub quote {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
3aaf323a Stephan Köhler
my ($self, $str) = @_;

081a4f97 Moritz Bunkus
if ($str && !ref($str)) {
8b68b3f8 Moritz Bunkus
$str =~ s/\"/&quot;/g;
3aaf323a Stephan Köhler
}

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
3aae3709 Moritz Bunkus
return $str;
3aaf323a Stephan Köhler
}

sub unquote {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
3aaf323a Stephan Köhler
my ($self, $str) = @_;

081a4f97 Moritz Bunkus
if ($str && !ref($str)) {
8b68b3f8 Moritz Bunkus
$str =~ s/&quot;/\"/g;
3aaf323a Stephan Köhler
}

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
3aae3709 Moritz Bunkus
return $str;
3aaf323a Stephan Köhler
}

sub hide_form {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
3aaf323a Stephan Köhler
my $self = shift;

if (@_) {
5494f687 Sven Schöling
map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
3aaf323a Stephan Köhler
} else {
081a4f97 Moritz Bunkus
for (sort keys %$self) {
ef17e41a Moritz Bunkus
next if (($_ eq "header") || (ref($self->{$_}) ne ""));
5494f687 Sven Schöling
print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
081a4f97 Moritz Bunkus
}
3aaf323a Stephan Köhler
}
560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
3aaf323a Stephan Köhler
}

8c31500d Moritz Bunkus
sub throw_on_error {
my ($self, $code) = @_;
6bdcd838 Moritz Bunkus
local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) };
8c31500d Moritz Bunkus
$code->();
}

d319704a Moritz Bunkus
sub error {
$main::lxdebug->enter_sub();

142f7c2c Moritz Bunkus
$main::lxdebug->show_backtrace();
4b17bfa8 Moritz Bunkus
d319704a Moritz Bunkus
my ($self, $msg) = @_;
8c31500d Moritz Bunkus
if ($self->{__ERROR_HANDLER}) {
$self->{__ERROR_HANDLER}->($msg);

} elsif ($ENV{HTTP_USER_AGENT}) {
d319704a Moritz Bunkus
$msg =~ s/\n/<br>/g;
637325bb Moritz Bunkus
$self->show_generic_error($msg);
d319704a Moritz Bunkus
} else {
c2bb1ff4 Moritz Bunkus
confess "Error: $msg\n";
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

sub info {
$main::lxdebug->enter_sub();

my ($self, $msg) = @_;

if ($ENV{HTTP_USER_AGENT}) {
86937e15 Moritz Bunkus
$self->header;
print $self->parse_html_template('generic/form_info', { message => $msg });
d319704a Moritz Bunkus
86937e15 Moritz Bunkus
} elsif ($self->{info_function}) {
&{ $self->{info_function} }($msg);
d319704a Moritz Bunkus
} else {
86937e15 Moritz Bunkus
print "$msg\n";
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

29795499 Sven Schöling
# calculates the number of rows in a textarea based on the content and column number
# can be capped with maxrows
d319704a Moritz Bunkus
sub numtextrows {
$main::lxdebug->enter_sub();
8c7e4493 Moritz Bunkus
my ($self, $str, $cols, $maxrows, $minrows) = @_;

$minrows ||= 1;
d319704a Moritz Bunkus
29795499 Sven Schöling
my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
$maxrows ||= $rows;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
8c7e4493 Moritz Bunkus
return max(min($rows, $maxrows), $minrows);
d319704a Moritz Bunkus
}

sub dberror {
my ($self, $msg) = @_;

6bdcd838 Moritz Bunkus
SL::X::DBError->throw(
msg => $msg,
db_error => $DBI::errstr,
660c7e53 Sven Schöling
);
d319704a Moritz Bunkus
}

sub isblank {
$main::lxdebug->enter_sub();

my ($self, $name, $msg) = @_;

777bf75c Moritz Bunkus
my $curr = $self;
7db5b95a Moritz Bunkus
foreach my $part (split m/\./, $name) {
777bf75c Moritz Bunkus
if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
$self->error($msg);
}
$curr = $curr->{$part};
d319704a Moritz Bunkus
}
777bf75c Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

ad9563c8 Moritz Bunkus
sub _get_request_uri {
my $self = shift;

return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
1d1cd1dd Sven Schöling
return URI->new if !$ENV{REQUEST_URI}; # for testing
ad9563c8 Moritz Bunkus
8e51379e Sven Schöling
my $scheme = $::request->is_https ? 'https' : 'http';
1d1cd1dd Sven Schöling
my $port = $ENV{SERVER_PORT};
ad9563c8 Moritz Bunkus
$port = undef if (($scheme eq 'http' ) && ($port == 80))
|| (($scheme eq 'https') && ($port == 443));

my $uri = URI->new("${scheme}://");
$uri->scheme($scheme);
$uri->port($port);
$uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR});
$uri->path_query($ENV{REQUEST_URI});
$uri->query('');

return $uri;
}

63b61189 Moritz Bunkus
sub _add_to_request_uri {
my $self = shift;

my $relative_new_path = shift;
my $request_uri = shift || $self->_get_request_uri;
my $relative_new_uri = URI->new($relative_new_path);
my @request_segments = $request_uri->path_segments;

my $new_uri = $request_uri->clone;
$new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments);

return $new_uri;
}

0c75bd00 Moritz Bunkus
sub create_http_response {
$main::lxdebug->enter_sub();

my $self = shift;
my %params = @_;

5494f687 Sven Schöling
my $cgi = $::request->{cgi};
0c75bd00 Moritz Bunkus
my $session_cookie;
if (defined $main::auth) {
07036bf1 Moritz Bunkus
my $uri = $self->_get_request_uri;
my @segments = $uri->path_segments;
pop @segments;
$uri->path_segments(@segments);

a97ebf45 Moritz Bunkus
my $session_cookie_value = $main::auth->get_session_id();
0c75bd00 Moritz Bunkus
a97ebf45 Moritz Bunkus
if ($session_cookie_value) {
d56bda45 Moritz Bunkus
$session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
'-value' => $session_cookie_value,
'-path' => $uri->path,
'-expires' => '+' . $::auth->{session_timeout} . 'm',
'-secure' => $::request->is_https);
86751c7a Moritz Bunkus
$session_cookie = "$session_cookie; SameSite=strict";
a97ebf45 Moritz Bunkus
}
0c75bd00 Moritz Bunkus
}

7b2d21f4 Moritz Bunkus
my %cgi_params = ('-type' => $params{content_type});
704e9499 Moritz Bunkus
$cgi_params{'-charset'} = $params{charset} if ($params{charset});
a97ebf45 Moritz Bunkus
$cgi_params{'-cookie'} = $session_cookie if ($session_cookie);
0c75bd00 Moritz Bunkus
2a496ad8 Moritz Bunkus
map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
4d6e7659 Moritz Bunkus
a97ebf45 Moritz Bunkus
my $output = $cgi->header(%cgi_params);
0c75bd00 Moritz Bunkus
$main::lxdebug->leave_sub();

return $output;
}

d319704a Moritz Bunkus
sub header {
50365526 Sven Schöling
$::lxdebug->enter_sub;
d319704a Moritz Bunkus
072d299d Sven Schöling
my ($self, %params) = @_;
50365526 Sven Schöling
my @header;
d319704a Moritz Bunkus
50365526 Sven Schöling
$::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
faef45c2 Moritz Bunkus
ddb162b6 Sven Schöling
if ($params{no_layout}) {
b6fd15a8 Sven Schöling
$::request->{layout} = SL::Layout::Dispatcher->new(style => 'none');
ddb162b6 Sven Schöling
}

my $layout = $::request->{layout};

0f179c9a Sven Schöling
# standard css for all
9ac3edeb Sven Schöling
# this should gradually move to the layouts that need it
0f179c9a Sven Schöling
$layout->use_stylesheet("$_.css") for qw(
92de2a26 Sven Schöling
common main menu list_accounts jquery.autocomplete
f64f0648 Moritz Bunkus
jquery.multiselect2side
7ff0d2ab Moritz Bunkus
ui-lightness/jquery-ui
6dbc83af Moritz Bunkus
jquery-ui.custom
c0713b66 Moritz Bunkus
tooltipster themes/tooltipster-light
0f179c9a Sven Schöling
);

a56327d7 Moritz Bunkus
$layout->use_javascript("$_.js") for (qw(
6dbc83af Moritz Bunkus
jquery jquery-ui jquery.cookie jquery.checkall jquery.download
9ef29797 Bernd Bleßmann
jquery/jquery.form jquery/fixes namespace client_js
c0713b66 Moritz Bunkus
jquery/jquery.tooltipster.min
b70da193 Sven Schöling
common part_selection
a56327d7 Moritz Bunkus
), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
01b3bcb9 Sven Schöling
6092ef39 Moritz Bunkus
$layout->use_javascript("$_.js") for @{ $params{use_javascripts} // [] };

50365526 Sven Schöling
$self->{favicon} ||= "favicon.ico";
d90b14b1 Sven Schöling
$self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->read_version if $self->{title} || !$self->{titlebar};
154fc71c Moritz Bunkus
50365526 Sven Schöling
# build includes
if ($self->{refresh_url} || $self->{refresh_time}) {
my $refresh_time = $self->{refresh_time} || 3;
my $refresh_url = $self->{refresh_url} || $ENV{REFERER};
push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
}
d319704a Moritz Bunkus
bae050e9 Moritz Bunkus
my $auto_reload_resources_param = $layout->auto_reload_resources_param;

push @header, map { qq|<link rel="stylesheet" href="${_}${auto_reload_resources_param}" type="text/css" title="Stylesheet">| } $layout->stylesheets;
0f179c9a Sven Schöling
push @header, "<style type='text/css'>\@page { size:landscape; }</style> " if $self->{landscape};
push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>" if -f $self->{favicon};
bae050e9 Moritz Bunkus
push @header, map { qq|<script type="text/javascript" src="${_}${auto_reload_resources_param}"></script>| } $layout->javascripts;
ceaa31db Sven Schöling
push @header, '<meta name="viewport" content="width=device-width, initial-scale=1">';
ffcac560 Sven Schöling
push @header, $self->{javascript} if $self->{javascript};
50365526 Sven Schöling
push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };

7ef8fa08 Sven Schöling
my %doctypes = (
strict => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|,
transitional => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|,
frameset => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|,
0f179c9a Sven Schöling
html5 => qq|<!DOCTYPE html>|,
7ef8fa08 Sven Schöling
);

50365526 Sven Schöling
# output
dbda14c2 Moritz Bunkus
print $self->create_http_response(content_type => 'text/html', charset => 'UTF-8');
2b6e91d5 Sven Schöling
print $doctypes{$params{doctype} || $::request->layout->html_dialect}, $/;
50365526 Sven Schöling
print <<EOT;
<html>
<head>
dbda14c2 Moritz Bunkus
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
d319704a Moritz Bunkus
<title>$self->{titlebar}</title>
50365526 Sven Schöling
EOT
print " $_\n" for @header;
print <<EOT;
cf4ac170 Sven Schöling
<meta name="robots" content="noindex,nofollow">
50365526 Sven Schöling
</head>
3880d657 Sven Schöling
<body>
d319704a Moritz Bunkus
50365526 Sven Schöling
EOT
4a12c839 Sven Schöling
print $::request->{layout}->pre_content;
print $::request->{layout}->start_content;
d319704a Moritz Bunkus
2219d158 Sven Schöling
$layout->header_done;

50365526 Sven Schöling
$::lxdebug->leave_sub;
d319704a Moritz Bunkus
}

4a12c839 Sven Schöling
sub footer {
2219d158 Sven Schöling
return unless $::request->{layout}->need_footer;

0f179c9a Sven Schöling
print $::request->{layout}->end_content;
4a12c839 Sven Schöling
print $::request->{layout}->post_content;
a8814e0e Sven Schöling
if (my @inline_scripts = $::request->{layout}->javascripts_inline) {
fb0b04e5 Sven Schöling
print "<script type='text/javascript'>" . join("; ", @inline_scripts) . "</script>\n";
a8814e0e Sven Schöling
}
4a12c839 Sven Schöling
print <<EOL
</body>
</html>
EOL
}

08ca74a8 Moritz Bunkus
sub ajax_response_header {
$main::lxdebug->enter_sub();

my ($self) = @_;

dbda14c2 Moritz Bunkus
my $output = $::request->{cgi}->header('-charset' => 'UTF-8');
08ca74a8 Moritz Bunkus
$main::lxdebug->leave_sub();

return $output;
}

ad9563c8 Moritz Bunkus
sub redirect_header {
my $self = shift;
my $new_url = shift;

my $base_uri = $self->_get_request_uri;
my $new_uri = URI->new_abs($new_url, $base_uri);

8a149188 Sven Schöling
die "Headers already sent" if $self->{header};
ad9563c8 Moritz Bunkus
$self->{header} = 1;

5494f687 Sven Schöling
return $::request->{cgi}->redirect($new_uri);
ad9563c8 Moritz Bunkus
}

dc50b737 Sven Schöling
sub set_standard_title {
$::lxdebug->enter_sub;
my $self = shift;

d90b14b1 Sven Schöling
$self->{titlebar} = "kivitendo " . $::locale->text('Version') . " " . $self->read_version;
dc50b737 Sven Schöling
$self->{titlebar} .= "- $::myconfig{name}" if $::myconfig{name};
$self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};

$::lxdebug->leave_sub;
}

bf3cc4b6 Moritz Bunkus
sub _prepare_html_template {
99ccfeab Moritz Bunkus
$main::lxdebug->enter_sub();

2787b39a Moritz Bunkus
my ($self, $file, $additional_params) = @_;
af85b761 Moritz Bunkus
my $language;
40db40e8 Moritz Bunkus
f59ed16f Sven Schöling
if (!%::myconfig || !$::myconfig{"countrycode"}) {
be6f6cfd Moritz Bunkus
$language = $::lx_office_conf{system}->{language};
af85b761 Moritz Bunkus
} else {
$language = $main::myconfig{"countrycode"};
}
f65faf20 Moritz Bunkus
$language = "de" unless ($language);
af85b761 Moritz Bunkus
25205ac9 Sven Schöling
my $webpages_path = $::request->layout->webpages_path;
my $webpages_fallback = $::request->layout->webpages_fallback_path;
4abd6557 Sven Schöling
25205ac9 Sven Schöling
my @templates = first { -f } map { "${_}/${file}.html" } grep { defined } $webpages_path, $webpages_fallback;
79038417 Moritz Bunkus
25205ac9 Sven Schöling
if (@templates) {
$file = $templates[0];
bdd1d7ea Sven Schöling
} elsif (ref $file eq 'SCALAR') {
# file is a scalarref, use inline mode
40db40e8 Moritz Bunkus
} else {
70bf7517 Sven Schöling
my $info = "Web page template '${file}' not found.\n";
bdd1d7ea Sven Schöling
$::form->header;
70bf7517 Sven Schöling
print qq|<pre>$info</pre>|;
09479f02 Moritz Bunkus
$::dispatcher->end_request;
40db40e8 Moritz Bunkus
}
99ccfeab Moritz Bunkus
a6f47843 Sven Schöling
$additional_params->{AUTH} = $::auth;
15e4b732 Moritz Bunkus
$additional_params->{INSTANCE_CONF} = $::instance_conf;
a6f47843 Sven Schöling
$additional_params->{LOCALE} = $::locale;
$additional_params->{LXCONFIG} = \%::lx_office_conf;
$additional_params->{LXDEBUG} = $::lxdebug;
$additional_params->{MYCONFIG} = \%::myconfig;
d1c335e9 Moritz Bunkus
bf3cc4b6 Moritz Bunkus
$main::lxdebug->leave_sub();

return $file;
}

9aaca433 Moritz Bunkus
sub parse_html_template {
bf3cc4b6 Moritz Bunkus
$main::lxdebug->enter_sub();

my ($self, $file, $additional_params) = @_;

$additional_params ||= { };

567c0d7c Sven Schöling
my $real_file = $self->_prepare_html_template($file, $additional_params);
9d8f72a0 Moritz Bunkus
my $template = $self->template;
bf3cc4b6 Moritz Bunkus
map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };

my $output;
567c0d7c Sven Schöling
$template->process($real_file, $additional_params, \$output) || die $template->error;
bf3cc4b6 Moritz Bunkus
$main::lxdebug->leave_sub();

return $output;
}

9d8f72a0 Moritz Bunkus
sub template { $::request->presenter->get_template }
567c0d7c Sven Schöling
99ccfeab Moritz Bunkus
sub show_generic_error {
02d89fd6 Moritz Bunkus
$main::lxdebug->enter_sub();

5c184abc Moritz Bunkus
my ($self, $error, %params) = @_;
99ccfeab Moritz Bunkus
8c31500d Moritz Bunkus
if ($self->{__ERROR_HANDLER}) {
$self->{__ERROR_HANDLER}->($error);
$main::lxdebug->leave_sub();
return;
}

b9740e8a Moritz Bunkus
if ($::request->is_ajax) {
SL::ClientJS->new
->error($error)
->render(SL::Controller::Base->new);
09479f02 Moritz Bunkus
$::dispatcher->end_request;
b9740e8a Moritz Bunkus
}

83cc6a5b Moritz Bunkus
my $add_params = {
5c184abc Moritz Bunkus
'title_error' => $params{title},
83cc6a5b Moritz Bunkus
'label_error' => $error,
};
99ccfeab Moritz Bunkus
d71bfc9b Sven Schöling
$self->{title} = $params{title} if $params{title};
83cc6a5b Moritz Bunkus
dd7cbf4f Moritz Bunkus
for my $bar ($::request->layout->get('actionbar')) {
$bar->add(
action => [
t8('Back'),
call => [ 'kivi.history_back' ],
accesskey => 'enter',
],
);
}

d1c335e9 Moritz Bunkus
$self->header();
9aaca433 Moritz Bunkus
print $self->parse_html_template("generic/error", $add_params);
d1c335e9 Moritz Bunkus
b2945bf6 Sven Schöling
print STDERR "Error: $error\n";

02d89fd6 Moritz Bunkus
$main::lxdebug->leave_sub();

09479f02 Moritz Bunkus
$::dispatcher->end_request;
d1c335e9 Moritz Bunkus
}

sub show_generic_information {
02d89fd6 Moritz Bunkus
$main::lxdebug->enter_sub();

83cc6a5b Moritz Bunkus
my ($self, $text, $title) = @_;

my $add_params = {
'title_information' => $title,
'label_information' => $text,
};
d1c335e9 Moritz Bunkus
83cc6a5b Moritz Bunkus
$self->{title} = $title if ($title);
d1c335e9 Moritz Bunkus
$self->header();
9aaca433 Moritz Bunkus
print $self->parse_html_template("generic/information", $add_params);
d1c335e9 Moritz Bunkus
02d89fd6 Moritz Bunkus
$main::lxdebug->leave_sub();

09479f02 Moritz Bunkus
$::dispatcher->end_request;
99ccfeab Moritz Bunkus
}

75f69249 Moritz Bunkus
sub _store_redirect_info_in_session {
my ($self) = @_;

return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x;

my ($controller, $params) = ($1, $2);
my $form = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params };
$self->{callback} = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form);
}

d319704a Moritz Bunkus
sub redirect {
$main::lxdebug->enter_sub();

my ($self, $msg) = @_;

dc50b737 Sven Schöling
if (!$self->{callback}) {
d319704a Moritz Bunkus
$self->info($msg);

3f930238 Moritz Bunkus
} else {
d975c574 Moritz Bunkus
SL::Helper::Flash::flash_later('info', $msg) if $msg;
75f69249 Moritz Bunkus
$self->_store_redirect_info_in_session;
3f930238 Moritz Bunkus
print $::form->redirect_header($self->{callback});
}
dc50b737 Sven Schöling
09479f02 Moritz Bunkus
$::dispatcher->end_request;
dc50b737 Sven Schöling
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

# sort of columns removed - empty sub
sub sort_columns {
$main::lxdebug->enter_sub();

my ($self, @columns) = @_;

$main::lxdebug->leave_sub();

return @columns;
}
e5e6947b Moritz Bunkus
#
d319704a Moritz Bunkus
5c0b8569 Sven Schöling
sub format_amount {
my ($self, $myconfig, $amount, $places, $dash) = @_;
SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
}
8c7e4493 Moritz Bunkus
b14c2015 Moritz Bunkus
sub format_string {
$main::lxdebug->enter_sub(2);

my $self = shift;
my $input = shift;

$input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx;
$input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
$input =~ s/\#\#/\#/g;

$main::lxdebug->leave_sub(2);

return $input;
}

8c7e4493 Moritz Bunkus
#

5c0b8569 Sven Schöling
sub parse_amount {
my ($self, $myconfig, $amount) = @_;
SL::Helper::Number::_parse_number($amount, %$myconfig);
}
081a4f97 Moritz Bunkus
a967d2a4 Sven Schöling
sub round_amount { shift; goto &SL::Helper::Number::_round_number; }
3aaf323a Stephan Köhler
d319704a Moritz Bunkus
sub parse_template {
$main::lxdebug->enter_sub();

8cd05ad6 Moritz Bunkus
my ($self, $myconfig) = @_;
6ff1674f Sven Schöling
my ($out, $out_mode);
974b5d86 Moritz Bunkus
local (*IN, *OUT);
54e4131e Moritz Bunkus
dc8ffeaa Moritz Bunkus
my $defaults = SL::DB::Default->get;
8cd05ad6 Moritz Bunkus
dc8ffeaa Moritz Bunkus
my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files};
$self->{cwd} = getcwd();
my $temp_dir = File::Temp->newdir(
"kivitendo-print-XXXXXX",
DIR => $self->{cwd} . "/" . $::lx_office_conf{paths}->{userspath},
CLEANUP => !$keep_temp_files,
);

my $userspath = File::Spec->abs2rel($temp_dir->dirname);
$self->{tmpdir} = $temp_dir->dirname;
54e4131e Moritz Bunkus
49c7621e Moritz Bunkus
my $ext_for_format;

0fba3edd Moritz Bunkus
my $template_type;
54e4131e Moritz Bunkus
if ($self->{"format"} =~ /(opendocument|oasis)/i) {
0fba3edd Moritz Bunkus
$template_type = 'OpenDocument';
66c91148 Moritz Bunkus
$ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
49c7621e Moritz Bunkus
54e4131e Moritz Bunkus
} elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
0fba3edd Moritz Bunkus
$template_type = 'LaTeX';
49c7621e Moritz Bunkus
$ext_for_format = 'pdf';

} elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
0fba3edd Moritz Bunkus
$template_type = 'HTML';
49c7621e Moritz Bunkus
$ext_for_format = 'html';

90815a31 Joachim Zach
} elsif ( $self->{"format"} =~ /excel/i ) {
0fba3edd Moritz Bunkus
$template_type = 'Excel';
90815a31 Joachim Zach
$ext_for_format = 'xls';

9f055edb Udo Spallek
} elsif ( defined $self->{'format'}) {
$self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
49c7621e Moritz Bunkus
9f055edb Udo Spallek
} elsif ( $self->{'format'} eq '' ) {
$self->error("No Outputformat given: $self->{'format'}");
49c7621e Moritz Bunkus
9f055edb Udo Spallek
} else { #Catch the rest
ef17e41a Moritz Bunkus
$self->error("Outputformat not defined: $self->{'format'}");
54e4131e Moritz Bunkus
}
d319704a Moritz Bunkus
0fba3edd Moritz Bunkus
my $template = SL::Template::create(type => $template_type,
file_name => $self->{IN},
form => $self,
myconfig => $myconfig,
3e466ad1 Moritz Bunkus
userspath => $userspath,
%{ $self->{TEMPLATE_DRIVER_OPTIONS} || {} });
0fba3edd Moritz Bunkus
d319704a Moritz Bunkus
# Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be.
2f8ead12 Moritz Bunkus
$self->{"notes"} = $self->{ $self->{"formname"} . "notes" } if exists $self->{ $self->{"formname"} . "notes" };
d319704a Moritz Bunkus
6c56877d Moritz Bunkus
if (!$self->{employee_id}) {
cd417762 Moritz Bunkus
$self->{"employee_${_}"} = $myconfig->{$_} for qw(email tel fax name signature);
$self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
6c56877d Moritz Bunkus
}
d319704a Moritz Bunkus
cd417762 Moritz Bunkus
$self->{"myconfig_${_}"} = $myconfig->{$_} for grep { $_ ne 'dbpasswd' } keys %{ $myconfig };
$self->{$_} = $defaults->$_ for qw(co_ustid);
$self->{"myconfig_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
893ae739 Sven Schöling
$self->{AUTH} = $::auth;
$self->{INSTANCE_CONF} = $::instance_conf;
$self->{LOCALE} = $::locale;
$self->{LXCONFIG} = $::lx_office_conf;
$self->{LXDEBUG} = $::lxdebug;
$self->{MYCONFIG} = \%::myconfig;
e3232a58 Udo Spallek
d319704a Moritz Bunkus
$self->{copies} = 1 if (($self->{copies} *= 1) <= 0);

# OUT is used for the media, screen, printer, email
# for postscript we store a copy in a temporary file
df50ddd5 Moritz Bunkus
b3b1b699 Moritz Bunkus
my ($temp_fh, $suffix);
$suffix = $self->{IN};
$suffix =~ s/.*\.//;
($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
3afca6ae Moritz Bunkus
strftime('kivitendo-print-%Y%m%d%H%M%S-XXXXXX', localtime()),
b3b1b699 Moritz Bunkus
SUFFIX => '.' . ($suffix || 'tex'),
DIR => $userspath,
df50ddd5 Moritz Bunkus
UNLINK => $keep_temp_files ? 0 : 1,
b3b1b699 Moritz Bunkus
);
close $temp_fh;
df50ddd5 Moritz Bunkus
chmod 0644, $self->{tmpfile} if $keep_temp_files;
d7acc048 Wulf Coulmann
(undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} );
974b5d86 Moritz Bunkus
20069819 Moritz Bunkus
$out = $self->{OUT};
$out_mode = $self->{OUT_MODE} || '>';
$self->{OUT} = "$self->{tmpfile}";
$self->{OUT_MODE} = '>';
d319704a Moritz Bunkus
f41c4ade Moritz Bunkus
my $result;
0e7795f3 Moritz Bunkus
my $command_formatter = sub {
my ($out_mode, $out) = @_;
return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
};
f41c4ade Moritz Bunkus
d319704a Moritz Bunkus
if ($self->{OUT}) {
0e7795f3 Moritz Bunkus
$self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
6ff1674f Sven Schöling
open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
d319704a Moritz Bunkus
} else {
56a13992 Sven Schöling
*OUT = ($::dispatcher->get_standard_filehandles)[1];
d319704a Moritz Bunkus
$self->header;
}

7274f9c8 Sven Schöling
if (!$template->parse(*OUT)) {
54e4131e Moritz Bunkus
$self->cleanup();
$self->error("$self->{IN} : " . $template->get_error());
d319704a Moritz Bunkus
}
53c26ac2 Moritz Bunkus
close OUT if $self->{OUT};
c29d964c Jan Büren
# check only one flag (webdav_documents)
# therefore copy to webdav, even if we do not have the webdav feature enabled (just archive)
55af54bc Jan Büren
my $copy_to_webdav = $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type}
&& $self->{type} ne 'statement';
a6873ed4 Bernd Bleßmann
$self->{attachment_filename} ||= $self->generate_attachment_filename;

c9b4e6bc Martin Helmling
if ( $ext_for_format eq 'pdf' && $self->doc_storage_enabled ) {
0bfbcce6 Martin Helmling
$self->append_general_pdf_attachments(filepath => $self->{tmpdir}."/".$self->{tmpfile},
type => $self->{type});
}
9c6337f3 Moritz Bunkus
if ($self->{media} eq 'file') {
copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
108753a7 Bernd Bleßmann
if ($copy_to_webdav) {
da1f7513 Bernd Bleßmann
if (my $error = Common::copy_file_to_webdav_folder($self)) {
chdir("$self->{cwd}");
$self->error($error);
}
108753a7 Bernd Bleßmann
}

6b019910 Bernd Bleßmann
if (!$self->{preview} && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled)
0bfbcce6 Martin Helmling
{
$self->store_pdf($self);
}
9c6337f3 Moritz Bunkus
$self->cleanup;
chdir("$self->{cwd}");

$::lxdebug->leave_sub();

return;
}

108753a7 Bernd Bleßmann
if ($copy_to_webdav) {
da1f7513 Bernd Bleßmann
if (my $error = Common::copy_file_to_webdav_folder($self)) {
chdir("$self->{cwd}");
$self->error($error);
}
108753a7 Bernd Bleßmann
}
91ea4ec2 Moritz Bunkus
6b019910 Bernd Bleßmann
if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) {
b0fc2ec2 Sven Schöling
my $file_obj = $self->store_pdf($self);
$self->{print_file_id} = $file_obj->id if $file_obj;
0bfbcce6 Martin Helmling
}
fc4cdd9b Jan Büren
# dn has its own send email method, but sets media for print templates
if ($self->{media} eq 'email' && !$self->{dunning_id}) {
a40f0c2f Martin Helmling
if ( getcwd() eq $self->{"tmpdir"} ) {
# in the case of generating pdf we are in the tmpdir, but WHY ???
$self->{tmpfile} = $userspath."/".$self->{tmpfile};
chdir("$self->{cwd}");
}
$self->send_email(\%::myconfig,$ext_for_format);
}
else {
$self->{OUT} = $out;
$self->{OUT_MODE} = $out_mode;
$self->output_file($template->get_mime_type,$command_formatter);
}
delete $self->{print_file_id};
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
$self->cleanup;
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
chdir("$self->{cwd}");
$main::lxdebug->leave_sub();
}
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
sub get_bcc_defaults {
my ($self, $myconfig, $mybcc) = @_;
edfac813 Martin Helmling
if (SL::DB::Default->get->bcc_to_login) {
$mybcc .= ", " if $mybcc;
$mybcc .= $myconfig->{email};
}
a40f0c2f Martin Helmling
my $otherbcc = SL::DB::Default->get->global_bcc;
if ($otherbcc) {
$mybcc .= ", " if $mybcc;
$mybcc .= $otherbcc;
}
return $mybcc;
}
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
sub send_email {
$main::lxdebug->enter_sub();
my ($self, $myconfig, $ext_for_format) = @_;
my $mail = Mailer->new;

map { $mail->{$_} = $self->{$_} }
d90b14b1 Sven Schöling
qw(cc subject message format);
a40f0c2f Martin Helmling
a96b6e95 Jan Büren
if ($self->{cc_employee}) {
my ($user, $my_emp_cc);
$user = SL::DB::Manager::AuthUser->find_by(login => $self->{cc_employee});
$my_emp_cc = $user->get_config_value('email') if ref $user eq 'SL::DB::AuthUser';
$mail->{cc} .= ", " if $mail->{cc};
$mail->{cc} .= $my_emp_cc if $my_emp_cc;
}

a40f0c2f Martin Helmling
$mail->{bcc} = $self->get_bcc_defaults($myconfig, $self->{bcc});
$mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
$mail->{from} = qq|"$myconfig->{name}" <$myconfig->{email}>|;
$mail->{fileid} = time() . '.' . $$ . '.';
824735fc Moritz Bunkus
$mail->{content_type} = "text/html";
a40f0c2f Martin Helmling
my $full_signature = $self->create_email_signature();

$mail->{attachments} = [];
my @attfiles;
# if we send html or plain text inline
if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
$mail->{message} =~ s/\r//g;
298aa1cb Moritz Bunkus
$mail->{message} =~ s{\n}{<br>\n}g;
a40f0c2f Martin Helmling
$mail->{message} .= $full_signature;
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
open(IN, "<", $self->{tmpfile})
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
$mail->{message} .= $_ while <IN>;
close(IN);
d319704a Moritz Bunkus
dd33cbec Moritz Bunkus
} elsif (($self->{attachment_policy} // '') ne 'no_file') {
my $attachment_name = $self->{attachment_filename} || $self->{tmpfile};
298aa1cb Moritz Bunkus
$attachment_name =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format);
dd33cbec Moritz Bunkus
if (($self->{attachment_policy} // '') eq 'old_file') {
0631649c Bernd Bleßmann
my ( $attfile ) = SL::File->get_all(object_id => $self->{id},
object_type => $self->{type},
file_type => 'document',
print_variant => $self->{formname},);
dd33cbec Moritz Bunkus
if ($attfile) {
$attfile->{override_file_name} = $attachment_name if $attachment_name;
push @attfiles, $attfile;
70ae535d Jan Büren
$self->{file_id} = $attfile->id;
a40f0c2f Martin Helmling
}
dd33cbec Moritz Bunkus
} else {
push @{ $mail->{attachments} }, { path => $self->{tmpfile},
id => $self->{print_file_id},
type => "application/pdf",
name => $attachment_name };
a40f0c2f Martin Helmling
}
}
dd33cbec Moritz Bunkus
push @attfiles,
grep { $_ }
map { SL::File->get(id => $_) }
@{ $self->{attach_file_ids} // [] };

foreach my $attfile ( @attfiles ) {
push @{ $mail->{attachments} }, {
path => $attfile->get_file,
id => $attfile->id,
type => $attfile->mime_type,
name => $attfile->{override_file_name} // $attfile->file_name,
content => $attfile->get_content ? ${ $attfile->get_content } : undef,
};
a40f0c2f Martin Helmling
}
dd33cbec Moritz Bunkus
a40f0c2f Martin Helmling
$mail->{message} =~ s/\r//g;
$mail->{message} .= $full_signature;
$self->{emailerr} = $mail->send();
56ed2f3a Moritz Bunkus
a40f0c2f Martin Helmling
$self->{email_journal_id} = $mail->{journalentry};
3d8c8e2f Martin Helmling
$self->{snumbers} = "emailjournal" . "_" . $self->{email_journal_id};
$self->{what_done} = $::form->{type};
$self->{addition} = "MAILED";
$self->save_history;
d319704a Moritz Bunkus
893edfe4 Bernd Bleßmann
if ($self->{emailerr}) {
$self->cleanup;
$self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr}));
}

a40f0c2f Martin Helmling
#write back for message info and mail journal
$self->{cc} = $mail->{cc};
$self->{bcc} = $mail->{bcc};
$self->{email} = $mail->{to};
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
$main::lxdebug->leave_sub();
}
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
sub output_file {
$main::lxdebug->enter_sub();
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
my ($self,$mimeType,$command_formatter) = @_;
my $numbytes = (-s $self->{tmpfile});
open(IN, "<", $self->{tmpfile})
or $self->error($self->cleanup . "$self->{tmpfile} : $!");
binmode IN;
0e7795f3 Moritz Bunkus
a40f0c2f Martin Helmling
$self->{copies} = 1 unless $self->{media} eq 'printer';
5ab97a89 Sven Schöling
a40f0c2f Martin Helmling
chdir("$self->{cwd}");
for my $i (1 .. $self->{copies}) {
if ($self->{OUT}) {
$self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
open OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
print OUT $_ while <IN>;
close OUT;
seek IN, 0, 0;
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
} else {
my %headers = ('-type' => $mimeType,
'-connection' => 'close',
'-charset' => 'UTF-8');
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
$self->{attachment_filename} ||= $self->generate_attachment_filename;
d319704a Moritz Bunkus
a40f0c2f Martin Helmling
if ($self->{attachment_filename}) {
%headers = (
%headers,
'-attachment' => $self->{attachment_filename},
'-content-length' => $numbytes,
'-charset' => '',
);
}
d1c335e9 Moritz Bunkus
a40f0c2f Martin Helmling
print $::request->cgi->header(%headers);

$::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
}
}
close(IN);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

6a751412 Moritz Bunkus
sub get_formname_translation {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
6a751412 Moritz Bunkus
my ($self, $formname) = @_;

$formname ||= $self->{formname};
564d8509 Sven Schöling
00f9b4aa Wulf Coulmann
$self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
ae1dafcd Sven Schöling
local $::locale = Locale->new($self->{recipient_locale});
00f9b4aa Wulf Coulmann
564d8509 Sven Schöling
my %formname_translations = (
41fab322 Bernd Bleßmann
bin_list => $main::locale->text('Bin List'),
credit_note => $main::locale->text('Credit Note'),
invoice => $main::locale->text('Invoice'),
invoice_copy => $main::locale->text('Invoice Copy'),
726a9fae Bernd Bleßmann
invoice_for_advance_payment => $main::locale->text('Invoice for Advance Payment'),
41fab322 Bernd Bleßmann
final_invoice => $main::locale->text('Final Invoice'),
pick_list => $main::locale->text('Pick List'),
proforma => $main::locale->text('Proforma Invoice'),
purchase_order => $main::locale->text('Purchase Order'),
7204be47 Bernd Bleßmann
purchase_order_confirmation => $main::locale->text('Purchase Order Confirmation'),
41fab322 Bernd Bleßmann
request_quotation => $main::locale->text('RFQ'),
37c4d9b1 Bernd Bleßmann
purchase_quotation_intake => $main::locale->text('Purchase Quotation Intake'),
c16a1baf Bernd Bleßmann
sales_order_intake => $main::locale->text('Sales Order Intake'),
41fab322 Bernd Bleßmann
sales_order => $main::locale->text('Confirmation'),
sales_quotation => $main::locale->text('Quotation'),
storno_invoice => $main::locale->text('Storno Invoice'),
sales_delivery_order => $main::locale->text('Delivery Order'),
purchase_delivery_order => $main::locale->text('Delivery Order'),
7074eea8 Sven Schöling
supplier_delivery_order => $main::locale->text('Supplier Delivery Order'),
rma_delivery_order => $main::locale->text('RMA Delivery Order'),
7ae1f251 Tamino Steinert
sales_reclamation => $main::locale->text('Sales Reclamation'),
purchase_reclamation => $main::locale->text('Purchase Reclamation'),
41fab322 Bernd Bleßmann
dunning => $main::locale->text('Dunning'),
dunning1 => $main::locale->text('Payment Reminder'),
dunning2 => $main::locale->text('Dunning'),
dunning3 => $main::locale->text('Last Dunning'),
dunning_invoice => $main::locale->text('Dunning Invoice'),
letter => $main::locale->text('Letter'),
ic_supply => $main::locale->text('Intra-Community supply'),
statement => $main::locale->text('Statement'),
564d8509 Sven Schöling
);

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
00f9b4aa Wulf Coulmann
return $formname_translations{$formname};
6a751412 Moritz Bunkus
}

17c2f7bd Bernd Bleßmann
sub get_cusordnumber_translation {
$main::lxdebug->enter_sub();
my ($self, $formname) = @_;

$formname ||= $self->{formname};

$self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
local $::locale = Locale->new($self->{recipient_locale});


$main::lxdebug->leave_sub();
return $main::locale->text('Your Order');
}

afe54bed Moritz Bunkus
sub get_number_prefix_for_type {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
6a751412 Moritz Bunkus
my ($self) = @_;

d707f7ac Moritz Bunkus
my $prefix =
475b7a3f Bernd Bleßmann
(first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note)) ? 'inv'
37c4d9b1 Bernd Bleßmann
: ($self->{type} =~ /_quotation/) ? 'quo'
41fab322 Bernd Bleßmann
: ($self->{type} =~ /_delivery_order$/) ? 'do'
: ($self->{type} =~ /letter/) ? 'letter'
: 'ord';
564d8509 Sven Schöling
a9b2cbe2 Jan Büren
# better default like this?
be1e36a6 Bernd Bleßmann
# : ($self->{type} =~ /(sales|purchase)_order/ : 'ord';
a9b2cbe2 Jan Büren
# : 'prefix_undefined';

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
afe54bed Moritz Bunkus
return $prefix;
}

sub get_extension_for_format {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
afe54bed Moritz Bunkus
my ($self) = @_;

my $extension = $self->{format} =~ /pdf/i ? ".pdf"
: $self->{format} =~ /postscript/i ? ".ps"
: $self->{format} =~ /opendocument/i ? ".odt"
90815a31 Joachim Zach
: $self->{format} =~ /excel/i ? ".xls"
afe54bed Moritz Bunkus
: $self->{format} =~ /html/i ? ".html"
: "";

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
afe54bed Moritz Bunkus
return $extension;
}

sub generate_attachment_filename {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
afe54bed Moritz Bunkus
my ($self) = @_;

00f9b4aa Wulf Coulmann
$self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
my $recipient_locale = Locale->new($self->{recipient_locale});

afe54bed Moritz Bunkus
my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();

475b7a3f Bernd Bleßmann
if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note))) {
00f9b4aa Wulf Coulmann
$attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
6826e7ed Moritz Bunkus
} elsif ($attachment_filename && $self->{"${prefix}number"}) {
afe54bed Moritz Bunkus
$attachment_filename .= "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
6826e7ed Moritz Bunkus
e943a04e Bernd Bleßmann
} elsif ($attachment_filename) {
$attachment_filename .= $self->get_extension_for_format();

564d8509 Sven Schöling
} else {
$attachment_filename = "";
}

6826e7ed Moritz Bunkus
$attachment_filename = $main::locale->quote_special_chars('filenames', $attachment_filename);
$attachment_filename =~ s|[\s/\\]+|_|g;

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
564d8509 Sven Schöling
return $attachment_filename;
}

afe54bed Moritz Bunkus
sub generate_email_subject {
560d94b2 Geoffrey Richardson
$main::lxdebug->enter_sub();
afe54bed Moritz Bunkus
my ($self) = @_;

my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
my $prefix = $self->get_number_prefix_for_type();

if ($subject && $self->{"${prefix}number"}) {
$subject .= " " . $self->{"${prefix}number"}
}

17c2f7bd Bernd Bleßmann
if ($self->{cusordnumber}) {
$subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject;
}

560d94b2 Geoffrey Richardson
$main::lxdebug->leave_sub();
afe54bed Moritz Bunkus
return $subject;
}

8ec984ac Jan Büren
sub generate_email_body {
$main::lxdebug->enter_sub();
6750c6aa Jan Büren
my ($self, %params) = @_;
8ec984ac Jan Büren
# simple german and english will work grammatically (most european languages as well)
# Dear Mr Alan Greenspan:
# Sehr geehrte Frau Meyer,
# A l’attention de Mme Villeroy,
# Gentile Signora Ferrari,
my $body = '';

47da14db Jan Büren
if ($self->{cp_id} && !$params{record_email}) {
8ec984ac Jan Büren
my $givenname = SL::DB::Contact->load_cached($self->{cp_id})->cp_givenname; # for qw(gender givename name);
my $name = SL::DB::Contact->load_cached($self->{cp_id})->cp_name; # for qw(gender givename name);
my $gender = SL::DB::Contact->load_cached($self->{cp_id})->cp_gender; # for qw(gender givename name);
my $mf = $gender eq 'f' ? 'female' : 'male';
$body = GenericTranslations->get(translation_type => "salutation_$mf", language_id => $self->{language_id});
$body .= ' ' . $givenname . ' ' . $name if $body;
} else {
$body = GenericTranslations->get(translation_type => "salutation_general", language_id => $self->{language_id});
}

return undef unless $body;

824735fc Moritz Bunkus
$body .= GenericTranslations->get(translation_type => "salutation_punctuation_mark", language_id => $self->{language_id});
$body = '<p>' . $::locale->quote_special_chars('HTML', $body) . '</p>';

d9ff130d Moritz Bunkus
my $translation_type = $params{translation_type} // "preset_text_$self->{formname}";
my $main_body = GenericTranslations->get(translation_type => $translation_type, language_id => $self->{language_id});
$main_body = GenericTranslations->get(translation_type => $params{fallback_translation_type}, language_id => $self->{language_id}) if !$main_body && $params{fallback_translation_type};
$body .= $main_body;
8ec984ac Jan Büren
$body = $main::locale->unquote_special_chars('HTML', $body);

$main::lxdebug->leave_sub();
return $body;
}

d319704a Moritz Bunkus
sub cleanup {
$main::lxdebug->enter_sub();

d232a246 Moritz Bunkus
my ($self, $application) = @_;

my $error_code = $?;
d319704a Moritz Bunkus
chdir("$self->{tmpdir}");

my @err = ();
d232a246 Moritz Bunkus
if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');

} elsif (-f "$self->{tmpfile}.err") {
3270e883 Geoffrey Richardson
open(FH, "<:encoding(UTF-8)", "$self->{tmpfile}.err");
d319704a Moritz Bunkus
@err = <FH>;
close(FH);
}

beeb5c96 Moritz Bunkus
if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
54e4131e Moritz Bunkus
$self->{tmpfile} =~ s|.*/||g;
# strip extension
$self->{tmpfile} =~ s/\.\w+$//g;
my $tmpfile = $self->{tmpfile};
unlink(<$tmpfile.*>);
d319704a Moritz Bunkus
}

chdir("$self->{cwd}");

$main::lxdebug->leave_sub();

return "@err";
}

sub datetonum {
$main::lxdebug->enter_sub();

my ($self, $date, $myconfig) = @_;
d71bfc9b Sven Schöling
my ($yy, $mm, $dd);
d319704a Moritz Bunkus
if ($date && $date =~ /\D/) {

if ($myconfig->{dateformat} =~ /^yy/) {
($yy, $mm, $dd) = split /\D/, $date;
}
if ($myconfig->{dateformat} =~ /^mm/) {
($mm, $dd, $yy) = split /\D/, $date;
}
if ($myconfig->{dateformat} =~ /^dd/) {
($dd, $mm, $yy) = split /\D/, $date;
}

$dd *= 1;
$mm *= 1;
$yy = ($yy < 70) ? $yy + 2000 : $yy;
$yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;

$dd = "0$dd" if ($dd < 10);
$mm = "0$mm" if ($mm < 10);

$date = "$yy$mm$dd";
}

$main::lxdebug->leave_sub();

return $date;
}

# Database routines used throughout
53cbf0de Sven Schöling
# DB Handling got moved to SL::DB, these are only shims for compatibility
d319704a Moritz Bunkus
sub dbconnect {
53cbf0de Sven Schöling
SL::DB->client->dbh;
d319704a Moritz Bunkus
}

820f3066 Moritz Bunkus
sub get_standard_dbh {
53cbf0de Sven Schöling
my $dbh = SL::DB->client->dbh;
820f3066 Moritz Bunkus
53cbf0de Sven Schöling
if ($dbh && !$dbh->{Active}) {
$main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$dbh is defined but not Active anymore");
SL::DB->client->dbh(undef);
de06210f Moritz Bunkus
}

53cbf0de Sven Schöling
SL::DB->client->dbh;
820f3066 Moritz Bunkus
}
6844d581 Moritz Bunkus
53cbf0de Sven Schöling
sub disconnect_standard_dbh {
SL::DB->client->dbh->rollback;
6844d581 Moritz Bunkus
}
820f3066 Moritz Bunkus
53cbf0de Sven Schöling
# /database

9e06d0e4 Philip Reetz
sub date_closed {
$main::lxdebug->enter_sub();

my ($self, $date, $myconfig) = @_;
9da45b82 Sven Schöling
my $dbh = $self->get_standard_dbh;
9e06d0e4 Philip Reetz
my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
cc0121af Jan Büren
my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));

# Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
3774d83b Moritz Bunkus
# es ist sicher ein conv_date vorher IMMER auszuführen.
# Testfälle ohne definiertes closedto:
cc0121af Jan Büren
# Leere Datumseingabe i.O.
# SELECT 1 FROM defaults WHERE '' < closedto
3774d83b Moritz Bunkus
# normale Zahlungsbuchung über Rechnungsmaske i.O.
6fb7bcc9 Moritz Bunkus
# SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
3774d83b Moritz Bunkus
# Testfälle mit definiertem closedto (30.04.2011):
cc0121af Jan Büren
# Leere Datumseingabe i.O.
# SELECT 1 FROM defaults WHERE '' < closedto
3774d83b Moritz Bunkus
# normale Buchung im geschloßenem Zeitraum i.O.
cc0121af Jan Büren
# SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
3774d83b Moritz Bunkus
# Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
cc0121af Jan Büren
# normale Buchung in aktiver Buchungsperiode i.O.
# SELECT 1 FROM defaults WHERE '01.05.2011' < closedto

9e06d0e4 Philip Reetz
my ($closed) = $sth->fetchrow_array;

$main::lxdebug->leave_sub();

return $closed;
}

f552f878 Jan Büren
# prevents bookings to the to far away future
sub date_max_future {
$main::lxdebug->enter_sub();

my ($self, $date, $myconfig) = @_;
9da45b82 Sven Schöling
my $dbh = $self->get_standard_dbh;
f552f878 Jan Büren
my $query = "SELECT 1 FROM defaults WHERE ? - current_date > max_future_booking_interval";
my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));

my ($max_future_booking_interval) = $sth->fetchrow_array;

$main::lxdebug->leave_sub();

return $max_future_booking_interval;
}


d319704a Moritz Bunkus
sub update_balance {
$main::lxdebug->enter_sub();

ef17e41a Moritz Bunkus
my ($self, $dbh, $table, $field, $where, $value, @values) = @_;
d319704a Moritz Bunkus
# if we have a value, go do it
if ($value != 0) {

# retrieve balance from table
my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
ef17e41a Moritz Bunkus
my $sth = prepare_execute_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
my ($balance) = $sth->fetchrow_array;
$sth->finish;

$balance += $value;

# update balance
$query = "UPDATE $table SET $field = $balance WHERE $where";
ef17e41a Moritz Bunkus
do_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
}
$main::lxdebug->leave_sub();
}

sub update_exchangerate {
$main::lxdebug->enter_sub();

9b04d6e3 Jan Büren
validate_pos(@_,
{ isa => 'Form'},
{ isa => 'DBI::db'},
{ type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
{ type => SCALAR, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+\d+\d+/ } } }, # we have three numers
fe243aca Jan Büren
{ type => SCALAR, callbacks => { is_null_or_ar_int => sub { $_[0] == 0
|| $_[0] > 0
e9b48f2e Jan Büren
&& $_[1]->[0]->{script} =~ m/cp\.pl|ar\.pl|is\.pl/ } } }, # value buy fxrate
fe243aca Jan Büren
{ type => SCALAR, callbacks => { is_null_or_ap_int => sub { $_[0] == 0
|| $_[0] > 0
e9b48f2e Jan Büren
&& $_[1]->[0]->{script} =~ m/cp\.pl|ap\.pl|ir\.pl/ } } }, # value sell fxrate
9b04d6e3 Jan Büren
{ type => SCALAR, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 },
{ type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/(ar|ap|bank_transactions)/ } }, optional => 1 }
);
fb37acdc Moritz Bunkus
9b04d6e3 Jan Büren
my ($self, $dbh, $curr, $transdate, $buy, $sell, $id, $record_table) = @_;
fb37acdc Moritz Bunkus
9b04d6e3 Jan Büren
# record has a exchange rate and should be updated
if ($record_table && $id) {
do_query($self, $dbh, qq|UPDATE $record_table SET exchangerate = ? WHERE id = ?|, $buy || $sell, $id);
fb37acdc Moritz Bunkus
$main::lxdebug->leave_sub();
return;
d319704a Moritz Bunkus
}

9b04d6e3 Jan Büren
my ($query);
a4d74009 Niclas Zimmermann
$query = qq|SELECT e.currency_id FROM exchangerate e
WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ?
ef17e41a Moritz Bunkus
FOR UPDATE|;
my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
d319704a Moritz Bunkus
fb37acdc Moritz Bunkus
if ($buy == 0) {
$buy = "";
}
if ($sell == 0) {
$sell = "";
}

$buy = conv_i($buy, "NULL");
$sell = conv_i($sell, "NULL");

d319704a Moritz Bunkus
my $set;
if ($buy != 0 && $sell != 0) {
$set = "buy = $buy, sell = $sell";
} elsif ($buy != 0) {
$set = "buy = $buy";
} elsif ($sell != 0) {
$set = "sell = $sell";
}

if ($sth->fetchrow_array) {
b8330aee Jan Büren
# die "this never happens never"; # except for credit or debit bookings
d319704a Moritz Bunkus
$query = qq|UPDATE exchangerate
SET $set
a4d74009 Niclas Zimmermann
WHERE currency_id = (SELECT id FROM currencies WHERE name = ?)
ef17e41a Moritz Bunkus
AND transdate = ?|;
f54fd660 Sven Schöling
d319704a Moritz Bunkus
} else {
a4d74009 Niclas Zimmermann
$query = qq|INSERT INTO exchangerate (currency_id, buy, sell, transdate)
VALUES ((SELECT id FROM currencies WHERE name = ?), $buy, $sell, ?)|;
d319704a Moritz Bunkus
}
$sth->finish;
ef17e41a Moritz Bunkus
do_query($self, $dbh, $query, $curr, $transdate);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

ef17e41a Moritz Bunkus
sub check_exchangerate {
$main::lxdebug->enter_sub();

cbb1f3f2 Jan Büren
validate_pos(@_,
9b04d6e3 Jan Büren
{ isa => 'Form'},
cbb1f3f2 Jan Büren
{ type => HASHREF, callbacks => { has_yy_in_dateformat => sub { $_[0]->{dateformat} =~ m/yy/ } } },
9b04d6e3 Jan Büren
{ type => SCALAR, callbacks => { is_fx_currency => sub { shift ne $_[1]->[0]->{defaultcurrency} } } }, # should be ISO three letter codes for currency identification (ISO 4217)
9f93f10d Jan Büren
{ type => SCALAR | HASHREF, callbacks => { is_valid_kivi_date => sub { shift =~ m/\d+.\d+.\d+/ } } }, # we have three numbers. Either DateTime or form scalar
{ type => SCALAR, callbacks => { is_buy_or_sell_rate => sub { shift =~ m/^(buy|sell)$/ } } },
452b5ca8 Bernd Bleßmann
{ type => SCALAR | UNDEF, callbacks => { is_current_form_id => sub { $_[0] == $_[1]->[0]->{id} } }, optional => 1 },
9f93f10d Jan Büren
{ type => SCALAR, callbacks => { is_valid_fx_table => sub { shift =~ m/^(ar|ap)$/ } }, optional => 1 }
cbb1f3f2 Jan Büren
);
9b04d6e3 Jan Büren
my ($self, $myconfig, $currency, $transdate, $fld, $id, $record_table) = @_;
ef17e41a Moritz Bunkus
9b04d6e3 Jan Büren
my $dbh = $self->get_standard_dbh($myconfig);

# callers wants a check if record has a exchange rate and should be fetched instead
if ($record_table && $id) {
my ($record_exchange_rate) = selectrow_query($self, $dbh, qq|SELECT exchangerate FROM $record_table WHERE id = ?|, $id);
46ca445c Jan Büren
if ($record_exchange_rate && $record_exchange_rate > 0) {
9b04d6e3 Jan Büren
$main::lxdebug->leave_sub();
fe243aca Jan Büren
# second param indicates record exchange rate
return ($record_exchange_rate, 1);
9b04d6e3 Jan Büren
}
fb37acdc Moritz Bunkus
}
ef17e41a Moritz Bunkus
9b04d6e3 Jan Büren
# fetch default from exchangerate table
ef17e41a Moritz Bunkus
my $query = qq|SELECT e.$fld FROM exchangerate e
a4d74009 Niclas Zimmermann
WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|;
fb37acdc Moritz Bunkus
ef17e41a Moritz Bunkus
my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
b262a6e8 Moritz Bunkus
ef17e41a Moritz Bunkus
$main::lxdebug->leave_sub();

return $exchangerate;
}

bea3f989 Moritz Bunkus
sub get_all_currencies {
fb37acdc Moritz Bunkus
$main::lxdebug->enter_sub();

f88cdcc7 Sven Schöling
my $self = shift;
my $myconfig = shift || \%::myconfig;
my $dbh = $self->get_standard_dbh($myconfig);
fb37acdc Moritz Bunkus
ba6a1366 Niclas Zimmermann
my $query = qq|SELECT name FROM currencies|;
my @currencies = map { $_->{name} } selectall_hashref_query($self, $dbh, $query);
fb37acdc Moritz Bunkus
$main::lxdebug->leave_sub();

bea3f989 Moritz Bunkus
return @currencies;
fb37acdc Moritz Bunkus
}

bea3f989 Moritz Bunkus
sub get_default_currency {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;
d331a3d7 Niclas Zimmermann
my $dbh = $self->get_standard_dbh($myconfig);
a4d74009 Niclas Zimmermann
my $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|;
d331a3d7 Niclas Zimmermann
my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
bea3f989 Moritz Bunkus
$main::lxdebug->leave_sub();

d331a3d7 Niclas Zimmermann
return $defaultcurrency;
bea3f989 Moritz Bunkus
}
fb37acdc Moritz Bunkus
54e4131e Moritz Bunkus
sub set_payment_options {
de009a3f Moritz Bunkus
my ($self, $myconfig, $transdate, $type) = @_;
54e4131e Moritz Bunkus
5bc87ade Moritz Bunkus
my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef;
return if !$terms;
54e4131e Moritz Bunkus
de009a3f Moritz Bunkus
my $is_invoice = $type =~ m{invoice}i;

5bc87ade Moritz Bunkus
$transdate ||= $self->{invdate} || $self->{transdate};
my $due_date = $self->{duedate} || $self->{reqdate};
566608b7 Philip Reetz
5bc87ade Moritz Bunkus
$self->{$_} = $terms->$_ for qw(terms_netto terms_skonto percent_skonto);
$self->{payment_description} = $terms->description;
$self->{netto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'net')->to_kivitendo;
$self->{skonto_date} = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'discount')->to_kivitendo;
820f3066 Moritz Bunkus
52ee8da6 Moritz Bunkus
my ($invtotal, $total);
my (%amounts, %formatted_amounts);
54a4321b Moritz Bunkus
52ee8da6 Moritz Bunkus
if ($self->{type} =~ /_order$/) {
$amounts{invtotal} = $self->{ordtotal};
$amounts{total} = $self->{ordtotal};

} elsif ($self->{type} =~ /_quotation$/) {
$amounts{invtotal} = $self->{quototal};
$amounts{total} = $self->{quototal};

} else {
$amounts{invtotal} = $self->{invtotal};
$amounts{total} = $self->{total};
}
map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;

5adfb691 Bernd Bleßmann
$amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
52ee8da6 Moritz Bunkus
$amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto};
$amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
$amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto});

7e6d7935 Moritz Bunkus
foreach (keys %amounts) {
$amounts{$_} = $self->round_amount($amounts{$_}, 2);
$formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
}
820f3066 Moritz Bunkus
if ($self->{"language_id"}) {
de009a3f Moritz Bunkus
my $language = SL::DB::Language->new(id => $self->{language_id})->load;

$self->{payment_terms} = $type =~ m{invoice}i ? $terms->translated_attribute('description_long_invoice', $language->id) : undef;
$self->{payment_terms} ||= $terms->translated_attribute('description_long', $language->id);

if ($language->output_dateformat) {
820f3066 Moritz Bunkus
foreach my $key (qw(netto_date skonto_date)) {
de009a3f Moritz Bunkus
$self->{$key} = $::locale->reformat_date($myconfig, $self->{$key}, $language->output_dateformat, $language->output_longdates);
54a4321b Moritz Bunkus
}
}
54e4131e Moritz Bunkus
de009a3f Moritz Bunkus
if ($language->output_numberformat && ($language->output_numberformat ne $myconfig->{numberformat})) {
local $myconfig->{numberformat};
$myconfig->{"numberformat"} = $language->output_numberformat;
$formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) for keys %amounts;
820f3066 Moritz Bunkus
}
54e4131e Moritz Bunkus
}

de009a3f Moritz Bunkus
$self->{payment_terms} = $self->{payment_terms} || ($is_invoice ? $terms->description_long_invoice : undef) || $terms->description_long;

820f3066 Moritz Bunkus
$self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
$self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
$self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
$self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
$self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
$self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
$self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
58cf6232 Moritz Bunkus
$self->{payment_terms} =~ s/<\%bic\%>/$self->{bic}/g;
$self->{payment_terms} =~ s/<\%iban\%>/$self->{iban}/g;
$self->{payment_terms} =~ s/<\%mandate_date_of_signature\%>/$self->{mandate_date_of_signature}/g;
$self->{payment_terms} =~ s/<\%mandator_id\%>/$self->{mandator_id}/g;
820f3066 Moritz Bunkus
52ee8da6 Moritz Bunkus
map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
238a69a6 Jan Büren
# put amounts in form for print template
foreach (keys %formatted_amounts) {
0119262d Jan Büren
next if $_ =~ m/(^total$|^invtotal$)/;
238a69a6 Jan Büren
$self->{$_} = $formatted_amounts{$_};
}
54e4131e Moritz Bunkus
}

sub get_template_language {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my $template_code = "";

if ($self->{language_id}) {
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT template_code FROM language WHERE id = ?|;
($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id});
54e4131e Moritz Bunkus
}

$main::lxdebug->leave_sub();

return $template_code;
}

sub get_printer_code {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my $template_code = "";

if ($self->{printer_id}) {
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|;
($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id});
54e4131e Moritz Bunkus
}

$main::lxdebug->leave_sub();

return $template_code;
}

sub get_shipto {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my $template_code = "";

if ($self->{shipto_id}) {
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id});
map({ $self->{$_} = $ref->{$_} } keys(%$ref));
4493d1eb Moritz Bunkus
my $cvars = CVar->get_custom_variables(
dbh => $dbh,
module => 'ShipTo',
trans_id => $self->{shipto_id},
);
$self->{"shiptocvar_$_->{name}"} = $_->{value} for @{ $cvars };
54e4131e Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

d319704a Moritz Bunkus
sub add_shipto {
54e4131e Moritz Bunkus
my ($self, $dbh, $id, $module) = @_;
ef17e41a Moritz Bunkus
d319704a Moritz Bunkus
my $shipto;
ef17e41a Moritz Bunkus
my @values;
a5f4490f Philip Reetz
1c181c11 Bernd Bleßmann
foreach my $item (qw(name department_1 department_2 street zipcode city country gln
b8fa93b5 Bernd Bleßmann
contact phone fax email)) {
d319704a Moritz Bunkus
if ($self->{"shipto$item"}) {
$shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
}
ef17e41a Moritz Bunkus
push(@values, $self->{"shipto${item}"});
d319704a Moritz Bunkus
}
a5f4490f Philip Reetz
4493d1eb Moritz Bunkus
return if !$shipto;

bca91008 Bernd Bleßmann
# shiptocp_gender only makes sense, if any other shipto attribute is set.
# Because shiptocp_gender is set to 'm' by default in forms
# it must not be considered above to decide if shiptos has to be added or
# updated, but must be inserted or updated as well in case.
push(@values, $self->{shiptocp_gender});

4493d1eb Moritz Bunkus
my $shipto_id = $self->{shipto_id};

if ($self->{shipto_id}) {
my $query = qq|UPDATE shipto set
shiptoname = ?,
shiptodepartment_1 = ?,
shiptodepartment_2 = ?,
shiptostreet = ?,
shiptozipcode = ?,
shiptocity = ?,
shiptocountry = ?,
shiptogln = ?,
shiptocontact = ?,
shiptophone = ?,
shiptofax = ?,
ed6ac955 Bernd Bleßmann
shiptoemail = ?,
shiptocp_gender = ?
4493d1eb Moritz Bunkus
WHERE shipto_id = ?|;
do_query($self, $dbh, $query, @values, $self->{shipto_id});
} else {
my $query = qq|SELECT * FROM shipto
WHERE shiptoname = ? AND
shiptodepartment_1 = ? AND
shiptodepartment_2 = ? AND
shiptostreet = ? AND
shiptozipcode = ? AND
shiptocity = ? AND
shiptocountry = ? AND
shiptogln = ? AND
shiptocontact = ? AND
shiptophone = ? AND
shiptofax = ? AND
shiptoemail = ? AND
15e3714a Bernd Bleßmann
shiptocp_gender = ? AND
4493d1eb Moritz Bunkus
module = ? AND
trans_id = ?|;
my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
if(!$insert_check){
my $insert_query =
qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln,
15e3714a Bernd Bleßmann
shiptocontact, shiptophone, shiptofax, shiptoemail, shiptocp_gender, module)
4493d1eb Moritz Bunkus
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
do_query($self, $dbh, $insert_query, $id, @values, $module);

$insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
54e4131e Moritz Bunkus
}
4493d1eb Moritz Bunkus
$shipto_id = $insert_check->{shipto_id};
d319704a Moritz Bunkus
}
ef17e41a Moritz Bunkus
4493d1eb Moritz Bunkus
return unless $shipto_id;

CVar->save_custom_variables(
dbh => $dbh,
module => 'ShipTo',
trans_id => $shipto_id,
variables => $self,
name_prefix => 'shipto',
);
d319704a Moritz Bunkus
}

sub get_employee {
$main::lxdebug->enter_sub();

my ($self, $dbh) = @_;

d4b17776 Sven Schöling
$dbh ||= $self->get_standard_dbh(\%main::myconfig);

ef17e41a Moritz Bunkus
my $query = qq|SELECT id, name FROM employee WHERE login = ?|;
16821864 Thomas Kasulke
($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login});
$self->{"employee_id"} *= 1;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

6c56877d Moritz Bunkus
sub get_employee_data {
afe8a81b Moritz Bunkus
$main::lxdebug->enter_sub();

6c56877d Moritz Bunkus
my $self = shift;
my %params = @_;
cd417762 Moritz Bunkus
my $defaults = SL::DB::Default->get;
6c56877d Moritz Bunkus
Common::check_params(\%params, qw(prefix));
Common::check_params_x(\%params, qw(id));

if (!$params{id}) {
$main::lxdebug->leave_sub();
return;
}
afe8a81b Moritz Bunkus
6c56877d Moritz Bunkus
my $myconfig = \%main::myconfig;
my $dbh = $params{dbh} || $self->get_standard_dbh($myconfig);
09a055b2 Sven Schöling
49be66cd Jan Büren
my ($login, $deleted) = selectrow_query($self, $dbh, qq|SELECT login,deleted FROM employee WHERE id = ?|, conv_i($params{id}));
afe8a81b Moritz Bunkus
if ($login) {
49be66cd Jan Büren
# login already fetched and still the same client (mandant) | same for both cases (delete|!delete)
6c56877d Moritz Bunkus
$self->{$params{prefix} . '_login'} = $login;
49be66cd Jan Büren
$self->{$params{prefix} . "_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns taxnumber);
afe8a81b Moritz Bunkus
49be66cd Jan Büren
if (!$deleted) {
# get employee data from auth.user_config
my $user = User->new(login => $login);
$self->{$params{prefix} . "_${_}"} = $user->{$_} for qw(email fax name signature tel);
} else {
# get saved employee data from employee
my $employee = SL::DB::Manager::Employee->find_by(id => conv_i($params{id}));
$self->{$params{prefix} . "_${_}"} = $employee->{"deleted_$_"} for qw(email fax signature tel);
$self->{$params{prefix} . "_name"} = $employee->name;
}
}
afe8a81b Moritz Bunkus
$main::lxdebug->leave_sub();
}

03c310de Moritz Bunkus
sub _get_contacts {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();

15682dc4 Moritz Bunkus
my ($self, $dbh, $id, $key) = @_;
d319704a Moritz Bunkus
15682dc4 Moritz Bunkus
$key = "all_contacts" unless ($key);
d319704a Moritz Bunkus
56ed6467 Moritz Bunkus
if (!$id) {
$self->{$key} = [];
$main::lxdebug->leave_sub();
return;
}

15682dc4 Moritz Bunkus
my $query =
ef17e41a Moritz Bunkus
qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
qq|FROM contacts | .
15682dc4 Moritz Bunkus
qq|WHERE cp_cv_id = ? | .
ef17e41a Moritz Bunkus
qq|ORDER BY lower(cp_name)|;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

03c310de Moritz Bunkus
sub _get_projects {
59f8f1fa Moritz Bunkus
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

my ($all, $old_id, $where, @values);

if (ref($key) eq "HASH") {
my $params = $key;

$key = "ALL_PROJECTS";

foreach my $p (keys(%{$params})) {
if ($p eq "all") {
$all = $params->{$p};
} elsif ($p eq "old_id") {
$old_id = $params->{$p};
} elsif ($p eq "key") {
$key = $params->{$p};
}
}
}

if (!$all) {
$where = "WHERE active ";
if ($old_id) {
cfc6a60d Moritz Bunkus
if (ref($old_id) eq "ARRAY") {
my @ids = grep({ $_ } @{$old_id});
if (@ids) {
$where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
push(@values, @ids);
}
} else {
$where .= " OR (id = ?) ";
push(@values, $old_id);
}
59f8f1fa Moritz Bunkus
}
}

my $query =
qq|SELECT id, projectnumber, description, active | .
qq|FROM project | .
$where .
qq|ORDER BY lower(projectnumber)|;

ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
59f8f1fa Moritz Bunkus
$main::lxdebug->leave_sub();
}

03c310de Moritz Bunkus
sub _get_printers {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_printers" unless ($key);

b12e8d14 Moritz Bunkus
my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;
03c310de Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
03c310de Moritz Bunkus
$main::lxdebug->leave_sub();
}

913fe339 Moritz Bunkus
sub _get_charts {
$main::lxdebug->enter_sub();

my ($self, $dbh, $params) = @_;
d71bfc9b Sven Schöling
my ($key);
913fe339 Moritz Bunkus
$key = $params->{key};
$key = "all_charts" unless ($key);

my $transdate = quote_db_date($params->{transdate});

my $query =
12fb1a28 Jan Büren
qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
913fe339 Moritz Bunkus
qq|FROM chart c | .
qq|LEFT JOIN taxkeys tk ON | .
qq|(tk.id = (SELECT id FROM taxkeys | .
qq| WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
qq| ORDER BY startdate DESC LIMIT 1)) | .
qq|ORDER BY c.accno|;

ef17e41a Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
913fe339 Moritz Bunkus
$main::lxdebug->leave_sub();
}

ddbe3ea5 Moritz Bunkus
sub _get_taxzones {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_taxzones" unless ($key);
6e603868 Geoffrey Richardson
my $tzfilter = "";
3171c378 Jan Büren
$tzfilter = "WHERE obsolete is FALSE" if $key eq 'ALL_ACTIVE_TAXZONES';
ddbe3ea5 Moritz Bunkus
6e603868 Geoffrey Richardson
my $query = qq|SELECT * FROM tax_zones $tzfilter ORDER BY sortkey|;
ddbe3ea5 Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

a751b16c Moritz Bunkus
sub _get_employees {
$main::lxdebug->enter_sub();

ca18e047 Moritz Bunkus
my ($self, $dbh, $params) = @_;

my $deleted = 0;

my $key;
if (ref $params eq 'HASH') {
$key = $params->{key};
$deleted = $params->{deleted};

} else {
$key = $params;
}
a751b16c Moritz Bunkus
ca18e047 Moritz Bunkus
$key ||= "all_employees";
my $filter = $deleted ? '' : 'WHERE NOT COALESCE(deleted, FALSE)';
$self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee $filter ORDER BY lower(name)|);
16821864 Thomas Kasulke
$main::lxdebug->leave_sub();
}

9fa58e1b Moritz Bunkus
sub _get_business_types {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

6d169764 Moritz Bunkus
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_business_types";
my $where = '';

if (exists $options->{salesman}) {
$where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
}

$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
9fa58e1b Moritz Bunkus
$main::lxdebug->leave_sub();
}

b12e8d14 Moritz Bunkus
sub _get_languages {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_languages" unless ($key);

my $query = qq|SELECT * FROM language ORDER BY id|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

b4089f8d Moritz Bunkus
sub _get_dunning_configs {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_dunning_configs" unless ($key);

my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;

$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

aa8ce6f5 Thomas Kasulke
sub _get_currencies {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_currencies" unless ($key);

d331a3d7 Niclas Zimmermann
$self->{$key} = [$self->get_all_currencies()];
aa8ce6f5 Thomas Kasulke
$main::lxdebug->leave_sub();
}

f6fa032d Thomas Kasulke
sub _get_payments {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_payments" unless ($key);

93be9aa2 Moritz Bunkus
my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
f54fd660 Sven Schöling
f6fa032d Thomas Kasulke
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

a5d5620d Thomas Kasulke
sub _get_customers {
$main::lxdebug->enter_sub();

9d60642b Moritz Bunkus
my ($self, $dbh, $key) = @_;
a5d5620d Thomas Kasulke
9d60642b Moritz Bunkus
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_customers";
74fca575 Sven Schöling
my $limit_clause = $options->{limit} ? "LIMIT $options->{limit}" : '';
a5d5620d Thomas Kasulke
0bf218ff Moritz Bunkus
my @where;
push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman};
push @where, qq|NOT obsolete| if !$options->{with_obsolete};
my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';

my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
9d60642b Moritz Bunkus
$self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
a5d5620d Thomas Kasulke
$main::lxdebug->leave_sub();
}

86b09030 Thomas Kasulke
sub _get_vendors {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_vendors" unless ($key);

a5501b16 Moritz Bunkus
my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;
86b09030 Thomas Kasulke
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

2c5603bb Moritz Bunkus
sub _get_departments {
$main::lxdebug->enter_sub();

my ($self, $dbh, $key) = @_;

$key = "all_departments" unless ($key);

03daa77e Moritz Bunkus
my $query = qq|SELECT * FROM department ORDER BY description|;
2c5603bb Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

8c7e4493 Moritz Bunkus
sub _get_warehouses {
1e251313 Moritz Bunkus
$main::lxdebug->enter_sub();

8c7e4493 Moritz Bunkus
my ($self, $dbh, $param) = @_;

696aad9c Moritz Bunkus
my ($key, $bins_key);
1e251313 Moritz Bunkus
8c7e4493 Moritz Bunkus
if ('' eq ref $param) {
$key = $param;
696aad9c Moritz Bunkus
8c7e4493 Moritz Bunkus
} else {
$key = $param->{key};
$bins_key = $param->{bins};
}

my $query = qq|SELECT w.* FROM warehouse w
WHERE (NOT w.invalid) AND
((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
ORDER BY w.sortkey|;

696aad9c Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);
1e251313 Moritz Bunkus
8c7e4493 Moritz Bunkus
if ($bins_key) {
fd69a37d Jan Büren
$query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
ORDER BY description|;
8c7e4493 Moritz Bunkus
my $sth = prepare_query($self, $dbh, $query);

foreach my $warehouse (@{ $self->{$key} }) {
do_statement($self, $sth, $query, $warehouse->{id});
$warehouse->{$bins_key} = [];

while (my $ref = $sth->fetchrow_hashref()) {
push @{ $warehouse->{$bins_key} }, $ref;
}
}
$sth->finish();
}

$main::lxdebug->leave_sub();
}

sub _get_simple {
$main::lxdebug->enter_sub();

my ($self, $dbh, $table, $key, $sortkey) = @_;

my $query = qq|SELECT * FROM $table|;
$query .= qq| ORDER BY $sortkey| if ($sortkey);
1e251313 Moritz Bunkus
$self->{$key} = selectall_hashref_query($self, $dbh, $query);

$main::lxdebug->leave_sub();
}

15682dc4 Moritz Bunkus
sub get_lists {
d319704a Moritz Bunkus
$main::lxdebug->enter_sub();

15682dc4 Moritz Bunkus
my $self = shift;
my %params = @_;

0d180400 Bernd Bleßmann
croak "get_lists: shipto is no longer supported" if $params{shipto};

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh(\%main::myconfig);
15682dc4 Moritz Bunkus
my ($sth, $query, $ref);
d319704a Moritz Bunkus
2536b717 Sven Schöling
my ($vc, $vc_id);
0d180400 Bernd Bleßmann
if ($params{contacts}) {
2536b717 Sven Schöling
$vc = 'customer' if $self->{"vc"} eq "customer";
$vc = 'vendor' if $self->{"vc"} eq "vendor";
a9b2cbe2 Jan Büren
die "invalid use of get_lists, need 'vc'" unless $vc;
2536b717 Sven Schöling
$vc_id = $self->{"${vc}_id"};
}
d319704a Moritz Bunkus
15682dc4 Moritz Bunkus
if ($params{"contacts"}) {
03c310de Moritz Bunkus
$self->_get_contacts($dbh, $vc_id, $params{"contacts"});
d319704a Moritz Bunkus
}

59f8f1fa Moritz Bunkus
if ($params{"projects"} || $params{"all_projects"}) {
03c310de Moritz Bunkus
$self->_get_projects($dbh, $params{"all_projects"} ?
$params{"all_projects"} : $params{"projects"},
$params{"all_projects"} ? 1 : 0);
59f8f1fa Moritz Bunkus
}

1b3fe156 Sven Schöling
if ($params{"printers"}) {
03c310de Moritz Bunkus
$self->_get_printers($dbh, $params{"printers"});
1b3fe156 Sven Schöling
}

b12e8d14 Moritz Bunkus
if ($params{"languages"}) {
$self->_get_languages($dbh, $params{"languages"});
}

913fe339 Moritz Bunkus
if ($params{"charts"}) {
$self->_get_charts($dbh, $params{"charts"});
}

ddbe3ea5 Moritz Bunkus
if ($params{"taxzones"}) {
$self->_get_taxzones($dbh, $params{"taxzones"});
}

a751b16c Moritz Bunkus
if ($params{"employees"}) {
ca18e047 Moritz Bunkus
$self->_get_employees($dbh, $params{"employees"});
a751b16c Moritz Bunkus
}
f54fd660 Sven Schöling
16821864 Thomas Kasulke
if ($params{"salesmen"}) {
b922ab4c Geoffrey Richardson
$self->_get_employees($dbh, $params{"salesmen"});
16821864 Thomas Kasulke
}
a751b16c Moritz Bunkus
9fa58e1b Moritz Bunkus
if ($params{"business_types"}) {
$self->_get_business_types($dbh, $params{"business_types"});
}

b4089f8d Moritz Bunkus
if ($params{"dunning_configs"}) {
$self->_get_dunning_configs($dbh, $params{"dunning_configs"});
}
f54fd660 Sven Schöling
aa8ce6f5 Thomas Kasulke
if($params{"currencies"}) {
$self->_get_currencies($dbh, $params{"currencies"});
}
f54fd660 Sven Schöling
a5d5620d Thomas Kasulke
if($params{"customers"}) {
9d60642b Moritz Bunkus
$self->_get_customers($dbh, $params{"customers"});
a5d5620d Thomas Kasulke
}
f54fd660 Sven Schöling
86b09030 Thomas Kasulke
if($params{"vendors"}) {
b6dc5623 Sven Schöling
if (ref $params{"vendors"} eq 'HASH') {
$self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
} else {
$self->_get_vendors($dbh, $params{"vendors"});
}
86b09030 Thomas Kasulke
}
f54fd660 Sven Schöling
f6fa032d Thomas Kasulke
if($params{"payments"}) {
$self->_get_payments($dbh, $params{"payments"});
}
b4089f8d Moritz Bunkus
2c5603bb Moritz Bunkus
if($params{"departments"}) {
$self->_get_departments($dbh, $params{"departments"});
}

1e251313 Moritz Bunkus
if ($params{price_factors}) {
8c7e4493 Moritz Bunkus
$self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
}

if ($params{warehouses}) {
$self->_get_warehouses($dbh, $params{warehouses});
7a7f33b5 Moritz Bunkus
}

2740f3f0 Sven Schöling
if ($params{partsgroup}) {
$self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
}
1e251313 Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

# this sub gets the id and name from $table
sub get_name {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $table) = @_;

# connect to database
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$table = $table eq "customer" ? "customer" : "vendor";
my $arap = $self->{arap} eq "ar" ? "ar" : "ap";
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
my ($query, @values);
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
if (!$self->{openinvoices}) {
my $where;
if ($self->{customernumber} ne "") {
$where = qq|(vc.customernumber ILIKE ?)|;
bc40bcab Moritz Bunkus
push(@values, like($self->{customernumber}));
ef17e41a Moritz Bunkus
} else {
$where = qq|(vc.name ILIKE ?)|;
bc40bcab Moritz Bunkus
push(@values, like($self->{$table}));
ef17e41a Moritz Bunkus
}
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$query =
qq~SELECT vc.id, vc.name,
vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
FROM $table vc
WHERE $where AND (NOT vc.obsolete)
ORDER BY vc.name~;
} else {
$query =
qq~SELECT DISTINCT vc.id, vc.name,
vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
FROM $arap a
JOIN $table vc ON (a.${table}_id = vc.id)
WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
ORDER BY vc.name~;
bc40bcab Moritz Bunkus
push(@values, like($self->{$table}));
d319704a Moritz Bunkus
}
ef17e41a Moritz Bunkus
$self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

ef17e41a Moritz Bunkus
return scalar(@{ $self->{name_list} });
d319704a Moritz Bunkus
}

8c1d5d75 Martin Helmling
sub new_lastmtime {
573d7fd1 Jan Büren
my ($self, $table, $provided_dbh) = @_;
8c1d5d75 Martin Helmling
573d7fd1 Jan Büren
my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh;
8c1d5d75 Martin Helmling
return unless $self->{id};
croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;

my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
573d7fd1 Jan Büren
my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
8c1d5d75 Martin Helmling
$ref->{mtime} ||= $ref->{itime};
$self->{lastmtime} = $ref->{mtime};
573d7fd1 Jan Büren
8c1d5d75 Martin Helmling
}

d735aab3 Martin Helmling
sub mtime_ischanged {
6c9d43ef Jan Büren
my ($self, $table, $option) = @_;
d735aab3 Martin Helmling
6c9d43ef Jan Büren
return unless $self->{id};
e998dd2f Jan Büren
croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;
d2af074a Jan Büren
6c9d43ef Jan Büren
my $query = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
my $ref = selectfirst_hashref_query($self, $self->get_standard_dbh, $query, $self->{id});
$ref->{mtime} ||= $ref->{itime};
d2af074a Jan Büren
d735aab3 Martin Helmling
if ($self->{lastmtime} && $self->{lastmtime} ne $ref->{mtime} ) {
61cbd09d Jan Büren
$self->error(($option eq 'mail') ?
t8("The document has been changed by another user. No mail was sent. Please reopen it in another window and copy the changes to the new window") :
t8("The document has been changed by another user. Please reopen it in another window and copy the changes to the new window")
);
09479f02 Moritz Bunkus
$::dispatcher->end_request;
d735aab3 Martin Helmling
}
}

77807bf5 Geoffrey Richardson
# language_payment duplicates some of the functionality of all_vc (language,
# printer, payment_terms), and at least in the case of sales invoices both
# all_vc and language_payment are called when adding new invoices
54e4131e Moritz Bunkus
sub language_payment {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
54e4131e Moritz Bunkus
# get languages
my $query = qq|SELECT id, description
ef17e41a Moritz Bunkus
FROM language
ORDER BY id|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{languages} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get printer
$query = qq|SELECT printer_description, id
FROM printers
ef17e41a Moritz Bunkus
ORDER BY printer_description|;
54e4131e Moritz Bunkus
ef17e41a Moritz Bunkus
$self->{printers} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
# get payment terms
$query = qq|SELECT id, description
FROM payment_terms
77807bf5 Geoffrey Richardson
WHERE ( obsolete IS FALSE OR id = ? )
ORDER BY sortkey |;
$self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef);
54e4131e Moritz Bunkus
# get buchungsgruppen
$query = qq|SELECT id, description
FROM buchungsgruppen|;

ef17e41a Moritz Bunkus
$self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

# this is only used for reports
sub all_departments {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $table) = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
my $query = qq|SELECT id, description
FROM department
ORDER BY description|;
$self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
e2b9e173 Sven Schöling
delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub create_links {
$main::lxdebug->enter_sub();

f36eb9fc Moritz Bunkus
my ($self, $module, $myconfig, $table, $provided_dbh) = @_;
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
my ($fld, $arap);
if ($table eq "customer") {
$fld = "buy";
$arap = "ar";
} else {
$table = "vendor";
$fld = "sell";
$arap = "ap";
}

d319704a Moritz Bunkus
# get last customers or vendors
ef17e41a Moritz Bunkus
my ($query, $sth, $ref);
d319704a Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
my %xkeyref = ();

53beea8b Philip Reetz
if (!$self->{id}) {
d319704a Moritz Bunkus
53beea8b Philip Reetz
my $transdate = "current_date";
if ($self->{transdate}) {
ef17e41a Moritz Bunkus
$transdate = $dbh->quote($self->{transdate});
53beea8b Philip Reetz
}
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# now get the account numbers
f4194b70 Sven Schöling
$query = qq|
41cceb1e Moritz Bunkus
SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id
f4194b70 Sven Schöling
FROM chart c
-- find newest entries in taxkeys
INNER JOIN (
SELECT chart_id, MAX(startdate) AS startdate
FROM taxkeys
WHERE (startdate <= $transdate)
GROUP BY chart_id
) tk ON (c.id = tk.chart_id)
-- and load all of those entries
INNER JOIN taxkeys tk2
ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
WHERE (c.link LIKE ?)
ORDER BY c.accno|;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$sth = $dbh->prepare($query);
fbe66f59 Udo Spallek
bc40bcab Moritz Bunkus
do_statement($self, $sth, $query, like($module));
fbe66f59 Udo Spallek
53beea8b Philip Reetz
$self->{accounts} = "";
d71bfc9b Sven Schöling
while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
ef17e41a Moritz Bunkus
97d71ce1 Moritz Bunkus
foreach my $key (split(/:/, $ref->{link})) {
5cf977e5 Moritz Bunkus
if ($key =~ /\Q$module\E/) {
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
push @{ $self->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
41cceb1e Moritz Bunkus
chart_id => $ref->{chart_id},
53beea8b Philip Reetz
description => $ref->{description},
taxkey => $ref->{taxkey_id},
tax_id => $ref->{tax_id} };
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
}
d319704a Moritz Bunkus
}
}
}

54e4131e Moritz Bunkus
# get taxkeys and description
97c05a9f Sven Schöling
$query = qq|SELECT id, taxkey, taxdescription FROM tax|;
98ad02ca Moritz Bunkus
$self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);
54e4131e Moritz Bunkus
d319704a Moritz Bunkus
if (($module eq "AP") || ($module eq "AR")) {
# get tax rates and description
ef17e41a Moritz Bunkus
$query = qq|SELECT * FROM tax|;
98ad02ca Moritz Bunkus
$self->{TAX} = selectall_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
}

ee2b1ef3 Moritz Bunkus
my $extra_columns = '';
d623e974 Moritz Bunkus
$extra_columns .= 'a.direct_debit, ' if ($module eq 'AR') || ($module eq 'AP');
ee2b1ef3 Moritz Bunkus
d319704a Moritz Bunkus
if ($self->{id}) {
ef17e41a Moritz Bunkus
$query =
qq|SELECT
c4767543 Bernd Bleßmann
a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate,
142ea3bf Moritz Bunkus
a.duedate, a.tax_point, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes,
d2af074a Jan Büren
a.mtime, a.itime,
ef17e41a Moritz Bunkus
a.intnotes, a.department_id, a.amount AS oldinvtotal,
a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
caaa17be Bernd Bleßmann
a.globalproject_id, a.transaction_description, ${extra_columns}
ef17e41a Moritz Bunkus
c.name AS $table,
d.description AS department,
e.name AS employee
FROM $arap a
a0f1b420 Moritz Bunkus
JOIN $table c ON (a.${table}_id = c.id)
ef17e41a Moritz Bunkus
LEFT JOIN employee e ON (e.id = a.employee_id)
LEFT JOIN department d ON (d.id = a.department_id)
WHERE a.id = ?|;
$ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
d319704a Moritz Bunkus
d71bfc9b Sven Schöling
foreach my $key (keys %$ref) {
d319704a Moritz Bunkus
$self->{$key} = $ref->{$key};
}
6c9d43ef Jan Büren
$self->{mtime} ||= $self->{itime};
d735aab3 Martin Helmling
$self->{lastmtime} = $self->{mtime};
53beea8b Philip Reetz
my $transdate = "current_date";
if ($self->{transdate}) {
ef17e41a Moritz Bunkus
$transdate = $dbh->quote($self->{transdate});
53beea8b Philip Reetz
}
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# now get the account numbers
41cceb1e Moritz Bunkus
$query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id
b49779f0 Moritz Bunkus
FROM chart c
LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
WHERE c.link LIKE ?
AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
1aa5ac26 Philip Reetz
OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
b49779f0 Moritz Bunkus
ORDER BY c.accno|;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$sth = $dbh->prepare($query);
bc40bcab Moritz Bunkus
do_statement($self, $sth, $query, like($module));
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$self->{accounts} = "";
d71bfc9b Sven Schöling
while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
ef17e41a Moritz Bunkus
97d71ce1 Moritz Bunkus
foreach my $key (split(/:/, $ref->{link})) {
5cf977e5 Moritz Bunkus
if ($key =~ /\Q$module\E/) {
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
# cross reference for keys
$xkeyref{ $ref->{accno} } = $key;
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
push @{ $self->{"${module}_links"}{$key} },
{ accno => $ref->{accno},
41cceb1e Moritz Bunkus
chart_id => $ref->{chart_id},
53beea8b Philip Reetz
description => $ref->{description},
taxkey => $ref->{taxkey_id},
tax_id => $ref->{tax_id} };
ef17e41a Moritz Bunkus
53beea8b Philip Reetz
$self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
}
}
}


d319704a Moritz Bunkus
# get amounts from individual entries
ef17e41a Moritz Bunkus
$query =
qq|SELECT
1c084510 Moritz Bunkus
c.accno, c.description,
41cceb1e Moritz Bunkus
a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id,
ef17e41a Moritz Bunkus
p.projectnumber,
b099c63c Sven Schöling
t.rate, t.id,
a.fx_transaction
ef17e41a Moritz Bunkus
FROM acc_trans a
LEFT JOIN chart c ON (c.id = a.chart_id)
LEFT JOIN project p ON (p.id = a.project_id)
9d2d867c Niclas Zimmermann
LEFT JOIN tax t ON (t.id= a.tax_id)
ef17e41a Moritz Bunkus
WHERE a.trans_id = ?
6ff01fdb Moritz Bunkus
ORDER BY a.acc_trans_id, a.transdate|;
d319704a Moritz Bunkus
$sth = $dbh->prepare($query);
98ad02ca Moritz Bunkus
do_statement($self, $sth, $query, $self->{id});
d319704a Moritz Bunkus
# get exchangerate for currency
36a93d2e Jan Büren
($self->{exchangerate}, $self->{record_forex}) = $self->check_exchangerate($myconfig, $self->{currency}, $self->{transdate}, $fld,
$self->{id}, $arap);

081a4f97 Moritz Bunkus
my $index = 0;
b099c63c Sven Schöling
my @fx_transaction_entries;
d319704a Moritz Bunkus
# store amounts in {acc_trans}{$key} for multiple accounts
d71bfc9b Sven Schöling
while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
b099c63c Sven Schöling
# skip fx_transaction entries and add them for post processing
if ($ref->{fx_transaction}) {
die "first entry in a record transaction should not be fx_transaction" unless @fx_transaction_entries;
push @{ $fx_transaction_entries[-1] }, $ref;
next;
} else {
push @fx_transaction_entries, [ $ref ];
}


36a93d2e Jan Büren
# credit and debit bookings calc fx rate for positions
b099c63c Sven Schöling
# also used as exchangerate_$i for payments - exchangerate here can come from frontend or from bank transactions
d319704a Moritz Bunkus
$ref->{exchangerate} =
46a49667 Jan Büren
$self->check_exchangerate($myconfig, $self->{currency}, $ref->{transdate}, $fld);
081a4f97 Moritz Bunkus
if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
de651621 Stephan Köhler
$index++;
}
54e4131e Moritz Bunkus
if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
$ref->{amount} *= -1;
}
de651621 Stephan Köhler
$ref->{index} = $index;
d319704a Moritz Bunkus
push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
}

b099c63c Sven Schöling
# post process fx_transactions.
# old bin/mozilla code first posts the intended foreign currency amount and then the correction for exchange flagged as fx_transaction
# for example: when posting 20 USD on a system in EUR with an exchangerate of 1.1, the resulting acc_trans will say:
# +20 no fx (intended: 20 USD)
# +2 fx (but it's actually 22 EUR)
#
# for payments this is followed by the fxgain/loss. when paying the above invoice with 20 USD at 1.3 exchange:
# -20 no fx (intended: 20 USD)
# -6 fx (but it's actually 26 EUR)
# +4 fx (but 4 of them go to fxgain)
#
# bin/mozilla/ controllers will display the intended amount as is, but would have to guess at the actual book value
# without the extra fields
#
# bank transactions however will convert directly into internal currency, so a foreign currency invoice might end up
# having non-fxtransactions. to make sure that these are roundtrip safe, flag the fx-transaction payments as fx and give the
# intendended internal amount
#
# this still operates on the cached entries of form->{acc_trans}
for my $fx_block (@fx_transaction_entries) {
my ($ref, @fx_entries) = @$fx_block;
for my $fx_ref (@fx_entries) {
if ($fx_ref->{chart_id} == $ref->{chart_id}) {
$ref->{defaultcurrency_paid} //= $ref->{amount};
$ref->{defaultcurrency_paid} += $fx_ref->{amount};
$ref->{fx_transaction} = 1;
}
}
}

53beea8b Philip Reetz
$sth->finish;
d331a3d7 Niclas Zimmermann
#check das:
ef17e41a Moritz Bunkus
$query =
qq|SELECT
d331a3d7 Niclas Zimmermann
d.closedto, d.revtrans,
a4d74009 Niclas Zimmermann
(SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
ef17e41a Moritz Bunkus
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
030c2086 Rolf Fluehmann
(SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno,
(SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno,
(SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno
ef17e41a Moritz Bunkus
FROM defaults d|;
$ref = selectfirst_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
map { $self->{$_} = $ref->{$_} } keys %$ref;

} else {

# get date
ef17e41a Moritz Bunkus
$query =
qq|SELECT
d331a3d7 Niclas Zimmermann
current_date AS transdate, d.closedto, d.revtrans,
a4d74009 Niclas Zimmermann
(SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
ef17e41a Moritz Bunkus
(SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
030c2086 Rolf Fluehmann
(SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno,
(SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno,
(SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno
ef17e41a Moritz Bunkus
FROM defaults d|;
$ref = selectfirst_hashref_query($self, $dbh, $query);
d319704a Moritz Bunkus
map { $self->{$_} = $ref->{$_} } keys %$ref;

f0dfaf1d Jan Büren
# failsafe, set currency if caller has not yet assigned one
$self->lastname_used($dbh, $myconfig, $table, $module) unless ($self->{"$self->{vc}_id"});
$self->{currency} = $self->{defaultcurrency} unless $self->{currency};
$self->{exchangerate} =
$self->check_exchangerate($myconfig, $self->{currency}, $self->{transdate}, $fld);
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

sub lastname_used {
$main::lxdebug->enter_sub();

my ($self, $dbh, $myconfig, $table, $module) = @_;

556a2137 Moritz Bunkus
my ($arap, $where);

$table = $table eq "customer" ? "customer" : "vendor";
d331a3d7 Niclas Zimmermann
my %column_map = ("a.${table}_id" => "${table}_id",
556a2137 Moritz Bunkus
"a.department_id" => "department_id",
"d.description" => "department",
"ct.name" => $table,
aa0fece0 Niclas Zimmermann
"cu.name" => "currency",
556a2137 Moritz Bunkus
);

if ($self->{type} =~ /delivery_order/) {
$arap = 'delivery_orders';
d331a3d7 Niclas Zimmermann
delete $column_map{"cu.currency"};
d319704a Moritz Bunkus
556a2137 Moritz Bunkus
} elsif ($self->{type} =~ /_order/) {
d319704a Moritz Bunkus
$arap = 'oe';
$where = "quotation = '0'";
556a2137 Moritz Bunkus
} elsif ($self->{type} =~ /_quotation/) {
d319704a Moritz Bunkus
$arap = 'oe';
$where = "quotation = '1'";
556a2137 Moritz Bunkus
} elsif ($table eq 'customer') {
$arap = 'ar';

} else {
$arap = 'ap';

d319704a Moritz Bunkus
}

556a2137 Moritz Bunkus
$where = "($where) AND" if ($where);
my $query = qq|SELECT MAX(id) FROM $arap
WHERE $where ${table}_id > 0|;
my ($trans_id) = selectrow_query($self, $dbh, $query);
$trans_id *= 1;
d319704a Moritz Bunkus
556a2137 Moritz Bunkus
my $column_spec = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
$query = qq|SELECT $column_spec
FROM $arap a
LEFT JOIN $table ct ON (a.${table}_id = ct.id)
LEFT JOIN department d ON (a.department_id = d.id)
a4d74009 Niclas Zimmermann
LEFT JOIN currencies cu ON (cu.id=ct.currency_id)
556a2137 Moritz Bunkus
WHERE a.id = ?|;
my $ref = selectfirst_hashref_query($self, $dbh, $query, $trans_id);

map { $self->{$_} = $ref->{$_} } values %column_map;
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

54ce5144 Martin Helmling
sub get_variable_content_types {
c1551e49 Moritz Bunkus
my ($self) = @_;

7608d92e Moritz Bunkus
my %html_variables = (
longdescription => 'html',
partnotes => 'html',
notes => 'html',
orignotes => 'html',
notes1 => 'html',
notes2 => 'html',
notes3 => 'html',
notes4 => 'html',
header_text => 'html',
footer_text => 'html',
54ce5144 Martin Helmling
);
c1551e49 Moritz Bunkus
return {
%html_variables,
$self->get_variable_content_types_for_cvars,
};
}

sub get_variable_content_types_for_cvars {
my ($self) = @_;
my $html_configs = SL::DB::Manager::CustomVariableConfig->get_all(where => [ type => 'htmlfield' ]);
my %types;

if (@{ $html_configs }) {
my %prefix_by_module = (
Contacts => 'cp_cvar_',
CT => 'vc_cvar_',
IC => 'ic_cvar_',
Projects => 'project_cvar_',
ShipTo => 'shiptocvar_',
);

foreach my $cfg (@{ $html_configs }) {
my $prefix = $prefix_by_module{$cfg->module};
$types{$prefix . $cfg->name} = 'html' if $prefix;
}
}

return %types;
54ce5144 Martin Helmling
}

d319704a Moritz Bunkus
sub current_date {
$main::lxdebug->enter_sub();

f88cdcc7 Sven Schöling
my $self = shift;
my $myconfig = shift || \%::myconfig;
8001c18b Sven Schöling
my ($thisdate, $days) = @_;
d319704a Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
my $query;
d319704a Moritz Bunkus
$days *= 1;
if ($thisdate) {
my $dateformat = $myconfig->{dateformat};
$dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
ef17e41a Moritz Bunkus
$thisdate = $dbh->quote($thisdate);
$query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
d319704a Moritz Bunkus
} else {
ef17e41a Moritz Bunkus
$query = qq|SELECT current_date AS thisdate|;
d319704a Moritz Bunkus
}

ef17e41a Moritz Bunkus
($thisdate) = selectrow_query($self, $dbh, $query);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();

return $thisdate;
}

sub redo_rows {
$main::lxdebug->enter_sub();

my ($self, $flds, $new, $count, $numrows) = @_;

my @ndx = ();

29795499 Sven Schöling
map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
d319704a Moritz Bunkus
my $i = 0;

# fill rows
foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
$i++;
d71bfc9b Sven Schöling
my $j = $item->{ndx} - 1;
d319704a Moritz Bunkus
map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
}

# delete empty rows
for $i ($count + 1 .. $numrows) {
map { delete $self->{"${_}_$i"} } @{$flds};
}

$main::lxdebug->leave_sub();
}

sub update_status {
$main::lxdebug->enter_sub();

my ($self, $myconfig) = @_;

my ($i, $id);

a422993f Sven Schöling
SL::DB->client->with_transaction(sub {
my $dbh = SL::DB->client->dbh;
d319704a Moritz Bunkus
a422993f Sven Schöling
my $query = qq|DELETE FROM status
WHERE (formname = ?) AND (trans_id = ?)|;
my $sth = prepare_query($self, $dbh, $query);
d319704a Moritz Bunkus
a422993f Sven Schöling
if ($self->{formname} =~ /(check|receipt)/) {
for $i (1 .. $self->{rowcount}) {
do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
}
} else {
do_statement($self, $sth, $query, $self->{formname}, $self->{id});
d319704a Moritz Bunkus
}
a422993f Sven Schöling
$sth->finish();
d319704a Moritz Bunkus
a422993f Sven Schöling
my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
d319704a Moritz Bunkus
a422993f Sven Schöling
my %queued = split / /, $self->{queued};
my @values;
d319704a Moritz Bunkus
a422993f Sven Schöling
if ($self->{formname} =~ /(check|receipt)/) {
d319704a Moritz Bunkus
a422993f Sven Schöling
# this is a check or receipt, add one entry for each lineitem
my ($accno) = split /--/, $self->{account};
$query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
@values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
$sth = prepare_query($self, $dbh, $query);
d319704a Moritz Bunkus
a422993f Sven Schöling
for $i (1 .. $self->{rowcount}) {
if ($self->{"checked_$i"}) {
do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
}
d319704a Moritz Bunkus
}
a422993f Sven Schöling
$sth->finish();
d319704a Moritz Bunkus
a422993f Sven Schöling
} else {
$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
$queued{$self->{formname}}, $self->{formname});
}
1;
}) or do { die SL::DB->client->error };
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub save_status {
$main::lxdebug->enter_sub();

my ($self, $dbh) = @_;

my ($query, $printed, $emailed);

my $formnames = $self->{printed};
my $emailforms = $self->{emailed};

29795499 Sven Schöling
$query = qq|DELETE FROM status
ef17e41a Moritz Bunkus
WHERE (formname = ?) AND (trans_id = ?)|;
do_query($self, $dbh, $query, $self->{formname}, $self->{id});
d319704a Moritz Bunkus
# this only applies to the forms
# checks and receipts are posted when printed or queued

if ($self->{queued}) {
my %queued = split / /, $self->{queued};

foreach my $formname (keys %queued) {
5cf977e5 Moritz Bunkus
$printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
$emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
d319704a Moritz Bunkus
ef17e41a Moritz Bunkus
$query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
VALUES (?, ?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
d319704a Moritz Bunkus
5cf977e5 Moritz Bunkus
$formnames =~ s/\Q$self->{formname}\E//;
$emailforms =~ s/\Q$self->{formname}\E//;
d319704a Moritz Bunkus
}
}

# save printed, emailed info
$formnames =~ s/^ +//g;
$emailforms =~ s/^ +//g;

my %status = ();
map { $status{$_}{printed} = 1 } split / +/, $formnames;
map { $status{$_}{emailed} = 1 } split / +/, $emailforms;

foreach my $formname (keys %status) {
5cf977e5 Moritz Bunkus
$printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0";
$emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
d319704a Moritz Bunkus
$query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
ef17e41a Moritz Bunkus
VALUES (?, ?, ?, ?)|;
do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
d319704a Moritz Bunkus
}

$main::lxdebug->leave_sub();
}

ef17e41a Moritz Bunkus
#--- 4 locale ---#
# $main::locale->text('SAVED')
0bfbcce6 Martin Helmling
# $main::locale->text('SCREENED')
ef17e41a Moritz Bunkus
# $main::locale->text('DELETED')
# $main::locale->text('ADDED')
# $main::locale->text('PAYMENT POSTED')
# $main::locale->text('POSTED')
# $main::locale->text('POSTED AS NEW')
# $main::locale->text('ELSE')
# $main::locale->text('SAVED FOR DUNNING')
# $main::locale->text('DUNNING STARTED')
8cc7857c Bernd Bleßmann
# $main::locale->text('PREVIEWED')
ef17e41a Moritz Bunkus
# $main::locale->text('PRINTED')
# $main::locale->text('MAILED')
# $main::locale->text('SCREENED')
f8f101f3 Thomas Kasulke
# $main::locale->text('CANCELED')
0bfbcce6 Martin Helmling
# $main::locale->text('IMPORT')
927ec727 Jan Büren
# $main::locale->text('UNDO TRANSFER')
0bfbcce6 Martin Helmling
# $main::locale->text('UNIMPORT')
ef17e41a Moritz Bunkus
# $main::locale->text('invoice')
726a9fae Bernd Bleßmann
# $main::locale->text('invoice_for_advance_payment')
475b7a3f Bernd Bleßmann
# $main::locale->text('final_invoice')
ef17e41a Moritz Bunkus
# $main::locale->text('proforma')
2209853f Bernd Bleßmann
# $main::locale->text('storno_invoice')
c16a1baf Bernd Bleßmann
# $main::locale->text('sales_order_intake')
ef17e41a Moritz Bunkus
# $main::locale->text('sales_order')
# $main::locale->text('pick_list')
# $main::locale->text('purchase_order')
7204be47 Bernd Bleßmann
# $main::locale->text('purchase_order_confirmation')
ef17e41a Moritz Bunkus
# $main::locale->text('bin_list')
# $main::locale->text('sales_quotation')
# $main::locale->text('request_quotation')
37c4d9b1 Bernd Bleßmann
# $main::locale->text('purchase_quotation_intake')
ef17e41a Moritz Bunkus
sub save_history {
$main::lxdebug->enter_sub();

a590a651 Sven Schöling
my $self = shift;
a422993f Sven Schöling
my $dbh = shift || SL::DB->client->dbh;
SL::DB->client->with_transaction(sub {
ef17e41a Moritz Bunkus
a422993f Sven Schöling
if(!exists $self->{employee_id}) {
&get_employee($self, $dbh);
}
ef17e41a Moritz Bunkus
a422993f Sven Schöling
my $query =
qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
my @values = (conv_i($self->{id}), $self->{login},
$self->{addition}, $self->{what_done}, "$self->{snumbers}");
do_query($self, $dbh, $query, @values);
1;
}) or do { die SL::DB->client->error };
a590a651 Sven Schöling
ef17e41a Moritz Bunkus
$main::lxdebug->leave_sub();
}

sub get_history {
$main::lxdebug->enter_sub();

73f6453e Thomas Kasulke
my ($self, $dbh, $trans_id, $restriction, $order) = @_;
my ($orderBy, $desc) = split(/\-\-/, $order);
$order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
ef17e41a Moritz Bunkus
my @tempArray;
my $i = 0;
if ($trans_id ne "") {
my $query =
e077b319 Thomas Kasulke
qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | .
ef17e41a Moritz Bunkus
qq|FROM history_erp h | .
qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
90ae24e1 Sven Schöling
qq|WHERE (trans_id = | . $dbh->quote($trans_id) . qq|) $restriction | .
7dd95f35 Moritz Bunkus
$order;
f54fd660 Sven Schöling
ef17e41a Moritz Bunkus
my $sth = $dbh->prepare($query) || $self->dberror($query);

41a03969 Thomas Kasulke
$sth->execute() || $self->dberror("$query");
ef17e41a Moritz Bunkus
while(my $hash_ref = $sth->fetchrow_hashref()) {
$hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
$hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
3d8c8e2f Martin Helmling
my ( $what, $number ) = split /_/, $hash_ref->{snumbers};
$hash_ref->{snumbers} = $number;
$hash_ref->{haslink} = 'controller.pl?action=EmailJournal/show&id='.$number if $what eq 'emailjournal';
$hash_ref->{snumbers} = $main::locale->text("E-Mail").' '.$number if $what eq 'emailjournal';
ef17e41a Moritz Bunkus
$tempArray[$i++] = $hash_ref;
}
f54fd660 Sven Schöling
$main::lxdebug->leave_sub() and return \@tempArray
ef17e41a Moritz Bunkus
if ($i > 0 && $tempArray[0] ne "");
}
$main::lxdebug->leave_sub();
return 0;
}

d319704a Moritz Bunkus
sub get_partsgroup {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $p) = @_;
2740f3f0 Sven Schöling
my $target = $p->{target} || 'all_partsgroup';
d319704a Moritz Bunkus
820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
d319704a Moritz Bunkus
my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
FROM partsgroup pg
ef17e41a Moritz Bunkus
JOIN parts p ON (p.partsgroup_id = pg.id) |;
my @values;
d319704a Moritz Bunkus
if ($p->{searchitems} eq 'part') {
98b64fe1 Geoffrey Richardson
$query .= qq|WHERE p.part_type = 'part'|;
d319704a Moritz Bunkus
}
if ($p->{searchitems} eq 'service') {
98b64fe1 Geoffrey Richardson
$query .= qq|WHERE p.part_type = 'service'|;
d319704a Moritz Bunkus
}
if ($p->{searchitems} eq 'assembly') {
98b64fe1 Geoffrey Richardson
$query .= qq|WHERE p.part_type = 'assembly'|;
d319704a Moritz Bunkus
}

ef17e41a Moritz Bunkus
$query .= qq|ORDER BY partsgroup|;
d319704a Moritz Bunkus
if ($p->{all}) {
$query = qq|SELECT id, partsgroup FROM partsgroup
ORDER BY partsgroup|;
}

if ($p->{language_code}) {
$query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
ef17e41a Moritz Bunkus
t.description AS translation
d319704a Moritz Bunkus
FROM partsgroup pg
ef17e41a Moritz Bunkus
JOIN parts p ON (p.partsgroup_id = pg.id)
LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
ORDER BY translation|;
@values = ($p->{language_code});
d319704a Moritz Bunkus
}

2740f3f0 Sven Schöling
$self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);
d319704a Moritz Bunkus
$main::lxdebug->leave_sub();
}

07d71c33 Stephan Köhler
sub get_pricegroup {
$main::lxdebug->enter_sub();

my ($self, $myconfig, $p) = @_;

820f3066 Moritz Bunkus
my $dbh = $self->get_standard_dbh($myconfig);
07d71c33 Stephan Köhler
my $query = qq|SELECT p.id, p.pricegroup
FROM pricegroup p|;

ef17e41a Moritz Bunkus
$query .= qq| ORDER BY pricegroup|;
07d71c33 Stephan Köhler
if ($p->{all}) {
$query = qq|SELECT id, pricegroup FROM pricegroup
ORDER BY pricegroup|;
}

ef17e41a Moritz Bunkus
$self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);
07d71c33 Stephan Köhler
$main::lxdebug->leave_sub();
}

7848e9c8 Udo Spallek
sub all_years {
# usage $form->all_years($myconfig, [$dbh])
# return list of all years where bookings found
# (@all_years)

$main::lxdebug->enter_sub();

my ($self, $myconfig, $dbh) = @_;
ef17e41a Moritz Bunkus
820f3066 Moritz Bunkus
$dbh ||= $self->get_standard_dbh($myconfig);
ef17e41a Moritz Bunkus
7848e9c8 Udo Spallek
# get years
my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
ef17e41a Moritz Bunkus
(SELECT MAX(transdate) FROM acc_trans)|;
my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);
7848e9c8 Udo Spallek
if ($myconfig->{dateformat} =~ /^yy/) {
($startdate) = split /\W/, $startdate;
($enddate) = split /\W/, $enddate;
ef17e41a Moritz Bunkus
} else {
7848e9c8 Udo Spallek
(@_) = split /\W/, $startdate;
$startdate = $_[2];
(@_) = split /\W/, $enddate;
ef17e41a Moritz Bunkus
$enddate = $_[2];
7848e9c8 Udo Spallek
}

my @all_years;
$startdate = substr($startdate,0,4);
$enddate = substr($enddate,0,4);
ef17e41a Moritz Bunkus
7848e9c8 Udo Spallek
while ($enddate >= $startdate) {
push @all_years, $enddate--;
}

return @all_years;

$main::lxdebug->leave_sub();
}

d7420ba8 Sven Schöling
sub backup_vars {
$main::lxdebug->enter_sub();
my $self = shift;
my @vars = @_;

17a8e2bb Moritz Bunkus
map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;
d7420ba8 Sven Schöling
$main::lxdebug->leave_sub();
}

sub restore_vars {
$main::lxdebug->enter_sub();

my $self = shift;
my @vars = @_;

17a8e2bb Moritz Bunkus
map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;
d7420ba8 Sven Schöling
$main::lxdebug->leave_sub();
}

06ebdd6a Moritz Bunkus
sub prepare_for_printing {
my ($self) = @_;

2e66dde5 Moritz Bunkus
my $defaults = SL::DB::Default->get;

$self->{templates} ||= $defaults->templates;
06ebdd6a Moritz Bunkus
$self->{formname} ||= $self->{type};
$self->{media} ||= 'email';

576b67fd Moritz Bunkus
die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
06ebdd6a Moritz Bunkus
cd417762 Moritz Bunkus
# Several fields that used to reside in %::myconfig (stored in
# auth.user_config) are now stored in defaults. Copy them over for
# compatibility.
$self->{$_} = $defaults->$_ for qw(company address taxnumber co_ustid duns sepa_creditor_id);

db9ec33a Moritz Bunkus
$self->{"myconfig_${_}"} = $::myconfig{$_} for grep { $_ ne 'dbpasswd' } keys %::myconfig;

if (!$self->{employee_id}) {
$self->{"employee_${_}"} = $::myconfig{$_} for qw(email tel fax name signature);
$self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
}

06ebdd6a Moritz Bunkus
my $language = $self->{language} ? '_' . $self->{language} : '';

my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
if ($self->{language_id}) {
($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
}

43ad317e Moritz Bunkus
$output_dateformat ||= $::myconfig{dateformat};
$output_numberformat ||= $::myconfig{numberformat};
$output_longdates //= 1;

$self->{myconfig_output_dateformat} = $output_dateformat // $::myconfig{dateformat};
$self->{myconfig_output_longdates} = $output_longdates // 1;
$self->{myconfig_output_numberformat} = $output_numberformat // $::myconfig{numberformat};
db9ec33a Moritz Bunkus
6d8fc7da Moritz Bunkus
# Retrieve accounts for tax calculation.
IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});

06ebdd6a Moritz Bunkus
if ($self->{type} =~ /_delivery_order$/) {
c5651754 Bernd Bleßmann
DO->order_details(\%::myconfig, $self);
37c4d9b1 Bernd Bleßmann
} elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order|purchase_quotation_intake/) {
06ebdd6a Moritz Bunkus
OE->order_details(\%::myconfig, $self);
407245ca Cem Aydin
} elsif ($self->{type} =~ /reclamation/) {
# skip reclamation here, legacy template arrays are added in the reclamation controller
06ebdd6a Moritz Bunkus
} else {
IS->invoice_details(\%::myconfig, $self, $::locale);
}

00177fae Moritz Bunkus
$self->set_addition_billing_address_print_variables;

06ebdd6a Moritz Bunkus
# Chose extension & set source file name
my $extension = 'html';
if ($self->{format} eq 'postscript') {
$self->{postscript} = 1;
$extension = 'tex';
} elsif ($self->{"format"} =~ /pdf/) {
$self->{pdf} = 1;
$extension = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
} elsif ($self->{"format"} =~ /opendocument/) {
$self->{opendocument} = 1;
$extension = 'odt';
} elsif ($self->{"format"} =~ /excel/) {
$self->{excel} = 1;
$extension = 'xls';
}

74fca575 Sven Schöling
my $printer_code = $self->{printer_code} ? '_' . $self->{printer_code} : '';
40b16805 Moritz Bunkus
my $email_extension = $self->{media} eq 'email' && -f ($defaults->templates . "/$self->{formname}_email${language}.${extension}") ? '_email' : '';
27cf17f0 Moritz Bunkus
$self->{IN} = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
06ebdd6a Moritz Bunkus
# Format dates.
$self->format_dates($output_dateformat, $output_longdates,
0b36b225 Moritz Bunkus
qw(invdate orddate quodate pldate duedate reqdate transdate tax_point shippingdate deliverydate validitydate paymentdate datepaid
06ebdd6a Moritz Bunkus
transdate_oe deliverydate_oe employee_startdate employee_enddate),
grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));

$self->reformat_numbers($output_numberformat, 2,
qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));

$self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));

my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');

if (scalar @{ $cvar_date_fields }) {
$self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
}

while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
$self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
}

7ff6942c Bernd Bleßmann
# Translate units
if (($self->{language} // '') ne '') {
my $template_arrays = $self->{TEMPLATE_ARRAYS} || $self;
for my $idx (0..scalar(@{ $template_arrays->{unit} }) - 1) {
$template_arrays->{unit}->[$idx] = AM->translate_units($self, $self->{language}, $template_arrays->{unit}->[$idx], $template_arrays->{qty}->[$idx])
}
}

142628e0 Moritz Bunkus
$self->{template_meta} = {
formname => $self->{formname},
language => SL::DB::Manager::Language->find_by_or_create(id => $self->{language_id} || undef),
format => $self->{format},
media => $self->{media},
extension => $extension,
printer => SL::DB::Manager::Printer->find_by_or_create(id => $self->{printer_id} || undef),
today => DateTime->today,
};

46f9d91b Moritz Bunkus
if ($defaults->print_interpolate_variables_in_positions) {
$self->substitute_placeholders_in_template_arrays({ field => 'description', type => 'text' }, { field => 'longdescription', type => 'html' });
}

return $self;
}

00177fae Moritz Bunkus
sub set_addition_billing_address_print_variables {
my ($self) = @_;

return if !$self->{billing_address_id};

my $address = SL::DB::Manager::AdditionalBillingAddress->find_by(id => $self->{billing_address_id});
return if !$address;

$self->{"billing_address_${_}"} = $address->$_ for map { $_->name } @{ $address->meta->columns };
}

46f9d91b Moritz Bunkus
sub substitute_placeholders_in_template_arrays {
my ($self, @fields) = @_;

foreach my $spec (@fields) {
$spec = { field => $spec, type => 'text' } if !ref($spec);
my $field = $spec->{field};

next unless exists $self->{TEMPLATE_ARRAYS} && exists $self->{TEMPLATE_ARRAYS}->{$field};

my $tag_start = $spec->{type} eq 'html' ? '&lt;%' : '<%';
my $tag_end = $spec->{type} eq 'html' ? '%&gt;' : '%>';
my $formatter = $spec->{type} eq 'html' ? sub { $::locale->quote_special_chars('html', $_[0] // '') } : sub { $_[0] };

$self->{TEMPLATE_ARRAYS}->{$field} = [
apply { s{${tag_start}(.+?)${tag_end}}{ $formatter->($self->{$1}) }eg }
@{ $self->{TEMPLATE_ARRAYS}->{$field} }
];
}

06ebdd6a Moritz Bunkus
return $self;
}

0e68056c Geoffrey Richardson
sub calculate_arap {
my ($self,$buysell,$taxincluded,$exchangerate,$roundplaces) = @_;

# this function is used to calculate netamount, total_tax and amount for AP and
# AR transactions (Kreditoren-/Debitorenbuchungen) by going over all lines
# (1..$rowcount)
# Thus it needs a fully prepared $form to work on.
# calculate_arap assumes $form->{amount_$i} entries still need to be parsed

# The calculated total values are all rounded (default is to 2 places) and
# returned as parameters rather than directly modifying form. The aim is to
# make the calculation of AP and AR behave identically. There is a test-case
# for this function in t/form/arap.t

# While calculating the totals $form->{amount_$i} and $form->{tax_$i} are
# modified and formatted and receive the correct sign for writing straight to
# acc_trans, depending on whether they are ar or ap.

# check parameters
die "taxincluded needed in Form->calculate_arap" unless defined $taxincluded;
die "exchangerate needed in Form->calculate_arap" unless defined $exchangerate;
die 'illegal buysell parameter, has to be \"buy\" or \"sell\" in Form->calculate_arap\n' unless $buysell =~ /^(buy|sell)$/;
$roundplaces = 2 unless $roundplaces;

my $sign = 1; # adjust final results for writing amount to acc_trans
$sign = -1 if $buysell eq 'buy';

my ($netamount,$total_tax,$amount);

my $tax;

# parse and round amounts, setting correct sign for writing to acc_trans
for my $i (1 .. $self->{rowcount}) {
$self->{"amount_$i"} = $self->round_amount($self->parse_amount(\%::myconfig, $self->{"amount_$i"}) * $exchangerate * $sign, $roundplaces);

$amount += $self->{"amount_$i"} * $sign;
}

for my $i (1 .. $self->{rowcount}) {
next unless $self->{"amount_$i"};
($self->{"tax_id_$i"}) = split /--/, $self->{"taxchart_$i"};
my $tax_id = $self->{"tax_id_$i"};

my $selected_tax = SL::DB::Manager::Tax->find_by(id => "$tax_id");
5b4ef61a Jan Büren
if ( $selected_tax && !$selected_tax->reverse_charge_chart_id) {
0e68056c Geoffrey Richardson
if ( $buysell eq 'sell' ) {
5d140e07 Martin Helmling
$self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
0e68056c Geoffrey Richardson
} else {
5d140e07 Martin Helmling
$self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
0e68056c Geoffrey Richardson
};

$self->{"taxkey_$i"} = $selected_tax->taxkey;
$self->{"taxrate_$i"} = $selected_tax->rate;
};

5b4ef61a Jan Büren
$self->{"taxkey_$i"} = $selected_tax->taxkey if ($selected_tax && $selected_tax->reverse_charge_chart_id);
36761255 Jan Büren
0e68056c Geoffrey Richardson
($self->{"amount_$i"}, $self->{"tax_$i"}) = $self->calculate_tax($self->{"amount_$i"},$self->{"taxrate_$i"},$taxincluded,$roundplaces);

$netamount += $self->{"amount_$i"};
$total_tax += $self->{"tax_$i"};

}
$amount = $netamount + $total_tax;

# due to $sign amount_$i und tax_$i already have the right sign for acc_trans
# but reverse sign of totals for writing amounts to ar
if ( $buysell eq 'buy' ) {
$netamount *= -1;
$amount *= -1;
$total_tax *= -1;
};

return($netamount,$total_tax,$amount);
}

bc433711 Moritz Bunkus
sub format_dates {
my ($self, $dateformat, $longformat, @indices) = @_;

$dateformat ||= $::myconfig{dateformat};

foreach my $idx (@indices) {
if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
$self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
}
}

next unless defined $self->{$idx};

if (!ref($self->{$idx})) {
$self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);

} elsif (ref($self->{$idx}) eq "ARRAY") {
for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
$self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
}
}
}
}

sub reformat_numbers {
my ($self, $numberformat, $places, @indices) = @_;

return if !$numberformat || ($numberformat eq $::myconfig{numberformat});

foreach my $idx (@indices) {
if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
$self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
}
}

next unless defined $self->{$idx};

if (!ref($self->{$idx})) {
$self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});

} elsif (ref($self->{$idx}) eq "ARRAY") {
for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
$self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
}
}
}

my $saved_numberformat = $::myconfig{numberformat};
$::myconfig{numberformat} = $numberformat;

foreach my $idx (@indices) {
if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
$self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
}
}

next unless defined $self->{$idx};

if (!ref($self->{$idx})) {
$self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);

} elsif (ref($self->{$idx}) eq "ARRAY") {
for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
$self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
}
}
}

$::myconfig{numberformat} = $saved_numberformat;
}

718f7a1b Geoffrey Richardson
sub create_email_signature {
my $client_signature = $::instance_conf->get_signature;
my $user_signature = $::myconfig{signature};

824735fc Moritz Bunkus
return join '', grep { $_ } ($user_signature, $client_signature);
}
718f7a1b Geoffrey Richardson
0e68056c Geoffrey Richardson
sub calculate_tax {
# this function calculates the net amount and tax for the lines in ar, ap and
# gl and is used for update as well as post. When used with update the return
# value of amount isn't needed

# calculate_tax should always work with positive values, or rather as the user inputs them
# calculate_tax uses db/perl numberformat, i.e. parsed numbers
# convert to negative numbers (when necessary) only when writing to acc_trans
# the amount from $form for ap/ar/gl is currently always rounded to 2 decimals before it reaches here
# for post_transaction amount already contains exchangerate and correct sign and is rounded
# calculate_tax doesn't (need to) know anything about exchangerate

my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_;

6c94b5a5 Sven Schöling
$roundplaces //= 2;
$taxincluded //= 0;
0e68056c Geoffrey Richardson
my $tax;

6c94b5a5 Sven Schöling
if ($taxincluded) {
0e68056c Geoffrey Richardson
# calculate tax (unrounded), subtract from amount, round amount and round tax
$tax = $amount - ($amount / ($taxrate + 1)); # equivalent to: taxrate * amount / (taxrate + 1)
$amount = $self->round_amount($amount - $tax, $roundplaces);
$tax = $self->round_amount($tax, $roundplaces);
} else {
$tax = $amount * $taxrate;
$tax = $self->round_amount($tax, $roundplaces);
}

$tax = 0 unless $tax;

return ($amount,$tax);
};

d319704a Moritz Bunkus
1;
66022cbd Sven Schöling
__END__

=head1 NAME

SL::Form.pm - main data object.

=head1 SYNOPSIS

008c2e15 Moritz Bunkus
This is the main data object of kivitendo.
66022cbd Sven Schöling
Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
Points of interest for a beginner are:

- $form->error - renders a generic error in html. accepts an error message
- $form->get_standard_dbh - returns a database connection for the

=head1 SPECIAL FUNCTIONS

4edf06e5 Sven Schöling
=head2 C<redirect_header> $url
ad9563c8 Moritz Bunkus
Generates a HTTP redirection header for the new C<$url>. Constructs an
absolute URL including scheme, host name and port. If C<$url> is a
008c2e15 Moritz Bunkus
relative URL then it is considered relative to kivitendo base URL.
ad9563c8 Moritz Bunkus
This function C<die>s if headers have already been created with
C<$::form-E<gt>header>.

Examples:

print $::form->redirect_header('oe.pl?action=edit&id=1234');
print $::form->redirect_header('http://www.lx-office.org/');

4edf06e5 Sven Schöling
=head2 C<header>

Generates a general purpose http/html header and includes most of the scripts
6fb7bcc9 Moritz Bunkus
and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.
4edf06e5 Sven Schöling
Only one header will be generated. If the method was already called in this
request it will not output anything and return undef. Also if no
HTTP_USER_AGENT is found, no header is generated.

Although header does not accept parameters itself, it will honor special
hashkeys of its Form instance:

=over 4

=item refresh_time

=item refresh_url

If one of these is set, a http-equiv refresh is generated. Missing parameters
default to 3 seconds and the refering url.

=item stylesheet

6fb7bcc9 Moritz Bunkus
Either a scalar or an array ref. Will be inlined into the header. Add
stylesheets with the L<use_stylesheet> function.
4edf06e5 Sven Schöling
=item landscape

If true, a css snippet will be generated that sets the page in landscape mode.

=item favicon

Used to override the default favicon.

=item title

A html page title will be generated from this

6c9d43ef Jan Büren
=item mtime_ischanged

Tries to avoid concurrent write operations to records by checking the database mtime with a fetched one.

Can be used / called with any table, that has itime and mtime attributes.
Valid C<table> names are: oe, ar, ap, delivery_orders, parts.
Can be called wit C<option> mail to generate a different error message.

Returns undef if no save operation has been done yet ($self->{id} not present).
Returns undef if no concurrent write process is detected otherwise a error message.

9b04d6e3 Jan Büren
=back

=over 4

=item C<check_exchangerate> $myconfig, $currency, $transdate, $fld, $id, $record_table

Needs a local myconfig, a currency string, a date of the transaction, a field (fld) which
has to be either the buy or sell exchangerate and checks if there is already a buy or
sell exchangerate for this date.
Returns 0 or (NULL) if no entry is found or the already stored exchangerate.
If the optional parameter id and record_table is passed, the method tries to look up
a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions.
If none is found the default (daily) entry will be checked.
The method is very strict about the parameters and tries to fail if anything does
not look like the expected type.

=item C<update_exchangerate> $dbh, $curr, $transdate, $buy, $sell, $id, $record_table

Needs a dbh connection, a currency string, a date of the transaction, buy (0|1), sell (0|1) which
determines if either the buy or sell or both exchangerates should be updated and updates
the exchangerate for this currency for this date.
If the optional parameter id and record_table is passed, the method saves
a custom exchangerate for a record with id. record_table can either be ar, ap or bank_transactions.

The method is very strict about the parameters and tries to fail if anything does not look
like the expected type.




66022cbd Sven Schöling
=back

=cut