File Coverage

blib/lib/HTTP/Request/AsCurl.pm

Criterion	Covered	Total	%
statement	50	52	96.1
branch	7	10	70.0
condition	2	5	40.0
subroutine	9	10	90.0
pod	1	1	100.0
total	69	78	88.4

package HTTP::Request::AsCurl;
use 5.008005;
use strict;
use warnings;

our $VERSION = "0.03";

use Carp;
use String::ShellQuote qw/ shell_quote /;
use Win32::ShellQuote qw/ cmd_escape /;
use Exporter::Shiny qw/ as_curl /;

sub as_curl {
    my ($request, %params) = @_;

    my $content = $request->content;
    my @data    = split '&', $content;
    my $method  = $request->method;
    my $uri     = $request->uri;
    my $headers = $request->headers;
    my $user    = $headers->authorization_basic;
    my @h       = grep { $_ !~ /(authorization|content-length|content-type)/i }
        $headers->header_field_names;

    my @cmd = (["curl"]);
    push(@cmd, ["--request", $method, $uri]);
    push(@cmd, ["--dump-header", "-"]);
    push(@cmd, ["--user",   $user]) if $user;
    push(@cmd, ["--header", "$_: " . $headers->header($_)]) for sort @h;
    push(@cmd, ["--data", $_]) for sort @data;

    return map { @$_ } @cmd unless keys %params;

    return _make_it_pretty(\@cmd, %params);
}

sub _make_it_pretty {
    my ($cmd, %params) = @_;

    $params{shell}   = $params{shell}   || _default_shell_escape();
    $params{newline} = $params{newline} || "\n";

    my $string;
    for my $part (@$cmd) {
        if ($params{shell} eq 'win32') {
            $string .= cmd_escape join " ", @$part;
            $string .= ' ^' . $params{newline};
        }
        elsif ($params{shell} eq 'bourne') {
            $string .= shell_quote @$part;
            $string .= ' \\' . $params{newline};
        }
        else {
            croak "this shell is not currently supported: $params{shell}";
        }

    }

    return $string;
}

sub _default_shell_escape { $^O eq 'MSWin32' ? 'win32' : 'bourne' }


1;
__END__