Merge branch 'master' of vc.linet-services.de:public/lx-office-erp

[mfinanz.git] / SL / Request.pm

diff --git a/SL/Request.pm b/SL/Request.pm
index 57b72979842b29ff7105ebc39f16aab9f321c3fb..3b8262f2c26500adc3b29d66d993ef92b9fea83f 100644 (file)
--- a/SL/Request.pm
+++ b/SL/Request.pm
@@ -51,7 +51,7 @@ sub _input_to_hash {
 
 sub _parse_multipart_formdata {
   my ($target, $temp_target, $input) = @_;
 
 sub _parse_multipart_formdata {
   my ($target, $temp_target, $input) = @_;

-  my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous, $encoding, $transfer_encoding);
+  my ($name, $filename, $headers_done, $content_type, $boundary_found, $need_cr, $previous, $p_attachment, $encoding, $transfer_encoding);

 
   # We SHOULD honor encodings and transfer-encodings here, but as hard as I
   # looked I couldn't find a reasonably recent webbrowser that makes use of
 
   # We SHOULD honor encodings and transfer-encodings here, but as hard as I
   # looked I couldn't find a reasonably recent webbrowser that makes use of


@@ -103,14 +103,38 @@ sub _parse_multipart_formdata {
           substr $line, $-[0], $+[0] - $-[0], "";
         }
 
           substr $line, $-[0], $+[0] - $-[0], "";
         }
 

-        $previous                = _store_value($filename ? $target : $temp_target, $name, '') if ($name);
-        $temp_target->{FILENAME} = $filename if ($filename);
+        if ($name) {
+          # legacy, some old upload routines expect this to be here
+          $temp_target->{FILENAME} = $filename if defined $filename;
+
+          # name can potentially be both a normal variable or a file upload
+          # a file upload can be identified by its "filename" attribute
+          # the thing is, if a [+] clause vivifies atructur in one of the
+          # branches it must be done in both, or subsequent "[]" will fail
+          my $temp_target_slot = _store_value($temp_target, $name);
+          my $target_slot      = _store_value($target,      $name);
+
+          # set the reference for appending of multiline data to the correct one
+          $previous            = defined $filename ? $target_slot : $temp_target_slot;
+
+          # for multiple uploads: save the attachments in a SL/Mailer like structure
+          if (defined $filename) {
+            my $target_attachment      = _store_value($target,      "ATTACHMENTS.$name", {});
+            my $temp_target_attachment = _store_value($temp_target, "ATTACHMENTS.$name", {});
+
+            $$target_attachment->{data}          = $previous;
+            $$temp_target_attachment->{filename} = $filename;
+
+            $p_attachment = $$temp_target_attachment;
+          }
+        }

 
         next;
       }
 
       if ($line =~ m|^content-type\s*:\s*(.*?)[;\$]|i) {
         $content_type = $1;
 
         next;
       }
 
       if ($line =~ m|^content-type\s*:\s*(.*?)[;\$]|i) {
         $content_type = $1;

+        $p_attachment->{content_type} = $1;

 
         if ($content_type =~ /^text/ && $line =~ m|;\s*charset\s*:\s*("?)(.*?)\1$|i) {
           $encoding = $2;
 
         if ($content_type =~ /^text/ && $line =~ m|;\s*charset\s*:\s*("?)(.*?)\1$|i) {
           $encoding = $2;


@@ -124,6 +148,7 @@ sub _parse_multipart_formdata {
         if ($transfer_encoding  && $transfer_encoding !~ /^[78]bit|binary$/) {
           die 'Transfer encodings beyond 7bit/8bit and binary are not implemented.';
         }
         if ($transfer_encoding  && $transfer_encoding !~ /^[78]bit|binary$/) {
           die 'Transfer encodings beyond 7bit/8bit and binary are not implemented.';
         }

+        $p_attachment->{transfer_encoding} = $transfer_encoding;

 
         next;
       }
 
         next;
       }


@@ -151,7 +176,7 @@ sub _recode_recursively {
         # Workaround for a bug: converting $from->{$key} directly
         # leads to 'undef'. I don't know why. Converting a copy works,
         # though.
         # Workaround for a bug: converting $from->{$key} directly
         # leads to 'undef'. I don't know why. Converting a copy works,
         # though.

-        $to->{$key} = $iconv->convert("" . $from->{$key});
+        $to->{$key} = $iconv->convert("" . $from->{$key}) if defined $from->{$key} && !defined $to->{$key};

       } else {
         $to->{$key} ||= {} if 'HASH'  eq ref $from->{$key};
         $to->{$key} ||= [] if 'ARRAY' eq ref $from->{$key};
       } else {
         $to->{$key} ||= {} if 'HASH'  eq ref $from->{$key};
         $to->{$key} ||= [] if 'ARRAY' eq ref $from->{$key};


@@ -165,7 +190,7 @@ sub _recode_recursively {
         # Workaround for a bug: converting $from->[$idx] directly
         # leads to 'undef'. I don't know why. Converting a copy works,
         # though.
         # Workaround for a bug: converting $from->[$idx] directly
         # leads to 'undef'. I don't know why. Converting a copy works,
         # though.

-        $from->[$idx] = $iconv->convert("" . $from->[$idx]);
+        $to->[$idx] = $iconv->convert("" . $from->[$idx]);

       } else {
         $to->[$idx] ||= {} if 'HASH'  eq ref $from->[$idx];
         $to->[$idx] ||= [] if 'ARRAY' eq ref $from->[$idx];
       } else {
         $to->[$idx] ||= {} if 'HASH'  eq ref $from->[$idx];
         $to->[$idx] ||= [] if 'ARRAY' eq ref $from->[$idx];


@@ -199,9 +224,6 @@ sub read_cgi_input {
   if ($ENV{CONTENT_LENGTH}) {
     my $content;
     read STDIN, $content, $ENV{CONTENT_LENGTH};
   if ($ENV{CONTENT_LENGTH}) {
     my $content;
     read STDIN, $content, $ENV{CONTENT_LENGTH};

-    open my $fh, '>:raw', '/tmp/blubb.bin' or die;
-    print $fh $content;
-    close $fh;

     if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
       # multipart formdata can bring it's own encoding, so give it both
       # and let ti decide on it's own
     if ($ENV{'CONTENT_TYPE'} && $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
       # multipart formdata can bring it's own encoding, so give it both
       # and let ti decide on it's own


@@ -212,18 +234,16 @@ sub read_cgi_input {
     }
   }
 
     }
   }
 

+  my $encoding     = delete $temp_target->{INPUT_ENCODING} || $db_charset;
+
+  _recode_recursively(SL::Iconv->new($encoding, $db_charset), $temp_target => $target) if keys %$target;
+

   if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
     my %temp_form;
     $::auth->restore_form_from_session(delete $target->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
     _store_value($target, $_, $temp_form{$_}) for keys %temp_form;
   }
 
   if ($target->{RESTORE_FORM_FROM_SESSION_ID}) {
     my %temp_form;
     $::auth->restore_form_from_session(delete $target->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
     _store_value($target, $_, $temp_form{$_}) for keys %temp_form;
   }
 

-  my $encoding     = delete $temp_target->{INPUT_ENCODING} || $db_charset;
-
-  _recode_recursively(SL::Iconv->new($encoding, $db_charset), $temp_target => $target) if keys %$target;
-
-  map { $target->{$_} = $temp_target->{$_} } keys %{ $temp_target };
-

   $::lxdebug->leave_sub;
 
   return $target;
   $::lxdebug->leave_sub;
 
   return $target;