Anpassungen an neues SL::File::Object Interface

[mfinanz.git] / SL / Form.pm

diff --git a/SL/Form.pm b/SL/Form.pm
index b0433bdddb7bf48f4d32c1f8f70d0dfcb47ed6e5..5424a7c923cbd2e6812b59471d953208c058ddeb 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -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
 # 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
 #======================================================================
 # Utilities for parsing forms
 # and supporting routines for linking account numbers


@@ -62,10 +63,12 @@ use SL::DB::Default;
 use SL::DB::PaymentTerm;
 use SL::DB::Vendor;
 use SL::DO;
 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;
 use SL::Locale;
 use SL::IC;
 use SL::IS;
 use SL::Layout::Dispatcher;
 use SL::Locale;

+use SL::Locale::String;

 use SL::Mailer;
 use SL::Menu;
 use SL::MoreCommon qw(uri_encode uri_decode);
 use SL::Mailer;
 use SL::Menu;
 use SL::MoreCommon qw(uri_encode uri_decode);


@@ -74,27 +77,18 @@ use SL::PrefixedNumber;
 use SL::Request;
 use SL::Template;
 use SL::User;
 use SL::Request;
 use SL::Template;
 use SL::User;

+use SL::Util;

 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::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::CreatePDF qw(merge_pdfs);

 
 use strict;
 
 
 use strict;
 

