File Coverage

blib/lib/HTTP/Tiny/Multipart.pm

Criterion	Covered	Total	%
statement	75	75	100.0
branch	21	26	80.7
condition	6	12	50.0
subroutine	10	10	100.0
pod			n/a
total	112	123	91.0

package HTTP::Tiny::Multipart;

# ABSTRACT: Add post_multipart to HTTP::Tiny

use strict;
use warnings;

use HTTP::Tiny;
use File::Basename;
use Carp;
use MIME::Base64;

our $VERSION = 0.08;

sub _get_boundary {
    my ($headers, $content) = @_;

    # Generate and check boundary
    my $boundary;
    my $size = 1;

    while (1) {
        $boundary = encode_base64 join('', map chr(rand 256), 1 .. $size++ * 3);
        $boundary =~ s/\W/X/g;
        last unless grep{ $_ =~ m{$boundary} }@{$content};
    }

    # Add boundary to Content-Type header
    my $before = 'multipart/form-data';
    my $after  = '';
    if( defined $headers->{'content-type'} ) {
        if( $headers->{'content-type'} =~ m!^(.*multipart/[^;]+)(.*)$! ) {
            $before = $1;
            $after  = $2;
        }
    }

    $headers->{'content-type'} = "$before; boundary=$boundary$after";

    return "--$boundary\x0d\x0a";
}

sub _build_content {
    my ($data) = @_;

    my @params = ref $data eq 'HASH' ? %$data : @$data;
    @params % 2 == 0
        or Carp::croak("form data reference must have an even number of terms\n");

    my @terms;
    while( @params ) {
        my ($key, $value) = splice(@params, 0, 2);
        if ( ref $value eq 'ARRAY' ) {
            unshift @params, map { $key => $_ } @$value;
        }
        else {
            my $filename     = '';
            my $content      = $value;
            my $content_type = '';

            if ( ref $value and ref $value eq 'HASH' ) {
                if ( $value->{content} ) {
                    $content = $value->{content};
                }

                if ( $value->{filename} ) {
                    $filename = $value->{filename};
                }
                else {
                    $filename = $key;
                }

                $filename = '; filename="' . basename( $filename ) . '"';

                if ( $value->{content_type} ) {
                    $content_type = "\x0d\x0aContent-Type: " . $value->{content_type};
                }
            }

            push @terms, sprintf "Content-Disposition: form-data; name=\"%s\"%s%s\x0d\x0a\x0d\x0a%s\x0d\x0a",
                $key,
                $filename,
                $content_type,
                $content;
        }
    }

    return \@terms;
}

no warnings 'redefine';

*HTTP::Tiny::post_multipart = sub {
    my ($self, $url, $data, $args) = @_;

    local $Carp::Internal{ 'HTTP::Tiny::Multipart' } = 1;

    (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
        or Carp::croak(q/Usage: $http->post_multipart(URL, DATAREF, [HASHREF])/ . "\n");

    (ref $data eq 'HASH' || ref $data eq 'ARRAY')
        or Carp::croak("form data must be a hash or array reference\n");

    my $headers = {};
    while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
        $headers->{lc $key} = $value;
    }

    my $content_parts = _build_content($data);
    my $boundary      = _get_boundary($headers, $content_parts);

    my $last_boundary = $boundary;
    substr $last_boundary, -2, 0, "--";

    return $self->request('POST', $url, {
            %$args,
            content => $boundary . join( $boundary, @{$content_parts}) . $last_boundary,
            headers => $headers,
        }
    );
};

1;

__END__