view release on metacpan or  search on metacpan

lib/HTTP/Request/FromCurl.pm  view on Meta::CPAN

        if( @form_args) {
            $method //= 'POST';

            #my $req = HTTP::Request::Common::POST(
            #    'https://example.com',
            #    Content_Type => 'form-data',
            #    Content => \@form_args,
            #);
            #$body = $req->content;
            #$request_default_headers{ 'Content-Type' } = join "; ", $req->headers->content_type;

        } elsif( $options->{ get }) {
            $method = 'GET';
            # Also, append the POST data to the URL
            if( $data ) {
                my $q = $uri->query;
                if( defined $q and length $q ) {
                    $q .= "&";
                } else {
                    $q = "";
                };
                $q .= $data;
                $uri->query( $q );
            };

        } elsif( $options->{ head }) {
            $method = 'HEAD';

        } elsif( defined $data ) {
            $method //= 'POST';
            $body = $data;

            if( @post_json_data ) {
                $request_default_headers{ 'Content-Type' } = "application/json";
                $request_default_headers{ 'Accept' } = "application/json";

             } else {
                $request_default_headers{ 'Content-Type' } = 'application/x-www-form-urlencoded';
            };

        } else {
            $method ||= 'GET';
        };

        if( defined $body ) {
            $request_default_headers{ 'Content-Length' } = length $body;
        };

        if( $options->{ 'oauth2-bearer' } ) {
            push @headers, sprintf 'Authorization: Bearer %s', $options->{'oauth2-bearer'};
        };

        if( $options->{ 'user' } ) {
            if(    $options->{anyauth}
                || $options->{digest}
                || $options->{ntlm}
                || $options->{negotiate}
                ) {
                # Nothing to do here, just let LWP::UserAgent do its thing
                # This means one additional request to fetch the appropriate
                # 401 response asking for credentials, but ...
            } else {
                # $options->{basic} or none at all
                my $info = delete $options->{'user'};
                if( $info !~ /:/ ) {
                    # No password given, so append it
                    $info .= ':';
                };

                # We need to bake this into the header here?!
                push @headers, sprintf 'Authorization: Basic %s', encode_base64( $info );
            }
        };

        my %headers;
        for my $kv (
            (map { /^\s*([^:\s]+)\s*:\s*(.*)$/ ? [$1 => $2] : () } @headers),) {
                $self->_add_header( \%headers, @$kv );
        };

        if( defined $options->{ 'user-agent' }) {
            $self->_add_header( \%headers, "User-Agent", $options->{ 'user-agent' } );
        };

        if( defined $options->{ referrer }) {
            $self->_add_header( \%headers, "Referer" => $options->{ 'referrer' } );
        };

        if( defined $options->{ range }) {
            $self->_add_header( \%headers, "Range" => $options->{ 'range' } );
        };

        # We want to compare the headers case-insensitively
        my %headers_lc = map { lc $_ => 1 } keys %headers;

        for my $k (keys %request_default_headers) {
            if( ! $headers_lc{ lc $k }) {
                $self->_add_header( \%headers, $k, $request_default_headers{ $k });
            };
        };
        if( ! $headers{ 'Host' }) {
            $self->_add_header( \%headers, 'Host' => $host );
        };

        if( defined $options->{ 'cookie-jar' }) {
                $options->{'cookie-jar-options'}->{ 'write' } = 1;
        };

        if( defined( my $c = $options->{ cookie })) {
            if( $c =~ /=/ ) {
                $headers{ Cookie } = $options->{ 'cookie' };
            } else {
                $options->{'cookie-jar'} = $c;
                $options->{'cookie-jar-options'}->{ 'read' } = 1;
            };
        };

        # Curl 7.61.0 ignores these:
        #if( $options->{ keepalive }) {
        #    $headers{ 'Keep-Alive' } = 1;
        #} elsif( exists $options->{ keepalive }) {
        #    $headers{ 'Keep-Alive' } = 0;
        #};

        if( $options->{ compressed }) {
            my $compressions = HTTP::Message::decodable();
            $self->_add_header( \%headers, 'Accept-Encoding' => $compressions );
        };

        my $auth;
        for my $kind (qw(basic ntlm negotiate)) {
            if( $options->{$kind}) {
                $auth = $kind;
            }
        };

        push @res, HTTP::Request::CurlParameters->new({
                  method => $method,
                  uri    => $uri,
                  headers => \%headers,
                  body   => $body,
            maybe auth => $auth,
            maybe cert => $options->{cert},
            maybe capath => $options->{capath},
            maybe credentials => $options->{ user },
            maybe output => $options->{ output },
            maybe timeout => $options->{ 'max-time' },
            maybe cookie_jar => $options->{'cookie-jar'},
            maybe cookie_jar_options => $options->{'cookie-jar-options'},
            maybe insecure => $options->{'insecure'},
            maybe max_filesize => $options->{'max-filesize'},
            maybe show_error => $options->{'show-error'},
            maybe fail => $options->{'fail'},
            maybe unix_socket => $options->{'unix-socket'},
            maybe local_address => $options->{'interface'},
            maybe form_args => scalar @form_args ? \@form_args : undef,
        });
    }

    return @res
};

1;

=head1 LIVE DEMO

L<https://corion.net/curl2lwp.psgi>

=head1 KNOWN DIFFERENCES

=head2 Incompatible cookie jar formats

Until somebody writes a robust Netscape cookie file parser and proper loading
and storage for L<HTTP::CookieJar>, this module will not be able to load and
save files in the format that Curl uses.

=head2 Loading/saving cookie jars is the job of the UA

You're expected to instruct your UA to load/save cookie jars:

    use Path::Tiny;
    use HTTP::CookieJar::LWP;

    if( my $cookies = $r->cookie_jar ) {
        $ua->cookie_jar( HTTP::CookieJar::LWP->new()->load_cookies(
            path($cookies)->lines
        ));
    };

=head2 Different Content-Length for POST requests

=head2 Different delimiter for form data

The delimiter is built by L<HTTP::Message>, and C<curl> uses a different
mechanism to come up with a unique data delimiter. This results in differences
in the raw body content and the C<Content-Length> header.

=head1 MISSING FUNCTIONALITY

=over 4

=item *

File uploads / content from files