view release on metacpan or  search on metacpan

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

=item C< --junk-session-cookies >

If you want to keep session cookies between subsequent requests, you need to
provide a cookie jar in your user agent.

=item C<--next>

Resetting the UA between requests is something you need to handle yourself

=item C<--parallel>

=item C<--parallel-immediate>

=item C<--parallel-max>

Parallel requests is something you need to handle in the UA

=back

=cut

our @option_spec = (
    'user-agent|A=s',
    'verbose|v',         # ignored
    'show-error|S',      # ignored
    'fail|f',            # ignored
    'silent|s',          # ignored
    'anyauth',           # ignored
    'basic',
    'buffer!',
    'capath=s',
    # 'cacert=s', # to be added
    'cert|E=s', # this is the client certificate
    'compressed',
    'cookie|b=s',
    'cookie-jar|c=s',
    'data|d=s@',
    'data-ascii=s@',
    'data-binary=s@',
    'data-raw=s@',
    'data-urlencode=s@',
    'digest',
    'disable|q!',        # ignored
    'dump-header|D=s',   # ignored
    'referrer|e=s',
    'form|F=s@',
    'form-string=s@',
    'get|G',
    'globoff|g',
    'head|I',
    'header|H=s@',
    'include|i',         # ignored
    'interface=s',
    'insecure|k',
    'json=s@',
    'location|L',        # ignored, we always follow redirects
    'max-filesize=s',
    'max-time|m=s',
    'ntlm',
    'keepalive!',
    'range=s',
    'request|X=s',
    'oauth2-bearer=s',
    'output|o=s',
    'progress-bar|#',    # ignored
    'user|u=s',
    'next',                      # ignored
    'parallel|Z',                # ignored
    'parallel-immediate',        # ignored
    'parallel-max',              # ignored
    'junk-session-cookies|j',    # ignored, must be set in code using the HTTP request
    'unix-socket=s',
    'url=s@',
);

sub new( $class, %options ) {
    my $cmd = $options{ argv };

    if( $options{ command }) {
        require Text::ParseWords;
        $cmd = [ Text::ParseWords::shellwords($options{ command }) ];

    } elsif( $options{ command_curl }) {
        require Text::ParseWords;
        $cmd = [ Text::ParseWords::shellwords($options{ command_curl }) ];

        # remove the implicit curl command:
        shift @$cmd;
    };

    for (@$cmd) {
        $_ = '--next'
            if $_ eq '-:'; # GetOptions does not like "next|:" as specification
    };

    my $p = Getopt::Long::Parser->new(
        config => [ 'bundling', 'no_auto_abbrev', 'no_ignore_case_always' ],
    );
    $p->getoptionsfromarray( $cmd,
        \my %curl_options,
        @option_spec,
    ) or return;
    my @urls = (@$cmd, @{ $curl_options{ url } || [] });

    return
        wantarray ? map { $class->_build_request( $_, \%curl_options, %options ) } @urls
                  :       ($class->_build_request( $urls[0], \%curl_options, %options ))[0]
                  ;
}

=head1 METHODS

=head2 C<< ->squash_uri( $uri ) >>

    my $uri = HTTP::Request::FromCurl->squash_uri(
        URI->new( 'https://example.com/foo/bar/..' )
    );
    # https://example.com/foo/

Helper method to clean up relative path elements from the URI the same way

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

            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'};
                # 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;