X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=8d28f845b869a38afe3348df0669eb9dc06a86a2;hb=ce83fab980b72a2b3d4066ce2b49cbf3feec56a5;hp=0268aaf2e2a82eb659425192f17f69904c787449;hpb=cf4ac17020af74a0ab2443fde0ae2c85b181af0a;p=kivitendo-erp.git

diff --git a/SL/Form.pm b/SL/Form.pm
index 0268aaf2e..8d28f845b 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -40,7 +40,6 @@ package Form;
 use Data::Dumper;
 
 use CGI;
-use CGI::Ajax;
 use Cwd;
 use Encode;
 use File::Copy;
@@ -57,9 +56,12 @@ use SL::DBUtils;
 use SL::DO;
 use SL::IC;
 use SL::IS;
+use SL::Locale;
 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::X;
@@ -82,168 +84,6 @@ sub disconnect_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;
-  my $uploads = {};
-
-  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 $uploads;
-  }
-
-  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         = _store_value($uploads, $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);
-
-  return $uploads;
-}
-
-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();
 
@@ -259,43 +99,6 @@ sub new {
 
   bless $self, $type;
 
-  $main::lxdebug->leave_sub();
-
-  return $self;
-}
-
-sub read_cgi_input {
-  $main::lxdebug->enter_sub();
-
-  my ($self) = @_;
-
-  $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};
-    $uploads = $self->_request_to_hash($content);
-  }
-
-  if ($self->{RESTORE_FORM_FROM_SESSION_ID}) {
-    my %temp_form;
-    $::auth->restore_form_from_session(delete $self->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
-    $self->_input_to_hash(join '&', map { $self->escape($_) . '=' . $self->escape($temp_form{$_}) } keys %temp_form);
-  }
-
-  my $db_charset   = $::lx_office_conf{system}->{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);
-
-  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} =  <VERSION_FILE>;
   close VERSION_FILE;
@@ -306,6 +109,11 @@ sub read_cgi_input {
   return $self;
 }
 
