Merge branch 'b-3.6.1' of ../kivitendo-erp_20220811
[kivitendo-erp.git] / SL / Form.pm
index eee73db..fd79b96 100644 (file)
@@ -1,4 +1,4 @@
-#========= ===========================================================
+#=====================================================================
 # LX-Office ERP
 # Copyright (C) 2004
 # Based on SQL-Ledger Version 2.1.9
@@ -27,7 +27,8 @@
 # GNU General Public License for more details.
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+# MA 02110-1335, USA.
 #======================================================================
 # Utilities for parsing forms
 # and supporting routines for linking account numbers
@@ -41,13 +42,14 @@ use Carp;
 use Data::Dumper;
 
 use Carp;
-use Config;
 use CGI;
 use Cwd;
 use Encode;
 use File::Copy;
+use File::Temp ();
 use IO::File;
 use Math::BigInt;
+use POSIX qw(strftime);
 use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
@@ -57,11 +59,14 @@ use SL::CVar;
 use SL::DB;
 use SL::DBConnect;
 use SL::DBUtils;
+use SL::DB::AdditionalBillingAddress;
 use SL::DB::Customer;
+use SL::DB::CustomVariableConfig;
 use SL::DB::Default;
 use SL::DB::PaymentTerm;
 use SL::DB::Vendor;
 use SL::DO;
+use SL::Helper::Flash qw();
 use SL::IC;
 use SL::IS;
 use SL::Layout::Dispatcher;
@@ -75,37 +80,22 @@ use SL::PrefixedNumber;
 use SL::Request;
 use SL::Template;
 use SL::User;
+use SL::Util;
+use SL::Version;
 use SL::X;
 use Template;
 use URI;
 use List::Util qw(first max min sum);
 use List::MoreUtils qw(all any apply);
 use SL::DB::Tax;
+use SL::Helper::File qw(:all);
+use SL::Helper::Number;
+use SL::Helper::CreatePDF qw(merge_pdfs);
 
 use strict;
 
-my $standard_dbh;
-
-END {
-  disconnect_standard_dbh();
-}
-
-sub disconnect_standard_dbh {
-  return unless $standard_dbh;
-
-  $standard_dbh->rollback();
-  undef $standard_dbh;
-}
-
 sub read_version {
-  my ($self) = @_;
-
-  open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
-  my $version =  <VERSION_FILE>;
-  $version    =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code.
-  close VERSION_FILE;
-
-  return $version;
+  SL::Version->get_version;
 }
 
 sub new {
@@ -123,18 +113,11 @@ sub new {
 
   bless $self, $type;
 
-  $self->{version} = $self->read_version;
-
   $main::lxdebug->leave_sub();
 
   return $self;
 }
 
-sub read_cgi_input {
-  my ($self) = @_;
-  SL::Request::read_cgi_input($self);
-}
-
 sub _flatten_variables_rec {
   $main::lxdebug->enter_sub(2);
 
@@ -165,7 +148,7 @@ sub _flatten_variables_rec {
           $first_array_entry = 0;
         }
       } else {
-        @result = ({ 'key' => $prefix . $key . ($first_array_entry ? '[+]' : '[]'), 'value' => $element });
+        push @result, { 'key' => $prefix . $key . '[]', 'value' => $element };
       }
     }
   }
@@ -196,7 +179,7 @@ sub flatten_standard_variables {
   $main::lxdebug->enter_sub(2);
 
   my $self      = shift;
-  my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_);
+  my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar), @_);
 
   my @variables;
 
@@ -209,36 +192,6 @@ sub flatten_standard_variables {
   return @variables;
 }
 
-sub debug {
-  $main::lxdebug->enter_sub();
-
-  my ($self) = @_;
-
-  print "\n";
-
-  map { print "$_ = $self->{$_}\n" } (sort keys %{$self});
-
-  $main::lxdebug->leave_sub();
-}
-
-sub dumper {
-  $main::lxdebug->enter_sub(2);
-
-  my $self          = shift;
-  my $password      = $self->{password};
-
-  $self->{password} = 'X' x 8;
-
-  local $Data::Dumper::Sortkeys = 1;
-  my $output                    = Dumper($self);
-
-  $self->{password} = $password;
-
-  $main::lxdebug->leave_sub(2);
-
-  return $output;
-}
-
 sub escape {
   my ($self, $str) = @_;
 
@@ -294,7 +247,7 @@ sub hide_form {
 
 sub throw_on_error {
   my ($self, $code) = @_;
-  local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) };
+  local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) };
   $code->();
 }
 
@@ -354,13 +307,12 @@ sub numtextrows {
 }
 
 sub dberror {
-  $main::lxdebug->enter_sub();
-
   my ($self, $msg) = @_;
 
-  $self->error("$msg\n" . $DBI::errstr);
-
-  $main::lxdebug->leave_sub();
+  SL::X::DBError->throw(
+    msg      => $msg,
+    db_error => $DBI::errstr,
+  );
 }
 
 sub isblank {
@@ -385,7 +337,7 @@ sub _get_request_uri {
   return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
   return URI->new                                  if !$ENV{REQUEST_URI}; # for testing
 
-  my $scheme =  $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http';
+  my $scheme =  $::request->is_https ? 'https' : 'http';
   my $port   =  $ENV{SERVER_PORT};
   $port      =  undef if (($scheme eq 'http' ) && ($port == 80))
                       || (($scheme eq 'https') && ($port == 443));
@@ -432,10 +384,12 @@ sub create_http_response {
     my $session_cookie_value = $main::auth->get_session_id();
 
     if ($session_cookie_value) {
-      $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
-                                     '-value'  => $session_cookie_value,
-                                     '-path'   => $uri->path,
-                                     '-secure' => $ENV{HTTPS});
+      $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);
+      $session_cookie = "$session_cookie; SameSite=strict";
     }
   }
 
@@ -443,7 +397,7 @@ sub create_http_response {
   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
   $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 
-  map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length);
+  map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
 
   my $output = $cgi->header(%cgi_params);
 
