projects / kivitendo-erp.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
kivitendo rebranding: title strings
[kivitendo-erp.git] / SL / Form.pm
diff --git a/SL/Form.pm b/SL/Form.pm
index f0ad1a1..8d28f84 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -40,24 +40,35 @@ package Form;
 use Data::Dumper;
 
 use CGI;
 use Data::Dumper;
 
 use CGI;
-use CGI::Ajax;
 use Cwd;
 use Encode;
 use Cwd;
 use Encode;
+use File::Copy;
 use IO::File;
 use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
 use SL::AM;
 use SL::Common;
 use IO::File;
 use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
 use SL::AM;
 use SL::Common;
+use SL::CVar;
+use SL::DB;
+use SL::DBConnect;
 use SL::DBUtils;
 use SL::DBUtils;
+use SL::DO;
+use SL::IC;
+use SL::IS;
+use SL::Locale;
 use SL::Mailer;
 use SL::Menu;
 use SL::Mailer;
 use SL::Menu;
+use SL::MoreCommon qw(uri_encode uri_decode);
+use SL::OE;
+use SL::Request;
 use SL::Template;
 use SL::User;
 use SL::Template;
 use SL::User;
+use SL::X;
 use Template;
 use URI;
 use List::Util qw(first max min sum);
 use Template;
 use URI;
 use List::Util qw(first max min sum);
-use List::MoreUtils qw(any apply);
+use List::MoreUtils qw(all any apply);
 
 use strict;
 
 
 use strict;
 
@@ -73,165 +84,6 @@ sub disconnect_standard_dbh {
   undef $standard_dbh;
 }
 
   undef $standard_dbh;
 }
 
