X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/kivitendo-erp.git/blobdiff_plain/91ab1ef646193de9359076a876a33a74d7691145..de998cce754a73341988441034e2649f3ded6c54:/SL/Form.pm

diff --git a/SL/Form.pm b/SL/Form.pm
index f43578bb6..4c630f119 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -38,16 +38,21 @@
 package Form;
 use Data::Dumper;
 
-use Cwd;
-use Template;
-use SL::Template;
+use CGI;
 use CGI::Ajax;
+use Cwd;
+use List::Util qw(min max);
+use SL::Auth;
+use SL::Auth::DB;
+use SL::Auth::LDAP;
+use SL::AM;
+use SL::Common;
 use SL::DBUtils;
 use SL::Mailer;
 use SL::Menu;
+use SL::Template;
 use SL::User;
-use SL::Common;
-use CGI;
+use Template;
 use List::Util qw(max min sum);
 
 my $standard_dbh;
@@ -59,36 +64,71 @@ sub DESTROY {
   }
 }
 
+sub _store_value {
+  $main::lxdebug->enter_sub(2);
+
+  my $self  = shift;
+  my $key   = shift;
+  my $value = shift;
+
+  my $curr  = $self;
+
+  while ($key =~ /\[\+?\]\.|\./) {
+    substr($key, 0, $+[0]) = '';
+
+    if ($& eq '.') {
+      $curr->{$`} ||= { };
+      $curr         = $curr->{$`};
+
+    } else {
+      $curr->{$`} ||= [ ];
+      if (!scalar @{ $curr->{$`} } || $& eq '[+].') {
+        push @{ $curr->{$`} }, { };
+      }
+
+      $curr = $curr->{$`}->[-1];
+    }
+  }
+
+  $curr->{$key} = $value;
+
+  $main::lxdebug->leave_sub(2);
+
+  return \$curr->{$key};
+}
+
 sub _input_to_hash {
   $main::lxdebug->enter_sub(2);
 
-  my $input = $_[0];
-  my %in    = ();
+  my $self  = shift;
+  my $input = shift;
+
   my @pairs = split(/&/, $input);
 
   foreach (@pairs) {
-    my ($name, $value) = split(/=/, $_, 2);
-    $in{$name} = unescape(undef, $value);
+    my ($key, $value) = split(/=/, $_, 2);
+    $self->_store_value($self->unescape($key), $self->unescape($value));
   }
 
   $main::lxdebug->leave_sub(2);
-
-  return %in;
 }
 
 sub _request_to_hash {
   $main::lxdebug->enter_sub(2);
 
-  my ($input) = @_;
+  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 _input_to_hash($input);
+    return;
   }
 
-  my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr);
-  my %params;
+  my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous);
 
   my $boundary = '--' . $1;
 
@@ -96,9 +136,9 @@ sub _request_to_hash {
     last if (($line eq "${boundary}--") || ($line eq "${boundary}--\r"));
 
     if (($line eq $boundary) || ($line eq "$boundary\r")) {
-      $params{$name} =~ s|\r?\n$|| if $name;
+      ${ $previous } =~ s|\r?\n$|| if $previous;
 
-      undef $name;
+      undef $previous;
       undef $filename;
 
       $headers_done   = 0;
@@ -130,8 +170,8 @@ sub _request_to_hash {
           substr $line, $-[0], $+[0] - $-[0], "";
         }
 
-        $params{$name}    = "";
-        $params{FILENAME} = $filename if ($filename);
+        $previous         = $self->_store_value($name, '');
+        $self->{FILENAME} = $filename if ($filename);
 
         next;
       }
@@ -143,15 +183,14 @@ sub _request_to_hash {
       next;
     }
 
-    next unless $name;
+    next unless $previous;
 
-    $params{$name} .= "${line}\n";
+    ${ $previous } .= "${line}\n";
   }
 
-  $params{$name} =~ s|\r?\n$|| if $name;
+  ${ $previous } =~ s|\r?\n$|| if $previous;
 
   $main::lxdebug->leave_sub(2);