@@ -480,11 +434,13 @@ sub header {
     jquery jquery-ui jquery.cookie jquery.checkall jquery.download
     jquery/jquery.form jquery/fixes client_js
     jquery/jquery.tooltipster.min
-    common part_selection switchmenuframe
+    common part_selection
   ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
 
+  $layout->use_javascript("$_.js") for @{ $params{use_javascripts} // [] };
+
   $self->{favicon} ||= "favicon.ico";
-  $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title} || !$self->{titlebar};
+  $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->read_version if $self->{title} || !$self->{titlebar};
 
   # build includes
   if ($self->{refresh_url} || $self->{refresh_time}) {
@@ -499,6 +455,7 @@ sub header {
   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};
   push @header, map { qq|<script type="text/javascript" src="${_}${auto_reload_resources_param}"></script>| }                    $layout->javascripts;
+  push @header, '<meta name="viewport" content="width=device-width, initial-scale=1">';
   push @header, $self->{javascript} if $self->{javascript};
   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
 
@@ -578,24 +535,13 @@ sub set_standard_title {
   $::lxdebug->enter_sub;
   my $self = shift;
 
-  $self->{titlebar}  = "kivitendo " . $::locale->text('Version') . " $self->{version}";
+  $self->{titlebar}  = "kivitendo " . $::locale->text('Version') . " " . $self->read_version;
   $self->{titlebar} .= "- $::myconfig{name}"   if $::myconfig{name};
   $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
 
   $::lxdebug->leave_sub;
 }
 
-sub prepare_global_vars {
-  my ($self) = @_;
-
-  $self->{AUTH}            = $::auth;
-  $self->{INSTANCE_CONF}   = $::instance_conf;
-  $self->{LOCALE}          = $::locale;
-  $self->{LXCONFIG}        = $::lx_office_conf;
-  $self->{LXDEBUG}         = $::lxdebug;
-  $self->{MYCONFIG}        = \%::myconfig;
-}
-
 sub _prepare_html_template {
   $main::lxdebug->enter_sub();
 
@@ -609,8 +555,10 @@ sub _prepare_html_template {
   }
   $language = "de" unless ($language);
 
-  if (-f "templates/webpages/${file}.html") {
-    $file = "templates/webpages/${file}.html";
+  my $webpages_path = $::request->layout->webpages_path;
+
+  if (-f "${webpages_path}/${file}.html") {
+    $file = "${webpages_path}/${file}.html";
 
   } elsif (ref $file eq 'SCALAR') {
     # file is a scalarref, use inline mode
@@ -618,39 +566,15 @@ sub _prepare_html_template {
     my $info = "Web page template '${file}' not found.\n";
     $::form->header;
     print qq|<pre>$info</pre>|;
-    ::end_of_request();
-  }
-
-  if ($self->{"DEBUG"}) {
-    $additional_params->{"DEBUG"} = $self->{"DEBUG"};
-  }
-
-  if ($additional_params->{"DEBUG"}) {
-    $additional_params->{"DEBUG"} =
-      "<br><em>DEBUG INFORMATION:</em><pre>" . $additional_params->{"DEBUG"} . "</pre>";
-  }
-
-  if (%main::myconfig) {
-    $::myconfig{jsc_dateformat} = apply {
-      s/d+/\%d/gi;
-      s/m+/\%m/gi;
-      s/y+/\%Y/gi;
-    } $::myconfig{"dateformat"};
-    $additional_params->{"myconfig"} ||= \%::myconfig;
-    map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
+    $::dispatcher->end_request;
   }
 
+  $additional_params->{AUTH}          = $::auth;
   $additional_params->{INSTANCE_CONF} = $::instance_conf;
-
-  if (my $debug_options = $::lx_office_conf{debug}{options}) {
-    map { $additional_params->{'DEBUG_' . uc($_)} = $debug_options->{$_} } keys %$debug_options;
-  }
-
-  if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) {
-    while (my ($key, $value) = each %{ $main::auth->{RIGHTS}->{$self->{login}} }) {
-      $additional_params->{"AUTH_RIGHTS_" . uc($key)} = $value;
-    }
-  }
+  $additional_params->{LOCALE}        = $::locale;
+  $additional_params->{LXCONFIG}      = \%::lx_office_conf;
+  $additional_params->{LXDEBUG}       = $::lxdebug;
+  $additional_params->{MYCONFIG}      = \%::myconfig;
 
   $main::lxdebug->leave_sub();
 
@@ -665,7 +589,7 @@ sub parse_html_template {
   $additional_params ||= { };
 
   my $real_file = $self->_prepare_html_template($file, $additional_params);
-  my $template  = $self->template || $self->init_template;
+  my $template  = $self->template;
 
   map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
 
@@ -677,32 +601,7 @@ sub parse_html_template {
   return $output;
 }
 
-sub init_template {
-  my $self = shift;
-
-  return $self->template if $self->template;
-
-  # Force scripts/locales.pl to pick up the exception handling template.
-  # parse_html_template('generic/exception')
-  return $self->template(Template->new({
-     'INTERPOLATE'  => 0,
-     'EVAL_PERL'    => 0,
-     'ABSOLUTE'     => 1,
-     'CACHE_SIZE'   => 0,
-     'PLUGIN_BASE'  => 'SL::Template::Plugin',
-     'INCLUDE_PATH' => '.:templates/webpages',
-     'COMPILE_EXT'  => '.tcc',
-     'COMPILE_DIR'  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
-     'ERROR'        => 'templates/webpages/generic/exception.html',
-     'ENCODING'     => 'utf8',
-  })) || die;
-}
-
-sub template {
-  my $self = shift;
-  $self->{template_object} = shift if @_;
-  return $self->{template_object};
-}
+sub template { $::request->presenter->get_template }
 
 sub show_generic_error {
   $main::lxdebug->enter_sub();
@@ -719,7 +618,7 @@ sub show_generic_error {
     SL::ClientJS->new
       ->error($error)
       ->render(SL::Controller::Base->new);
-    ::end_of_request();
+    $::dispatcher->end_request;
   }
 
   my $add_params = {
@@ -727,22 +626,18 @@ sub show_generic_error {
     'label_error' => $error,
   };
 
-  if ($params{action}) {
-    my @vars;
-
-    map { delete($self->{$_}); } qw(action);
-    map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self };
-
-    $add_params->{SHOW_BUTTON}  = 1;
-    $add_params->{BUTTON_LABEL} = $params{label} || $params{action};
-    $add_params->{VARIABLES}    = \@vars;
+  $self->{title} = $params{title} if $params{title};
 
-  } elsif ($params{back_button}) {
-    $add_params->{SHOW_BACK_BUTTON} = 1;
+  for my $bar ($::request->layout->get('actionbar')) {
+    $bar->add(
+      action => [
+        t8('Back'),
+        call      => [ 'kivi.history_back' ],
+        accesskey => 'enter',
+      ],
+    );
   }
 
-  $self->{title} = $params{title} if $params{title};
-
   $self->header();
   print $self->parse_html_template("generic/error", $add_params);
 
@@ -750,7 +645,7 @@ sub show_generic_error {
 
   $main::lxdebug->leave_sub();
 
-  ::end_of_request();
+  $::dispatcher->end_request;
 }
 
 sub show_generic_information {
@@ -770,7 +665,7 @@ sub show_generic_information {
 
   $main::lxdebug->leave_sub();
 
-  ::end_of_request();
+  $::dispatcher->end_request;
 }
 
 sub _store_redirect_info_in_session {
@@ -792,11 +687,12 @@ sub redirect {
     $self->info($msg);
 
   } else {
+    SL::Helper::Flash::flash_later('info', $msg) if $msg;
     $self->_store_redirect_info_in_session;
     print $::form->redirect_header($self->{callback});
   }
 
-  ::end_of_request();
+  $::dispatcher->end_request;
 
   $main::lxdebug->leave_sub();
 }
@@ -812,112 +708,10 @@ sub sort_columns {
   return @columns;
 }
 #
-sub format_amount {
-  $main::lxdebug->enter_sub(2);
 
+sub format_amount {
   my ($self, $myconfig, $amount, $places, $dash) = @_;
-  $amount ||= 0;
-  $dash   ||= '';
-  my $neg = $amount < 0;
-  my $force_places = defined $places && $places >= 0;
-
-  $amount = $self->round_amount($amount, abs $places) if $force_places;
-  $neg    = 0 if $amount == 0; # don't show negative zero
-  $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa
-
-  # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl
-  # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on
-  # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs.
-
-  $amount =~ s/0*$// unless defined $places && $places == 0;             # cull trailing 0s
-
-  my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
-  my @p = split(/\./, $amount);                                          # split amount at decimal point
-
-  $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1];                             # add 1,000 delimiters
-  $amount = $p[0];
-  if ($places || $p[1]) {
-    $amount .= $d[0]
-            .  ( $p[1] || '' )
-            .  (0 x max(abs($places || 0) - length ($p[1]||''), 0));     # pad the fraction
-  }
-
-  $amount = do {
-    ($dash =~ /-/)    ? ($neg ? "($amount)"                            : "$amount" )                              :
-    ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) :
-                        ($neg ? "-$amount"                             : "$amount" )                              ;
-  };
-
-  $main::lxdebug->leave_sub(2);
-  return $amount;
-}
-
-sub format_amount_units {
-  $main::lxdebug->enter_sub();
-
-  my $self             = shift;
-  my %params           = @_;
-
-  my $myconfig         = \%main::myconfig;
-  my $amount           = $params{amount} * 1;
-  my $places           = $params{places};
-  my $part_unit_name   = $params{part_unit};
-  my $amount_unit_name = $params{amount_unit};
-  my $conv_units       = $params{conv_units};
-  my $max_places       = $params{max_places};
-
-  if (!$part_unit_name) {
-    $main::lxdebug->leave_sub();
-    return '';
-  }
-
-  my $all_units        = AM->retrieve_all_units;
-
-  if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
-    $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
-  }
-
-  if (!scalar @{ $conv_units }) {
-    my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
-    $main::lxdebug->leave_sub();
-    return $result;
-  }
-
-  my $part_unit  = $all_units->{$part_unit_name};
-  my $conv_unit  = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;
-
-  $amount       *= $conv_unit->{factor};
-
-  my @values;
-  my $num;
-
-  foreach my $unit (@$conv_units) {
-    my $last = $unit->{name} eq $part_unit->{name};
-    if (!$last) {
-      $num     = int($amount / $unit->{factor});
-      $amount -= $num * $unit->{factor};
-    }
-
-    if ($last ? $amount : $num) {
-      push @values, { "unit"   => $unit->{name},
-                      "amount" => $last ? $amount / $unit->{factor} : $num,
-                      "places" => $last ? $places : 0 };
-    }
-
-    last if $last;
-  }
-
-  if (!@values) {
-    push @values, { "unit"   => $part_unit_name,
-                    "amount" => 0,
-                    "places" => 0 };
-  }
-
-  my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;
-
-  $main::lxdebug->leave_sub();
-
-  return $result;
+  SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
 }
 
 sub format_string {
@@ -938,75 +732,11 @@ sub format_string {
 #
 
 sub parse_amount {
-  $main::lxdebug->enter_sub(2);
-
   my ($self, $myconfig, $amount) = @_;
-
-  if (!defined($amount) || ($amount eq '')) {
-    $main::lxdebug->leave_sub(2);
-    return 0;
-  }
-
-  if (   ($myconfig->{numberformat} eq '1.000,00')
-      || ($myconfig->{numberformat} eq '1000,00')) {
-    $amount =~ s/\.//g;
-    $amount =~ s/,/\./g;
-  }
-
-  if ($myconfig->{numberformat} eq "1'000.00") {
-    $amount =~ s/\'//g;
-  }
-
-  $amount =~ s/,//g;
-
-  $main::lxdebug->leave_sub(2);
-
-  # Make sure no code wich is not a math expression ends up in eval().
-  return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
-
-  # Prevent numbers from being parsed as octals;
-  $amount =~ s{ (?<! [\d.] ) 0+ (?= [1-9] ) }{}gx;
-
-  return scalar(eval($amount)) * 1 ;
+  SL::Helper::Number::_parse_number($amount, %$myconfig);
 }
 
-sub round_amount {
-  my ($self, $amount, $places) = @_;
-
-  return 0 if !defined $amount;
-
-  # We use Perl's knowledge of string representation for
-  # rounding. First, convert the floating point number to a string
-  # with a high number of places. Then split the string on the decimal
-  # sign and use integer calculation for rounding the decimal places
-  # part. If an overflow occurs then apply that overflow to the part
-  # before the decimal sign as well using integer arithmetic again.
-
-  my $int_amount = int(abs $amount);
-  my $str_places = max(min(10, 16 - length("$int_amount") - $places), $places);
-  my $amount_str = sprintf '%.*f', $places + $str_places, abs($amount);
-
-  return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
-
-  my ($pre, $post)      = ($1, $2);
-  my $decimals          = '1' . substr($post, 0, $places);
-
-  my $propagation_limit = $Config{i32size} == 4 ? 7 : 18;
-  my $add_for_rounding  = substr($post, $places, 1) >= 5 ? 1 : 0;
-
-  if ($places > $propagation_limit) {
-    $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding);
-    $pre      = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2';
-
-  } else {
-    $decimals += $add_for_rounding;
-    $pre      += 1 if substr($decimals, 0, 1) eq '2';
-  }
-
-  $amount  = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0);
-
-  return $amount;
-}
+sub round_amount { shift; goto &SL::Helper::Number::_round_number; }
 
 sub parse_template {
   $main::lxdebug->enter_sub();
@@ -1016,11 +746,18 @@ sub parse_template {
 
   local (*IN, *OUT);
 
-  my $defaults  = SL::DB::Default->get;
-  my $userspath = $::lx_office_conf{paths}->{userspath};
+  my $defaults        = SL::DB::Default->get;
+
+  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,
+  );
 
-  $self->{"cwd"} = getcwd();
-  $self->{"tmpdir"} = $self->{cwd} . "/${userspath}";
+  my $userspath   = File::Spec->abs2rel($temp_dir->dirname);
+  $self->{tmpdir} = $temp_dir->dirname;
 
   my $ext_for_format;
 
@@ -1037,13 +774,6 @@ sub parse_template {
     $template_type  = 'HTML';
     $ext_for_format = 'html';
 
-  } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) {
-    $template_type  = 'XML';
-    $ext_for_format = 'xml';
-
-  } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
-    $template_type = 'XML';
-
   } elsif ( $self->{"format"} =~ /excel/i ) {
     $template_type  = 'Excel';
     $ext_for_format = 'xls';
@@ -1087,16 +817,18 @@ sub parse_template {
 
   # OUT is used for the media, screen, printer, email
   # for postscript we store a copy in a temporary file
+
   my ($temp_fh, $suffix);
   $suffix =  $self->{IN};
   $suffix =~ s/.*\.//;
   ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
-    'kivitendo-printXXXXXX',
+    strftime('kivitendo-print-%Y%m%d%H%M%S-XXXXXX', localtime()),
     SUFFIX => '.' . ($suffix || 'tex'),
     DIR    => $userspath,
-    UNLINK => ($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})? 0 : 1,
+    UNLINK => $keep_temp_files ? 0 : 1,
   );
   close $temp_fh;
+  chmod 0644, $self->{tmpfile} if $keep_temp_files;
   (undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} );
 
   $out              = $self->{OUT};
@@ -1126,11 +858,29 @@ sub parse_template {
   close OUT if $self->{OUT};
   # check only one flag (webdav_documents)
   # therefore copy to webdav, even if we do not have the webdav feature enabled (just archive)
-  my $copy_to_webdav =  $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type};
+  my $copy_to_webdav =  $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type}
+                        && $self->{type} ne 'statement';
+
+  $self->{attachment_filename} ||= $self->generate_attachment_filename;
 
+  if ( $ext_for_format eq 'pdf' && $self->doc_storage_enabled ) {
+    $self->append_general_pdf_attachments(filepath =>  $self->{tmpdir}."/".$self->{tmpfile},
+                                          type     =>  $self->{type});
+  }
   if ($self->{media} eq 'file') {
     copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
-    Common::copy_file_to_webdav_folder($self)                                                                         if $copy_to_webdav;
+
+    if ($copy_to_webdav) {
+      if (my $error = Common::copy_file_to_webdav_folder($self)) {
+        chdir("$self->{cwd}");
+        $self->error($error);
+      }
+    }
+
+    if (!$self->{preview} && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled)
+    {
+      $self->store_pdf($self);
+    }
     $self->cleanup;
     chdir("$self->{cwd}");
 
@@ -1139,100 +889,192 @@ sub parse_template {
     return;
   }
 
-  Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
+  if ($copy_to_webdav) {
+    if (my $error = Common::copy_file_to_webdav_folder($self)) {
+      chdir("$self->{cwd}");
+      $self->error($error);
+    }
+  }
 
+  if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) {
+    my $file_obj = $self->store_pdf($self);
+    $self->{print_file_id} = $file_obj->id if $file_obj;
+  }
   if ($self->{media} eq 'email') {
+    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};
 
-    my $mail = Mailer->new;
-
-    map { $mail->{$_} = $self->{$_} }
-      qw(cc bcc subject message version format);
-    $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
-    $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
-    $mail->{fileid} = time() . '.' . $$ . '.';
-    my $full_signature     =  $self->create_email_signature();
-    $full_signature        =~ s/\r//g;
-
-    # if we send html or plain text inline
-    if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
-      $mail->{contenttype}    =  "text/html";
-      $mail->{message}        =~ s/\r//g;
-      $mail->{message}        =~ s/\n/<br>\n/g;
-      $full_signature         =~ s/\n/<br>\n/g;
-      $mail->{message}       .=  $full_signature;
-
-      open(IN, "<:encoding(UTF-8)", $self->{tmpfile})
-        or $self->error($self->cleanup . "$self->{tmpfile} : $!");
-      $mail->{message} .= $_ while <IN>;
-      close(IN);
+  $self->cleanup;
 
-    } else {
+  chdir("$self->{cwd}");
+  $main::lxdebug->leave_sub();
+}
 
-      if (!$self->{"do_not_attach"}) {
-        my $attachment_name  =  $self->{attachment_filename} || $self->{tmpfile};
-        $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
-        $mail->{attachments} =  [{ "filename" => $self->{tmpfile},
-                                   "name"     => $attachment_name }];
-      }
+sub get_bcc_defaults {
+  my ($self, $myconfig, $mybcc) = @_;
+  if (SL::DB::Default->get->bcc_to_login) {
+    $mybcc .= ", " if $mybcc;
+    $mybcc .= $myconfig->{email};
+  }
+  my $otherbcc = SL::DB::Default->get->global_bcc;
+  if ($otherbcc) {
+    $mybcc .= ", " if $mybcc;
+    $mybcc .= $otherbcc;
+  }
+  return $mybcc;
+}
 
-      $mail->{message} .= $full_signature;
-    }
+sub send_email {
+  $main::lxdebug->enter_sub();
+  my ($self, $myconfig, $ext_for_format) = @_;
+  my $mail = Mailer->new;
 
-    my $err = $mail->send();
-    $self->error($self->cleanup . "$err") if ($err);
+  map { $mail->{$_} = $self->{$_} }
+    qw(cc subject message format);
 
-  } else {
+  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;
+  }
 
-    $self->{OUT}      = $out;
-    $self->{OUT_MODE} = $out_mode;
+  $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() . '.' . $$ . '.';
+  $mail->{content_type}  =  "text/html";
+  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;
+    $mail->{message}        =~ s{\n}{<br>\n}g;
+    $mail->{message}       .=  $full_signature;
 
-    my $numbytes = (-s $self->{tmpfile});
     open(IN, "<", $self->{tmpfile})
       or $self->error($self->cleanup . "$self->{tmpfile} : $!");
-    binmode IN;
+    $mail->{message} .= $_ while <IN>;
+    close(IN);
 
-    $self->{copies} = 1 unless $self->{media} eq 'printer';
+  } elsif (($self->{attachment_policy} // '') ne 'no_file') {
+    my $attachment_name  =  $self->{attachment_filename}  || $self->{tmpfile};
+    $attachment_name     =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format);
 
-    chdir("$self->{cwd}");
-    #print(STDERR "Kopien $self->{copies}\n");
-    #print(STDERR "OUT $self->{OUT}\n");
-    for my $i (1 .. $self->{copies}) {
-      if ($self->{OUT}) {
-        $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+    if (($self->{attachment_policy} // '') eq 'old_file') {
+      my ( $attfile ) = SL::File->get_all(object_id     => $self->{id},
+                                          object_type   => $self->{type},
+                                          file_type     => 'document',
+                                          print_variant => $self->{formname},);
 
-        open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
-        print OUT $_ while <IN>;
-        close OUT;
-        seek  IN, 0, 0;
+      if ($attfile) {
+        $attfile->{override_file_name} = $attachment_name if $attachment_name;
+        push @attfiles, $attfile;
+      }
 
-      } else {
-        my %headers = ('-type'       => $template->get_mime_type,
-                       '-connection' => 'close',
-                       '-charset'    => 'UTF-8');
-
-        $self->{attachment_filename} ||= $self->generate_attachment_filename;
-
-        if ($self->{attachment_filename}) {
-          %headers = (
-            %headers,
-            '-attachment'     => $self->{attachment_filename},
-            '-content-length' => $numbytes,
-            '-charset'        => '',
-          );
-        }
+    } else {
+      push @{ $mail->{attachments} }, { path => $self->{tmpfile},
+                                        id   => $self->{print_file_id},
+                                        type => "application/pdf",
+                                        name => $attachment_name };
+    }
+  }
 
-        print $::request->cgi->header(%headers);
+  push @attfiles,
+    grep { $_ }
+    map  { SL::File->get(id => $_) }
+    @{ $self->{attach_file_ids} // [] };
 
-        $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
-      }
-    }
+  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,
+    };
+  }
 
