Framework für after/before-Hooks bei load/save/delete
[kivitendo-erp.git] / SL / Form.pm
index 7b7746d..582d2af 100644 (file)
@@ -43,21 +43,30 @@ use CGI;
 use CGI::Ajax;
 use Cwd;
 use Encode;
 use CGI::Ajax;
 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::Mailer;
 use SL::Menu;
 use SL::Mailer;
 use SL::Menu;
+use SL::OE;
 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;
 
@@ -126,6 +135,7 @@ sub _request_to_hash {
 
   my $self  = shift;
   my $input = shift;
 
   my $self  = shift;
   my $input = shift;
+  my $uploads = {};
 
   if (!$ENV{'CONTENT_TYPE'}
       || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
 
   if (!$ENV{'CONTENT_TYPE'}
       || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
@@ -133,7 +143,7 @@ sub _request_to_hash {
     $self->_input_to_hash($input);
 
     $main::lxdebug->leave_sub(2);
     $self->_input_to_hash($input);
 
     $main::lxdebug->leave_sub(2);
-    return;
+    return $uploads;
   }
 
   my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
   }
 
   my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
@@ -178,7 +188,7 @@ sub _request_to_hash {
           substr $line, $-[0], $+[0] - $-[0], "";
         }
 
           substr $line, $-[0], $+[0] - $-[0], "";
         }
 
-        $previous         = $self->_store_value($name, '') if ($name);
+        $previous         = _store_value($uploads, $name, '') if ($name);
         $self->{FILENAME} = $filename if ($filename);
 
         next;
         $self->{FILENAME} = $filename if ($filename);
 
         next;
@@ -199,6 +209,8 @@ sub _request_to_hash {
   ${ $previous } =~ s|\r?\n$|| if $previous;
 
   $main::lxdebug->leave_sub(2);
   ${ $previous } =~ s|\r?\n$|| if $previous;
 
   $main::lxdebug->leave_sub(2);
+
+  return $uploads;
 }
 
 sub _recode_recursively {
 }
 
 sub _recode_recursively {
@@ -249,13 +261,14 @@ sub new {
   $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
   $self->_input_to_hash($ARGV[0])           if @ARGV && $ARGV[0];
 
   $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
   $self->_input_to_hash($ARGV[0])           if @ARGV && $ARGV[0];
 
+  my $uploads;
   if ($ENV{CONTENT_LENGTH}) {
     my $content;
     read STDIN, $content, $ENV{CONTENT_LENGTH};
   if ($ENV{CONTENT_LENGTH}) {
     my $content;
     read STDIN, $content, $ENV{CONTENT_LENGTH};
-    $self->_request_to_hash($content);
+    $uploads = $self->_request_to_hash($content);
   }
 
   }
 
-  my $db_charset   = $main::dbcharset;
+  my $db_charset   = $::lx_office_conf{system}->{dbcharset};
   $db_charset    ||= Common::DEFAULT_CHARSET;
 
   my $encoding     = $self->{INPUT_ENCODING} || $db_charset;
   $db_charset    ||= Common::DEFAULT_CHARSET;
 
   my $encoding     = $self->{INPUT_ENCODING} || $db_charset;
@@ -263,8 +276,7 @@ sub new {
 
   _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
 
 
   _recode_recursively(SL::Iconv->new($encoding, $db_charset), $self);
 
-  $self->{action}  =  lc $self->{action};
-  $self->{action}  =~ s/( |-|,|\#)/_/g;
+  map { $self->{$_} = $uploads->{$_} } keys %{ $uploads } if $uploads;
 
   #$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} =  "2.6.1";                 # Old hardcoded but secure style
   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
@@ -381,7 +393,7 @@ sub escape {
   my ($self, $str) = @_;
 
   $str =  Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
   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;
+  $str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge;
 
   $main::lxdebug->leave_sub(2);
 
 
   $main::lxdebug->leave_sub(2);
 
@@ -397,6 +409,7 @@ sub unescape {
   $str =~ s/\\$//;
 
   $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
   $str =~ s/\\$//;
 
   $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
+  $str =  Encode::decode('utf-8-strict', $str) if $::locale->is_utf8;
 
   $main::lxdebug->leave_sub(2);
 
 
   $main::lxdebug->leave_sub(2);
 
@@ -444,13 +457,23 @@ sub hide_form {
   $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);
 
@@ -594,26 +617,41 @@ sub create_http_response {
     pop @segments;
     $uri->path_segments(@segments);
 
     pop @segments;
     $uri->path_segments(@segments);
 
-    my $session_cookie_value   = $main::auth->get_session_id();
-    $session_cookie_value    ||= 'NO_SESSION';
+    my $session_cookie_value = $main::auth->get_session_id();
 
 
-    $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
-                                   '-value'  => $session_cookie_value,
-                                   '-path'   => $uri->path,
-                                   '-secure' => $ENV{HTTPS});
+    if ($session_cookie_value) {
+      $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
+                                     '-value'  => $session_cookie_value,
+                                     '-path'   => $uri->path,
+                                     '-secure' => $ENV{HTTPS});
+    }
   }
 
   my %cgi_params = ('-type' => $params{content_type});
   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
   }
 
   my %cgi_params = ('-type' => $params{content_type});
   $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('-cookie' => $session_cookie,
-                            %cgi_params);
+  my $output = $cgi->header(%cgi_params);
 
   $main::lxdebug->leave_sub();
 
   return $output;
 }
 
 
   $main::lxdebug->leave_sub();
 
   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 header {
   $::lxdebug->enter_sub;
 
 sub header {
   $::lxdebug->enter_sub;
@@ -621,7 +659,7 @@ sub header {
   # 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) = @_;
   # 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 $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}++;
@@ -636,8 +674,7 @@ 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="Lx-Office 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};
@@ -681,7 +718,6 @@ EOT
   print <<EOT;
   <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
   <meta name="robots" content="noindex,nofollow" />
   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" />
   <script type="text/javascript" src="js/tabcontent.js">
 
   <link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
   <script type="text/javascript" src="js/tabcontent.js">
 
@@ -706,7 +742,7 @@ sub ajax_response_header {
 
   my ($self) = @_;
 
 
   my ($self) = @_;
 
-  my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
+  my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
   my $cgi        = $main::cgi || CGI->new('');
   my $output     = $cgi->header('-charset' => $db_charset);
 
   my $cgi        = $main::cgi || CGI->new('');
   my $output     = $cgi->header('-charset' => $db_charset);
 
@@ -722,7 +758,7 @@ 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;
 
   my $cgi = $main::cgi || CGI->new('');
   $self->{header} = 1;
 
   my $cgi = $main::cgi || CGI->new('');
@@ -747,26 +783,18 @@ 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 {
-    my $info = "Web page template '${file}' not found.\n" .
-      "Please re-run 'locales.pl' in 'locale/${language}'.";
-    print(qq|<pre>$info</pre>|);
+    my $info = "Web page template '${file}' not found.\n";
+    print qq|<pre>$info</pre>|;
     ::end_of_request();
   }
 
     ::end_of_request();
   }
 
@@ -789,13 +817,16 @@ sub _prepare_html_template {
     map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
   }
 
     map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
   }
 
-  $additional_params->{"conf_dbcharset"}              = $main::dbcharset;
-  $additional_params->{"conf_webdav"}                 = $main::webdav;
-  $additional_params->{"conf_lizenzen"}               = $main::lizenzen;
-  $additional_params->{"conf_latex_templates"}        = $main::latex;
-  $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates;
-  $additional_params->{"conf_vertreter"}              = $main::vertreter;
-  $additional_params->{"conf_show_best_before"}       = $main::show_best_before;
+  $additional_params->{"conf_dbcharset"}              = $::lx_office_conf{system}->{dbcharset};
+  $additional_params->{"conf_webdav"}                 = $::lx_office_conf{features}->{webdav};
+  $additional_params->{"conf_lizenzen"}               = $::lx_office_conf{features}->{lizenzen};
+  $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};
 
   if (%main::debug_options) {
     map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
 
   if (%main::debug_options) {
     map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
@@ -845,7 +876,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 +891,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,
@@ -964,17 +1001,13 @@ sub redirect {
   my ($self, $msg) = @_;
 
   if (!$self->{callback}) {
   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 {
+    print $::form->redirect_header($self->{callback});
+  }
 
 
-  print $::form->redirect_header($self->{callback});
+  ::end_of_request();
 
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
@@ -1131,7 +1164,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 +1175,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 +1204,13 @@ sub round_amount {
 sub parse_template {
   $main::lxdebug->enter_sub();
 
 sub parse_template {
   $main::lxdebug->enter_sub();
 
-  my ($self, $myconfig, $userspath) = @_;
+  my ($self, $myconfig) = @_;
   my $out;
 
   local (*IN, *OUT);
 
   my $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}";
 
@@ -1198,7 +1235,7 @@ sub parse_template {
     $ext_for_format = 'xml';
 
   } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
     $ext_for_format = 'xml';
 
   } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
-    $template_type = 'xml';
+    $template_type = 'XML';
 
   } elsif ( $self->{"format"} =~ /excel/i ) {
     $template_type  = 'Excel';
 
   } elsif ( $self->{"format"} =~ /excel/i ) {
     $template_type  = 'Excel';
@@ -1228,6 +1265,7 @@ 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);
 
 
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
@@ -1269,6 +1307,16 @@ sub parse_template {
     $self->error("$self->{IN} : " . $template->get_error());
   }
 
     $self->error("$self->{IN} : " . $template->get_error());
   }
 
+  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,7 +1325,7 @@ 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->{fileid} = "$fileid.";
       $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
       $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
       $mail->{fileid} = "$fileid.";
@@ -1324,6 +1372,7 @@ sub parse_template {
       my $numbytes = (-s $self->{tmpfile});
       open(IN, $self->{tmpfile})
         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
       my $numbytes = (-s $self->{tmpfile});
       open(IN, $self->{tmpfile})
         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
+      binmode IN;
 
       $self->{copies} = 1 unless $self->{media} eq 'printer';
 
 
       $self->{copies} = 1 unless $self->{media} eq 'printer';
 
@@ -1374,7 +1423,6 @@ sub get_formname_translation {
     bin_list                => $main::locale->text('Bin List'),
     credit_note             => $main::locale->text('Credit Note'),
     invoice                 => $main::locale->text('Invoice'),
     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'),
     pick_list               => $main::locale->text('Pick List'),
     proforma                => $main::locale->text('Proforma Invoice'),
     purchase_order          => $main::locale->text('Purchase Order'),
@@ -1382,7 +1430,6 @@ sub get_formname_translation {
     sales_order             => $main::locale->text('Confirmation'),
     sales_quotation         => $main::locale->text('Quotation'),
     storno_invoice          => $main::locale->text('Storno Invoice'),
     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'),
     sales_delivery_order    => $main::locale->text('Delivery Order'),
     purchase_delivery_order => $main::locale->text('Delivery Order'),
     dunning                 => $main::locale->text('Dunning'),
     sales_delivery_order    => $main::locale->text('Delivery Order'),
     purchase_delivery_order => $main::locale->text('Delivery Order'),
     dunning                 => $main::locale->text('Dunning'),
@@ -1474,7 +1521,7 @@ sub cleanup {
     close(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;
@@ -1539,7 +1586,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
@@ -1558,7 +1605,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
@@ -1596,7 +1643,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();
@@ -1811,12 +1875,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 "") {
@@ -1863,10 +1927,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,
@@ -2340,7 +2406,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);
 
@@ -2418,7 +2484,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} }) {
@@ -3225,7 +3292,6 @@ sub save_status {
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')
-# $main::locale->text('packing_list')
 # $main::locale->text('pick_list')
 # $main::locale->text('purchase_order')
 # $main::locale->text('bin_list')
 # $main::locale->text('pick_list')
 # $main::locale->text('purchase_order')
 # $main::locale->text('bin_list')
@@ -3499,6 +3565,163 @@ sub restore_vars {
   $main::lxdebug->leave_sub();
 }
 
   $main::lxdebug->leave_sub();
 }
 
+sub prepare_for_printing {
+  my ($self) = @_;
+
+  $self->{templates} ||= $::myconfig{templates};
+  $self->{formname}  ||= $self->{type};
+  $self->{media}     ||= 'email';
+
+  die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
+
+  # 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};
+  }
+
+  my $language = $self->{language} ? '_' . $self->{language} : '';
+
+  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;
+  }
+
+  # Retrieve accounts for tax calculation.
+  IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});
+
+  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';
+  }
+
+  my $printer_code    = '_' . $self->{printer_code} if $self->{printer_code};
+  my $email_extension = '_email' if -f "$self->{templates}/$self->{formname}_email${language}${printer_code}.${extension}";
+  $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
+
+  # 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})));
+
+  $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 });
+  }
+
+  while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
+    $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
+  }
+
+  return $self;
+}
+
+sub format_dates {
+  my ($self, $dateformat, $longformat, @indices) = @_;
+
+  $dateformat ||= $::myconfig{dateformat};
+
+  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);
+      }
+    }
+
+    next unless defined $self->{$idx};
+
+    if (!ref($self->{$idx})) {
+      $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);
+
+    } 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);
+      }
+    }
+  }
+}
+
+sub reformat_numbers {
+  my ($self, $numberformat, $places, @indices) = @_;
+
+  return if !$numberformat || ($numberformat eq $::myconfig{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->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
+      }
+    }
+
+    next unless defined $self->{$idx};
+
+    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]);
+      }
+    }
+  }
+
+  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__
 1;
 
 __END__
@@ -3602,7 +3825,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
@@ -3622,9 +3845,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