create_body.pl

sub _create_body {
    my ($c) = @_;

    my $body = '';
    my $boundary = $c->req->{_body}->can('boundary') ? $c->req->{_body}->boundary : undef;

    if ( defined $boundary && $boundary ne '' ) {
        # multipart/form-data の場合

        # ファイル
        for my $param_name ( keys %{ $c->req->{_body}->upload } ) {
            my $upload = $c->req->{_body}->upload->{$param_name};
            my $value = $c->req->upload($param_name)->slurp;
            $body .= "--$boundary\r\n";
            $body .= 'Content-Disposition: ' . $upload->{headers}->{'Content-Disposition'} . "\r\n";
            $body .= 'Content-Type: ' . $upload->{headers}->{'Content-Type'} . "\r\n";
            $body .= "\r\n";
            $body .= "$value\r\n";
        }

        # パラメータ
        for my $param_name ( keys %{ $c->req->body_parameters } ) {
            # チェックボックスなど配列指定のパラメータの場合があるので配列扱い
            my @values = ref $c->req->body_parameters->{$param_name} eq 'ARRAY' ? @{ $c->req->body_parameters->{$param_name} }
                                                                                : ( $c->req->body_parameters->{$param_name} );
            for my $value ( @values ) {
                $body .= "--$boundary\r\n";
                $body .= "Content-Disposition: form-data; name=\"$param_name\"\r\n";
                $body .= "\r\n";
                $body .= "$value\r\n";
            }
        }
        $body .= "--$boundary--\r\n";
    }
    else {
        # シンプルなPOSTの場合
        my $uri_for_body = URI->new();
        $uri_for_body->query_form( $c->req->body_parameters );
        ($body = $uri_for_body->as_string) =~ s{\A\?}{};
    }
    return $body;
}