Form::create_links: überflüssige Kommentare entfernt
[kivitendo-erp.git] / SL / Form.pm
index 28e50a2..7cea6a2 100644 (file)
@@ -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
@@ -66,6 +67,7 @@ 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);
@@ -74,6 +76,7 @@ use SL::PrefixedNumber;
 use SL::Request;
 use SL::Template;
 use SL::User;
+use SL::Util;
 use SL::X;
 use Template;
 use URI;
@@ -83,19 +86,6 @@ use SL::DB::Tax;
 
 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) = @_;
 
@@ -468,7 +458,7 @@ sub header {
   # 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
@@ -479,7 +469,7 @@ 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}");
 
   $self->{favicon} ||= "favicon.ico";
@@ -584,17 +574,6 @@ sub set_standard_title {
   $::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();
 
@@ -617,39 +596,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();
 
@@ -718,7 +673,7 @@ sub show_generic_error {
     SL::ClientJS->new
       ->error($error)
       ->render(SL::Controller::Base->new);
-    ::end_of_request();
+    $::dispatcher->end_request;
   }
 
   my $add_params = {
@@ -749,7 +704,7 @@ sub show_generic_error {
 
   $main::lxdebug->leave_sub();
 
-  ::end_of_request();
+  $::dispatcher->end_request;
 }
 
 sub show_generic_information {
@@ -769,7 +724,7 @@ sub show_generic_information {
 
   $main::lxdebug->leave_sub();
 
-  ::end_of_request();
+  $::dispatcher->end_request;
 }
 
 sub _store_redirect_info_in_session {
@@ -795,7 +750,7 @@ sub redirect {
     print $::form->redirect_header($self->{callback});
   }
 
-  ::end_of_request();
+  $::dispatcher->end_request;
 
   $main::lxdebug->leave_sub();
 }
@@ -821,6 +776,7 @@ sub format_amount {
   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
@@ -837,7 +793,7 @@ sub format_amount {
   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 {
@@ -969,10 +925,17 @@ sub parse_amount {
 }
 
 sub round_amount {
-  my ($self, $amount, $places) = @_;
+  my ($self, $amount, $places, $adjust) = @_;
 
   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
@@ -980,7 +943,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.
 
-  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+)$};
 
@@ -1255,7 +1220,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'),
-    letter                  => $main::locale->text('Letter')
+    letter                  => $main::locale->text('Letter'),
+    ic_supply               => $main::locale->text('Intra-Community supply'),
   );
 
   $main::lxdebug->leave_sub();
@@ -1410,69 +1376,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();
 
@@ -1610,18 +1536,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();
 }
@@ -1719,16 +1645,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;
@@ -1761,39 +1688,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;
@@ -1801,6 +1715,10 @@ 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/<\%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;
 
@@ -1856,20 +1774,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 $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
+  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"});
@@ -1877,52 +1800,68 @@ sub add_shipto {
     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 {
@@ -2496,10 +2435,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 =
@@ -2516,7 +2455,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);
@@ -2592,13 +2531,53 @@ sub all_vc {
   # get payment terms
   $query = qq|SELECT id, description
               FROM payment_terms
-              ORDER BY sortkey|;
+              WHERE ( obsolete IS FALSE OR id = ? )
+              ORDER BY sortkey |;
+  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef);
+
+  $main::lxdebug->leave_sub();
+}
+
+sub new_lastmtime {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $table, $provided_dbh) = @_;
+
+  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->message(LXDebug->DEBUG2(),"new lastmtime=".$self->{lastmtime});
 
   $main::lxdebug->leave_sub();
 }
 
+sub mtime_ischanged {
+  my ($self, $table, $option) = @_;
+
+  return                                       unless $self->{id};
+  croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;
+
+  my $query       = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
+  my $ref         = selectfirst_hashref_query($self, $self->get_standard_dbh, $query, $self->{id});
+  $ref->{mtime} ||= $ref->{itime};
+
+  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();
 
@@ -2622,9 +2601,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
@@ -2684,13 +2663,6 @@ 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
         FROM chart c
@@ -2709,7 +2681,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")) {
@@ -2750,6 +2722,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,
+           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}
@@ -2766,7 +2739,8 @@ sub create_links {
     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});
@@ -2782,7 +2756,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")) {
@@ -2849,7 +2823,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;
@@ -2862,7 +2838,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;
@@ -2969,22 +2947,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();
 
@@ -3018,52 +2980,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();
 }
@@ -3149,20 +3111,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();
 }
@@ -3214,16 +3177,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|;
@@ -3353,10 +3313,17 @@ 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;
+  # 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->{"shiptocvar_" . $_->config->name} = $_->value_as_text for @{ $shipto->cvars_by_config };
   }
 
   my $language = $self->{language} ? '_' . $self->{language} : '';
@@ -3642,11 +3609,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);
@@ -3732,6 +3700,17 @@ Used to override the default favicon.
 
 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