-    close(IN);
+  $mail->{message}  =~ s/\r//g;
+  $mail->{message} .= $full_signature;
+  $self->{emailerr} = $mail->send();
+
+  if ($self->{emailerr}) {
+    $self->cleanup;
+    $self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr}));
   }
 
-  $self->cleanup;
+  $self->{email_journal_id} = $mail->{journalentry};
+  $self->{snumbers}  = "emailjournal" . "_" . $self->{email_journal_id};
+  $self->{what_done} = $::form->{type};
+  $self->{addition}  = "MAILED";
+  $self->save_history;
+
+  #write back for message info and mail journal
+  $self->{cc}  = $mail->{cc};
+  $self->{bcc} = $mail->{bcc};
+  $self->{email} = $mail->{to};
+
+  $main::lxdebug->leave_sub();
+}
+
+sub output_file {
+  $main::lxdebug->enter_sub();
+
+  my ($self,$mimeType,$command_formatter) = @_;
+  my $numbytes = (-s $self->{tmpfile});
+  open(IN, "<", $self->{tmpfile})
+    or $self->error($self->cleanup . "$self->{tmpfile} : $!");
+  binmode IN;
+
+  $self->{copies} = 1 unless $self->{media} eq 'printer';
 
   chdir("$self->{cwd}");
+  for my $i (1 .. $self->{copies}) {
+    if ($self->{OUT}) {
+      $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+
+      open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
+      print OUT $_ while <IN>;
+      close OUT;
+      seek  IN, 0, 0;
+
+    } else {
+      my %headers = ('-type'       => $mimeType,
+                     '-connection' => 'close',
+                     '-charset'    => 'UTF-8');
+
+      $self->{attachment_filename} ||= $self->generate_attachment_filename;
+
+      if ($self->{attachment_filename}) {
+        %headers = (
+          %headers,
+          '-attachment'     => $self->{attachment_filename},
+          '-content-length' => $numbytes,
+          '-charset'        => '',
+        );
+      }
+
+      print $::request->cgi->header(%headers);
+
+      $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
+    }
+  }
+  close(IN);
   $main::lxdebug->leave_sub();
 }
 
