X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=7636b16595b6ed42ca5efb4a4ec3191ec59602a3;hb=bb374138781bbf3a368d104445aee887494aa381;hp=5c2b5737916ad1224feb5a24f719afdb4435b26a;hpb=4dbb09950c9f5596646537c12d991c99086fe7c1;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index 5c2b57379..7636b1659 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -1,4 +1,4 @@
-#=====================================================================
+#====================================================================
# LX-Office ERP
# Copyright (C) 2004
# Based on SQL-Ledger Version 2.1.9
@@ -36,55 +36,69 @@
#======================================================================
package Form;
+use Data::Dumper;
+
+use Cwd;
+use HTML::Template;
+use SL::Template;
+use CGI::Ajax;
+use SL::DBUtils;
+use SL::Menu;
+use CGI;
sub _input_to_hash {
- $main::lxdebug->enter_sub();
+ $main::lxdebug->enter_sub(2);
my $input = $_[0];
- my %in = ();
+ my %in = ();
my @pairs = split(/&/, $input);
foreach (@pairs) {
- my ($name, $value) = split(/=/,$_,2);
+ my ($name, $value) = split(/=/, $_, 2);
$in{$name} = unescape(undef, $value);
}
- $main::lxdebug->leave_sub();
+ $main::lxdebug->leave_sub(2);
return %in;
}
sub _request_to_hash {
- $main::lxdebug->enter_sub();
+ $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);
+ 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=(.+)$/)) {
+ if ($ENV{'CONTENT_TYPE'}
+ && ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/)) {
$boundary = quotemeta('--' . $1);
- @list = split(/$boundary/, $input);
+ @list = split(/$boundary/, $input);
+
# For some reason there are always 2 extra, that are empty
- $size = @list -2 ;
+ $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 = $'; #'
$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=\"(.+)\"/;
@@ -93,19 +107,19 @@ sub _request_to_hash {
$ATTACH{'FILE_NAME'} =~ s/\s//g;
$ATTACH{'FILE_CONTENT'} = $body;
- for($i = $x; $list[$i]; $i++) {
+ for ($i = $x; $list[$i]; $i++) {
$list[$i] =~ s/^.+name=$//;
$list[$i] =~ /\"(\w+)\"/;
- $ATTACH{$1} = $'; #'
+ $ATTACH{$1} = $'; #'
}
}
}
- $main::lxdebug->leave_sub();
+ $main::lxdebug->leave_sub(2);
return %ATTACH;
- } else {
- $main::lxdebug->leave_sub();
+ } else {
+ $main::lxdebug->leave_sub(2);
return _input_to_hash($input);
}
}
@@ -130,20 +144,16 @@ sub new {
my %parameters = _request_to_hash($_);
map({ $self->{$_} = $parameters{$_}; } keys(%parameters));
- $self->{menubar} = 1 if $self->{path} =~ /lynx/i;
-
$self->{action} = lc $self->{action};
- $self->{action} =~ s/( |-|,|#)/_/g;
+ $self->{action} =~ s/( |-|,|\#)/_/g;
- $self->{version} = "2.1.2";
- $self->{dbversion} = "2.1.2";
+ $self->{version} = "2.4.2";
$main::lxdebug->leave_sub();
bless $self, $type;
}
-
sub debug {
$main::lxdebug->enter_sub();
@@ -156,9 +166,8 @@ sub debug {
$main::lxdebug->leave_sub();
}
-
sub escape {
- $main::lxdebug->enter_sub();
+ $main::lxdebug->enter_sub(2);
my ($self, $str, $beenthere) = @_;
@@ -169,14 +178,13 @@ sub escape {
$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) = @_;
@@ -185,34 +193,79 @@ 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 {
+ my ($self, $str) = @_;
-sub error {
- $main::lxdebug->enter_sub();
+ if ($str && !ref($str)) {
+ $str =~ s/\"/"/g;
+ }
- my ($self, $msg) = @_;
+ $str;
- if ($ENV{HTTP_USER_AGENT}) {
- $msg =~ s/\n/
/g;
+}
- $self->header;
+sub unquote {
+ my ($self, $str) = @_;
- print qq|
-
$msg +} - -