]> wagnertech.de Git - kivitendo-erp.git/blobdiff - SL/Form.pm
projects / kivitendo-erp.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
SQL-Injection vermeiden. Fix für Revisionen 2936, 2937.
[kivitendo-erp.git] / SL / Form.pm
diff --git a/SL/Form.pm b/SL/Form.pm
index d39625d482fc34fd5430370e892596b14435d6dc..f43578bb623e43a5c15fb7e5deef0c0a8529215d 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -39,7 +39,7 @@ package Form;
 use Data::Dumper;
 
 use Cwd;
 use Data::Dumper;
 
 use Cwd;
-use HTML::Template;
+use Template;
 use SL::Template;
 use CGI::Ajax;
 use SL::DBUtils;
 use SL::Template;
 use CGI::Ajax;
 use SL::DBUtils;
@@ -48,6 +48,7 @@ use SL::Menu;
 use SL::User;
 use SL::Common;
 use CGI;
 use SL::User;
 use SL::Common;
 use CGI;
+use List::Util qw(max min sum);
 
 my $standard_dbh;
 
 
 my $standard_dbh;
 
@@ -97,7 +98,8 @@ sub _request_to_hash {
     if (($line eq $boundary) || ($line eq "$boundary\r")) {
       $params{$name} =~ s|\r?\n$|| if $name;
 
     if (($line eq $boundary) || ($line eq "$boundary\r")) {
       $params{$name} =~ s|\r?\n$|| if $name;
 
-      undef $name, $filename;
+      undef $name;
+      undef $filename;
 
       $headers_done   = 0;
       $content_type   = "text/plain";
 
       $headers_done   = 0;
       $content_type   = "text/plain";
@@ -180,7 +182,7 @@ sub new {
   $self->{action} = lc $self->{action};
   $self->{action} =~ s/( |-|,|\#)/_/g;
 
   $self->{action} = lc $self->{action};
   $self->{action} =~ s/( |-|,|\#)/_/g;
 
-  $self->{version}   = "2.4.2";
+  $self->{version}   = "2.4.3";
 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 
@@ -293,11 +295,7 @@ sub error {
 
   } else {
 
 
   } else {
 
-    if ($self->{error_function}) {
-      &{ $self->{error_function} }($msg);
-    } else {
-      die "Error: $msg\n";
-    }
+    die "Error: $msg\n";
   }
 
   $main::lxdebug->leave_sub();
   }
 
   $main::lxdebug->leave_sub();
@@ -334,20 +332,17 @@ sub info {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
+# calculates the number of rows in a textarea based on the content and column number
+# can be capped with maxrows
 sub numtextrows {
   $main::lxdebug->enter_sub();
 sub numtextrows {
   $main::lxdebug->enter_sub();
-
   my ($self, $str, $cols, $maxrows) = @_;
 
   my ($self, $str, $cols, $maxrows) = @_;
 
-  my $rows = 0;
-
-  map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str;
-
-  $maxrows = $rows unless defined $maxrows;
+  my $rows   = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
+  $maxrows ||= $rows;
 
   $main::lxdebug->leave_sub();
 
   $main::lxdebug->leave_sub();
-
-  return ($rows > $maxrows) ? $maxrows : $rows;
+  return min $rows, $maxrows;
 }
 
 sub dberror {
 }
 
 sub dberror {
@@ -384,11 +379,22 @@ sub header {
   my ($stylesheet, $favicon);
 
   if ($ENV{HTTP_USER_AGENT}) {
   my ($stylesheet, $favicon);
 
   if ($ENV{HTTP_USER_AGENT}) {
+    my $doctype;
 
 
-    if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) {
-      $stylesheet =
-        qq|<LINK REL="stylesheet" HREF="css/$self->{stylesheet}" TYPE="text/css" TITLE="Lx-Office stylesheet">
- |;
+    if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) {
+      # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise.
+      $doctype = qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">\n|;
+    }
+
+    my $stylesheets = "$self->{stylesheet} $self->{stylesheets}";
+
+    $stylesheets =~ s|^\s*||;
+    $stylesheets =~ s|\s*$||;
+    foreach my $file (split m/\s+/, $stylesheets) {
+      $file =~ s|.*/||;
+      next if (! -f "css/$file");
+
+      $stylesheet .= qq|<link rel="stylesheet" href="css/$file" TYPE="text/css" TITLE="Lx-Office stylesheet">\n|;
     }
 
     $self->{favicon}    = "favicon.ico" unless $self->{favicon};
     }
 
     $self->{favicon}    = "favicon.ico" unless $self->{favicon};
@@ -432,7 +438,7 @@ sub header {
     }
     print qq|Content-Type: text/html; charset=${db_charset};
 
     }
     print qq|Content-Type: text/html; charset=${db_charset};
 
-<html>
+${doctype}<html>
 <head>
   <title>$self->{titlebar}</title>
   $stylesheet
 <head>
   <title>$self->{titlebar}</title>
   $stylesheet
@@ -474,7 +480,7 @@ sub header {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
-sub parse_html_template {
+sub _prepare_html_template {
   $main::lxdebug->enter_sub();
 
   my ($self, $file, $additional_params) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $file, $additional_params) = @_;
@@ -508,14 +514,6 @@ sub parse_html_template {
     die($info);
   }
 
     die($info);
   }
 
-  my $template = HTML::Template->new("filename" => $file,
-                                     "die_on_bad_params" => 0,
-                                     "strict" => 0,
-                                     "case_sensitive" => 1,
-                                     "loop_context_vars" => 1,
-                                     "global_vars" => 1);
-
-  $additional_params = {} unless ($additional_params);
   if ($self->{"DEBUG"}) {
     $additional_params->{"DEBUG"} = $self->{"DEBUG"};
   }
   if ($self->{"DEBUG"}) {
     $additional_params->{"DEBUG"} = $self->{"DEBUG"};
   }
@@ -539,15 +537,40 @@ sub parse_html_template {
   $additional_params->{"conf_latex_templates"}        = $main::latex;
   $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates;
 
   $additional_params->{"conf_latex_templates"}        = $main::latex;
   $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates;
 
-  my @additional_param_names = keys(%{$additional_params});
-  foreach my $key ($template->param()) {
-    my $param = $self->{$key};
-    $param = $additional_params->{$key} if (grep(/^${key}$/, @additional_param_names));
-    $param = [] if (($template->query("name" => $key) eq "LOOP") && (ref($param) ne "ARRAY"));
-    $template->param($key => $param);
+  if (%main::debug_options) {
+    map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
+  }
+
+  $main::lxdebug->leave_sub();
+
+  return $file;
+}
+
+sub parse_html_template {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $file, $additional_params) = @_;
+
+  $additional_params ||= { };
+
+  $file = $self->_prepare_html_template($file, $additional_params);
+
+  my $template = Template->new({ 'INTERPOLATE'  => 0,
+                                 'EVAL_PERL'    => 0,
+                                 'ABSOLUTE'     => 1,
+                                 'CACHE_SIZE'   => 0,
+                                 'PLUGIN_BASE'  => 'SL::Template::Plugin',
+                                 'INCLUDE_PATH' => '.:templates/webpages',
+                               }) || die;
+
+  map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
+
+  my $output;
+  if (!$template->process($file, $additional_params, \$output)) {
+    print STDERR $template->error();
   }
 
   }
 
-  my $output = $template->output();
+  $output = $main::locale->{iconv}->convert($output) if ($main::locale);
 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 
@@ -557,9 +580,10 @@ sub parse_html_template {
 sub show_generic_error {
   my ($self, $error, $title, $action) = @_;
 
 sub show_generic_error {
   my ($self, $error, $title, $action) = @_;
 
-  my $add_params = {};
-  $add_params->{"title"} = $title if ($title);
-  $self->{"label_error"} = $error;
+  my $add_params = {
+    'title_error' => $title,
+    'label_error' => $error,
+  };
 
   my @vars;
   if ($action) {
 
   my @vars;
   if ($action) {
@@ -572,21 +596,26 @@ sub show_generic_error {
   }
   $add_params->{"VARIABLES"} = \@vars;
 
   }
   $add_params->{"VARIABLES"} = \@vars;
 
+  $self->{title} = $title if ($title);
+
   $self->header();
   $self->header();
-  print($self->parse_html_template("generic/error", $add_params));
+  print $self->parse_html_template("generic/error", $add_params);
 
   die("Error: $error\n");
 }
 
 sub show_generic_information {
 
   die("Error: $error\n");
 }
 
 sub show_generic_information {
-  my ($self, $error, $title) = @_;
+  my ($self, $text, $title) = @_;
+
+  my $add_params = {
+    'title_information' => $title,
+    'label_information' => $text,
+  };
 
 
-  my $add_params = {};
-  $add_params->{"title"} = $title if ($title);
-  $self->{"label_information"} = $error;
+  $self->{title} = $title if ($title);
 
   $self->header();
 
   $self->header();
-  print($self->parse_html_template("generic/information", $add_params));
+  print $self->parse_html_template("generic/information", $add_params);
 
   die("Information: $error\n");
 }
 
   die("Information: $error\n");
 }
@@ -645,7 +674,9 @@ sub redirect {
 
   if ($self->{callback}) {
 
 
   if ($self->{callback}) {
 
-    ($script, $argv) = split(/\?/, $self->{callback});
+    ($script, $argv) = split(/\?/, $self->{callback}, 2);
+    $script =~ s|.*/||;
+    $script =~ s|[^a-zA-Z0-9_\.]||g;
     exec("perl", "$script", $argv);
 
   } else {
     exec("perl", "$script", $argv);
 
   } else {
@@ -676,18 +707,23 @@ sub format_amount {
   if ($amount eq "") {
     $amount = 0;
   }
   if ($amount eq "") {
     $amount = 0;
   }
-  my $neg = ($amount =~ s/-//);
-
+  
+  # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
+  
+  my $neg = ($amount =~ s/^-//);
+  my $exp = ($amount =~ m/[e]/) ? 1 : 0;
+  
   if (defined($places) && ($places ne '')) {
   if (defined($places) && ($places ne '')) {
-    if ($places < 0) {
-      $amount *= 1;
-      $places *= -1;
-
-      my ($actual_places) = ($amount =~ /\.(\d+)/);
-      $actual_places = length($actual_places);
-      $places = $actual_places > $places ? $actual_places : $places;
+    if (not $exp) {
+      if ($places < 0) {
+        $amount *= 1;
+        $places *= -1;
+
+        my ($actual_places) = ($amount =~ /\.(\d+)/);
+        $actual_places = length($actual_places);
+        $places = $actual_places > $places ? $actual_places : $places;
+      }
     }
     }
-
     $amount = $self->round_amount($amount, $places);
   }
 
     $amount = $self->round_amount($amount, $places);
   }
 
@@ -710,6 +746,22 @@ sub format_amount {
   return $amount;
 }
 #
   return $amount;
 }
 #
+
+sub format_string {
+  $main::lxdebug->enter_sub(2);
+
+  my $self  = shift;
+  my $input = shift;
+
+  $input =~ s/(^|[^\#]) \#  (\d+)  /$1$_[$2 - 1]/gx;
+  $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
+  $input =~ s/\#\#/\#/g;
+
+  $main::lxdebug->leave_sub(2);
+
+  return $input;
+}
+
 sub parse_amount {
   $main::lxdebug->enter_sub(2);
 
 sub parse_amount {
   $main::lxdebug->enter_sub(2);
 
@@ -797,6 +849,10 @@ sub parse_template {
       qw(company address signature));
   map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature));
 
       qw(company address signature));
   map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature));
 
+  map({ $self->{"${_}"} = $myconfig->{$_}; }
+      qw(co_ustid));
+              
+
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
   # OUT is used for the media, screen, printer, email
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
   # OUT is used for the media, screen, printer, email
@@ -935,25 +991,33 @@ Content-Length: $numbytes
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
-sub generate_attachment_filename {
-  my ($self) = @_;
+sub get_formname_translation {
+  my ($self, $formname) = @_;
+
+  $formname ||= $self->{formname};
 
   my %formname_translations = (
 
   my %formname_translations = (
-     bin_list            => $main::locale->text('Bin List'),
-     credit_note         => $main::locale->text('Credit Note'),
-     invoice             => $main::locale->text('Invoice'),
-     packing_list        => $main::locale->text('Packing List'),
-     pick_list           => $main::locale->text('Pick List'),
-     proforma            => $main::locale->text('Proforma Invoice'),
-     purchase_order      => $main::locale->text('Purchase Order'),
-     request_quotation   => $main::locale->text('RFQ'),
-     sales_order         => $main::locale->text('Confirmation'),
-     sales_quotation     => $main::locale->text('Quotation'),
-     storno_invoice      => $main::locale->text('Storno Invoice'),
-     storno_packing_list => $main::locale->text('Storno Packing List'),
+    bin_list            => $main::locale->text('Bin List'),
+    credit_note         => $main::locale->text('Credit Note'),
+    invoice             => $main::locale->text('Invoice'),
+    packing_list        => $main::locale->text('Packing List'),
+    pick_list           => $main::locale->text('Pick List'),
+    proforma            => $main::locale->text('Proforma Invoice'),
+    purchase_order      => $main::locale->text('Purchase Order'),
+    request_quotation   => $main::locale->text('RFQ'),
+    sales_order         => $main::locale->text('Confirmation'),
+    sales_quotation     => $main::locale->text('Quotation'),
+    storno_invoice      => $main::locale->text('Storno Invoice'),
+    storno_packing_list => $main::locale->text('Storno Packing List'),
   );
 
   );
 
-  my $attachment_filename = $formname_translations{$self->{"formname"}};
+  return $formname_translations{$formname}
+}
+
+sub generate_attachment_filename {
+  my ($self) = @_;
+
+  my $attachment_filename = $self->get_formname_translation();
   my $prefix = 
       (grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv"
     : ($self->{"type"} =~ /_quotation$/)                       ? "quo"
   my $prefix = 
       (grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv"
     : ($self->{"type"} =~ /_quotation$/)                       ? "quo"
@@ -1066,7 +1130,7 @@ sub dbconnect_noauto {
   $main::lxdebug->enter_sub();
 
   my ($self, $myconfig) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $myconfig) = @_;
-
+  
   # connect to database
   $dbh =
     DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser},
   # connect to database
   $dbh =
     DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser},
@@ -1122,18 +1186,38 @@ sub update_exchangerate {
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
-
+  my ($query);
   # some sanity check for currency
   if ($curr eq '') {
     $main::lxdebug->leave_sub();
     return;
   # some sanity check for currency
   if ($curr eq '') {
     $main::lxdebug->leave_sub();
     return;
+  }  
+  $query = qq|SELECT curr FROM defaults|;
+
+  my ($currency) = selectrow_query($self, $dbh, $query);
+  my ($defaultcurrency) = split m/:/, $currency;
+
+
+  if ($curr eq $defaultcurrency) {
+    $main::lxdebug->leave_sub();
+    return;
   }
 
   }
 
-  my $query = qq|SELECT e.curr FROM exchangerate e
+  $query = qq|SELECT e.curr FROM exchangerate e
                  WHERE e.curr = ? AND e.transdate = ?
                  FOR UPDATE|;
   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
 
                  WHERE e.curr = ? AND e.transdate = ?
                  FOR UPDATE|;
   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
 
+  if ($buy == 0) {
+    $buy = "";
+  }
+  if ($sell == 0) {
+    $sell = "";
+  }
+
+  $buy = conv_i($buy, "NULL");
+  $sell = conv_i($sell, "NULL");
+
   my $set;
   if ($buy != 0 && $sell != 0) {
     $set = "buy = $buy, sell = $sell";
   my $set;
   if ($buy != 0 && $sell != 0) {
     $set = "buy = $buy, sell = $sell";
@@ -1148,6 +1232,7 @@ sub update_exchangerate {
                 SET $set
                 WHERE curr = ?
                 AND transdate = ?|;
                 SET $set
                 WHERE curr = ?
                 AND transdate = ?|;
+    
   } else {
     $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
                 VALUES (?, $buy, $sell, ?)|;
   } else {
     $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
                 VALUES (?, $buy, $sell, ?)|;
@@ -1165,12 +1250,15 @@ sub save_exchangerate {
 
   my $dbh = $self->dbconnect($myconfig);
 
 
   my $dbh = $self->dbconnect($myconfig);
 
-  my ($buy, $sell) = (0, 0);
+  my ($buy, $sell);
+
   $buy  = $rate if $fld eq 'buy';
   $sell = $rate if $fld eq 'sell';
 
   $buy  = $rate if $fld eq 'buy';
   $sell = $rate if $fld eq 'sell';
 
+
   $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
 
   $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
 
+
   $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
   $dbh->disconnect;
 
   $main::lxdebug->leave_sub();
@@ -1180,19 +1268,28 @@ sub get_exchangerate {
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $fld) = @_;
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $curr, $transdate, $fld) = @_;
+  my ($query);
 
   unless ($transdate) {
     $main::lxdebug->leave_sub();
     return 1;
   }
 
 
   unless ($transdate) {
     $main::lxdebug->leave_sub();
     return 1;
   }
 
-  my $query = qq|SELECT e.$fld FROM exchangerate e
+  $query = qq|SELECT curr FROM defaults|;
+
+  my ($currency) = selectrow_query($self, $dbh, $query);
+  my ($defaultcurrency) = split m/:/, $currency;
+
+  if ($currency eq $defaultcurrency) {
+    $main::lxdebug->leave_sub();
+    return 1;
+  }
+
+  $query = qq|SELECT e.$fld FROM exchangerate e
                  WHERE e.curr = ? AND e.transdate = ?|;
   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
 
                  WHERE e.curr = ? AND e.transdate = ?|;
   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
 
-  if (!$exchangerate) {
-    $exchangerate = 1;
-  }
+
 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 
@@ -1209,14 +1306,19 @@ sub check_exchangerate {
     return "";
   }
 
     return "";
   }
 
-  my $dbh = $self->dbconnect($myconfig);
+  my ($defaultcurrency) = $self->get_default_currency($myconfig);
+
+  if ($currency eq $defaultcurrency) {
+    $main::lxdebug->leave_sub();
+    return 1;
+  }
 
 
+  my $dbh   = $self->get_standard_dbh($myconfig);
   my $query = qq|SELECT e.$fld FROM exchangerate e
                  WHERE e.curr = ? AND e.transdate = ?|;
   my $query = qq|SELECT e.$fld FROM exchangerate e
                  WHERE e.curr = ? AND e.transdate = ?|;
+
   my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
   my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
-  $dbh->disconnect();
 
 
-  $exchangerate = 1 if ($exchangerate == 0);
   $exchangerate = 1 if ($exchangerate eq "");
 
   $main::lxdebug->leave_sub();
   $exchangerate = 1 if ($exchangerate eq "");
 
   $main::lxdebug->leave_sub();
@@ -1224,6 +1326,23 @@ sub check_exchangerate {
   return $exchangerate;
 }
 
   return $exchangerate;
 }
 
+sub get_default_currency {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $myconfig) = @_;
+  my $dbh = $self->get_standard_dbh($myconfig);
+
+  my $query = qq|SELECT curr FROM defaults|;
+
+  my ($curr)            = selectrow_query($self, $dbh, $query);
+  my ($defaultcurrency) = split m/:/, $curr;
+
+  $main::lxdebug->leave_sub();
+
+  return $defaultcurrency;
+}
+
+
 sub set_payment_options {
   $main::lxdebug->enter_sub();
 
 sub set_payment_options {
   $main::lxdebug->enter_sub();
 
@@ -1256,12 +1375,32 @@ sub set_payment_options {
   ($self->{netto_date}, $self->{skonto_date}) =
     selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});
 
   ($self->{netto_date}, $self->{skonto_date}) =
     selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});
 
-  my $total = ($self->{invtotal}) ? $self->{invtotal} : $self->{ordtotal};
-  my $skonto_amount = $self->parse_amount($myconfig, $total) *
-    $self->{percent_skonto};
+  my ($invtotal, $total);
+  my (%amounts, %formatted_amounts);
+
+  if ($self->{type} =~ /_order$/) {
+    $amounts{invtotal} = $self->{ordtotal};
+    $amounts{total}    = $self->{ordtotal};
+
+  } elsif ($self->{type} =~ /_quotation$/) {
+    $amounts{invtotal} = $self->{quototal};
+    $amounts{total}    = $self->{quototal};
+
+  } else {
+    $amounts{invtotal} = $self->{invtotal};
+    $amounts{total}    = $self->{total};
+  }
+
+  map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
 
 
-  $self->{skonto_amount} =
-    $self->format_amount($myconfig, $skonto_amount, 2);
+  $amounts{skonto_amount}      = $amounts{invtotal} * $self->{percent_skonto};
+  $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
+  $amounts{total_wo_skonto}    = $amounts{total}    * (1 - $self->{percent_skonto});
+
+  foreach (keys %amounts) {
+    $amounts{$_}           = $self->round_amount($amounts{$_}, 2);
+    $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
+  }
 
   if ($self->{"language_id"}) {
     $query =
 
   if ($self->{"language_id"}) {
     $query =
@@ -1289,23 +1428,21 @@ sub set_payment_options {
         ($output_numberformat ne $myconfig->{"numberformat"})) {
       my $saved_numberformat = $myconfig->{"numberformat"};
       $myconfig->{"numberformat"} = $output_numberformat;
         ($output_numberformat ne $myconfig->{"numberformat"})) {
       my $saved_numberformat = $myconfig->{"numberformat"};
       $myconfig->{"numberformat"} = $output_numberformat;
-      $self->{skonto_amount} =
-        $self->format_amount($myconfig, $skonto_amount, 2);
+      map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts;
       $myconfig->{"numberformat"} = $saved_numberformat;
     }
   }
 
   $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
   $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
       $myconfig->{"numberformat"} = $saved_numberformat;
     }
   }
 
   $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
   $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
-  $self->{payment_terms} =~ s/<%skonto_amount%>/$self->{skonto_amount}/g;
-  $self->{payment_terms} =~ s/<%total%>/$self->{total}/g;
-  $self->{payment_terms} =~ s/<%invtotal%>/$self->{invtotal}/g;
   $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
   $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
   $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
   $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
   $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
 
   $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
   $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
   $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
   $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
   $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
 
+  map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
+
   $main::lxdebug->leave_sub();
 
 }
   $main::lxdebug->leave_sub();
 
 }
@@ -1370,6 +1507,7 @@ sub add_shipto {
 
   my $shipto;
   my @values;
 
   my $shipto;
   my @values;
+
   foreach my $item (qw(name department_1 department_2 street zipcode city country
                        contact phone fax email)) {
     if ($self->{"shipto$item"}) {
   foreach my $item (qw(name department_1 department_2 street zipcode city country
                        contact phone fax email)) {
     if ($self->{"shipto$item"}) {
@@ -1377,6 +1515,7 @@ 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
   if ($shipto) {
     if ($self->{shipto_id}) {
       my $query = qq|UPDATE shipto set
@@ -1405,8 +1544,10 @@ sub add_shipto {
                        shiptocontact = ? AND
                        shiptophone = ? AND
                        shiptofax = ? AND
                        shiptocontact = ? AND
                        shiptophone = ? AND
                        shiptofax = ? AND
-                       shiptoemail = ?|;
-      my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values);
+                       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,
       if(!$insert_check){
         $query =
           qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
@@ -1705,11 +1846,12 @@ $main::lxdebug->enter_sub();
 sub _get_customers {
   $main::lxdebug->enter_sub();
 
 sub _get_customers {
   $main::lxdebug->enter_sub();
 
-  my ($self, $dbh, $key) = @_;
+  my ($self, $dbh, $key, $limit) = @_;
 
   $key = "all_customers" unless ($key);
 
   $key = "all_customers" unless ($key);
+  $limit_clause = "LIMIT $limit" if $limit;
 
 
-  my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name|;
+  my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|;
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
@@ -1744,6 +1886,20 @@ sub _get_departments {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
+sub _get_price_factors {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $dbh, $key) = @_;
+
+  $key ||= "all_price_factors";
+
+  my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|;
+
+  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
+
+  $main::lxdebug->leave_sub();
+}
+
 sub get_lists {
   $main::lxdebug->enter_sub();
 
 sub get_lists {
   $main::lxdebug->enter_sub();
 
@@ -1811,11 +1967,19 @@ sub get_lists {
   }
   
   if($params{"customers"}) {
   }
   
   if($params{"customers"}) {
-    $self->_get_customers($dbh, $params{"customers"});
+    if (ref $params{"customers"} eq 'HASH') {
+      $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit});
+    } else {
+      $self->_get_customers($dbh, $params{"customers"});
+    }
   }
   
   if($params{"vendors"}) {
   }
   
   if($params{"vendors"}) {
-    $self->_get_vendors($dbh, $params{"vendors"});
+    if (ref $params{"vendors"} eq 'HASH') {
+      $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
+    } else {
+      $self->_get_vendors($dbh, $params{"vendors"});
+    }
   }
   
   if($params{"payments"}) {
   }
   
   if($params{"payments"}) {
@@ -1826,6 +1990,10 @@ sub get_lists {
     $self->_get_departments($dbh, $params{"departments"});
   }
 
     $self->_get_departments($dbh, $params{"departments"});
   }
 
+  if ($params{price_factors}) {
+    $self->_get_price_factors($dbh, $params{price_factors});
+  }
+
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
@@ -2063,7 +2231,7 @@ sub create_links {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
-        if ($key =~ /$module/) {
+        if ($key =~ /\Q$module\E/) {
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
@@ -2122,7 +2290,7 @@ sub create_links {
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?
                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?
                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
-                    OR c.link LIKE '%_tax%')
+                    OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
                 ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
                 ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
@@ -2132,7 +2300,7 @@ sub create_links {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
     while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
 
       foreach my $key (split(/:/, $ref->{link})) {
-        if ($key =~ /$module/) {
+        if ($key =~ /\Q$module\E/) {
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
 
           # cross reference for keys
           $xkeyref{ $ref->{accno} } = $key;
@@ -2322,8 +2490,7 @@ sub redo_rows {
 
   my @ndx = ();
 
 
   my @ndx = ();
 
-  map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } }
-    (1 .. $count);
+  map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
 
   my $i = 0;
 
 
   my $i = 0;
 
@@ -2364,8 +2531,8 @@ sub update_status {
   }
   $sth->finish();
 
   }
   $sth->finish();
 
-  my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0";
-  my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "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;
@@ -2409,7 +2576,7 @@ sub save_status {
   my $formnames  = $self->{printed};
   my $emailforms = $self->{emailed};
 
   my $formnames  = $self->{printed};
   my $emailforms = $self->{emailed};
 
-  my $query = qq|DELETE FROM status
+  $query = qq|DELETE FROM status
                  WHERE (formname = ?) AND (trans_id = ?)|;
   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
 
                  WHERE (formname = ?) AND (trans_id = ?)|;
   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
 
@@ -2420,15 +2587,15 @@ sub save_status {
     my %queued = split / /, $self->{queued};
 
     foreach my $formname (keys %queued) {
     my %queued = split / /, $self->{queued};
 
     foreach my $formname (keys %queued) {
-      $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0";
-      $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0";
+      $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
+      $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
 
       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
                   VALUES (?, ?, ?, ?, ?)|;
       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
 
 
       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
                   VALUES (?, ?, ?, ?, ?)|;
       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
 
-      $formnames  =~ s/$self->{formname}//;
-      $emailforms =~ s/$self->{formname}//;
+      $formnames  =~ s/\Q$self->{formname}\E//;
+      $emailforms =~ s/\Q$self->{formname}\E//;
 
     }
   }
 
     }
   }
@@ -2442,8 +2609,8 @@ sub save_status {
   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
 
   foreach my $formname (keys %status) {
   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
 
   foreach my $formname (keys %status) {
-    $printed = ($formnames  =~ /$self->{formname}/) ? "1" : "0";
-    $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0";
+    $printed = ($formnames  =~ /\Q$self->{formname}\E/) ? "1" : "0";
+    $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
 
     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
                 VALUES (?, ?, ?, ?)|;
 
     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
                 VALUES (?, ?, ?, ?)|;
@@ -2549,8 +2716,14 @@ sub update_defaults {
   my ($var) = $sth->fetchrow_array;
   $sth->finish;
 
   my ($var) = $sth->fetchrow_array;
   $sth->finish;
 
-  $var =~ s/\d+$/ sprintf '%0*d', length($&), $&+1 /e;
-  $var ||= 1;
+  if ($var =~ m/\d+$/) {
+    my $new_var  = (substr $var, $-[0]) * 1 + 1;
+    my $len_diff = length($var) - $-[0] - length($new_var);
+    $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
+
+  } else {
+    $var = $var . '1';
+  }
 
   $query = qq|UPDATE defaults SET $fld = ?|;
   do_query($self, $dbh, $query, $var);
 
   $query = qq|UPDATE defaults SET $fld = ?|;
   do_query($self, $dbh, $query, $var);
@@ -2581,8 +2754,15 @@ sub update_business {
        WHERE id = ? FOR UPDATE|;
   my ($var) = selectrow_query($self, $dbh, $query, $business_id);
 
        WHERE id = ? FOR UPDATE|;
   my ($var) = selectrow_query($self, $dbh, $query, $business_id);
 
-  $var =~ s/\d+$/ sprintf '%0*d', length($&), $&+1 /e;
-  
+  if ($var =~ m/\d+$/) {
+    my $new_var  = (substr $var, $-[0]) * 1 + 1;
+    my $len_diff = length($var) - $-[0] - length($new_var);
+    $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
+
+  } else {
+    $var = $var . '1';
+  }
+
   $query = qq|UPDATE business
               SET customernumberinit = ?
               WHERE id = ?|;
   $query = qq|UPDATE business
               SET customernumberinit = ?
               WHERE id = ?|;
Unnamed repository; edit this file 'description' to name the repository.