view release on metacpan or  search on metacpan

lib/App/LWPUtils.pm  view on Meta::CPAN

package App::LWPUtils;

our $DATE = '2019-04-15'; # DATE
our $VERSION = '0.002'; # VERSION

use 5.010001;
use strict;
use warnings;

use Perinci::Sub::Util qw(gen_modified_sub);

our %SPEC;

sub _lwputil_request {
    require HTTP::Request;

    my ($class, %args) = @_;

    (my $class_pm = "$class.pm") =~ s!::!/!g;
    require $class_pm;

    my $res;
    my $method = $args{method} // 'GET';
    for my $i (0 .. $#{ $args{urls} }) {
        my $url = $args{urls}[$i];
        my $is_last_url = $i == $#{ $args{urls} };

        my $req = HTTP::Request->new($method => $url);

        if (defined $args{headers}) {
            for (keys %{ $args{headers} }) {
                $req->header($_ => $args{headers}{$_});
            }
        }
        if (defined $args{content}) {
            $req->content($args{content});
        } elsif (!(-t STDIN)) {
            local $/;
            $req->content(scalar <STDIN>);
        }

        my $res0 = $class->new(%{ $args{attributes} // {} })
            ->request($req);
        my $success = $res0->is_success;

        if ($args{raw}) {
            $res = [200, "OK", $res0->as_string];
        } else {
            $res = [$res0->code, $res0->message, $res0->content];
            print $res0->content unless $is_last_url;
        }

        unless ($success) {
            last unless $args{ignore_errors};
        }
    }
    $res;
}

$SPEC{lwputil_request} = {
    v => 1.1,
    summary => 'Perform request(s) with LWP::UserAgent',
    args => {
        urls => {
            'x.name.is_plural' => 1,
            'x.name.singular' => 'url',
            schema => ['array*', of=>'str*'],
            req => 1,
            pos => 0,
            slurpy => 1,
        },
        method => {
            schema => ['str*', match=>qr/\A[A-Z]+\z/],
            default => 'GET',
            cmdline_aliases => {
                delete => {summary => 'Shortcut for --method DELETE', is_flag=>1, code=>sub { $_[0]{method} = 'DELETE' } },
                get    => {summary => 'Shortcut for --method GET'   , is_flag=>1, code=>sub { $_[0]{method} = 'GET'    } },
                head   => {summary => 'Shortcut for --method HEAD'  , is_flag=>1, code=>sub { $_[0]{method} = 'HEAD'   } },
                post   => {summary => 'Shortcut for --method POST'  , is_flag=>1, code=>sub { $_[0]{method} = 'POST'   } },
                put    => {summary => 'Shortcut for --method PUT'   , is_flag=>1, code=>sub { $_[0]{method} = 'PUT'    } },
            },
        },
        attributes => {
            'x.name.is_plural' => 1,
            'x.name.singular' => 'attribute',
            summary => 'Pass attributes to LWP::UserAgent constructor',
            schema => ['hash*', each_key => 'str*'],
        },