From 6e0f42ed77bb2554d8c062abb6450fdabe658be0 Mon Sep 17 00:00:00 2001
From: Julian Maurice <julian.maurice@biblibre.com>
Date: Wed, 31 Oct 2018 10:44:12 +0100
Subject: [PATCH] Bug 20582: Handle multipart content-type
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Mojo::Message::Request's body attribute does not contain anything when
the content-type is multipart/*
We have to rebuild the multipart body for CGI scripts

Test plan:
1. Go to Tools » Upload and try to upload a file
---
 Koha/App/Plugin/CGIBinKoha.pm | 32 ++++++++++++++++++++++++++++++--
 1 file changed, 30 insertions(+), 2 deletions(-)

diff --git a/Koha/App/Plugin/CGIBinKoha.pm b/Koha/App/Plugin/CGIBinKoha.pm
index 05e89457c2..06c8f07e10 100644
--- a/Koha/App/Plugin/CGIBinKoha.pm
+++ b/Koha/App/Plugin/CGIBinKoha.pm
@@ -56,10 +56,9 @@ sub _psgi_env {
 
     my $env = $c->req->env;
 
-    my $body = $c->req->body;
     $env = {
         %$env,
-        'psgi.input' => IO::Scalar->new(\$body),
+        'psgi.input' => $self->_psgi_input($c),
         'psgi.errors' => *STDERR,
         REQUEST_METHOD => $c->req->method,
         QUERY_STRING => $c->req->url->query->to_string,
@@ -81,4 +80,33 @@ sub _psgi_env {
     return $env;
 }
 
+sub _psgi_input {
+    my ($self, $c) = @_;
+
+    my $body;
+
+    my $content = $c->req->content;
+
+    if ($content->is_multipart) {
+        # Rebuild the multipart content
+        $body = '';
+        my $boundary = $content->boundary;
+        my $CRLF = "\r\n";
+        for my $part (@{ $content->parts }) {
+            $body .= "$CRLF--$boundary$CRLF";
+            for my $name (@{ $part->headers->names }) {
+                my $value = $part->headers->header($name);
+                $body .= "$name: $value$CRLF";
+            }
+            $body .= $CRLF;
+            $body .= $part->asset->slurp;
+        }
+        $body .= "$CRLF--$boundary--$CRLF";
+    } else {
+        $body = $c->req->body;
+    }
+
+    return IO::Scalar->new(\$body);
+}
+
 1;
-- 
2.17.1