-sub _store_value {
-  $main::lxdebug->enter_sub(2);
-
-  my $self  = shift;
-  my $key   = shift;
-  my $value = shift;
-
-  my @tokens = split /((?:\[\+?\])?(?:\.|$))/, $key;
-
-  my $curr;
-
-  if (scalar @tokens) {
-     $curr = \ $self->{ shift @tokens };
-  }
-
-  while (@tokens) {
-    my $sep = shift @tokens;
-    my $key = shift @tokens;
-
-    $curr = \ $$curr->[++$#$$curr], next if $sep eq '[]';
-    $curr = \ $$curr->[max 0, $#$$curr]  if $sep eq '[].';
-    $curr = \ $$curr->[++$#$$curr]       if $sep eq '[+].';
-    $curr = \ $$curr->{$key}
-  }
-
-  $$curr = $value;
-
-  $main::lxdebug->leave_sub(2);
-
-  return $curr;
-}
-
-sub _input_to_hash {
-  $main::lxdebug->enter_sub(2);
-
-  my $self  = shift;
-  my $input = shift;
-
-  my @pairs = split(/&/, $input);
-
-  foreach (@pairs) {
-    my ($key, $value) = split(/=/, $_, 2);
-    $self->_store_value($self->unescape($key), $self->unescape($value)) if ($key);
-  }
-
-  $main::lxdebug->leave_sub(2);
-}
-
-sub _request_to_hash {
-  $main::lxdebug->enter_sub(2);
-
-  my $self  = shift;
-  my $input = shift;
-
-  if (!$ENV{'CONTENT_TYPE'}
-      || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
-
-    $self->_input_to_hash($input);
-
-    $main::lxdebug->leave_sub(2);
-    return;
-  }
-
-  my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
-
-  my $boundary = '--' . $1;
-
-  foreach my $line (split m/\n/, $input) {
-    last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));
-
-    if (($line eq $boundary) || ($line eq "$boundary\r")) {
-      ${ $previous } =~ s|\r?\n$|| if $previous;
-
-      undef $previous;
-      undef $filename;
-
-      $headers_done   = 0;
-      $content_type   = "text/plain";
-      $boundary_found = 1;
-      $need_cr        = 0;
-
-      next;
-    }
-
-    next unless $boundary_found;
-
-    if (!$headers_done) {
-      $line =~ s/[\r\n]*$//;
-
-      if (!$line) {
-        $headers_done = 1;
-        next;
-      }
-
-      if ($line =~ m|^content-disposition\s*:.*?form-data\s*;|i) {
-        if ($line =~ m|filename\s*=\s*"(.*?)"|i) {
-          $filename = $1;
-          substr $line, $-[0], $+[0] - $-[0], "";
-        }
-
-        if ($line =~ m|name\s*=\s*"(.*?)"|i) {
-          $name = $1;
-          substr $line, $-[0], $+[0] - $-[0], "";
-        }
-
-        $previous         = $self->_store_value($name, '') if ($name);
-        $self->{FILENAME} = $filename if ($filename);
-
-        next;
-      }
-
-      if ($line =~ m|^content-type\s*:\s*(.*?)$|i) {
-        $content_type = $1;
-      }
-
-      next;
-    }
-
-    next unless $previous;
-
-    ${ $previous } .= "${line}\n";
-  }
-
-  ${ $previous } =~ s|\r?\n$|| if $previous;
-
-  $main::lxdebug->leave_sub(2);
-}
-
-sub _recode_recursively {
-  $main::lxdebug->enter_sub();
-  my ($iconv, $param) = @_;
-
-  if (any { ref $param eq $_ } qw(Form HASH)) {
-    foreach my $key (keys %{ $param }) {
-      if (!ref $param->{$key}) {
-        # Workaround for a bug: converting $param->{$key} directly
-        # leads to 'undef'. I don't know why. Converting a copy works,
-        # though.
-        $param->{$key} = $iconv->convert("" . $param->{$key});
-      } else {
-        _recode_recursively($iconv, $param->{$key});
-      }
-    }
-
-  } elsif (ref $param eq 'ARRAY') {
-    foreach my $idx (0 .. scalar(@{ $param }) - 1) {
-      if (!ref $param->[$idx]) {
-        # Workaround for a bug: converting $param->[$idx] directly
-        # leads to 'undef'. I don't know why. Converting a copy works,
-        # though.
-        $param->[$idx] = $iconv->convert("" . $param->[$idx]);
-      } else {
-        _recode_recursively($iconv, $param->[$idx]);
-      }
-    }
-  }
-  $main::lxdebug->leave_sub();
-}
-
 sub new {
   $main::lxdebug->enter_sub();
 
 sub new {
   $main::lxdebug->enter_sub();
 
@@ -239,6 +91,7 @@ sub new {
 
   my $self = {};
 
 
   my $self = {};
 
+  no warnings 'once';
   if ($LXDebug::watch_form) {
     require SL::Watchdog;
     tie %{ $self }, 'SL::Watchdog';
   if ($LXDebug::watch_form) {
     require SL::Watchdog;
     tie %{ $self }, 'SL::Watchdog';
@@ -246,24 +99,6 @@ sub new {
 
   bless $self, $type;
 
 
   bless $self, $type;
 
-  $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
-  $self->_input_to_hash($ARGV[0])           if @ARGV && $ARGV[0];
-
-  if ($ENV{CONTENT_LENGTH}) {
-    my $content;
-    read STDIN, $content, $ENV{CONTENT_LENGTH};
-    $self->_request_to_hash($content);
-  }
-
-  my $db_charset   = $main::dbcharset;
-  $db_charset    ||= Common::DEFAULT_CHARSET;
-
-  my $encoding     = $self->{INPUT_ENCODING} || $db_charset;
-  delete $self->{INPUT_ENCODING};
-
-  _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
-
-  #$self->{version} =  "2.6.1";                 # Old hardcoded but secure style
   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
   $self->{version} =  <VERSION_FILE>;
   close VERSION_FILE;
   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
   $self->{version} =  <VERSION_FILE>;
   close VERSION_FILE;
@@ -274,6 +109,11 @@ sub new {
   return $self;
 }
 
   return $self;
 }
 
+sub read_cgi_input {
+  my ($self) = @_;
+  SL::Request::read_cgi_input($self);
+}
+
 sub _flatten_variables_rec {
   $main::lxdebug->enter_sub(2);
 
 sub _flatten_variables_rec {
   $main::lxdebug->enter_sub(2);
 
@@ -373,31 +213,15 @@ sub dumper {
 }
 
 sub escape {
 }
 
 sub escape {
-  $main::lxdebug->enter_sub(2);
-
   my ($self, $str) = @_;
 
   my ($self, $str) = @_;
 
-  $str =  Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
-  $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
-
-  $main::lxdebug->leave_sub(2);
-
-  return $str;
+  return uri_encode($str);
 }
 
 sub unescape {
 }
 
 sub unescape {
-  $main::lxdebug->enter_sub(2);
-
   my ($self, $str) = @_;
 
   my ($self, $str) = @_;
 
-  $str =~ tr/+/ /;
-  $str =~ s/\\$//;
-
-  $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
-
-  $main::lxdebug->leave_sub(2);
-
-  return $str;
+  return uri_decode($str);
 }
 
 sub quote {
 }
 
 sub quote {
@@ -431,23 +255,33 @@ sub hide_form {
   my $self = shift;
 
   if (@_) {
   my $self = shift;
 
   if (@_) {
-    map({ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
+    map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
   } else {
     for (sort keys %$self) {
       next if (($_ eq "header") || (ref($self->{$_}) ne ""));
   } else {
     for (sort keys %$self) {
       next if (($_ eq "header") || (ref($self->{$_}) ne ""));
-      print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
+      print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
     }
   }
   $main::lxdebug->leave_sub();
 }
 
     }
   }
   $main::lxdebug->leave_sub();
 }
 
+sub throw_on_error {
+  my ($self, $code) = @_;
+  local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) };
+  $code->();
+}
+
 sub error {
   $main::lxdebug->enter_sub();
 
   $main::lxdebug->show_backtrace();
 
   my ($self, $msg) = @_;
 sub error {
   $main::lxdebug->enter_sub();
 
   $main::lxdebug->show_backtrace();
 
   my ($self, $msg) = @_;
-  if ($ENV{HTTP_USER_AGENT}) {
+
+  if ($self->{__ERROR_HANDLER}) {
+    $self->{__ERROR_HANDLER}->($msg);
+
+  } elsif ($ENV{HTTP_USER_AGENT}) {
     $msg =~ s/\n/<br>/g;
     $self->show_generic_error($msg);
 
     $msg =~ s/\n/<br>/g;
     $self->show_generic_error($msg);
 
@@ -478,7 +312,7 @@ sub info {
     <script type="text/javascript">
     <!--
     // If JavaScript is enabled, the whole thing will be reloaded.
     <script type="text/javascript">
     <!--
     // If JavaScript is enabled, the whole thing will be reloaded.
-    // The reason is: When one changes his menu setup (HTML / XUL / CSS ...)
+    // The reason is: When one changes his menu setup (HTML / CSS ...)
     // it now loads the correct code into the browser instead of do nothing.
     setTimeout("top.frames.location.href='login.pl'",500);
     //-->
     // it now loads the correct code into the browser instead of do nothing.
     setTimeout("top.frames.location.href='login.pl'",500);
     //-->
@@ -581,8 +415,7 @@ sub create_http_response {
   my $self     = shift;
   my %params   = @_;
 
   my $self     = shift;
   my %params   = @_;
 
-  my $cgi      = $main::cgi;
-  $cgi       ||= CGI->new('');
+  my $cgi      = $::request->{cgi};
 
   my $session_cookie;
   if (defined $main::auth) {
 
   my $session_cookie;
   if (defined $main::auth) {
@@ -605,6 +438,8 @@ sub create_http_response {
   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
   $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 
   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
   $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 
+  map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length);
+
   my $output = $cgi->header(%cgi_params);
 
   $main::lxdebug->leave_sub();
   my $output = $cgi->header(%cgi_params);
 
   $main::lxdebug->leave_sub();
@@ -612,18 +447,50 @@ sub create_http_response {
   return $output;
 }
 
   return $output;
 }
 
+sub use_stylesheet {
+  my $self = shift;
+
+  $self->{stylesheet} = [ $self->{stylesheet} ] unless ref $self->{stylesheet} eq 'ARRAY';
+  $self->{stylesheet} = [ grep { -f                       }
+                          map  { m:^css/: ? $_ : "css/$_" }
+                          grep { $_                       }
+                               (@{ $self->{stylesheet} }, @_)
+                        ];
+
+  return @{ $self->{stylesheet} };
+}
+
+sub get_stylesheet_for_user {
+  my $css_path = 'css';
+  if (my $user_style = $::myconfig{stylesheet}) {
+    $user_style =~ s/\.css$//; # nuke trailing .css, this is a remnand of pre 2.7.0 stylesheet handling
+    if (-d "$css_path/$user_style" &&
+        -f "$css_path/$user_style/main.css") {
+      $css_path = "$css_path/$user_style";
+    } else {
+      $css_path = "$css_path/lx-office-erp";
+    }
+  } else {
+    $css_path = "$css_path/lx-office-erp";
+  }
+  $::myconfig{css_path} = $css_path; # needed for menunew, FIXME: don't do this here
+
+  return $css_path;
+}
 
 sub header {
   $::lxdebug->enter_sub;
 
   # extra code is currently only used by menuv3 and menuv4 to set their css.
   # it is strongly deprecated, and will be changed in a future version.
 
 sub header {
   $::lxdebug->enter_sub;
 
   # extra code is currently only used by menuv3 and menuv4 to set their css.
   # it is strongly deprecated, and will be changed in a future version.
-  my ($self, $extra_code) = @_;
-  my $db_charset = $::dbcharset || Common::DEFAULT_CHARSET;
+  my ($self, %params) = @_;
+  my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
   my @header;
 
   $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
 
   my @header;
 
   $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
 
+  my $css_path = $self->get_stylesheet_for_user;
+
   $self->{favicon} ||= "favicon.ico";
   $self->{titlebar}  = "$self->{title} - $self->{titlebar}" if $self->{title};
 
   $self->{favicon} ||= "favicon.ico";
   $self->{titlebar}  = "$self->{title} - $self->{titlebar}" if $self->{title};
 
@@ -634,19 +501,16 @@ sub header {
     push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
   }
 
     push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
   }
 
-  push @header, "<link rel='stylesheet' href='css/$_' type='text/css' title='Lx-Office stylesheet'>"
-    for grep { -f "css/$_" } apply { s|.*/|| } $self->{stylesheet}, $self->{stylesheets};
+  push @header, map { qq|<link rel="stylesheet" href="$_" type="text/css" title="Stylesheet">| } $self->use_stylesheet;
 
   push @header, "<style type='text/css'>\@page { size:landscape; }</style>" if $self->{landscape};
   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>" if -f $self->{favicon};
 
   push @header, "<style type='text/css'>\@page { size:landscape; }</style>" if $self->{landscape};
   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>" if -f $self->{favicon};
-  push @header, '<script type="text/javascript" src="js/jquery.js"></script>',
-                '<script type="text/javascript" src="js/common.js"></script>',
-                '<style type="text/css">@import url(js/jscalendar/calendar-win2k-1.css);</style>',
-                '<script type="text/javascript" src="js/jscalendar/calendar.js"></script>',
-                '<script type="text/javascript" src="js/jscalendar/lang/calendar-de.js"></script>',
-                '<script type="text/javascript" src="js/jscalendar/calendar-setup.js"></script>',
-                '<script type="text/javascript" src="js/part_selection.js"></script>';
+  push @header, map { qq|<script type="text/javascript" src="js/$_.js"></script>| }
+       qw(jquery common jscalendar/calendar jscalendar/lang/calendar-de jscalendar/calendar-setup part_selection jquery-ui jqModal switchmenuframe);
   push @header, $self->{javascript} if $self->{javascript};
   push @header, $self->{javascript} if $self->{javascript};
+  push @header, map { qq|<link rel="stylesheet" type="text/css" href="$css_path/$_.css">| }
+       qw(main menu tabcontent list_accounts jquery.autocomplete jquery.multiselect2side frame_header/header ui-lightness/jquery-ui-1.8.12.custom);
+  push @header, map { qq|<link rel="stylesheet" type="text/css" href="js/jscalendar/calendar-win2k-1.css">| }
   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
   push @header, "<script type='text/javascript'>function fokus(){ document.$self->{fokus}.focus(); }</script>" if $self->{fokus};
   push @header, sprintf "<script type='text/javascript'>top.document.title='%s';</script>",
   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
   push @header, "<script type='text/javascript'>function fokus(){ document.$self->{fokus}.focus(); }</script>" if $self->{fokus};
   push @header, sprintf "<script type='text/javascript'>top.document.title='%s';</script>",
@@ -665,10 +529,15 @@ sub header {
     </script>|;
   }
 
     </script>|;
   }
 
+  my  %doctypes = (
+    strict       => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|,
+    transitional => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|,
+    frameset     => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|,
+  );
+
   # output
   print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
   # output
   print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
-  print "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01//EN' 'http://www.w3.org/TR/html4/strict.dtd'>\n"
-    if  $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/; # Other browsers may choke on menu scripts with DOCTYPE.
+  print $doctypes{$params{doctype} || 'transitional'}, $/;
   print <<EOT;
 <html>
  <head>
   print <<EOT;
 <html>
  <head>
@@ -677,10 +546,7 @@ sub header {
 EOT
   print "  $_\n" for @header;
   print <<EOT;
 EOT
   print "  $_\n" for @header;
   print <<EOT;
-  <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
-  <meta name="robots" content="noindex,nofollow" />
-  <script type="text/javascript" src="js/highlight_input.js"></script>
-  <link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
+  <meta name="robots" content="noindex,nofollow">
   <script type="text/javascript" src="js/tabcontent.js">
 
   /***********************************************
   <script type="text/javascript" src="js/tabcontent.js">
 
   /***********************************************
@@ -690,7 +556,7 @@ EOT
    ***********************************************/
 
   </script>
    ***********************************************/
 
   </script>
-  $extra_code
+  $params{extra_code}
   $title_hack
  </head>
 
   $title_hack
  </head>
 
@@ -704,9 +570,8 @@ sub ajax_response_header {
 
   my ($self) = @_;
 
 
   my ($self) = @_;
 
-  my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
-  my $cgi        = $main::cgi || CGI->new('');
-  my $output     = $cgi->header('-charset' => $db_charset);
+  my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
+  my $output     = $::request->{cgi}->header('-charset' => $db_charset);
 
   $main::lxdebug->leave_sub();
 
 
   $main::lxdebug->leave_sub();
 
@@ -720,18 +585,17 @@ sub redirect_header {
   my $base_uri = $self->_get_request_uri;
   my $new_uri  = URI->new_abs($new_url, $base_uri);
 
   my $base_uri = $self->_get_request_uri;
   my $new_uri  = URI->new_abs($new_url, $base_uri);
 
-  die "Headers already sent" if $::self->{header};
+  die "Headers already sent" if $self->{header};
   $self->{header} = 1;
 
   $self->{header} = 1;
 
-  my $cgi = $main::cgi || CGI->new('');
-  return $cgi->redirect($new_uri);
+  return $::request->{cgi}->redirect($new_uri);
 }
 
 sub set_standard_title {
   $::lxdebug->enter_sub;
   my $self = shift;
 
 }
 
 sub set_standard_title {
   $::lxdebug->enter_sub;
   my $self = shift;
 
-  $self->{titlebar}  = "Lx-Office " . $::locale->text('Version') . " $self->{version}";
+  $self->{titlebar}  = "kivitendo " . $::locale->text('Version') . " $self->{version}";
   $self->{titlebar} .= "- $::myconfig{name}"   if $::myconfig{name};
   $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
 
   $self->{titlebar} .= "- $::myconfig{name}"   if $::myconfig{name};
   $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
 
@@ -745,20 +609,13 @@ sub _prepare_html_template {
   my $language;
 
   if (!%::myconfig || !$::myconfig{"countrycode"}) {
   my $language;
 
   if (!%::myconfig || !$::myconfig{"countrycode"}) {
-    $language = $main::language;
+    $language = $::lx_office_conf{system}->{language};
   } else {
     $language = $main::myconfig{"countrycode"};
   }
   $language = "de" unless ($language);
 
   if (-f "templates/webpages/${file}.html") {
   } else {
     $language = $main::myconfig{"countrycode"};
   }
   $language = "de" unless ($language);
 
   if (-f "templates/webpages/${file}.html") {
-    if ((-f ".developer") && ((stat("templates/webpages/${file}.html"))[9] > (stat("locale/${language}/all"))[9])) {
-      my $info = "Developer information: templates/webpages/${file}.html is newer than the translation file locale/${language}/all.\n" .
-        "Please re-run 'locales.pl' in 'locale/${language}'.";
-      print(qq|<pre>$info</pre>|);
-      ::end_of_request();
-    }
-
     $file = "templates/webpages/${file}.html";
 
   } else {
     $file = "templates/webpages/${file}.html";
 
   } else {
@@ -786,19 +643,20 @@ sub _prepare_html_template {
     map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
   }
 
     map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
   }
 
-  $additional_params->{"conf_dbcharset"}              = $::dbcharset;
-  $additional_params->{"conf_webdav"}                 = $::webdav;
-  $additional_params->{"conf_lizenzen"}               = $::lizenzen;
-  $additional_params->{"conf_latex_templates"}        = $::latex;
-  $additional_params->{"conf_opendocument_templates"} = $::opendocument_templates;
-  $additional_params->{"conf_vertreter"}              = $::vertreter;
-  $additional_params->{"conf_show_best_before"}       = $::show_best_before;
-  $additional_params->{"conf_parts_image_css"}        = $::parts_image_css;
-  $additional_params->{"conf_parts_listing_images"}   = $::parts_listing_images;
-  $additional_params->{"conf_parts_show_image"}       = $::parts_show_image;
+  $additional_params->{"conf_dbcharset"}              = $::lx_office_conf{system}->{dbcharset};
+  $additional_params->{"conf_webdav"}                 = $::lx_office_conf{features}->{webdav};
+  $additional_params->{"conf_latex_templates"}        = $::lx_office_conf{print_templates}->{latex};
+  $additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument};
+  $additional_params->{"conf_vertreter"}              = $::lx_office_conf{features}->{vertreter};
+  $additional_params->{"conf_show_best_before"}       = $::lx_office_conf{features}->{show_best_before};
+  $additional_params->{"conf_parts_image_css"}        = $::lx_office_conf{features}->{parts_image_css};
+  $additional_params->{"conf_parts_listing_images"}   = $::lx_office_conf{features}->{parts_listing_images};
+  $additional_params->{"conf_parts_show_image"}       = $::lx_office_conf{features}->{parts_show_image};
+  $additional_params->{"conf_payments_changeable"}    = $::lx_office_conf{features}->{payments_changeable};
+  $additional_params->{"INSTANCE_CONF"}               = $::instance_conf;
 
 
-  if (%main::debug_options) {
-    map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
+  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}}) {
   }
 
   if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) {
@@ -835,7 +693,7 @@ sub parse_html_template {
 sub init_template {
   my $self = shift;
 
 sub init_template {
   my $self = shift;
 
-  return if $self->template;
+  return $self->template if $self->template;
 
   return $self->template(Template->new({
      'INTERPOLATE'  => 0,
 
   return $self->template(Template->new({
      'INTERPOLATE'  => 0,
@@ -845,7 +703,7 @@ sub init_template {
      'PLUGIN_BASE'  => 'SL::Template::Plugin',
      'INCLUDE_PATH' => '.:templates/webpages',
      'COMPILE_EXT'  => '.tcc',
      'PLUGIN_BASE'  => 'SL::Template::Plugin',
      'INCLUDE_PATH' => '.:templates/webpages',
      'COMPILE_EXT'  => '.tcc',
-     'COMPILE_DIR'  => $::userspath . '/templates-cache',
+     'COMPILE_DIR'  => $::lx_office_conf{paths}->{userspath} . '/templates-cache',
   })) || die;
 }
 
   })) || die;
 }
 
@@ -860,6 +718,12 @@ sub show_generic_error {
 
   my ($self, $error, %params) = @_;
 
 
   my ($self, $error, %params) = @_;
 
+  if ($self->{__ERROR_HANDLER}) {
+    $self->{__ERROR_HANDLER}->($error);
+    $main::lxdebug->leave_sub();
+    return;
+  }
+
   my $add_params = {
     'title_error' => $params{title},
     'label_error' => $error,
   my $add_params = {
     'title_error' => $params{title},
     'label_error' => $error,
@@ -958,23 +822,30 @@ sub write_trigger {
   return $jsscript;
 }    #end sub write_trigger
 
   return $jsscript;
 }    #end sub write_trigger
 
+sub _store_redirect_info_in_session {
+  my ($self) = @_;
+
+  return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x;
+
+  my ($controller, $params) = ($1, $2);
+  my $form                  = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params };
+  $self->{callback}         = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form);
+}
+
 sub redirect {
   $main::lxdebug->enter_sub();
 
   my ($self, $msg) = @_;
 
   if (!$self->{callback}) {
 sub redirect {
   $main::lxdebug->enter_sub();
 
   my ($self, $msg) = @_;
 
   if (!$self->{callback}) {
-
     $self->info($msg);
     $self->info($msg);
-    ::end_of_request();
-  }
 
 
-#  my ($script, $argv) = split(/\?/, $self->{callback}, 2);
-#  $script =~ s|.*/||;
-#  $script =~ s|[^a-zA-Z0-9_\.]||g;
-#  exec("perl", "$script", $argv);
+  } else {
+    $self->_store_redirect_info_in_session;
+    print $::form->redirect_header($self->{callback});
+  }
 
 
-  print $::form->redirect_header($self->{callback});
+  ::end_of_request();
 
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
@@ -994,6 +865,7 @@ sub format_amount {
   $main::lxdebug->enter_sub(2);
 
   my ($self, $myconfig, $amount, $places, $dash) = @_;
   $main::lxdebug->enter_sub(2);
 
   my ($self, $myconfig, $amount, $places, $dash) = @_;
+  $dash ||= '';
 
   if ($amount eq "") {
     $amount = 0;
 
   if ($amount eq "") {
     $amount = 0;
@@ -1010,9 +882,10 @@ sub format_amount {
         $amount *= 1;
         $places *= -1;
 
         $amount *= 1;
         $places *= -1;
 
-        my ($actual_places) = ($amount =~ /\.(\d+)/);
-        $actual_places = length($actual_places);
-        $places = $actual_places > $places ? $actual_places : $places;
+        if ($amount =~ /\.(\d+)/) {
+          my $actual_places = length $1;
+          $places = $actual_places if $actual_places > $places;
+        }
       }
     }
     $amount = $self->round_amount($amount, $places);
       }
     }
     $amount = $self->round_amount($amount, $places);
@@ -1024,7 +897,7 @@ sub format_amount {
   $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
 
   $amount = $p[0];
   $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
 
   $amount = $p[0];
-  $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne '');
+  $amount .= $d[0].($p[1]||'').(0 x ($places - length ($p[1]||''))) if ($places || $p[1] ne '');
 
   $amount = do {
     ($dash =~ /-/)    ? ($neg ? "($amount)"                            : "$amount" )                              :
 
   $amount = do {
     ($dash =~ /-/)    ? ($neg ? "($amount)"                            : "$amount" )                              :
@@ -1056,8 +929,7 @@ sub format_amount_units {
     return '';
   }
 
     return '';
   }
 
-  AM->retrieve_all_units();
-  my $all_units        = $main::all_units;
+  my $all_units        = AM->retrieve_all_units;
 
   if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
     $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
 
   if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
     $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
@@ -1131,7 +1003,7 @@ sub parse_amount {
   if (   ($myconfig->{numberformat} eq '1.000,00')
       || ($myconfig->{numberformat} eq '1000,00')) {
     $amount =~ s/\.//g;
   if (   ($myconfig->{numberformat} eq '1.000,00')
       || ($myconfig->{numberformat} eq '1000,00')) {
     $amount =~ s/\.//g;
-    $amount =~ s/,/\./;
+    $amount =~ s/,/\./g;
   }
 
   if ($myconfig->{numberformat} eq "1'000.00") {
   }
 
   if ($myconfig->{numberformat} eq "1'000.00") {
@@ -1142,7 +1014,9 @@ sub parse_amount {
 
   $main::lxdebug->leave_sub(2);
 
 
   $main::lxdebug->leave_sub(2);
 
-  return ($amount * 1);
+  # Make sure no code wich is not a math expression ends up in eval().
+  return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
+  return scalar(eval($amount)) * 1 ;
 }
 
 sub round_amount {
 }
 
 sub round_amount {
@@ -1169,11 +1043,13 @@ sub round_amount {
 sub parse_template {
   $main::lxdebug->enter_sub();
 
 sub parse_template {
   $main::lxdebug->enter_sub();
 
-  my ($self, $myconfig, $userspath) = @_;
-  my $out;
+  my ($self, $myconfig) = @_;
+  my ($out, $out_mode);
 
   local (*IN, *OUT);
 
 
   local (*IN, *OUT);
 
+  my $userspath = $::lx_office_conf{paths}->{userspath};
+
   $self->{"cwd"} = getcwd();
   $self->{"tmpdir"} = $self->{cwd} . "/${userspath}";
 
   $self->{"cwd"} = getcwd();
   $self->{"tmpdir"} = $self->{cwd} . "/${userspath}";
 
@@ -1228,47 +1104,61 @@ sub parse_template {
   }
 
   map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid);
   }
 
   map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid);
+  map { $self->{"myconfig_${_}"} = $myconfig->{$_} } grep { $_ ne 'dbpasswd' } keys %{ $myconfig };
 
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
   # OUT is used for the media, screen, printer, email
   # for postscript we store a copy in a temporary file
 
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
   # OUT is used for the media, screen, printer, email
   # for postscript we store a copy in a temporary file
-  my $fileid = time;
-  my $prepend_userspath;
-
-  if (!$self->{tmpfile}) {
-    $self->{tmpfile}   = "${fileid}.$self->{IN}";
-    $prepend_userspath = 1;
-  }
-
-  $prepend_userspath = 1 if substr($self->{tmpfile}, 0, length $userspath) eq $userspath;
-
-  $self->{tmpfile} =~ s|.*/||;
-  $self->{tmpfile} =~ s/[^a-zA-Z0-9\._\ \-]//g;
-  $self->{tmpfile} = "$userspath/$self->{tmpfile}" if $prepend_userspath;
+  my ($temp_fh, $suffix);
+  $suffix =  $self->{IN};
+  $suffix =~ s/.*\.//;
+  ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
+    'kivitendo-printXXXXXX',
+    SUFFIX => '.' . ($suffix || 'tex'),
+    DIR    => $userspath,
+    UNLINK => 1,
+  );
+  close $temp_fh;
 
   if ($template->uses_temp_file() || $self->{media} eq 'email') {
 
   if ($template->uses_temp_file() || $self->{media} eq 'email') {
-    $out = $self->{OUT};
-    $self->{OUT} = ">$self->{tmpfile}";
+    $out              = $self->{OUT};
+    $out_mode         = $self->{OUT_MODE} || '>';
+    $self->{OUT}      = "$self->{tmpfile}";
+    $self->{OUT_MODE} = '>';
   }
 
   my $result;
   }
 
   my $result;
+  my $command_formatter = sub {
+    my ($out_mode, $out) = @_;
+    return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
+  };
 
   if ($self->{OUT}) {
 
   if ($self->{OUT}) {
-    open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!");
-    $result = $template->parse(*OUT);
-    close OUT;
-
+    $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+    open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
   } else {
   } else {
+    *OUT = ($::dispatcher->get_standard_filehandles)[1];
     $self->header;
     $self->header;
-    $result = $template->parse(*STDOUT);
   }
 
   }
 
-  if (!$result) {
+  if (!$template->parse(*OUT)) {
     $self->cleanup();
     $self->error("$self->{IN} : " . $template->get_error());
   }
 
     $self->cleanup();
     $self->error("$self->{IN} : " . $template->get_error());
   }
 
+  close OUT if $self->{OUT};
+
+  if ($self->{media} eq 'file') {
+    copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
+    $self->cleanup;
+    chdir("$self->{cwd}");
+
+    $::lxdebug->leave_sub();
+
+    return;
+  }
+
   if ($template->uses_temp_file() || $self->{media} eq 'email') {
 
     if ($self->{media} eq 'email') {
   if ($template->uses_temp_file() || $self->{media} eq 'email') {
 
     if ($self->{media} eq 'email') {
@@ -1277,27 +1167,23 @@ sub parse_template {
 
       map { $mail->{$_} = $self->{$_} }
         qw(cc bcc subject message version format);
 
       map { $mail->{$_} = $self->{$_} }
         qw(cc bcc subject message version format);
-      $mail->{charset} = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
+      $mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
       $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
       $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
       $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
       $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
-      $mail->{fileid} = "$fileid.";
+      $mail->{fileid} = time() . '.' . $$ . '.';
       $myconfig->{signature} =~ s/\r//g;
 
       # if we send html or plain text inline
       if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
       $myconfig->{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;
-        $myconfig->{signature} =~ s/\n/<br>\n/g;
-        $mail->{message} .= "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
+        $mail->{contenttype}    =  "text/html";
+        $mail->{message}        =~ s/\r//g;
+        $mail->{message}        =~ s/\n/<br>\n/g;
+        $myconfig->{signature}  =~ s/\n/<br>\n/g;
+        $mail->{message}       .=  "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
 
 
-        open(IN, $self->{tmpfile})
+        open(IN, "<", $self->{tmpfile})
           or $self->error($self->cleanup . "$self->{tmpfile} : $!");
           or $self->error($self->cleanup . "$self->{tmpfile} : $!");
-        while (<IN>) {
-          $mail->{message} .= $_;
-        }
-
+        $mail->{message} .= $_ while <IN>;
         close(IN);
 
       } else {
         close(IN);
 
       } else {
@@ -1319,11 +1205,13 @@ sub parse_template {
 
     } else {
 
 
     } else {
 
-      $self->{OUT} = $out;
+      $self->{OUT}      = $out;
+      $self->{OUT_MODE} = $out_mode;
 
       my $numbytes = (-s $self->{tmpfile});
 
       my $numbytes = (-s $self->{tmpfile});
-      open(IN, $self->{tmpfile})
+      open(IN, "<", $self->{tmpfile})
         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
+      binmode IN;
 
       $self->{copies} = 1 unless $self->{media} eq 'printer';
 
 
       $self->{copies} = 1 unless $self->{media} eq 'printer';
 
@@ -1332,10 +1220,12 @@ sub parse_template {
       #print(STDERR "OUT $self->{OUT}\n");
       for my $i (1 .. $self->{copies}) {
         if ($self->{OUT}) {
       #print(STDERR "OUT $self->{OUT}\n");
       for my $i (1 .. $self->{copies}) {
         if ($self->{OUT}) {
-          open OUT, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
-          print OUT while <IN>;
+          $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+
+          open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
+          print OUT $_ while <IN>;
           close OUT;
           close OUT;
-          seek IN, 0, 0;
+          seek  IN, 0, 0;
 
         } else {
           $self->{attachment_filename} = ($self->{attachment_filename})
 
         } else {
           $self->{attachment_filename} = ($self->{attachment_filename})
@@ -1370,6 +1260,9 @@ sub get_formname_translation {
 
   $formname ||= $self->{formname};
 
 
   $formname ||= $self->{formname};
 
+  $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
+  local $::locale = Locale->new($self->{recipient_locale});
+
   my %formname_translations = (
     bin_list                => $main::locale->text('Bin List'),
     credit_note             => $main::locale->text('Credit Note'),
   my %formname_translations = (
     bin_list                => $main::locale->text('Bin List'),
     credit_note             => $main::locale->text('Credit Note'),
@@ -1387,7 +1280,7 @@ sub get_formname_translation {
   );
 
   $main::lxdebug->leave_sub();
   );
 
   $main::lxdebug->leave_sub();
-  return $formname_translations{$formname}
+  return $formname_translations{$formname};
 }
 
 sub get_number_prefix_for_type {
 }
 
 sub get_number_prefix_for_type {
@@ -1423,11 +1316,14 @@ sub generate_attachment_filename {
   $main::lxdebug->enter_sub();
   my ($self) = @_;
 
   $main::lxdebug->enter_sub();
   my ($self) = @_;
 
+  $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
+  my $recipient_locale = Locale->new($self->{recipient_locale});
+
   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
   my $prefix              = $self->get_number_prefix_for_type();
 
   if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
   my $prefix              = $self->get_number_prefix_for_type();
 
   if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
-    $attachment_filename .= ' (' . $main::locale->text('Preview') . ')' . $self->get_extension_for_format();
+    $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
 
   } 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();
@@ -1461,18 +1357,23 @@ sub generate_email_subject {
 sub cleanup {
   $main::lxdebug->enter_sub();
 
 sub cleanup {
   $main::lxdebug->enter_sub();
 
-  my $self = shift;
+  my ($self, $application) = @_;
+
+  my $error_code = $?;
 
   chdir("$self->{tmpdir}");
 
   my @err = ();
 
   chdir("$self->{tmpdir}");
 
   my @err = ();
-  if (-f "$self->{tmpfile}.err") {
+  if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
+    push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');
+
+  } elsif (-f "$self->{tmpfile}.err") {
     open(FH, "$self->{tmpfile}.err");
     @err = <FH>;
     close(FH);
   }
 
     open(FH, "$self->{tmpfile}.err");
     @err = <FH>;
     close(FH);
   }
 
-  if ($self->{tmpfile} && ! $::keep_temp_files) {
+  if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
     $self->{tmpfile} =~ s|.*/||g;
     # strip extension
     $self->{tmpfile} =~ s/\.\w+$//g;
     $self->{tmpfile} =~ s|.*/||g;
     # strip extension
     $self->{tmpfile} =~ s/\.\w+$//g;
@@ -1537,7 +1438,7 @@ sub dbconnect {
   my ($self, $myconfig) = @_;
 
   # connect to database
   my ($self, $myconfig) = @_;
 
   # connect to database
-  my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
+  my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
     or $self->dberror;
 
   # set db options
     or $self->dberror;
 
   # set db options
@@ -1556,7 +1457,7 @@ sub dbconnect_noauto {
   my ($self, $myconfig) = @_;
 
   # connect to database
   my ($self, $myconfig) = @_;
 
   # connect to database
-  my $dbh = DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
+  my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
     or $self->dberror;
 
   # set db options
     or $self->dberror;
 
   # set db options
@@ -1594,7 +1495,24 @@ sub date_closed {
   my $dbh = $self->dbconnect($myconfig);
 
   my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
   my $dbh = $self->dbconnect($myconfig);
 
   my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
-  my $sth = prepare_execute_query($self, $dbh, $query, $date);
+  my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
+
+  # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
+  # es ist sicher ein conv_date vorher IMMER auszuführen.
+  # Testfälle ohne definiertes closedto:
+  #   Leere Datumseingabe i.O.
+  #     SELECT 1 FROM defaults WHERE '' < closedto
+  #   normale Zahlungsbuchung über Rechnungsmaske i.O.
+  #     SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
+  # Testfälle mit definiertem closedto (30.04.2011):
+  #  Leere Datumseingabe i.O.
+  #   SELECT 1 FROM defaults WHERE '' < closedto
+  # normale Buchung im geschloßenem Zeitraum i.O.
+  #   SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
+  #     Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
+  # normale Buchung in aktiver Buchungsperiode i.O.
+  #   SELECT 1 FROM defaults WHERE '01.05.2011' < closedto
+
   my ($closed) = $sth->fetchrow_array;
 
   $main::lxdebug->leave_sub();
   my ($closed) = $sth->fetchrow_array;
 
   $main::lxdebug->leave_sub();
@@ -1809,12 +1727,12 @@ sub set_payment_options {
   my $dbh = $self->get_standard_dbh($myconfig);
 
   my $query =
   my $dbh = $self->get_standard_dbh($myconfig);
 
   my $query =
-    qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long | .
+    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 = ?|;
 
   ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
     qq|FROM payment_terms p | .
     qq|WHERE p.id = ?|;
 
   ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
-   $self->{payment_terms}) =
+   $self->{payment_terms}, $self->{payment_description}) =
      selectrow_query($self, $dbh, $query, $self->{payment_id});
 
   if ($transdate eq "") {
      selectrow_query($self, $dbh, $query, $self->{payment_id});
 
   if ($transdate eq "") {
@@ -1861,10 +1779,12 @@ sub set_payment_options {
 
   if ($self->{"language_id"}) {
     $query =
 
   if ($self->{"language_id"}) {
     $query =
-      qq|SELECT t.description_long, l.output_numberformat, l.output_dateformat, l.output_longdates | .
-      qq|FROM translation_payment_terms t | .
+      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|LEFT JOIN language l ON t.language_id = l.id | .
-      qq|WHERE (t.language_id = ?) AND (t.payment_terms_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,
     my ($description_long, $output_numberformat, $output_dateformat,
       $output_longdates) =
       selectrow_query($self, $dbh, $query,
@@ -2057,7 +1977,7 @@ sub get_employee_data {
   my ($login)  = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
 
   if ($login) {
   my ($login)  = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
 
   if ($login) {
-    my $user = User->new($login);
+    my $user = User->new(login => $login);
     map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
 
     $self->{$params{prefix} . '_login'}   = $login;
     map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
 
     $self->{$params{prefix} . '_login'}   = $login;
@@ -2237,7 +2157,7 @@ sub _get_taxcharts {
     $key = $params;
   }
 
     $key = $params;
   }
 
-  my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where);
+  my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
 
   my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
 
 
   my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
 
@@ -2338,7 +2258,7 @@ $main::lxdebug->enter_sub();
 
   $key = "all_payments" unless ($key);
 
 
   $key = "all_payments" unless ($key);
 
-  my $query = qq|SELECT * FROM payment_terms ORDER BY id|;
+  my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
@@ -2352,7 +2272,7 @@ sub _get_customers {
 
   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
   $options->{key}  ||= "all_customers";
 
   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
   $options->{key}  ||= "all_customers";
-  my $limit_clause   = "LIMIT $options->{limit}" if $options->{limit};
+  my $limit_clause   = $options->{limit} ? "LIMIT $options->{limit}" : '';
 
   my @where;
   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
 
   my @where;
   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
@@ -2416,7 +2336,8 @@ sub _get_warehouses {
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
   if ($bins_key) {
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
   if ($bins_key) {
-    $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|;
+    $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
+                ORDER BY description|;
     my $sth = prepare_query($self, $dbh, $query);
 
     foreach my $warehouse (@{ $self->{$key} }) {
     my $sth = prepare_query($self, $dbh, $query);
 
     foreach my $warehouse (@{ $self->{$key} }) {
@@ -2613,7 +2534,7 @@ sub get_name {
   return scalar(@{ $self->{name_list} });
 }
 
   return scalar(@{ $self->{name_list} });
 }
 
-# the selection sub is used in the AR, AP, IS, IR and OE module
+# the selection sub is used in the AR, AP, IS, IR, DO and OE module
 #
 sub all_vc {
   $main::lxdebug->enter_sub();
 #
 sub all_vc {
   $main::lxdebug->enter_sub();
@@ -2625,13 +2546,17 @@ sub all_vc {
 
   $table = $table eq "customer" ? "customer" : "vendor";
 
 
   $table = $table eq "customer" ? "customer" : "vendor";
 
-  my $query = qq|SELECT count(*) FROM $table|;
+  # 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 = "WHERE NOT obsolete" unless $self->{id};
+  my $query = qq|SELECT count(*) FROM $table $obsolete|;
   my ($count) = selectrow_query($self, $dbh, $query);
 
   my ($count) = selectrow_query($self, $dbh, $query);
 
-  # build selection list
-  if ($count <= $myconfig->{vclimit}) {
+  if ($count < $myconfig->{vclimit}) {
     $query = qq|SELECT id, name, salesman_id
     $query = qq|SELECT id, name, salesman_id
-                FROM $table WHERE NOT obsolete
+                FROM $table $obsolete
                 ORDER BY name|;
     $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
   }
                 ORDER BY name|;
     $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
   }
@@ -2654,19 +2579,11 @@ sub all_vc {
   @{ $self->{all_employees} } =
     sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };
 
   @{ $self->{all_employees} } =
     sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };
 
-  if ($module eq 'AR') {
 
     # prepare query for departments
 
     # prepare query for departments
-    $query = qq|SELECT id, description
-                FROM department
-                WHERE role = 'P'
-                ORDER BY description|;
-
-  } else {
     $query = qq|SELECT id, description
                 FROM department
                 ORDER BY description|;
     $query = qq|SELECT id, description
                 FROM department
                 ORDER BY description|;
-  }
 
   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
 
 
   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
 
@@ -2737,15 +2654,9 @@ sub all_departments {
   my ($self, $myconfig, $table) = @_;
 
   my $dbh = $self->get_standard_dbh($myconfig);
   my ($self, $myconfig, $table) = @_;
 
   my $dbh = $self->get_standard_dbh($myconfig);
-  my $where;
-
-  if ($table eq 'customer') {
-    $where = "WHERE role = 'P' ";
-  }
 
   my $query = qq|SELECT id, description
                  FROM department
 
   my $query = qq|SELECT id, description
                  FROM department
-                 $where
                  ORDER BY description|;
   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
 
                  ORDER BY description|;
   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
 
@@ -2785,11 +2696,28 @@ 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|;
+#    $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
+        -- find newest entries in taxkeys
+        INNER JOIN (
+          SELECT chart_id, MAX(startdate) AS startdate
+          FROM taxkeys
+          WHERE (startdate <= $transdate)
+          GROUP BY chart_id
+        ) tk ON (c.id = tk.chart_id)
+        -- and load all of those entries
+        INNER JOIN taxkeys tk2
+           ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
+       WHERE (c.link LIKE ?)
+      ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
 
 
     $sth = $dbh->prepare($query);
 
@@ -2833,6 +2761,7 @@ sub create_links {
            a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
            a.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
            a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
            a.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
+           a.globalproject_id,
            c.name AS $table,
            d.description AS department,
            e.name AS employee
            c.name AS $table,
            d.description AS department,
            e.name AS employee
@@ -2847,6 +2776,9 @@ sub create_links {
       $self->{$key} = $ref->{$key};
     }
 
       $self->{$key} = $ref->{$key};
     }
 
+    # remove any trailing whitespace
+    $self->{currency} =~ s/\s*$//;
+
     my $transdate = "current_date";
     if ($self->{transdate}) {
       $transdate = $dbh->quote($self->{transdate});
     my $transdate = "current_date";
     if ($self->{transdate}) {
       $transdate = $dbh->quote($self->{transdate});
@@ -2889,7 +2821,7 @@ sub create_links {
     $query =
       qq|SELECT
            c.accno, c.description,
     $query =
       qq|SELECT
            c.accno, c.description,
-           a.source, a.amount, a.memo, a.transdate, 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,
            p.projectnumber,
            t.rate, t.id
          FROM acc_trans a
            p.projectnumber,
            t.rate, t.id
          FROM acc_trans a
@@ -2954,7 +2886,7 @@ sub create_links {
     if ($self->{"$self->{vc}_id"}) {
 
       # only setup currency
     if ($self->{"$self->{vc}_id"}) {
 
       # only setup currency
-      ($self->{currency}) = split(/:/, $self->{currencies});
+      ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency};
 
     } else {
 
 
     } else {
 
@@ -2984,12 +2916,14 @@ sub lastname_used {
                     "a.department_id"         => "department_id",
                     "d.description"           => "department",
                     "ct.name"                 => $table,
                     "a.department_id"         => "department_id",
                     "d.description"           => "department",
                     "ct.name"                 => $table,
+                    "ct.curr"                 => "cv_curr",
                     "current_date + ct.terms" => "duedate",
     );
 
   if ($self->{type} =~ /delivery_order/) {
     $arap  = 'delivery_orders';
     delete $column_map{"a.curr"};
                     "current_date + ct.terms" => "duedate",
     );
 
   if ($self->{type} =~ /delivery_order/) {
     $arap  = 'delivery_orders';
     delete $column_map{"a.curr"};
+    delete $column_map{"ct.curr"};
 
   } elsif ($self->{type} =~ /_order/) {
     $arap  = 'oe';
 
   } elsif ($self->{type} =~ /_order/) {
     $arap  = 'oe';
@@ -3023,6 +2957,13 @@ sub lastname_used {
 
   map { $self->{$_} = $ref->{$_} } values %column_map;
 
 
   map { $self->{$_} = $ref->{$_} } values %column_map;
 
+  # remove any trailing whitespace
+  $self->{currency} =~ s/\s*$// if $self->{currency};
+  $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr};
+
+  # if customer/vendor currency is set use this
+  $self->{currency} = $self->{cv_curr} if $self->{cv_curr};
+
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
@@ -3496,79 +3437,181 @@ sub restore_vars {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
-1;
+sub prepare_for_printing {
+  my ($self) = @_;
 
 
-__END__
+  $self->{templates} ||= $::myconfig{templates};
+  $self->{formname}  ||= $self->{type};
+  $self->{media}     ||= 'email';
 
 
-=head1 NAME
+  die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
 
 
-SL::Form.pm - main data object.
+  # set shipto from billto unless set
+  my $has_shipto = any { $self->{"shipto$_"} } qw(name street zipcode city country contact);
+  if (!$has_shipto && ($self->{type} =~ m/^(?:purchase_order|request_quotation)$/)) {
+    $self->{shiptoname}   = $::myconfig{company};
+    $self->{shiptostreet} = $::myconfig{address};
+  }
 
 
-=head1 SYNOPSIS
+  my $language = $self->{language} ? '_' . $self->{language} : '';
 
 
-This is the main data object of Lx-Office.
-Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
-Points of interest for a beginner are:
+  my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
+  if ($self->{language_id}) {
+    ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
+  } else {
+    $output_dateformat   = $::myconfig{dateformat};
+    $output_numberformat = $::myconfig{numberformat};
+    $output_longdates    = 1;
+  }
 
 
- - $form->error            - renders a generic error in html. accepts an error message
- - $form->get_standard_dbh - returns a database connection for the
+  # Retrieve accounts for tax calculation.
+  IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});
 
 
-=head1 SPECIAL FUNCTIONS
+  if ($self->{type} =~ /_delivery_order$/) {
+    DO->order_details();
+  } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) {
+    OE->order_details(\%::myconfig, $self);
+  } else {
+    IS->invoice_details(\%::myconfig, $self, $::locale);
+  }
+
+  # Chose extension & set source file name
+  my $extension = 'html';
+  if ($self->{format} eq 'postscript') {
+    $self->{postscript}   = 1;
+    $extension            = 'tex';
+  } elsif ($self->{"format"} =~ /pdf/) {
+    $self->{pdf}          = 1;
+    $extension            = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
+  } elsif ($self->{"format"} =~ /opendocument/) {
+    $self->{opendocument} = 1;
+    $extension            = 'odt';
+  } elsif ($self->{"format"} =~ /excel/) {
+    $self->{excel}        = 1;
+    $extension            = 'xls';
+  }
 
 
-=head2 C<_store_value()>
+  my $printer_code    = $self->{printer_code} ? '_' . $self->{printer_code} : '';
+  my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : '';
+  $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
 
 
-parses a complex var name, and stores it in the form.
+  # Format dates.
+  $self->format_dates($output_dateformat, $output_longdates,
+                      qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid
+                         transdate_oe deliverydate_oe employee_startdate employee_enddate),
+                      grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
 
 
-syntax:
-  $form->_store_value($key, $value);
+  $self->reformat_numbers($output_numberformat, 2,
+                          qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
+                          grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));
+
+  $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));
+
+  my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');
+
+  if (scalar @{ $cvar_date_fields }) {
+    $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
+  }
 
 
-keys must start with a string, and can contain various tokens.
-supported key structures are:
+  while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
+    $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
+  }
 
 
-1. simple access
-  simple key strings work as expected
+  return $self;
+}
 
 
-  id => $form->{id}
+sub format_dates {
+  my ($self, $dateformat, $longformat, @indices) = @_;
 
 
-2. hash access.
-  separating two keys by a dot (.) will result in a hash lookup for the inner value
-  this is similar to the behaviour of java and templating mechanisms.
+  $dateformat ||= $::myconfig{dateformat};
 
 
-  filter.description => $form->{filter}->{description}
+  foreach my $idx (@indices) {
+    if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
+      for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
+        $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
+      }
+    }
 
 
-3. array+hashref access
+    next unless defined $self->{$idx};
 
 
-  adding brackets ([]) before the dot will cause the next hash to be put into an array.
-  using [+] instead of [] will force a new array index. this is useful for recurring
-  data structures like part lists. put a [+] into the first varname, and use [] on the
-  following ones.
+    if (!ref($self->{$idx})) {
+      $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);
 
 
-  repeating these names in your template:
+    } elsif (ref($self->{$idx}) eq "ARRAY") {
+      for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
+        $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
+      }
+    }
+  }
+}
 
 
-    invoice.items[+].id
-    invoice.items[].parts_id
+sub reformat_numbers {
+  my ($self, $numberformat, $places, @indices) = @_;
 
 
-  will result in:
+  return if !$numberformat || ($numberformat eq $::myconfig{numberformat});
 
 
-    $form->{invoice}->{items}->[
-      {
-        id       => ...
-        parts_id => ...
-      },
-      {
-        id       => ...
-        parts_id => ...
+  foreach my $idx (@indices) {
+    if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
+      for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
+        $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
       }
       }
-      ...
-    ]
+    }
 
 
-4. arrays
+    next unless defined $self->{$idx};
 
 
-  using brackets at the end of a name will result in a pure array to be created.
-  note that you mustn't use [+], which is reserved for array+hash access and will
-  result in undefined behaviour in array context.
+    if (!ref($self->{$idx})) {
+      $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});
+
+    } elsif (ref($self->{$idx}) eq "ARRAY") {
+      for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
+        $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
+      }
+    }
+  }
 
 
-  filter.status[]  => $form->{status}->[ val1, val2, ... ]
+  my $saved_numberformat    = $::myconfig{numberformat};
+  $::myconfig{numberformat} = $numberformat;
+
+  foreach my $idx (@indices) {
+    if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
+      for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
+        $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
+      }
+    }
+
+    next unless defined $self->{$idx};
+
+    if (!ref($self->{$idx})) {
+      $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);
+
+    } elsif (ref($self->{$idx}) eq "ARRAY") {
+      for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
+        $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
+      }
+    }
+  }
+
+  $::myconfig{numberformat} = $saved_numberformat;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+SL::Form.pm - main data object.
+
+=head1 SYNOPSIS
+
+This is the main data object of Lx-Office.
+Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
+Points of interest for a beginner are:
+
+ - $form->error            - renders a generic error in html. accepts an error message
+ - $form->get_standard_dbh - returns a database connection for the
+
+=head1 SPECIAL FUNCTIONS
 
 =head2 C<update_business> PARAMS
 
 
 =head2 C<update_business> PARAMS
 
@@ -3599,7 +3642,7 @@ Examples:
 =head2 C<header>
 
 Generates a general purpose http/html header and includes most of the scripts
 =head2 C<header>
 
 Generates a general purpose http/html header and includes most of the scripts
-ans stylesheets needed.
+and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.
 
 Only one header will be generated. If the method was already called in this
 request it will not output anything and return undef. Also if no
 
 Only one header will be generated. If the method was already called in this
 request it will not output anything and return undef. Also if no
@@ -3619,9 +3662,8 @@ default to 3 seconds and the refering url.
 
 =item stylesheet
 
 
 =item stylesheet
 
-=item stylesheets
-
-If these are arrayrefs the contents will be inlined into the header.
+Either a scalar or an array ref. Will be inlined into the header. Add
+stylesheets with the L<use_stylesheet> function.
 
 =item landscape
 
 
 =item landscape
 
Unnamed repository; edit this file 'description' to name the repository.