+sub read_cgi_input {
+  my ($self) = @_;
+  SL::Request::read_cgi_input($self);
+}
+
 sub _flatten_variables_rec {
   $main::lxdebug->enter_sub(2);
 
@@ -405,32 +213,15 @@ sub dumper {
 }
 
 sub escape {
-  $main::lxdebug->enter_sub(2);
-
   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 {
-  $main::lxdebug->enter_sub(2);
-
   my ($self, $str) = @_;
 
-  $str =~ tr/+/ /;
-  $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);
-
-  return $str;
+  return uri_decode($str);
 }
 
 sub quote {
@@ -521,7 +312,7 @@ sub info {
     <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);
     //-->
@@ -669,6 +460,24 @@ sub use_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;
 
@@ -680,6 +489,8 @@ sub 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};
 
@@ -690,20 +501,16 @@ sub header {
     push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
   }
 
-  push @header, map { qq|<link rel="stylesheet" href="$_" type="text/css" title="Lx-Office stylesheet">| } $self->use_stylesheet;
+  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, '<script type="text/javascript" src="js/jquery.js"></script>',
-                '<script type="text/javascript" src="js/common.js"></script>',
-                '<link rel="stylesheet" type="text/css" href="js/jscalendar/calendar-win2k-1.css">',
-                '<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>',
-                '<script type="text/javascript" src="js/jquery-ui.js"></script>',
-                '<link rel="stylesheet" type="text/css" href="css/ui-lightness/jquery-ui-1.8.12.custom.css">';
+  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, 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>",
@@ -722,10 +529,15 @@ sub header {
     </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);
-  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>
@@ -734,9 +546,7 @@ sub header {
 EOT
   print "  $_\n" for @header;
   print <<EOT;
-  <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css">
   <meta name="robots" content="noindex,nofollow">
-  <link rel="stylesheet" type="text/css" href="css/tabcontent.css">
   <script type="text/javascript" src="js/tabcontent.js">
 
   /***********************************************
@@ -785,7 +595,7 @@ 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};
 
@@ -1055,6 +865,7 @@ sub format_amount {
   $main::lxdebug->enter_sub(2);
 
   my ($self, $myconfig, $amount, $places, $dash) = @_;
+  $dash ||= '';
 
   if ($amount eq "") {
     $amount = 0;
@@ -1071,9 +882,10 @@ sub format_amount {
         $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);
@@ -1085,7 +897,7 @@ sub format_amount {
   $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" )                              :
@@ -1232,7 +1044,7 @@ sub parse_template {
   $main::lxdebug->enter_sub();
 
   my ($self, $myconfig) = @_;
-  my $out;
+  my ($out, $out_mode);
 
   local (*IN, *OUT);
 
@@ -1298,29 +1110,33 @@ sub parse_template {
 
   # 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') {
-    $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 $command_formatter = sub {
+    my ($out_mode, $out) = @_;
+    return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
+  };
 
   if ($self->{OUT}) {
-    open(OUT, ">", $self->{OUT}) or $self->error("$self->{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 {
     *OUT = ($::dispatcher->get_standard_filehandles)[1];
     $self->header;
@@ -1354,24 +1170,20 @@ sub parse_template {
       $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->{fileid} = time() . '.' . $$ . '.';
       $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})
           or $self->error($self->cleanup . "$self->{tmpfile} : $!");
-        while (<IN>) {
-          $mail->{message} .= $_;
-        }
-
+        $mail->{message} .= $_ while <IN>;
         close(IN);
 
       } else {
@@ -1393,7 +1205,8 @@ sub parse_template {
 
     } else {
 
-      $self->{OUT} = $out;
+      $self->{OUT}      = $out;
+      $self->{OUT_MODE} = $out_mode;
 
       my $numbytes = (-s $self->{tmpfile});
       open(IN, "<", $self->{tmpfile})
@@ -1407,10 +1220,12 @@ sub parse_template {
       #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;
-          seek IN, 0, 0;
+          seek  IN, 0, 0;
 
         } else {
           $self->{attachment_filename} = ($self->{attachment_filename})
@@ -1445,6 +1260,9 @@ sub get_formname_translation {
 
   $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'),
@@ -1462,7 +1280,7 @@ sub get_formname_translation {
   );
 
   $main::lxdebug->leave_sub();
-  return $formname_translations{$formname}
+  return $formname_translations{$formname};
 }
 
 sub get_number_prefix_for_type {
@@ -1498,11 +1316,14 @@ sub generate_attachment_filename {
   $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))) {
-    $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();
@@ -2156,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 $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;
@@ -2336,7 +2157,7 @@ sub _get_taxcharts {
     $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|;
 
@@ -2451,7 +2272,7 @@ sub _get_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};
@@ -2713,7 +2534,7 @@ sub get_name {
   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();
@@ -2725,13 +2546,17 @@ sub all_vc {
 
   $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);
 
-  # build selection list
-  if ($count <= $myconfig->{vclimit}) {
+  if ($count < $myconfig->{vclimit}) {
     $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);
   }
@@ -3061,7 +2886,7 @@ sub create_links {
     if ($self->{"$self->{vc}_id"}) {
 
       # only setup currency
-      ($self->{currency}) = split(/:/, $self->{currencies});
+      ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency};
 
     } else {
 
@@ -3091,12 +2916,14 @@ sub lastname_used {
                     "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"};
+    delete $column_map{"ct.curr"};
 
   } elsif ($self->{type} =~ /_order/) {
     $arap  = 'oe';
@@ -3132,6 +2959,10 @@ sub lastname_used {
 
   # 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();
 }
@@ -3660,8 +3491,8 @@ sub prepare_for_printing {
     $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}";
+  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}";
 
   # Format dates.
@@ -3782,61 +3613,6 @@ Points of interest for a beginner are:
 
 =head1 SPECIAL FUNCTIONS
 
-=head2 C<_store_value()>
-
-parses a complex var name, and stores it in the form.
-
-syntax:
-  $form->_store_value($key, $value);
-
-keys must start with a string, and can contain various tokens.
-supported key structures are:
-
-1. simple access
-  simple key strings work as expected
-
-  id => $form->{id}
-
-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.
-
-  filter.description => $form->{filter}->{description}
-
-3. array+hashref access
-
-  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.
-
-  repeating these names in your template:
-
-    invoice.items[+].id
-    invoice.items[].parts_id
-
-  will result in:
-
-    $form->{invoice}->{items}->[
-      {
-        id       => ...
-        parts_id => ...
-      },
-      {
-        id       => ...
-        parts_id => ...
-      }
-      ...
-    ]
-
-4. arrays
-
-  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.
-
-  filter.status[]  => $form->{status}->[ val1, val2, ... ]
-
 =head2 C<update_business> PARAMS
 
 PARAMS (not named):