@@ -1246,36 +1088,61 @@ sub get_formname_translation {
   local $::locale = Locale->new($self->{recipient_locale});
 
   my %formname_translations = (
-    bin_list                => $main::locale->text('Bin List'),
-    credit_note             => $main::locale->text('Credit Note'),
-    invoice                 => $main::locale->text('Invoice'),
-    pick_list               => $main::locale->text('Pick List'),
-    proforma                => $main::locale->text('Proforma Invoice'),
-    purchase_order          => $main::locale->text('Purchase Order'),
-    request_quotation       => $main::locale->text('RFQ'),
-    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'),
-    dunning                 => $main::locale->text('Dunning'),
-    letter                  => $main::locale->text('Letter')
+    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'),
+    invoice_for_advance_payment => $main::locale->text('Invoice for Advance Payment'),
+    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'),
+    request_quotation           => $main::locale->text('RFQ'),
+    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'),
+    supplier_delivery_order     => $main::locale->text('Supplier Delivery Order'),
+    rma_delivery_order          => $main::locale->text('RMA Delivery Order'),
+    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'),
   );
 
   $main::lxdebug->leave_sub();
   return $formname_translations{$formname};
 }
 
+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');
+}
+
 sub get_number_prefix_for_type {
   $main::lxdebug->enter_sub();
   my ($self) = @_;
 
   my $prefix =
-      (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
-    : ($self->{type} =~ /_quotation$/)                        ? 'quo'
-    : ($self->{type} =~ /_delivery_order$/)                   ? 'do'
-    : ($self->{type} =~ /letter/)                             ? 'letter'
-    :                                                           'ord';
+      (first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note)) ? 'inv'
+    : ($self->{type} =~ /_quotation$/)                                                                  ? 'quo'
+    : ($self->{type} =~ /_delivery_order$/)                                                             ? 'do'
+    : ($self->{type} =~ /letter/)                                                                       ? 'letter'
+    :                                                                                                     'ord';
 
   # better default like this?
   # : ($self->{type} =~ /(sales|purcharse)_order/           :  'ord';
@@ -1310,7 +1177,7 @@ sub generate_attachment_filename {
   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
   my $prefix              = $self->get_number_prefix_for_type();
 
-  if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
+  if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice invoice_for_advance_payment final_invoice credit_note))) {
     $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
 
   } elsif ($attachment_filename && $self->{"${prefix}number"}) {
@@ -1341,10 +1208,51 @@ sub generate_email_subject {
     $subject .= " " . $self->{"${prefix}number"}
   }
 
+  if ($self->{cusordnumber}) {
+    $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject;
+  }
+
   $main::lxdebug->leave_sub();
   return $subject;
 }
 