-my $standard_dbh;
-
-END {
-  disconnect_standard_dbh();
-}
-
-sub disconnect_standard_dbh {
-  return unless $standard_dbh;
-  $standard_dbh->disconnect();
-  undef $standard_dbh;
-}
-

 sub read_version {
   my ($self) = @_;
 
 sub read_version {
   my ($self) = @_;
 


@@ -352,13 +346,12 @@ sub numtextrows {
 }
 
 sub dberror {
 }
 
 sub dberror {

-  $main::lxdebug->enter_sub();
-

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

-  $self->error("$msg\n" . $DBI::errstr);
-
-  $main::lxdebug->leave_sub();
+  die SL::X::DBError->new(
+    msg   => $msg,
+    error => $DBI::errstr,
+  );

 }
 
 sub isblank {
 }
 
 sub isblank {


@@ -467,16 +460,18 @@ sub header {
   # standard css for all
   # this should gradually move to the layouts that need it
   $layout->use_stylesheet("$_.css") for qw(
   # standard css for all
   # this should gradually move to the layouts that need it
   $layout->use_stylesheet("$_.css") for qw(

-    main menu common list_accounts jquery.autocomplete
+    common main menu list_accounts jquery.autocomplete

     jquery.multiselect2side
     ui-lightness/jquery-ui
     jquery-ui.custom
     jquery.multiselect2side
     ui-lightness/jquery-ui
     jquery-ui.custom

+    tooltipster themes/tooltipster-light

   );
 
   $layout->use_javascript("$_.js") for (qw(
     jquery jquery-ui jquery.cookie jquery.checkall jquery.download
     jquery/jquery.form jquery/fixes client_js
   );
 
   $layout->use_javascript("$_.js") for (qw(
     jquery jquery-ui jquery.cookie jquery.checkall jquery.download
     jquery/jquery.form jquery/fixes client_js

-    common part_selection switchmenuframe
+    jquery/jquery.tooltipster.min
+    common part_selection

   ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
 
   $self->{favicon} ||= "favicon.ico";
   ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
 
   $self->{favicon} ||= "favicon.ico";


@@ -536,7 +531,7 @@ sub footer {
   print $::request->{layout}->post_content;
 
   if (my @inline_scripts = $::request->{layout}->javascripts_inline) {
   print $::request->{layout}->post_content;
 
   if (my @inline_scripts = $::request->{layout}->javascripts_inline) {

-    print "<script type='text/javascript'>@inline_scripts</script>\n";
+    print "<script type='text/javascript'>" . join("; ", @inline_scripts) . "</script>\n";

   }
 
   print <<EOL
   }
 
   print <<EOL


@@ -603,39 +598,15 @@ sub _prepare_html_template {
     my $info = "Web page template '${file}' not found.\n";
     $::form->header;
     print qq|<pre>$info</pre>|;
     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;
   $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();
 
 
   $main::lxdebug->leave_sub();
 


@@ -704,7 +675,7 @@ sub show_generic_error {
     SL::ClientJS->new
       ->error($error)
       ->render(SL::Controller::Base->new);
     SL::ClientJS->new
       ->error($error)
       ->render(SL::Controller::Base->new);

-    ::end_of_request();
+    $::dispatcher->end_request;

   }
 
   my $add_params = {
   }
 
   my $add_params = {


@@ -712,20 +683,6 @@ sub show_generic_error {
     'label_error' => $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;
-
-  } elsif ($params{back_button}) {
-    $add_params->{SHOW_BACK_BUTTON} = 1;
-  }
-

   $self->{title} = $params{title} if $params{title};
 
   $self->header();
   $self->{title} = $params{title} if $params{title};
 
   $self->header();


@@ -735,7 +692,7 @@ sub show_generic_error {
 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 

-  ::end_of_request();
+  $::dispatcher->end_request;

 }
 
 sub show_generic_information {
 }
 
 sub show_generic_information {


@@ -755,7 +712,7 @@ sub show_generic_information {
 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 

-  ::end_of_request();
+  $::dispatcher->end_request;

 }
 
 sub _store_redirect_info_in_session {
 }
 
 sub _store_redirect_info_in_session {


@@ -777,11 +734,12 @@ sub redirect {
     $self->info($msg);
 
   } else {
     $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});
   }
 
     $self->_store_redirect_info_in_session;
     print $::form->redirect_header($self->{callback});
   }
 

-  ::end_of_request();
+  $::dispatcher->end_request;

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


@@ -807,6 +765,7 @@ sub format_amount {
   my $force_places = defined $places && $places >= 0;
 
   $amount = $self->round_amount($amount, abs $places) if $force_places;
   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
   $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


@@ -823,7 +782,7 @@ sub format_amount {
   if ($places || $p[1]) {
     $amount .= $d[0]
             .  ( $p[1] || '' )
   if ($places || $p[1]) {
     $amount .= $d[0]
             .  ( $p[1] || '' )

-            .  (0 x (abs($places || 0) - length ($p[1]||'')));           # pad the fraction
+            .  (0 x max(abs($places || 0) - length ($p[1]||''), 0));     # pad the fraction

   }
 
   $amount = do {
   }
 
   $amount = do {


@@ -955,10 +914,17 @@ sub parse_amount {
 }
 
 sub round_amount {
 }
 
 sub round_amount {

-  my ($self, $amount, $places) = @_;
+  my ($self, $amount, $places, $adjust) = @_;

 
   return 0 if !defined $amount;
 
 
   return 0 if !defined $amount;
 

+  $places //= 0;
+
+  if ($adjust) {
+    my $precision = $::instance_conf->get_precision || 0.01;
+    return $self->round_amount( $self->round_amount($amount / $precision, 0) * $precision, $places);
+  }
+

   # 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
   # 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


@@ -966,7 +932,9 @@ sub round_amount {
   # part. If an overflow occurs then apply that overflow to the part
   # before the decimal sign as well using integer arithmetic again.
 
   # part. If an overflow occurs then apply that overflow to the part
   # before the decimal sign as well using integer arithmetic again.
 

-  my $amount_str = sprintf '%.*f', $places + 10, abs($amount);
+  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+)$};
 
 
   return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
 


@@ -1110,9 +1078,18 @@ sub parse_template {
   # 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};
 
   # 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};
 

+  if ( $ext_for_format eq 'pdf' && $::instance_conf->get_doc_storage ) {
+    $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 ($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 (!$self->{preview} && $::instance_conf->get_doc_storage)
+    {
+      $self->{attachment_filename} ||= $self->generate_attachment_filename;
+      $self->store_pdf($self);
+    }

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


@@ -1123,98 +1100,185 @@ sub parse_template {
 
   Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
 
 
   Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
 

+  if ( !$self->{preview} && $ext_for_format eq 'pdf' && $::instance_conf->get_doc_storage) {
+    $self->{attachment_filename} ||= $self->generate_attachment_filename;
+    $self->{print_file_id} = $self->store_pdf($self);
+  }

   if ($self->{media} eq 'email') {
   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 version format);

 
 

-  } else {
+  $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() . '.' . $$ . '.';
+  my $full_signature     =  $self->create_email_signature();
+  $full_signature        =~ s/\r//g;

 
 

-    $self->{OUT}      = $out;
-    $self->{OUT_MODE} = $out_mode;
+  $mail->{attachments} =  [];
+  my @attfiles;
+  # 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;

 
 

-    my $numbytes = (-s $self->{tmpfile});

     open(IN, "<", $self->{tmpfile})
       or $self->error($self->cleanup . "$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';
+  } else {
+    $main::lxdebug->message(LXDebug->DEBUG2(),"action_oldfile=" . $self->{action_oldfile}." action_nofile=".$self->{action_nofile});
+    if (!$self->{"do_not_attach"} && !$self->{action_nofile}) {
+      my $attachment_name  =  $self->{attachment_filename}  || $self->{tmpfile};
+      $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
+      if ( $self->{action_oldfile} ) {
+        $main::lxdebug->message(LXDebug->DEBUG2(),"object_id =>". $self->{id}." object_type =>". $self->{formname});
+        my ( $attfile ) = SL::File->get_all(object_id   => $self->{id},
+                                            object_type => $self->{formname},
+                                            file_type   => 'document');
+        $main::lxdebug->message(LXDebug->DEBUG2(), "old file obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      } else {
+        push @{ $mail->{attachments} }, { path => $self->{tmpfile},
+                                          id   => $self->{print_file_id},
+                                          type => "application/pdf",
+                                          name => $attachment_name };
+      }
+    }
+  }
+  if (!$self->{"do_not_attach"}) {
+    for my $i (1 .. $self->{attfile_count}) {
+      if (  $self->{"attsel_$i"} ) {
+        my $attfile = SL::File->get(id => $self->{"attfile_$i"});
+        $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      }
+    }
+    for my $i (1 .. $self->{attfile_cv_count}) {
+      if (  $self->{"attsel_cv_$i"} ) {
+        my $attfile = SL::File->get(id => $self->{"attfile_cv_$i"});
+        $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      }
+    }
+    for my $i (1 .. $self->{attfile_part_count}) {
+      if (  $self->{"attsel_part_$i"} ) {
+        my $attfile = SL::File->get(id => $self->{"attfile_part_$i"});
+        $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      }
+    }
+    foreach my $attfile ( @attfiles ) {
+      push @{ $mail->{attachments} }, { path => $attfile->get_file,
+                                        id   => $attfile->id,
+                                        type => $attfile->mime_type,
+                                        name => $attfile->file_name };
+    }
+  }
+  $mail->{message}  =~ s/\r//g;
+  $mail->{message} .= $full_signature;
+  $self->{emailerr} = $mail->send();
+  # $self->error($self->cleanup . "$err") if $self->{emailerr};
+  $self->{email_journal_id} = $mail->{journalentry};
+  $self->{snumbers}  = "emailjournal" . "_" . $self->{email_journal_id};
+  $self->{what_done} = $::form->{type};
+  $self->{addition}  = "MAILED";
+  $self->save_history;

 
 

-    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});
+  #write back for message info and mail journal
+  $self->{cc}  = $mail->{cc};
+  $self->{bcc} = $mail->{bcc};
+  $self->{email} = $mail->{to};

 
 

-        open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
-        print OUT $_ while <IN>;
-        close OUT;
-        seek  IN, 0, 0;
+  $main::lxdebug->leave_sub();
+}

 
 

-      } 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'        => '',
-          );
-        }
+sub output_file {
+  $main::lxdebug->enter_sub();

 
 

-        print $::request->cgi->header(%headers);
+  my ($self,$mimeType,$command_formatter) = @_;
+  my $numbytes = (-s $self->{tmpfile});
+  open(IN, "<", $self->{tmpfile})
+    or $self->error($self->cleanup . "$self->{tmpfile} : $!");
+  binmode IN;

 
 

-        $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
-      }
-    }
+  $self->{copies} = 1 unless $self->{media} eq 'printer';

 
 

-    close(IN);
-  }
+  chdir("$self->{cwd}");
+  for my $i (1 .. $self->{copies}) {
+    if ($self->{OUT}) {
+      $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});

 
 

-  $self->cleanup;
+      open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
+      print OUT $_ while <IN>;
+      close OUT;
+      seek  IN, 0, 0;

 
 

-  chdir("$self->{cwd}");
+    } 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();
 }
 
   $main::lxdebug->leave_sub();
 }
 


@@ -1241,7 +1305,8 @@ sub get_formname_translation {
     sales_delivery_order    => $main::locale->text('Delivery Order'),
     purchase_delivery_order => $main::locale->text('Delivery Order'),
     dunning                 => $main::locale->text('Dunning'),
     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')
+    letter                  => $main::locale->text('Letter'),
+    ic_supply               => $main::locale->text('Intra-Community supply'),

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


@@ -1298,6 +1363,9 @@ sub generate_attachment_filename {
   } elsif ($attachment_filename && $self->{"${prefix}number"}) {
     $attachment_filename .=  "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
 
   } elsif ($attachment_filename && $self->{"${prefix}number"}) {
     $attachment_filename .=  "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
 

+  } elsif ($attachment_filename) {
+    $attachment_filename .=  $self->get_extension_for_format();
+

   } else {
     $attachment_filename = "";
   }
   } else {
     $attachment_filename = "";
   }


@@ -1393,69 +1461,29 @@ sub datetonum {
 }
 
 # Database routines used throughout
 }
 
 # Database routines used throughout

+# DB Handling got moved to SL::DB, these are only shims for compatibility

 
 sub dbconnect {
 
 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 {
 }
 
 sub get_standard_dbh {

-  $main::lxdebug->enter_sub(2);
-
-  my $self     = shift;
-  my $myconfig = shift || \%::myconfig;
+  my $dbh = SL::DB->client->dbh;

 
 

-  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();
 
 sub date_closed {
   $main::lxdebug->enter_sub();
 


@@ -1593,18 +1621,18 @@ sub save_exchangerate {
 
   my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
 
 
   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();
 }
 
   $main::lxdebug->leave_sub();
 }


@@ -1702,36 +1730,20 @@ sub get_default_currency {
 }
 
 sub set_payment_options {
 }
 
 sub set_payment_options {

-  $main::lxdebug->enter_sub();
-
-  my ($self, $myconfig, $transdate) = @_;
+  my ($self, $myconfig, $transdate, $type) = @_;

 
 

-  return $main::lxdebug->leave_sub() unless ($self->{payment_id});
+  my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef;
+  return if !$terms;

 
 

-  my $dbh = $self->get_standard_dbh($myconfig);
+  my $is_invoice                = $type =~ m{invoice}i;

 
 

-  my $query =
-    qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | .
-    qq|FROM payment_terms p | .
-    qq|WHERE p.id = ?|;
+  $transdate                  ||= $self->{invdate} || $self->{transdate};
+  my $due_date                  = $self->{duedate} || $self->{reqdate};

 
 

-  ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
-   $self->{payment_terms}, $self->{payment_description}) =
-     selectrow_query($self, $dbh, $query, $self->{payment_id});
-
-  if ($transdate eq "") {
-    if ($self->{invdate}) {
-      $transdate = $self->{invdate};
-    } else {
-      $transdate = $self->{transdate};
-    }
-  }
-
-  $query =
-    qq|SELECT ?::date + ?::integer AS netto_date, ?::date + ?::integer AS skonto_date | .
-    qq|FROM payment_terms|;
-  ($self->{netto_date}, $self->{skonto_date}) =
-    selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});
+  $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;

 
   my ($invtotal, $total);
   my (%amounts, %formatted_amounts);
 
   my ($invtotal, $total);
   my (%amounts, %formatted_amounts);


@@ -1761,38 +1773,26 @@ sub set_payment_options {
   }
 
   if ($self->{"language_id"}) {
   }
 
   if ($self->{"language_id"}) {

-    $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)) {
       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;
   $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;


@@ -1800,13 +1800,15 @@ sub set_payment_options {
   $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;
   $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;

+  $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;

 
   map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
 
   $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
 
 
   map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
 
   $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
 

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

 }
 
 sub get_template_language {
 }
 
 sub get_template_language {


@@ -1857,20 +1859,25 @@ 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 $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->leave_sub();
 }
 
 sub add_shipto {

-  $main::lxdebug->enter_sub();
-

   my ($self, $dbh, $id, $module) = @_;
 
   my $shipto;
   my @values;
 
   my ($self, $dbh, $id, $module) = @_;
 
   my $shipto;
   my @values;
 

-  foreach my $item (qw(name department_1 department_2 street zipcode city country
+  foreach my $item (qw(name department_1 department_2 street zipcode city country gln

                        contact cp_gender phone fax email)) {
     if ($self->{"shipto$item"}) {
       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
                        contact cp_gender phone fax email)) {
     if ($self->{"shipto$item"}) {
       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});


@@ -1878,52 +1885,68 @@ sub add_shipto {
     push(@values, $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;
+
+  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 = ?,
+                     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
+                     shiptogln = ? 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){
+      my $insert_query =
+        qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
+                               shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln,
+                               shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, 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 {
 }
 
 sub get_employee {


@@ -1979,23 +2002,6 @@ sub get_employee_data {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 

-sub get_duedate {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $myconfig, $reference_date) = @_;
-
-  my $terms   = $self->{payment_id}  ? SL::DB::PaymentTerm->new(id => $self->{payment_id}) ->load
-              : $self->{customer_id} ? SL::DB::Customer   ->new(id => $self->{customer_id})->load->payment
-              : $self->{vendor_id}   ? SL::DB::Vendor     ->new(id => $self->{vendor_id})  ->load->payment
-              : $self->{invdate}     ? undef # no payment terms, therefore invdate == duedate
-              :                        croak("Missing field in \$::form: payment_id, customer_id, vendor_id or invdate");
-  my $duedate = $terms ? $terms->calc_date(reference_date => $reference_date)->to_kivitendo : undef;
-
-  $main::lxdebug->leave_sub();
-
-  return $duedate;
-}
-

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


@@ -2514,10 +2520,10 @@ sub get_name {
     my $where;
     if ($self->{customernumber} ne "") {
       $where = qq|(vc.customernumber ILIKE ?)|;
     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 ?)|;
     } else {
       $where = qq|(vc.name ILIKE ?)|;

-      push(@values, '%' . $self->{$table} . '%');
+      push(@values, like($self->{$table}));

     }
 
     $query =
     }
 
     $query =


@@ -2534,7 +2540,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~;
          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);
   }
 
   $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);


@@ -2544,79 +2550,43 @@ sub get_name {
   return scalar(@{ $self->{name_list} });
 }
 
   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();
+sub new_lastmtime {

 
 

-  my ($self, $myconfig, $table, $module) = @_;
+  my ($self, $table, $provided_dbh) = @_;

 
 

-  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);
+  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)$/;

 
 

-  # get languages
-  $query = qq|SELECT id, description
-              FROM language
-              ORDER BY id|;
-
-  $self->{languages} = 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};

 
 

-  # get printer
-  $query = qq|SELECT printer_description, id
-              FROM printers
-              ORDER BY printer_description|;
+}

 
 

-  $self->{printers} = selectall_hashref_query($self, $dbh, $query);
+sub mtime_ischanged {
+  my ($self, $table, $option) = @_;

 
 

-  # get payment terms
-  $query = qq|SELECT id, description
-              FROM payment_terms
-              ORDER BY sortkey|;
+  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, $self->get_standard_dbh, $query, $self->{id});
+  $ref->{mtime} ||= $ref->{itime};

 
 

-  $main::lxdebug->leave_sub();
+  if ($self->{lastmtime} && $self->{lastmtime} ne $ref->{mtime} ) {
+      $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")
+      );
+    $::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();
 
 sub language_payment {
   $main::lxdebug->enter_sub();
 


@@ -2640,9 +2610,9 @@ sub language_payment {
   # get payment terms
   $query = qq|SELECT id, description
               FROM payment_terms
   # 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
 
   # get buchungsgruppen
   $query = qq|SELECT id, description


@@ -2686,8 +2656,6 @@ sub create_links {
     $arap = "ap";
   }
 
     $arap = "ap";
   }
 

-  $self->all_vc($myconfig, $table, $module);
-

   # get last customers or vendors
   my ($query, $sth, $ref);
 
   # get last customers or vendors
   my ($query, $sth, $ref);
 


@@ -2702,15 +2670,8 @@ sub create_links {
     }
 
     # now get the account numbers
     }
 
     # 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|
     $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 (
         FROM chart c
         -- find newest entries in taxkeys
         INNER JOIN (


@@ -2727,7 +2688,7 @@ sub create_links {
 
     $sth = $dbh->prepare($query);
 
 
     $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")) {
 
     $self->{accounts} = "";
     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {


@@ -2740,6 +2701,7 @@ sub create_links {
 
           push @{ $self->{"${module}_links"}{$key} },
             { accno       => $ref->{accno},
 
           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} };
               description => $ref->{description},
               taxkey      => $ref->{taxkey_id},
               tax_id      => $ref->{tax_id} };


@@ -2768,6 +2730,7 @@ sub create_links {
       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,
       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.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.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
            a.globalproject_id, ${extra_columns}


@@ -2784,14 +2747,15 @@ sub create_links {
     foreach my $key (keys %$ref) {
       $self->{$key} = $ref->{$key};
     }
     foreach my $key (keys %$ref) {
       $self->{$key} = $ref->{$key};
     }

-
+    $self->{mtime}   ||= $self->{itime};
+    $self->{lastmtime} = $self->{mtime};

     my $transdate = "current_date";
     if ($self->{transdate}) {
       $transdate = $dbh->quote($self->{transdate});
     }
 
     # now get the account numbers
     my $transdate = "current_date";
     if ($self->{transdate}) {
       $transdate = $dbh->quote($self->{transdate});
     }
 
     # 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 ?
                 FROM chart c
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?


@@ -2800,7 +2764,7 @@ sub create_links {
                 ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
                 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")) {
 
     $self->{accounts} = "";
     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {


@@ -2813,6 +2777,7 @@ sub create_links {
 
           push @{ $self->{"${module}_links"}{$key} },
             { accno       => $ref->{accno},
 
           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} };
               description => $ref->{description},
               taxkey      => $ref->{taxkey_id},
               tax_id      => $ref->{tax_id} };


@@ -2827,7 +2792,7 @@ sub create_links {
     $query =
       qq|SELECT
            c.accno, c.description,
     $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
            p.projectnumber,
            t.rate, t.id
          FROM acc_trans a


@@ -2867,7 +2832,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,
            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;
          FROM defaults d|;
     $ref = selectfirst_hashref_query($self, $dbh, $query);
     map { $self->{$_} = $ref->{$_} } keys %$ref;


@@ -2880,7 +2847,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,
             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;
           FROM defaults d|;
     $ref = selectfirst_hashref_query($self, $dbh, $query);
     map { $self->{$_} = $ref->{$_} } keys %$ref;


@@ -2918,7 +2887,6 @@ sub lastname_used {
                     "d.description"           => "department",
                     "ct.name"                 => $table,
                     "cu.name"                 => "currency",
                     "d.description"           => "department",
                     "ct.name"                 => $table,
                     "cu.name"                 => "currency",

-                    "current_date + ct.terms" => "duedate",

     );
 
   if ($self->{type} =~ /delivery_order/) {
     );
 
   if ($self->{type} =~ /delivery_order/) {


@@ -2961,6 +2929,22 @@ sub lastname_used {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 

+sub get_variable_content_types {
+  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;
+}
+

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


@@ -2988,22 +2972,6 @@ sub current_date {
   return $thisdate;
 }
 
   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();
 
 sub redo_rows {
   $main::lxdebug->enter_sub();
 


@@ -3037,52 +3005,52 @@ sub update_status {
 
   my ($i, $id);
 
 
   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();
+      $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});
-  }
-
-  $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();
 }
 
   $main::lxdebug->leave_sub();
 }


@@ -3143,6 +3111,7 @@ sub save_status {
 
 #--- 4 locale ---#
 # $main::locale->text('SAVED')
 
 #--- 4 locale ---#
 # $main::locale->text('SAVED')

+# $main::locale->text('SCREENED')

 # $main::locale->text('DELETED')
 # $main::locale->text('ADDED')
 # $main::locale->text('PAYMENT POSTED')
 # $main::locale->text('DELETED')
 # $main::locale->text('ADDED')
 # $main::locale->text('PAYMENT POSTED')


@@ -3155,6 +3124,8 @@ sub save_status {
 # $main::locale->text('MAILED')
 # $main::locale->text('SCREENED')
 # $main::locale->text('CANCELED')
 # $main::locale->text('MAILED')
 # $main::locale->text('SCREENED')
 # $main::locale->text('CANCELED')

+# $main::locale->text('IMPORT')
+# $main::locale->text('UNIMPORT')

 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')


@@ -3168,20 +3139,21 @@ sub save_history {
   $main::lxdebug->enter_sub();
 
   my $self = shift;
   $main::lxdebug->enter_sub();
 
   my $self = shift;

-  my $dbh  = shift || $self->get_standard_dbh;
-
-  if(!exists $self->{employee_id}) {
-    &get_employee($self, $dbh);
-  }
+  my $dbh  = shift || SL::DB->client->dbh;
+  SL::DB->client->with_transaction(sub {

 
 

-  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();
 }
 
   $main::lxdebug->leave_sub();
 }


@@ -3209,7 +3181,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});
     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
       $tempArray[$i++] = $hash_ref;
     }
     $main::lxdebug->leave_sub() and return \@tempArray


@@ -3233,16 +3208,13 @@ sub get_partsgroup {
   my @values;
 
   if ($p->{searchitems} eq 'part') {
   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') {
   }
   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') {
   }
   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|;
   }
 
   $query .= qq|ORDER BY partsgroup|;


@@ -3372,10 +3344,17 @@ sub prepare_for_printing {
     $self->{"employee_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
   }
 
     $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;
+  # Load shipping address from database. If shipto_id is set then it's
+  # one from the customer's/vendor's master data. Otherwise look an a
+  # customized address linking back to the current record.
+  my $shipto_module = $self->{type} =~ /_delivery_order$/                                             ? 'DO'
+                    : $self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/ ? 'OE'
+                    :                                                                                   'AR';
+  my $shipto        = $self->{shipto_id} ? SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load
+                    :                      SL::DB::Manager::Shipto->get_first(where => [ module => $shipto_module, trans_id => $self->{id} ]);
+  if ($shipto) {

     $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns };
     $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns };

+    $self->{"shiptocvar_" . $_->config->name} = $_->value_as_text for @{ $shipto->cvars_by_config };

   }
 
   my $language = $self->{language} ? '_' . $self->{language} : '';
   }
 
   my $language = $self->{language} ? '_' . $self->{language} : '';


@@ -3507,9 +3486,9 @@ sub calculate_arap {
     if ( $selected_tax ) {
 
       if ( $buysell eq 'sell' ) {
     if ( $selected_tax ) {
 
       if ( $buysell eq 'sell' ) {

-        $self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno unless $selected_tax->taxkey == 0;
+        $self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;

       } else {
       } else {

-        $self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno unless $selected_tax->taxkey == 0;
+        $self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;

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


@@ -3661,11 +3640,12 @@ sub calculate_tax {
 
   my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_;
 
 
   my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_;
 

-  $roundplaces = 2 unless defined $roundplaces;
+  $roundplaces //= 2;
+  $taxincluded //= 0;

 
   my $tax;
 
 
   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);
     # 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);


@@ -3751,6 +3731,17 @@ Used to override the default favicon.
 
 A html page title will be generated from this
 
 
 A html page title will be generated from this
 

+=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.
+

 =back
 
 =cut
 =back
 
 =cut