-  return %params;
 }
 
 sub new {
@@ -176,17 +215,86 @@ sub new {
     $_ = $ARGV[0];
   }
 
-  my %parameters = _request_to_hash($_);
-  map({ $self->{$_} = $parameters{$_}; } keys(%parameters));
+  bless $self, $type;
+
+  $self->_request_to_hash($_);
 
-  $self->{action} = lc $self->{action};
-  $self->{action} =~ s/( |-|,|\#)/_/g;
+  $self->{action}  =  lc $self->{action};
+  $self->{action}  =~ s/( |-|,|\#)/_/g;
 
-  $self->{version}   = "2.4.3";
+  $self->{version} =  "2.4.3";
 
   $main::lxdebug->leave_sub();
 
-  bless $self, $type;
+  return $self;
+}
+
+sub _flatten_variables_rec {
+  $main::lxdebug->enter_sub(2);
+
+  my $self   = shift;
+  my $curr   = shift;
+  my $prefix = shift;
+  my $key    = shift;
+
+  my @result;
+
+  if ('' eq ref $curr->{$key}) {
+    @result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} });
+
+  } elsif ('HASH' eq ref $curr->{$key}) {
+    foreach my $hash_key (sort keys %{ $curr->{$key} }) {
+      push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key);
+    }
+
+  } else {
+    foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) {
+      my $first_array_entry = 1;
+
+      foreach my $hash_key (sort keys %{ $curr->{$key}->[$idx] }) {
+        push @result, $self->_flatten_variables_rec($curr->{$key}->[$idx], $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key);
+        $first_array_entry = 0;
+      }
+    }
+  }
+
+  $main::lxdebug->leave_sub(2);
+
+  return @result;
+}
+
+sub flatten_variables {
+  $main::lxdebug->enter_sub(2);
+
+  my $self = shift;
+  my @keys = @_;
+
+  my @variables;
+
+  foreach (@keys) {
+    push @variables, $self->_flatten_variables_rec($self, '', $_);
+  }
+
+  $main::lxdebug->leave_sub(2);
+
+  return @variables;
+}
+
+sub flatten_standard_variables {
+  $main::lxdebug->enter_sub(2);
+
+  my $self      = shift;
+  my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_);
+
+  my @variables;
+
+  foreach (grep { ! $skip_keys{$_} } keys %{ $self }) {
+    push @variables, $self->_flatten_variables_rec($self, '', $_);
+  }
+
+  $main::lxdebug->leave_sub(2);
+
+  return @variables;
 }
 
 sub debug {
@@ -201,6 +309,24 @@ sub debug {
   $main::lxdebug->leave_sub();
 }
 
+sub dumper {
+  $main::lxdebug->enter_sub(2);
+
+  my $self          = shift;
+  my $password      = $self->{password};
+
+  $self->{password} = 'X' x 8;
+
+  local $Data::Dumper::Sortkeys = 1;
+  my $output                    = Dumper($self);
+
+  $self->{password} = $password;
+
+  $main::lxdebug->leave_sub(2);
+
+  return $output;
+}
+
 sub escape {
   $main::lxdebug->enter_sub(2);
 
@@ -256,10 +382,11 @@ sub quote_html {
   my ($self, $str) = @_;
 
   my %replace =
-    ('order' => ['"', '<', '>'],
-     '<'             => '&lt;',
-     '>'             => '&gt;',
-     '"'             => '&quot;',
+    ('order' => ['&', '"', '<', '>'],
+     '<'     => '&lt;',
+     '>'     => '&gt;',
+     '"'     => '&quot;',
+     '&'     => '&amp;',
     );
 
   map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} });
@@ -269,6 +396,33 @@ sub quote_html {
   return $str;
 }
 
+sub unquote_html {
+  $main::lxdebug->enter_sub(2);
+
+  my ($self, $str) = @_;
+
+  my %replace  =
+    ('&auml;'  => 'ä',
+     '&ouml;'  => 'ö',
+     '&uuml;'  => 'ü',
+     '&Auml;'  => 'Ä',
+     '&Ouml;'  => 'Ö',
+     '&Uuml;'  => 'Ü',
+     '&szlig;' => 'ß',
+     '&gt;'    => '>',
+     '&lt;'    => '<',
+     '&quot;'  => '"',
+    );
+
+  map { $str =~ s/\Q$_\E/$replace{$_}/g; } keys %replace;
+  $str =~ s/\&amp;/\&/g;
+
+  $main::lxdebug->leave_sub(2);
+
+  return $str;
+}
+
+
 sub hide_form {
   my $self = shift;
 
@@ -336,13 +490,16 @@ sub info {
 # can be capped with maxrows
 sub numtextrows {
   $main::lxdebug->enter_sub();
-  my ($self, $str, $cols, $maxrows) = @_;
+  my ($self, $str, $cols, $maxrows, $minrows) = @_;
+
+  $minrows ||= 1;
 
   my $rows   = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
   $maxrows ||= $rows;
 
   $main::lxdebug->leave_sub();
-  return min $rows, $maxrows;
+
+  return max(min($rows, $maxrows), $minrows);
 }
 
 sub dberror {
@@ -360,9 +517,14 @@ sub isblank {
 
   my ($self, $name, $msg) = @_;
 
-  if ($self->{$name} =~ /^\s*$/) {
-    $self->error($msg);
+  my $curr = $self;
+  foreach my $part (split '.', $name) {
+    if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
+      $self->error($msg);
+    }
+    $curr = $curr->{$part};
   }
+
   $main::lxdebug->leave_sub();
 }
 
@@ -376,6 +538,9 @@ sub header {
     return;
   }
 
+  my $cgi   = $main::cgi;
+  $cgi    ||= CGI->new('');
+
   my ($stylesheet, $favicon);
 
   if ($ENV{HTTP_USER_AGENT}) {
@@ -436,9 +601,32 @@ sub header {
     foreach $item (@ { $self->{AJAX} }) {
       $ajax .= $item->show_javascript();
     }
-    print qq|Content-Type: text/html; charset=${db_charset};
 
-${doctype}<html>
+    my $base_path;
+
+    if ($ENV{HTTP_X_FORWARDED_FOR}) {
+      $base_path =  $ENV{HTTP_REFERER};
+      $base_path =~ s|^.*?://.*?/|/|;
+    } else {
+      $base_path =  $ENV{REQUEST_URI};
+    }
+    $base_path =~ s|[^/]+$||;
+    $base_path =~ s|/$||;
+
+    my $session_cookie;
+    if (defined $main::auth) {
+      my $session_cookie_value   = $main::auth->get_session_id();
+      $session_cookie_value    ||= 'NO_SESSION';
+
+      $session_cookie = $cgi->cookie('-name'  => $main::auth->get_session_cookie_name(),
+                                     '-value' => $session_cookie_value,
+                                     '-path'  => $base_path);
+    }
+
+    print $cgi->header('-type'    => 'text/html',
+                       '-charset' => $db_charset,
+                       '-cookie'  => $session_cookie);
+    print qq|${doctype}<html>
 <head>
   <title>$self->{titlebar}</title>
   $stylesheet
@@ -541,6 +729,12 @@ sub _prepare_html_template {
     map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
   }
 
+  if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) {
+    while (my ($key, $value) = each %{ $main::auth->{RIGHTS}->{$self->{login}} }) {
+      $additional_params->{"AUTH_RIGHTS_" . uc($key)} = $value;
+    }
+  }
+
   $main::lxdebug->leave_sub();
 
   return $file;
@@ -745,7 +939,71 @@ sub format_amount {
   $main::lxdebug->leave_sub(2);
   return $amount;
 }
-#
+
+sub format_amount_units {
+  $main::lxdebug->enter_sub();
+
+  my $self             = shift;
+  my %params           = @_;
+
+  Common::check_params(\%params, qw(amount part_unit));
+
+  my $myconfig         = \%main::myconfig;
+  my $amount           = $params{amount};
+  my $places           = $params{places};
+  my $part_unit_name   = $params{part_unit};
+  my $amount_unit_name = $params{amount_unit};
+  my $conv_units       = $params{conv_units};
+  my $max_places       = $params{max_places};
+
+  AM->retrieve_all_units();
+  my $all_units        = $main::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 (!scalar @{ $conv_units }) {
+    my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
+    $main::lxdebug->leave_sub();
+    return $result;
+  }
+
+  my $part_unit  = $all_units->{$part_unit_name};
+  my $conv_unit  = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;
+
+  $amount       *= $conv_unit->{factor};
+
+  my @values;
+
+  foreach my $unit (@$conv_units) {
+    my $last = $unit->{name} eq $part_unit->{name};
+    if (!$last) {
+      $num     = int($amount / $unit->{factor});
+      $amount -= $num * $unit->{factor};
+    }
+
+    if ($last ? $amount : $num) {
+      push @values, { "unit"   => $unit->{name},
+                      "amount" => $last ? $amount / $unit->{factor} : $num,
+                      "places" => $last ? $places : 0 };
+    }
+
+    last if $last;
+  }
+
+  if (!@values) {
+    push @values, { "unit"   => $part_unit_name,
+                    "amount" => 0,
+                    "places" => 0 };
+  }
+
+  my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;
+
+  $main::lxdebug->leave_sub();
+
+  return $result;
+}
 
 sub format_string {
   $main::lxdebug->enter_sub(2);
@@ -762,6 +1020,8 @@ sub format_string {
   return $input;
 }
 
+#
+
 sub parse_amount {
   $main::lxdebug->enter_sub(2);
 
@@ -845,9 +1105,6 @@ sub parse_template {
   map({ $self->{"employee_${_}"} = $myconfig->{$_}; }
       qw(email tel fax name signature company address businessnumber
          co_ustid taxnumber duns));
-  map({ $self->{"employee_${_}"} =~ s/\\n/\n/g; }
-      qw(company address signature));
-  map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature));
 
   map({ $self->{"${_}"} = $myconfig->{$_}; }
       qw(co_ustid));
@@ -902,14 +1159,15 @@ sub parse_template {
       $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
       $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
       $mail->{fileid} = "$fileid.";
-      $myconfig->{signature} =~ s/\\r\\n/\\n/g;
+      $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\n/<br>\n/g;
-        $myconfig->{signature} =~ s/\\n/<br>\n/g;
+        $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})
@@ -929,9 +1187,8 @@ sub parse_template {
                  $self->{"attachment_filename"} : $self->{"tmpfile"} });
         }
 
-        $mail->{message}       =~ s/\r\n/\n/g;
-        $myconfig->{signature} =~ s/\\n/\n/g;
-        $mail->{message} .= "\n-- \n$myconfig->{signature}";
+        $mail->{message}  =~ s/\r//g;
+        $mail->{message} .=  "\n-- \n$myconfig->{signature}";
 
       }
 
@@ -1017,7 +1274,7 @@ sub get_formname_translation {
 sub generate_attachment_filename {
   my ($self) = @_;
 
-  my $attachment_filename = $self->get_formname_translation();
+  my $attachment_filename = $self->unquote_html($self->get_formname_translation());
   my $prefix = 
       (grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv"
     : ($self->{"type"} =~ /_quotation$/)                       ? "quo"
@@ -1596,8 +1853,6 @@ sub get_salesman {
 
     $self->{salesman_name} = $login
       if ($self->{salesman_name} eq "");
-
-    map({ $self->{"salesman_$_"} =~ s/\\n/\n/g; } qw(address company));
   }
 
   $main::lxdebug->leave_sub();
@@ -1770,7 +2025,7 @@ sub _get_employees {
   my ($self, $dbh, $default_key, $key) = @_;
 
   $key = $default_key unless ($key);
-  $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY name|);
+  $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|);
 
   $main::lxdebug->leave_sub();
 }
@@ -1886,14 +2141,86 @@ sub _get_departments {
   $main::lxdebug->leave_sub();
 }
 
-sub _get_price_factors {
+sub _get_warehouses {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $dbh, $param) = @_;
+
+  my ($key, $bins_key, $q_access, @values);
+
+  if ('' eq ref $param) {
+    $key = $param;
+  } else {
+    $key      = $param->{key};
+    $bins_key = $param->{bins};
+
+    if ($param->{access}) {
+      $q_access =
+        qq| AND EXISTS (
+              SELECT wa.employee_id
+              FROM warehouse_access wa
+              WHERE (wa.employee_id  = (SELECT id FROM employee WHERE login = ?))
+                AND (wa.warehouse_id = w.id)
+                AND (wa.access IN ('ro', 'rw')))|;
+      push @values, $param->{access};
+    }
+
+    if ($param->{no_personal}) {
+      $q_access .= qq| AND (w.personal_warehouse_of IS NULL)|;
+
+    } elsif ($param->{personal}) {
+      $q_access .= qq| AND (w.personal_warehouse_of = ?)|;
+      push @values, conv_i($param->{personal});
+    }
+  }
+
+  my $query = qq|SELECT w.* FROM warehouse w
+                 WHERE (NOT w.invalid) AND
+                   ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
+                   $q_access
+                 ORDER BY w.sortkey|;
+
+  $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
+
+  if ($bins_key) {
+    $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|;
+    my $sth = prepare_query($self, $dbh, $query);
+
+    foreach my $warehouse (@{ $self->{$key} }) {
+      do_statement($self, $sth, $query, $warehouse->{id});
+      $warehouse->{$bins_key} = [];
+
+      while (my $ref = $sth->fetchrow_hashref()) {
+        push @{ $warehouse->{$bins_key} }, $ref;
+      }
+    }
+    $sth->finish();
+  }
+
+  $main::lxdebug->leave_sub();
+}
+
+sub _get_simple {
+  $main::lxdebug->enter_sub();
+
+  my ($self, $dbh, $table, $key, $sortkey) = @_;
+
+  my $query  = qq|SELECT * FROM $table|;
+  $query    .= qq| ORDER BY $sortkey| if ($sortkey);
+
+  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
+
+  $main::lxdebug->leave_sub();
+}
+
+sub _get_groups {
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $key) = @_;
 
-  $key ||= "all_price_factors";
+  $key ||= "all_groups";
 
-  my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|;
+  my $groups = $main::auth->read_groups();
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
@@ -1991,7 +2318,15 @@ sub get_lists {
   }
 
   if ($params{price_factors}) {
-    $self->_get_price_factors($dbh, $params{price_factors});
+    $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
+  }
+
+  if ($params{warehouses}) {
+    $self->_get_warehouses($dbh, $params{warehouses});
+  }
+
+  if ($params{groups}) {
+    $self->_get_groups($dbh, $params{groups});
   }
 
   $main::lxdebug->leave_sub();