+sub generate_email_body {
+  $main::lxdebug->enter_sub();
+  my ($self, %params) = @_;
+  # 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 = '';
+
+  if ($self->{cp_id} && !$params{record_email}) {
+    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;
+
+  $body .= GenericTranslations->get(translation_type => "salutation_punctuation_mark", language_id => $self->{language_id});
+  $body  = '<p>' . $::locale->quote_special_chars('HTML', $body) . '</p>';
+
+  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;
+
+  $body = $main::locale->unquote_special_chars('HTML', $body);
+
+  $main::lxdebug->leave_sub();
+  return $body;
+}
+
 sub cleanup {
   $main::lxdebug->enter_sub();
 
@@ -1414,69 +1322,29 @@ sub datetonum {
 }
 
 # Database routines used throughout
+# DB Handling got moved to SL::DB, these are only shims for compatibility
 
 sub dbconnect {
-  $main::lxdebug->enter_sub(2);
-
-  my ($self, $myconfig) = @_;
-
-  # connect to database
-  my $dbh = SL::DBConnect->connect or $self->dberror;
-
-  # set db options
-  if ($myconfig->{dboptions}) {
-    $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
-  }
-
-  $main::lxdebug->leave_sub(2);
-
-  return $dbh;
-}
-
-sub dbconnect_noauto {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $myconfig) = @_;
-
-  # connect to database
-  my $dbh = SL::DBConnect->connect(SL::DBConnect->get_connect_args(AutoCommit => 0)) or $self->dberror;
-
-  # set db options
-  if ($myconfig->{dboptions}) {
-    $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
-  }
-
-  $main::lxdebug->leave_sub();
-
-  return $dbh;
+  SL::DB->client->dbh;
 }
 
 sub get_standard_dbh {
-  $main::lxdebug->enter_sub(2);
+  my $dbh = SL::DB->client->dbh;
 
-  my $self     = shift;
-  my $myconfig = shift || \%::myconfig;
-
-  if ($standard_dbh && !$standard_dbh->{Active}) {
-    $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
-    undef $standard_dbh;
+  if ($dbh && !$dbh->{Active}) {
+    $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$dbh is defined but not Active anymore");
+    SL::DB->client->dbh(undef);
   }
 
-  $standard_dbh ||= $self->dbconnect_noauto($myconfig);
-
-  $main::lxdebug->leave_sub(2);
-
-  return $standard_dbh;
+  SL::DB->client->dbh;
 }
 
-sub set_standard_dbh {
-  my ($self, $dbh) = @_;
-  my $old_dbh      = $standard_dbh;
-  $standard_dbh    = $dbh;
-
-  return $old_dbh;
+sub disconnect_standard_dbh {
+  SL::DB->client->dbh->rollback;
 }
 
+# /database
+
 sub date_closed {
   $main::lxdebug->enter_sub();
 
@@ -1614,18 +1482,18 @@ sub save_exchangerate {
 
   my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
 
-  my $dbh = $self->dbconnect($myconfig);
-
-  my ($buy, $sell);
-
-  $buy  = $rate if $fld eq 'buy';
-  $sell = $rate if $fld eq 'sell';
+  SL::DB->client->with_transaction(sub {
+    my $dbh = SL::DB->client->dbh;
 
+    my ($buy, $sell);
 
-  $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
+    $buy  = $rate if $fld eq 'buy';
+    $sell = $rate if $fld eq 'sell';
 
 
-  $dbh->disconnect;
+    $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
+    1;
+  }) or do { die SL::DB->client->error };
 
   $main::lxdebug->leave_sub();
 }
@@ -1723,16 +1591,17 @@ sub get_default_currency {
 }
 
 sub set_payment_options {
-  my ($self, $myconfig, $transdate) = @_;
+  my ($self, $myconfig, $transdate, $type) = @_;
 
   my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef;
   return if !$terms;
 
+  my $is_invoice                = $type =~ m{invoice}i;
+
   $transdate                  ||= $self->{invdate} || $self->{transdate};
   my $due_date                  = $self->{duedate} || $self->{reqdate};
 
   $self->{$_}                   = $terms->$_ for qw(terms_netto terms_skonto percent_skonto);
-  $self->{payment_terms}        = $terms->description_long;
   $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;
@@ -1765,39 +1634,26 @@ sub set_payment_options {
   }
 
   if ($self->{"language_id"}) {
-    my $dbh   = $self->get_standard_dbh($myconfig);
-    my $query =
-      qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | .
-      qq|FROM generic_translations t | .
-      qq|LEFT JOIN language l ON t.language_id = l.id | .
-      qq|WHERE (t.language_id = ?)
-           AND (t.translation_id = ?)
-           AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|;
-    my ($description_long, $output_numberformat, $output_dateformat,
-      $output_longdates) =
-      selectrow_query($self, $dbh, $query,
-                      $self->{"language_id"}, $self->{"payment_id"});
-
-    $self->{payment_terms} = $description_long if ($description_long);
-
-    if ($output_dateformat) {
+    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) {
       foreach my $key (qw(netto_date skonto_date)) {
-        $self->{$key} =
-          $main::locale->reformat_date($myconfig, $self->{$key},
-                                       $output_dateformat,
-                                       $output_longdates);
+        $self->{$key} = $::locale->reformat_date($myconfig, $self->{$key}, $language->output_dateformat, $language->output_longdates);
       }
     }
 
-    if ($output_numberformat &&
-        ($output_numberformat ne $myconfig->{"numberformat"})) {
-      my $saved_numberformat = $myconfig->{"numberformat"};
-      $myconfig->{"numberformat"} = $output_numberformat;
-      map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts;
-      $myconfig->{"numberformat"} = $saved_numberformat;
+    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;
     }
   }
 
+  $self->{payment_terms} =  $self->{payment_terms} || ($is_invoice ? $terms->description_long_invoice : undef) || $terms->description_long;
+
   $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;
@@ -1864,73 +1720,100 @@ sub get_shipto {
     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));
+
+    my $cvars = CVar->get_custom_variables(
+      dbh      => $dbh,
+      module   => 'ShipTo',
+      trans_id => $self->{shipto_id},
+    );
+    $self->{"shiptocvar_$_->{name}"} = $_->{value} for @{ $cvars };
   }
 
   $main::lxdebug->leave_sub();
 }
 
 sub add_shipto {
-  $main::lxdebug->enter_sub();
-
   my ($self, $dbh, $id, $module) = @_;
 
   my $shipto;
   my @values;
 
-  foreach my $item (qw(name department_1 department_2 street zipcode city country
-                       contact cp_gender phone fax email)) {
+  foreach my $item (qw(name department_1 department_2 street zipcode city country gln
+                       contact phone fax email)) {
     if ($self->{"shipto$item"}) {
       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
     }
     push(@values, $self->{"shipto${item}"});
   }
 
-  if ($shipto) {
-    if ($self->{shipto_id}) {
-      my $query = qq|UPDATE shipto set
-                       shiptoname = ?,
-                       shiptodepartment_1 = ?,
-                       shiptodepartment_2 = ?,
-                       shiptostreet = ?,
-                       shiptozipcode = ?,
-                       shiptocity = ?,
-                       shiptocountry = ?,
-                       shiptocontact = ?,
-                       shiptocp_gender = ?,
-                       shiptophone = ?,
-                       shiptofax = ?,
-                       shiptoemail = ?
-                     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
-                       shiptocontact = ? AND
-                       shiptocp_gender = ? AND
-                       shiptophone = ? AND
-                       shiptofax = ? AND
-                       shiptoemail = ? AND
-                       module = ? AND
-                       trans_id = ?|;
-      my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
-      if(!$insert_check){
-        $query =
-          qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
-                                 shiptostreet, shiptozipcode, shiptocity, shiptocountry,
-                                 shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
-             VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
-        do_query($self, $dbh, $query, $id, @values, $module);
-      }
+  return if !$shipto;
+
+  # 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});
+
+  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 = ?,
+                     shiptoemail = ?
+                     shiptocp_gender = ?,
+                   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
+                     shiptocp_gender = ? AND
+                     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,
+                               shiptocontact, shiptophone, shiptofax, shiptoemail, shiptocp_gender, module)
+           VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
+      do_query($self, $dbh, $insert_query, $id, @values, $module);
+
+      $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
     }
+
+    $shipto_id = $insert_check->{shipto_id};
   }
 
-  $main::lxdebug->leave_sub();
+  return unless $shipto_id;
+
+  CVar->save_custom_variables(
+    dbh         => $dbh,
+    module      => 'ShipTo',
+    trans_id    => $shipto_id,
+    variables   => $self,
+    name_prefix => 'shipto',
+  );
 }
 
 sub get_employee {
@@ -2060,26 +1943,6 @@ sub _get_projects {
   $main::lxdebug->leave_sub();
 }
 
-sub _get_shipto {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $dbh, $vc_id, $key) = @_;
-
-  $key = "all_shipto" unless ($key);
-
-  if ($vc_id) {
-    # get shipping addresses
-    my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
-
-    $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
-
-  } else {
-    $self->{$key} = [];
-  }
-
-  $main::lxdebug->leave_sub();
-}
-
 sub _get_printers {
   $main::lxdebug->enter_sub();
 
@@ -2119,36 +1982,6 @@ sub _get_charts {
   $main::lxdebug->leave_sub();
 }
 
-sub _get_taxcharts {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $dbh, $params) = @_;
-
-  my $key = "all_taxcharts";
-  my @where;
-
-  if (ref $params eq 'HASH') {
-    $key = $params->{key} if ($params->{key});
-    if ($params->{module} eq 'AR') {
-      push @where, 'chart_categories ~ \'[ACILQ]\'';
-
-    } elsif ($params->{module} eq 'AP') {
-      push @where, 'chart_categories ~ \'[ACELQ]\'';
-    }
-
-  } elsif ($params) {
-    $key = $params;
-  }
-
-  my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
-
-  my $query = qq|SELECT * FROM tax $where ORDER BY taxkey, rate|;
-
-  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
-
-  $main::lxdebug->leave_sub();
-}
-
 sub _get_taxzones {
   $main::lxdebug->enter_sub();
 
@@ -2362,31 +2195,19 @@ sub _get_simple {
   $main::lxdebug->leave_sub();
 }
 
-#sub _get_groups {
-#  $main::lxdebug->enter_sub();
-#
-#  my ($self, $dbh, $key) = @_;
-#
-#  $key ||= "all_groups";
-#
-#  my $groups = $main::auth->read_groups();
-#
-#  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
-#
-#  $main::lxdebug->leave_sub();
-#}
-
 sub get_lists {
   $main::lxdebug->enter_sub();
 
   my $self = shift;
   my %params = @_;
 
+  croak "get_lists: shipto is no longer supported" if $params{shipto};
+
   my $dbh = $self->get_standard_dbh(\%main::myconfig);
   my ($sth, $query, $ref);
 
   my ($vc, $vc_id);
-  if ($params{contacts} || $params{shipto}) {
+  if ($params{contacts}) {
     $vc = 'customer' if $self->{"vc"} eq "customer";
     $vc = 'vendor'   if $self->{"vc"} eq "vendor";
     die "invalid use of get_lists, need 'vc'" unless $vc;
@@ -2397,10 +2218,6 @@ sub get_lists {
     $self->_get_contacts($dbh, $vc_id, $params{"contacts"});
   }
 
-  if ($params{"shipto"}) {
-    $self->_get_shipto($dbh, $vc_id, $params{"shipto"});
-  }
-
   if ($params{"projects"} || $params{"all_projects"}) {
     $self->_get_projects($dbh, $params{"all_projects"} ?
                          $params{"all_projects"} : $params{"projects"},
@@ -2419,10 +2236,6 @@ sub get_lists {
     $self->_get_charts($dbh, $params{"charts"});
   }
 
-  if ($params{"taxcharts"}) {
-    $self->_get_taxcharts($dbh, $params{"taxcharts"});
-  }
-
   if ($params{"taxzones"}) {
     $self->_get_taxzones($dbh, $params{"taxzones"});
   }
@@ -2475,10 +2288,6 @@ sub get_lists {
     $self->_get_warehouses($dbh, $params{warehouses});
   }
 
-#  if ($params{groups}) {
-#    $self->_get_groups($dbh, $params{groups});
-#  }
-
   if ($params{partsgroup}) {
     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
   }
@@ -2504,10 +2313,10 @@ sub get_name {
     my $where;
     if ($self->{customernumber} ne "") {
       $where = qq|(vc.customernumber ILIKE ?)|;
-      push(@values, '%' . $self->{customernumber} . '%');
+      push(@values, like($self->{customernumber}));
     } else {
       $where = qq|(vc.name ILIKE ?)|;
-      push(@values, '%' . $self->{$table} . '%');
+      push(@values, like($self->{$table}));
     }
 
     $query =
@@ -2524,7 +2333,7 @@ sub get_name {
          JOIN $table vc ON (a.${table}_id = vc.id)
          WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
          ORDER BY vc.name~;
-    push(@values, '%' . $self->{$table} . '%');
+    push(@values, like($self->{$table}));
   }
 
   $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
@@ -2534,77 +2343,19 @@ sub get_name {
   return scalar(@{ $self->{name_list} });
 }
 
-# the selection sub is used in the AR, AP, IS, IR, DO and OE module
-#
-sub all_vc {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $myconfig, $table, $module) = @_;
-
-  my $ref;
-  my $dbh = $self->get_standard_dbh;
-
-  $table = $table eq "customer" ? "customer" : "vendor";
-
-  # build selection list
-  # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege
-  # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch
-  # nicht für veränderbare Belege (oe, do, ...)
-  my $obsolete = $self->{id} ? '' : "WHERE NOT obsolete";
-  my $query = qq|SELECT count(*) FROM $table $obsolete|;
-  my ($count) = selectrow_query($self, $dbh, $query);
-
-  if ($count <= $myconfig->{vclimit}) {
-    $query = qq|SELECT id, name, salesman_id
-                FROM $table $obsolete
-                ORDER BY name|;
-    $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
-  }
-
-  # get self
-  $self->get_employee($dbh);
-
-  # setup sales contacts
-  $query = qq|SELECT e.id, e.name
-              FROM employee e
-              WHERE (e.sales = '1') AND (NOT e.id = ?)
-              ORDER BY name|;
-  $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
-
-  # this is for self
-  push(@{ $self->{all_employees} },
-       { id   => $self->{employee_id},
-         name => $self->{employee} });
-
-    # prepare query for departments
-    $query = qq|SELECT id, description
-                FROM department
-                ORDER BY description|;
-
-  $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
-
-  # get languages
-  $query = qq|SELECT id, description
-              FROM language
-              ORDER BY id|;
+sub new_lastmtime {
 
-  $self->{languages} = selectall_hashref_query($self, $dbh, $query);
+  my ($self, $table, $provided_dbh) = @_;
 
-  # get printer
-  $query = qq|SELECT printer_description, id
-              FROM printers
-              ORDER BY printer_description|;
-
-  $self->{printers} = selectall_hashref_query($self, $dbh, $query);
-
-  # get payment terms
-  $query = qq|SELECT id, description
-              FROM payment_terms
-              ORDER BY sortkey|;
+  my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh;
+  return                                       unless $self->{id};
+  croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;
 
-  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
+  my $query       = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
+  my $ref         = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
+  $ref->{mtime} ||= $ref->{itime};
+  $self->{lastmtime} = $ref->{mtime};
 
-  $main::lxdebug->leave_sub();
 }
 
 sub mtime_ischanged {
@@ -2622,10 +2373,13 @@ sub mtime_ischanged {
         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")
       );
-    ::end_of_request();
+    $::dispatcher->end_request;
   }
 }
 
+# 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
 sub language_payment {
   $main::lxdebug->enter_sub();
 
@@ -2649,9 +2403,9 @@ sub language_payment {
   # get payment terms
   $query = qq|SELECT id, description
               FROM payment_terms
-              ORDER BY sortkey|;
-
-  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
+              WHERE ( obsolete IS FALSE OR id = ? )
+              ORDER BY sortkey |;
+  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef);
 
   # get buchungsgruppen
   $query = qq|SELECT id, description
@@ -2695,8 +2449,6 @@ sub create_links {
     $arap = "ap";
   }
 
-  $self->all_vc($myconfig, $table, $module);
-
   # get last customers or vendors
   my ($query, $sth, $ref);
 
@@ -2711,15 +2463,8 @@ sub create_links {
     }
 
     # now get the account numbers
-#    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
-#                FROM chart c, taxkeys tk
-#                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
-#                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
-#                ORDER BY c.accno|;
-
-#  same query as above, but without expensive subquery for each row. about 80% faster
     $query = qq|
-      SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id
+      SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id
         FROM chart c
         -- find newest entries in taxkeys
         INNER JOIN (
@@ -2736,7 +2481,7 @@ sub create_links {
 
     $sth = $dbh->prepare($query);
 
-    do_statement($self, $sth, $query, '%' . $module . '%');
+    do_statement($self, $sth, $query, like($module));
 
     $self->{accounts} = "";
     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
@@ -2749,6 +2494,7 @@ sub create_links {
 
           push @{ $self->{"${module}_links"}{$key} },
             { accno       => $ref->{accno},
+              chart_id    => $ref->{chart_id},
               description => $ref->{description},
               taxkey      => $ref->{taxkey_id},
               tax_id      => $ref->{tax_id} };
@@ -2775,12 +2521,12 @@ sub create_links {
   if ($self->{id}) {
     $query =
       qq|SELECT
-           a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid,
-           a.duedate, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes,
+           a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate,
+           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,
            a.mtime, a.itime,
            a.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
-           a.globalproject_id, ${extra_columns}
+           a.globalproject_id, a.transaction_description, ${extra_columns}
            c.name AS $table,
            d.description AS department,
            e.name AS employee
@@ -2802,7 +2548,7 @@ sub create_links {
     }
 
     # now get the account numbers
-    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
+    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id
                 FROM chart c
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?
@@ -2811,7 +2557,7 @@ sub create_links {
                 ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
-    do_statement($self, $sth, $query, "%$module%");
+    do_statement($self, $sth, $query, like($module));
 
     $self->{accounts} = "";
     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
@@ -2824,6 +2570,7 @@ sub create_links {
 
           push @{ $self->{"${module}_links"}{$key} },
             { accno       => $ref->{accno},
+              chart_id    => $ref->{chart_id},
               description => $ref->{description},
               taxkey      => $ref->{taxkey_id},
               tax_id      => $ref->{tax_id} };
@@ -2838,7 +2585,7 @@ sub create_links {
     $query =
       qq|SELECT
            c.accno, c.description,
-           a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey,
+           a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id,
            p.projectnumber,
            t.rate, t.id
          FROM acc_trans a
@@ -2878,7 +2625,9 @@ sub create_links {
            d.closedto, d.revtrans,
            (SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
            (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
-           (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
+           (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
          FROM defaults d|;
     $ref = selectfirst_hashref_query($self, $dbh, $query);
     map { $self->{$_} = $ref->{$_} } keys %$ref;
@@ -2891,7 +2640,9 @@ sub create_links {
             current_date AS transdate, d.closedto, d.revtrans,
             (SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
             (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
-            (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
+            (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
           FROM defaults d|;
     $ref = selectfirst_hashref_query($self, $dbh, $query);
     map { $self->{$_} = $ref->{$_} } keys %$ref;
@@ -2971,6 +2722,51 @@ sub lastname_used {
   $main::lxdebug->leave_sub();
 }
 
+sub get_variable_content_types {
+  my ($self) = @_;
+
+  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',
+  );
+
+  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;
+}
+
 sub current_date {
   $main::lxdebug->enter_sub();
 
@@ -2998,22 +2794,6 @@ sub current_date {
   return $thisdate;
 }
 
-sub like {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $string) = @_;
-
-  if ($string !~ /%/) {
-    $string = "%$string%";
-  }
-
-  $string =~ s/\'/\'\'/g;
-
-  $main::lxdebug->leave_sub();
-
-  return $string;
-}
-
 sub redo_rows {
   $main::lxdebug->enter_sub();
 
@@ -3047,52 +2827,52 @@ sub update_status {
 
   my ($i, $id);
 
-  my $dbh = $self->dbconnect_noauto($myconfig);
+  SL::DB->client->with_transaction(sub {
+    my $dbh = SL::DB->client->dbh;
 
-  my $query = qq|DELETE FROM status
-                 WHERE (formname = ?) AND (trans_id = ?)|;
-  my $sth = prepare_query($self, $dbh, $query);
+    my $query = qq|DELETE FROM status
+                   WHERE (formname = ?) AND (trans_id = ?)|;
+    my $sth = prepare_query($self, $dbh, $query);
 
-  if ($self->{formname} =~ /(check|receipt)/) {
-    for $i (1 .. $self->{rowcount}) {
-      do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
+    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});
     }
-  } else {
-    do_statement($self, $sth, $query, $self->{formname}, $self->{id});
-  }
-  $sth->finish();
+    $sth->finish();
 
-  my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
-  my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+    my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+    my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
 
-  my %queued = split / /, $self->{queued};
-  my @values;
+    my %queued = split / /, $self->{queued};
+    my @values;
 
-  if ($self->{formname} =~ /(check|receipt)/) {
+    if ($self->{formname} =~ /(check|receipt)/) {
 
-    # this is a check or receipt, add one entry for each lineitem
-    my ($accno) = split /--/, $self->{account};
-    $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
-                VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
-    @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
-    $sth = prepare_query($self, $dbh, $query);
+      # 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);
 
-    for $i (1 .. $self->{rowcount}) {
-      if ($self->{"checked_$i"}) {
-        do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
+      for $i (1 .. $self->{rowcount}) {
+        if ($self->{"checked_$i"}) {
+          do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
+        }
       }
-    }
-    $sth->finish();
-
-  } 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});
-  }
+      $sth->finish();
 
-  $dbh->commit;
-  $dbh->disconnect;
+    } 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 };
 
   $main::lxdebug->leave_sub();
 }
@@ -3153,6 +2933,7 @@ sub save_status {
 
 #--- 4 locale ---#
 # $main::locale->text('SAVED')
+# $main::locale->text('SCREENED')
 # $main::locale->text('DELETED')
 # $main::locale->text('ADDED')
 # $main::locale->text('PAYMENT POSTED')
@@ -3161,11 +2942,17 @@ sub save_status {
 # $main::locale->text('ELSE')
 # $main::locale->text('SAVED FOR DUNNING')
 # $main::locale->text('DUNNING STARTED')
+# $main::locale->text('PREVIEWED')
 # $main::locale->text('PRINTED')
 # $main::locale->text('MAILED')
 # $main::locale->text('SCREENED')
 # $main::locale->text('CANCELED')
+# $main::locale->text('IMPORT')
+# $main::locale->text('UNDO TRANSFER')
+# $main::locale->text('UNIMPORT')
 # $main::locale->text('invoice')
+# $main::locale->text('invoice_for_advance_payment')
+# $main::locale->text('final_invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')
 # $main::locale->text('pick_list')
@@ -3178,20 +2965,21 @@ sub save_history {
   $main::lxdebug->enter_sub();
 
   my $self = shift;
-  my $dbh  = shift || $self->get_standard_dbh;
+  my $dbh  = shift || SL::DB->client->dbh;
+  SL::DB->client->with_transaction(sub {
 
-  if(!exists $self->{employee_id}) {
-    &get_employee($self, $dbh);
-  }
-
-  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);
+    if(!exists $self->{employee_id}) {
+      &get_employee($self, $dbh);
+    }
 
-  $dbh->commit;
+    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 };
 
   $main::lxdebug->leave_sub();
 }
@@ -3209,7 +2997,7 @@ sub get_history {
       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 | .
       qq|FROM history_erp h | .
       qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
-      qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | .
+      qq|WHERE (trans_id = | . $dbh->quote($trans_id) . qq|) $restriction | .
       $order;
 
     my $sth = $dbh->prepare($query) || $self->dberror($query);
@@ -3219,7 +3007,10 @@ sub get_history {
     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});
-      $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g;
+      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';
       $tempArray[$i++] = $hash_ref;
     }
     $main::lxdebug->leave_sub() and return \@tempArray
@@ -3243,16 +3034,13 @@ sub get_partsgroup {
   my @values;
 
   if ($p->{searchitems} eq 'part') {
-    $query .= qq|WHERE p.inventory_accno_id > 0|;
+    $query .= qq|WHERE p.part_type = 'part'|;
   }
   if ($p->{searchitems} eq 'service') {
-    $query .= qq|WHERE p.inventory_accno_id IS NULL|;
+    $query .= qq|WHERE p.part_type = 'service'|;
   }
   if ($p->{searchitems} eq 'assembly') {
-    $query .= qq|WHERE p.assembly = '1'|;
-  }
-  if ($p->{searchitems} eq 'labor') {
-    $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|;
+    $query .= qq|WHERE p.part_type = 'assembly'|;
   }
 
   $query .= qq|ORDER BY partsgroup|;
@@ -3382,12 +3170,6 @@ sub prepare_for_printing {
     $self->{"employee_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
   }
 
-  # Load shipping address from database if shipto_id is set.
-  if ($self->{shipto_id}) {
-    my $shipto  = SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load;
-    $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns };
-  }
-
   my $language = $self->{language} ? '_' . $self->{language} : '';
 
   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
@@ -3414,6 +3196,8 @@ sub prepare_for_printing {
     IS->invoice_details(\%::myconfig, $self, $::locale);
   }
 
+  $self->set_addition_billing_address_print_variables;
+
   # Chose extension & set source file name
   my $extension = 'html';
   if ($self->{format} eq 'postscript') {
@@ -3436,7 +3220,7 @@ sub prepare_for_printing {
 
   # Format dates.
   $self->format_dates($output_dateformat, $output_longdates,
-                      qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid
+                      qw(invdate orddate quodate pldate duedate reqdate transdate tax_point shippingdate deliverydate validitydate paymentdate datepaid
                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
 
@@ -3456,6 +3240,14 @@ sub prepare_for_printing {
     $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
   }
 
+  # 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])
+    }
+  }
+
   $self->{template_meta} = {
     formname  => $self->{formname},
     language  => SL::DB::Manager::Language->find_by_or_create(id => $self->{language_id} || undef),
@@ -3466,6 +3258,43 @@ sub prepare_for_printing {
     today     => DateTime->today,
   };
 
+  if ($defaults->print_interpolate_variables_in_positions) {
+    $self->substitute_placeholders_in_template_arrays({ field => 'description', type => 'text' }, { field => 'longdescription', type => 'html' });
+  }
+
+  return $self;
+}
+
+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 };
+}
+
+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} }
+    ];
+  }
+
   return $self;
 }
 
@@ -3620,41 +3449,10 @@ sub reformat_numbers {
 }
 
 sub create_email_signature {
-
   my $client_signature = $::instance_conf->get_signature;
   my $user_signature   = $::myconfig{signature};
 
-  my $signature = '';
-  if ( $client_signature or $user_signature ) {
-    $signature  = "\n\n-- \n";
-    $signature .= $user_signature   . "\n" if $user_signature;
-    $signature .= $client_signature . "\n" if $client_signature;
-  };
-  return $signature;
-
-};
-
-sub layout {
-  my ($self) = @_;
-  $::lxdebug->enter_sub;
-
-  my %style_to_script_map = (
-    v3  => 'v3',
-    neu => 'new',
-  );
-
-  my $menu_script = $style_to_script_map{$::myconfig{menustyle}} || '';
-
-  package main;
-  require "bin/mozilla/menu$menu_script.pl";
-  package Form;
-  require SL::Controller::FrameHeader;
-
-
-  my $layout = SL::Controller::FrameHeader->new->action_header . ::render();
-
-  $::lxdebug->leave_sub;
-  return $layout;
+  return join '', grep { $_ } ($user_signature, $client_signature);
 }
 
 sub calculate_tax {
@@ -3671,11 +3469,12 @@ sub calculate_tax {
 
   my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_;
 
-  $roundplaces = 2 unless defined $roundplaces;
+  $roundplaces //= 2;
+  $taxincluded //= 0;
 
   my $tax;
 
-  if ($taxincluded *= 1) {
+  if ($taxincluded) {
     # 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);