X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=37c16dcb06f4c51e68c80fab6d7f5d00d1119b5b;hb=dea9aaea2182221d62f88966d9ad8e4f85e3a3d6;hp=a0fa96a2ce6283852b21cd913aa8da349369a22c;hpb=a5f30bf0b12c7e02f545f06215b4b10f01fa12d0;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index a0fa96a2c..37c16dcb0 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -37,82 +37,186 @@
package Form;
+#use strict;
+
+use Data::Dumper;
+
+use CGI;
+use CGI::Ajax;
+use Cwd;
+use IO::File;
+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 Template;
+use List::Util qw(first max min sum);
+
+my $standard_dbh;
+
+END {
+ if ($standard_dbh) {
+ $standard_dbh->disconnect();
+ undef $standard_dbh;
+ }
+}
+
+sub _store_value {
+ $main::lxdebug->enter_sub(2);
+
+ my $curr = shift;
+ my $key = shift;
+ my $value = shift;
+
+ 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();
+ $main::lxdebug->enter_sub(2);
- my $input = $_[0];
- my %in = ();
- my @pairs = split(/&/, $input);
+ my $params = 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);
+ _store_value($params, unescape(undef, $key), unescape(undef, $value));
}
- $main::lxdebug->leave_sub();
-
- return %in;
+ $main::lxdebug->leave_sub(2);
}
sub _request_to_hash {
- $main::lxdebug->enter_sub();
+ $main::lxdebug->enter_sub(2);
+
+ my $params = shift;
+ my $input = shift;
+
+ if (!$ENV{'CONTENT_TYPE'}
+ || ($ENV{'CONTENT_TYPE'} !~ /multipart\/form-data\s*;\s*boundary\s*=\s*(.+)$/)) {
+
+ _input_to_hash($params, $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;
- 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} = $'; #'
+ 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($params, $name, '');
+ $params->{FILENAME} = $filename if ($filename);
+
+ next;
+ }
+
+ if ($line =~ m|^content-type\s*:\s*(.*?)$|i) {
+ $content_type = $1;
}
+
+ next;
}
- $main::lxdebug->leave_sub();
- return %ATTACH;
+ 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 (ref $param eq 'HASH') {
+ foreach my $key (keys %{ $param }) {
+ if (!ref $param->{$key}) {
+ $param->{$key} = $iconv->convert($param->{$key});
} else {
- $main::lxdebug->leave_sub();
- return _input_to_hash($input);
+ _recode_recursively($iconv, $param->{$key});
+ }
+ }
+
+ } elsif (ref $param eq 'ARRAY') {
+ foreach my $idx (0 .. scalar(@{ $param }) - 1) {
+ if (!ref $param->[$idx]) {
+ $param->[$idx] = $iconv->convert($param->[$idx]);
+ } else {
+ _recode_recursively($iconv, $param->[$idx]);
+ }
+ }
}
+ $main::lxdebug->leave_sub();
}
sub new {
@@ -122,6 +226,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}) {
@@ -132,20 +241,101 @@ sub new {
$_ = $ARGV[0];
}
- my %parameters = _request_to_hash($_);
- map({ $self->{$_} = $parameters{$_}; } keys(%parameters));
+ bless $self, $type;
+
+ my $parameters = { };
+ _request_to_hash($parameters, $_);
+
+ my $db_charset = $main::dbcharset;
+ $db_charset ||= Common::DEFAULT_CHARSET;
- $self->{menubar} = 1 if $self->{path} =~ /lynx/i;
+ if ($parameters->{INPUT_ENCODING} && (lc $parameters->{INPUT_ENCODING} ne $db_charset)) {
+ require Text::Iconv;
+ my $iconv = Text::Iconv->new($parameters->{INPUT_ENCODING}, $db_charset);
- $self->{action} = lc $self->{action};
- $self->{action} =~ s/( |-|,|#)/_/g;
+ _recode_recursively($iconv, $parameters);
- $self->{version} = "2.1.2";
- $self->{dbversion} = "2.1.2";
+ delete $parameters{INPUT_ENCODING};
+ }
+
+ map { $self->{$_} = $parameters->{$_}; } keys %{ $parameters };
+
+ $self->{action} = lc $self->{action};
+ $self->{action} =~ s/( |-|,|\#)/_/g;
+
+ $self->{version} = "2.6.0";
$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 {
@@ -160,25 +350,38 @@ sub debug {
$main::lxdebug->leave_sub();
}
-sub escape {
- $main::lxdebug->enter_sub();
+sub dumper {
+ $main::lxdebug->enter_sub(2);
+
+ my $self = shift;
+ my $password = $self->{password};
- my ($self, $str, $beenthere) = @_;
+ $self->{password} = 'X' x 8;
- # for Apache 2 we escape strings twice
- #if (($ENV{SERVER_SOFTWARE} =~ /Apache\/2/) && !$beenthere) {
- # $str = $self->escape($str, 1);
- #}
+ 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);
+
+ my ($self, $str) = @_;
$str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
- $main::lxdebug->leave_sub();
+ $main::lxdebug->leave_sub(2);
return $str;
}
sub unescape {
- $main::lxdebug->enter_sub();
+ $main::lxdebug->enter_sub(2);
my ($self, $str) = @_;
@@ -187,77 +390,65 @@ sub unescape {
$str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
- $main::lxdebug->leave_sub();
+ $main::lxdebug->leave_sub(2);
return $str;
}
sub quote {
+ $main::lxdebug->enter_sub();
my ($self, $str) = @_;
- if ($str && ! ref($str)) {
- $str =~ s/"/"/g;
+ if ($str && !ref($str)) {
+ $str =~ s/\"/"/g;
}
- $str;
+ $main::lxdebug->leave_sub();
+ return $str;
}
-
sub unquote {
+ $main::lxdebug->enter_sub();
my ($self, $str) = @_;
- if ($str && ! ref($str)) {
- $str =~ s/"/"/g;
+ if ($str && !ref($str)) {
+ $str =~ s/"/\"/g;
}
- $str;
+ $main::lxdebug->leave_sub();
+ return $str;
}
-
sub hide_form {
+ $main::lxdebug->enter_sub();
my $self = shift;
if (@_) {
- for (@_) { print qq|\n| }
+ map({ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
} else {
- delete $self->{header};
- for (sort keys %$self) { print qq|\n| }
+ for (sort keys %$self) {
+ next if (($_ eq "header") || (ref($self->{$_}) ne ""));
+ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
+ }
}
-
+ $main::lxdebug->leave_sub();
}
sub error {
$main::lxdebug->enter_sub();
- my ($self, $msg) = @_;
+ $main::lxdebug->show_backtrace();
+ my ($self, $msg) = @_;
if ($ENV{HTTP_USER_AGENT}) {
$msg =~ s/\n/
/g;
-
- $self->header;
-
- print qq|
-
$msg - - -