X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=4c630f119503a8649b79285d8c1ced6fe2a2a065;hb=33c1a7f111af21221572871e95a1b77e3e16aa51;hp=8275807d27e740941f197258f0ed50b7b330af9c;hpb=b4b714341153b2d66d5095b3ae7dddbddb95f61d;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 8275807d2..4c630f119 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -38,91 +38,159 @@ package Form; use Data::Dumper; -use Cwd; -use HTML::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 CGI; +use Template; +use List::Util qw(max min sum); + +my $standard_dbh; + +sub DESTROY { + if ($standard_dbh) { + $standard_dbh->disconnect(); + undef $standard_dbh; + } +} + +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 ($i, $loc, $key, $val); - my (%ATTACH, $f, $header, $header_body, $len, $buf); - my ($boundary, @list, $size, $body, $x, $blah, $name); - - if ($ENV{'CONTENT_TYPE'} - && ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/)) { - $boundary = quotemeta('--' . $1); - @list = split(/$boundary/, $input); - - # For some reason there are always 2 extra, that are empty - $size = @list - 2; - - for ($x = 1; $x <= $size; $x++) { - $header_body = $list[$x]; - $header_body =~ /\r\n\r\n|\n\n/; - - # Here we split the header and body - $header = $`; - $body = $'; #' - $body =~ s/\r\n$//; - - # Now we try to get the file name - $name = $header; - $name =~ /name=\"(.+)\"/; - ($name, $blah) = split(/\"/, $1); - - # If the form name is not attach, then we need to parse this like - # regular form data - if ($name ne "attach") { - $body =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg; - $ATTACH{$name} = $body; - - # Otherwise it is an attachment and we need to finish it up - } elsif ($name eq "attach") { - $header =~ /filename=\"(.+)\"/; - $ATTACH{'FILE_NAME'} = $1; - $ATTACH{'FILE_NAME'} =~ s/\"//g; - $ATTACH{'FILE_NAME'} =~ s/\s//g; - $ATTACH{'FILE_CONTENT'} = $body; - - for ($i = $x; $list[$i]; $i++) { - $list[$i] =~ s/^.+name=$//; - $list[$i] =~ /\"(\w+)\"/; - $ATTACH{$1} = $'; #' + 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, ''); + $self->{FILENAME} = $filename if ($filename); + + next; + } + + if ($line =~ m|^content-type\s*:\s*(.*?)$|i) { + $content_type = $1; } + + next; } - $main::lxdebug->leave_sub(2); - return %ATTACH; + next unless $previous; - } else { - $main::lxdebug->leave_sub(2); - return _input_to_hash($input); + ${ $previous } .= "${line}\n"; } + + ${ $previous } =~ s|\r?\n$|| if $previous; + + $main::lxdebug->leave_sub(2); } sub new { @@ -132,6 +200,11 @@ sub new { my $self = {}; + if ($LXDebug::watch_form) { + require SL::Watchdog; + tie %{ $self }, 'SL::Watchdog'; + } + read(STDIN, $_, $ENV{CONTENT_LENGTH}); if ($ENV{QUERY_STRING}) { @@ -142,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.2"; + $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 { @@ -167,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); @@ -222,10 +382,11 @@ sub quote_html { my ($self, $str) = @_; my %replace = - ('order' => ['"', '<', '>'], - '<' => '<', - '>' => '>', - '"' => '"', + ('order' => ['&', '"', '<', '>'], + '<' => '<', + '>' => '>', + '"' => '"', + '&' => '&', ); map({ $str =~ s/$_/$replace{$_}/g; } @{ $replace{"order"} }); @@ -235,6 +396,33 @@ sub quote_html { return $str; } +sub unquote_html { + $main::lxdebug->enter_sub(2); + + my ($self, $str) = @_; + + my %replace = + ('ä' => 'ä', + 'ö' => 'ö', + 'ü' => 'ü', + 'Ä' => 'Ä', + 'Ö' => 'Ö', + 'Ü' => 'Ü', + 'ß' => 'ß', + '>' => '>', + '<' => '<', + '"' => '"', + ); + + map { $str =~ s/\Q$_\E/$replace{$_}/g; } keys %replace; + $str =~ s/\&/\&/g; + + $main::lxdebug->leave_sub(2); + + return $str; +} + + sub hide_form { my $self = shift; @@ -252,6 +440,8 @@ sub hide_form { sub error { $main::lxdebug->enter_sub(); + $main::lxdebug->show_backtrace(); + my ($self, $msg) = @_; if ($ENV{HTTP_USER_AGENT}) { $msg =~ s/\n/
/g; @@ -259,11 +449,7 @@ sub error { } else { - if ($self->{error_function}) { - &{ $self->{error_function} }($msg); - } else { - die "Error: $msg\n"; - } + die "Error: $msg\n"; } $main::lxdebug->leave_sub(); @@ -300,20 +486,20 @@ sub info { $main::lxdebug->leave_sub(); } +# calculates the number of rows in a textarea based on the content and column number +# can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); + my ($self, $str, $cols, $maxrows, $minrows) = @_; - my ($self, $str, $cols, $maxrows) = @_; - - my $rows = 0; + $minrows ||= 1; - map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str; - - $maxrows = $rows unless defined $maxrows; + my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str; + $maxrows ||= $rows; $main::lxdebug->leave_sub(); - return ($rows > $maxrows) ? $maxrows : $rows; + return max(min($rows, $maxrows), $minrows); } sub dberror { @@ -331,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(); } @@ -347,14 +538,28 @@ sub header { return; } - my ($stylesheet, $favicon, $charset); + my $cgi = $main::cgi; + $cgi ||= CGI->new(''); + + my ($stylesheet, $favicon); if ($ENV{HTTP_USER_AGENT}) { + my $doctype; + + if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) { + # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise. + $doctype = qq|\n|; + } + + my $stylesheets = "$self->{stylesheet} $self->{stylesheets}"; + + $stylesheets =~ s|^\s*||; + $stylesheets =~ s|\s*$||; + foreach my $file (split m/\s+/, $stylesheets) { + $file =~ s|.*/||; + next if (! -f "css/$file"); - if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = - qq| - |; + $stylesheet .= qq|\n|; } $self->{favicon} = "favicon.ico" unless $self->{favicon}; @@ -365,11 +570,8 @@ sub header { |; } - if ($self->{charset}) { - $charset = - qq| - |; - } + my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; + if ($self->{landscape}) { $pagelayout = qq|