view release on metacpan or  search on metacpan

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

snippets from C<curl> examples.

=head3 Options

=over 4

=item B<implicit_headers>

Arrayref of headers that will not be output.

Convenient values are ['Content-Length']

=item B<type>

    type => 'Tiny',

Type of snippet. Valid values are C<LWP> for L<LWP::UserAgent>,
C<Mojolicious> for L<Mojolicious::UserAgent>
and C<Tiny> for L<HTTP::Tiny>.

=back

=cut

sub as_snippet( $self, %options ) {
    my $type = delete $options{ type } || 'LWP';
    if( 'LWP' eq $type ) {
        $self->as_lwp_snippet( %options )
    } elsif( 'Tiny' eq $type ) {
        $self->as_http_tiny_snippet( %options )
    } elsif( 'Mojolicious' eq $type ) {
        $self->as_mojolicious_snippet( %options )
    } else {
        croak "Unknown type '$type'.";
    }
}

sub as_lwp_snippet( $self, %options ) {
    $options{ prefix } ||= '';
    $options{ implicit_headers } ||= [];

    my @preamble;
    my @postamble;
    my %ssl_options;
    push @preamble, @{ $options{ preamble } } if $options{ preamble };
    push @postamble, @{ $options{ postamble } } if $options{ postamble };
    my @setup_ua = ('');

    my $request_args = join ", ",
                                 '$r',
                           $self->_pairlist([
                               maybe ':content_file', $self->output
                           ], '')
                       ;
    my $init_cookie_jar = $self->_init_cookie_jar_lwp();
    if( my $p = $init_cookie_jar->{preamble}) {
        push @preamble, @{$p}
    };

    if( $self->insecure ) {
        push @preamble, 'use IO::Socket::SSL;';
        $ssl_options{ SSL_verify_mode } = \'IO::Socket::SSL::SSL_VERIFY_NONE';
        $ssl_options{ SSL_hostname    } = '';
        $ssl_options{ verify_hostname } = '';
    };

    if( $self->cert ) {
        push @preamble, 'use IO::Socket::SSL;';
        $ssl_options{ SSL_ca_file } = $self->cert;
    };
    if( $self->capath ) {
        push @preamble, 'use IO::Socket::SSL;';
        $ssl_options{ SSL_ca_path } = $self->capath;
    };
    my $constructor_args = join ",",
                           $self->_pairlist([
                                     send_te => 0,
                               maybe local_address => $self->local_address,
                               maybe max_size      => $self->max_filesize,
                               maybe timeout       => $self->timeout,
                               maybe cookie_jar    => $init_cookie_jar->{code},
                               maybe SSL_opts      => keys %ssl_options ? \%ssl_options : undef,
                           ], '')
                           ;
    if( defined( my $credentials = $self->credentials )) {
        my( $user, $pass ) = split /:/, $credentials, 2;
        my $setup_credentials = sprintf qq{\$ua->credentials("%s","%s");},
            quotemeta $user,
            quotemeta $pass;
        push @setup_ua, $setup_credentials;
    };
    if( $self->show_error ) {
        push @postamble,
            '    die $res->message if $res->is_error;',
    } elsif( $self->fail ) {
        push @postamble,
            '    exit 1 if !$res->{success};',
    };

    @setup_ua = ()
        if @setup_ua == 1;

    my $request_constructor;

    if( $self->method ne 'GET' and @{ $self->form_args }) {
        push @preamble, 'use HTTP::Request::Common;';
        push @{$options{ implicit_headers }}, 'Content-Type';
        $request_constructor = <<SNIPPET;
    my \$r = HTTP::Request::Common::@{[$self->method]}(
        '@{[$self->uri]}',
        Content_Type => 'form-data',
        Content => [
            @{[$self->_pairlist($self->form_args, '            ')]}
        ],
@{[$self->_build_lwp_headers('            ', %options)]}
    );
SNIPPET
    } else {
        $request_constructor = <<SNIPPET;
    my \$r = HTTP::Request->new(
        '@{[$self->method]}' => '@{[$self->uri]}',
        [
@{[$self->_build_lwp_headers('            ', %options)]}
        ],
        @{[$self->_build_quoted_body()]}
    );
SNIPPET
    }

    @preamble = map { "$options{prefix}    $_\n" } @preamble;
    @postamble = map { "$options{prefix}    $_\n" } @postamble;
    @setup_ua = map { "$options{prefix}    $_\n" } @setup_ua;

    return <<SNIPPET;
@preamble
    my \$ua = LWP::UserAgent->new($constructor_args);@setup_ua
    $request_constructor
    my \$res = \$ua->request( $request_args );
@postamble
SNIPPET
};

sub as_http_tiny_snippet( $self, %options ) {
    $options{ prefix } ||= '';
    $options{ implicit_headers } ||= [];

    push @{ $options{ implicit_headers }}, 'Host'; # HTTP::Tiny dislikes that header

    my @preamble;
    my @postamble;
    my %ssl_options;
    push @preamble, @{ $options{ preamble } } if $options{ preamble };
    push @postamble, @{ $options{ postamble } } if $options{ postamble };
    my @setup_ua = ('');

    my $request_args = join ", ",
                                 '$r',
                           $self->_pairlist([
                               maybe ':content_file', $self->output
                           ], '')
                       ;
    my $init_cookie_jar = $self->_init_cookie_jar_tiny();
    if( my $p = $init_cookie_jar->{preamble}) {
        push @preamble, @{$p}
    };

    my @ssl;
    if( $self->insecure ) {
    } else {
        push @ssl, verify_SSL => 1;
    };
    if( $self->cert ) {
        push @preamble, 'use IO::Socket::SSL;';
        $ssl_options{ SSL_cert_file } = $self->cert;
    };
    if( $self->show_error ) {
        push @postamble,
            '    die $res->{reason} if !$res->{success};',
    } elsif( $self->fail ) {
        push @postamble,
            '    exit 1 if !$res->{success};',
    };
    my $constructor_args = join ",",
                           $self->_pairlist([
                                     @ssl,
                               maybe timeout       => $self->timeout,
                               maybe local_address => $self->local_address,
                               maybe max_size      => $self->max_filesize,
                               maybe cookie_jar    => $init_cookie_jar->{code},
                               maybe SSL_options   => keys %ssl_options ? \%ssl_options : undef,
                           ], '')
                           ;
    if( defined( my $credentials = $self->credentials )) {
        my( $user, $pass ) = split /:/, $credentials, 2;
        my $setup_credentials = sprintf qq{\$ua->credentials("%s","%s");},
            quotemeta $user,
            quotemeta $pass;
        push @setup_ua, $setup_credentials;
    };

    @setup_ua = ()
        if @setup_ua == 1;

    @preamble = map { "$options{prefix}    $_\n" } @preamble;
    @postamble = map { "$options{prefix}    $_\n" } @postamble;
    @setup_ua = map { "$options{prefix}    $_\n" } @setup_ua;

    my @content = $self->_build_quoted_body();
    if( grep {/\S/} @content ) {
        unshift @content, 'content => ',
    } elsif( @{ $self->form_args }) {
        my $req = HTTP::Request::Common::POST(
            'https://example.com',
            Content_Type => 'form-data',
            Content => $self->form_args,
        );
        @content = ('content => ', $self->_build_quoted_body( $req->content ));
        $self->headers->{ 'Content-Type' } = join "; ", $req->headers->content_type;
    }

    return <<SNIPPET;
@preamble
    my \$ua = HTTP::Tiny->new($constructor_args);@setup_ua
    my \$res = \$ua->request(
        '@{[$self->method]}' => '@{[$self->uri]}',
        {
          headers => {
@{[$self->_build_tiny_headers('            ', %options)]}
          },
          @content
        },
    );
@postamble