view release on metacpan or  search on metacpan

lib/AWS/CLIWrapper.pm  view on Meta::CPAN

        my $exit_value = $self->_run(\%opt, \@cmd);
        my $ret = $self->_handle($service, $operation, $exit_value);

        return $ret unless $Error->{Code};

        if ($retries-- > 0 and $Error->{Message} =~ $error_re) {
            my $delay = $self->catch_error_delay;

            warn "Caught error matching $error_re, sleeping $delay seconds before retrying\n"
                if $ENV{AWSCLI_DEBUG};

            sleep $delay;

            redo RETRY;
        }

        croak $Error->{Message} if $self->{croak_on_error};

        return $ret;
    }
}

sub _run {
    my ($self, $opt, $cmd) = @_;

    my $ret;
    if (exists $opt->{'nofork'} && $opt->{'nofork'}) {
        # better for perl debugger
        my($ok, $err, $buf, $stdout_buf, $stderr_buf) = IPC::Cmd::run(
            command => join(' ', @$cmd),
            timeout => $opt->{timeout} || $self->{timeout},
        );
        $ret->{stdout} = join "", @$stdout_buf;
        $ret->{err_msg} = (defined $err ? "$err\n" : "") . join "", @$stderr_buf;
        if ($ok) {
            $ret->{exit_code} = 0;
            $ret->{timeout} = 0;
        } else {
            $ret->{exit_code} = 2;
            $ret->{timeout} = 1 if defined $err && $err =~ /^IPC::Cmd::TimeOut:/;
        }
        print "";
    } else {
        $ret = IPC::Cmd::run_forked(join(' ', @$cmd), {
            timeout => $opt->{timeout} || $self->{timeout},
        });
    }

    return $ret;
}

sub _handle {
    my ($self, $service, $operation, $ret) = @_;

    if ($ret->{exit_code} == 0 && $ret->{timeout} == 0) {
        my $json = $ret->{stdout};
        warn sprintf("%s.%s[%s]: %s\n",
                     $service, $operation, 'OK', $json,
                    ) if $ENV{AWSCLI_DEBUG};
        local $@;
        my($ret) = eval {
            # aws s3 returns null HTTP body, so failed to parse as JSON

            # Temporary disable __DIE__ handler to prevent the
            # exception from decode() from catching by outer
            # __DIE__ handler.
            local $SIG{__DIE__} = sub {};

            $self->json->decode($json);
        };
        if ($@) {
            if ($ENV{AWSCLI_DEBUG}) {
                warn $@;
                warn qq|stdout: "$ret->{stdout}"|;
                warn qq|err_msg: "$ret->{err_msg}"|;
            }
            return $json || 'success';
        }
        return $ret;
    } else {
        my $stdout_str = $ret->{stdout};
        if ($stdout_str && $stdout_str =~ /^{/) {
            my $json = $stdout_str;
            warn sprintf("%s.%s[%s]: %s\n",
                         $service, $operation, 'NG', $json,
                        ) if $ENV{AWSCLI_DEBUG};
            my($ret) = $self->json->decode_prefix($json);
            if (exists $ret->{Errors} && ref($ret->{Errors}) eq 'ARRAY') {
                $Error = $ret->{Errors}[0];
            } elsif (exists $ret->{Response}{Errors}{Error}) {
                # old structure (maybe botocore < 0.7.0)
                $Error = $ret->{Response}{Errors}{Error};
            } else {
                $Error = { Message => 'Unknown', Code => 'Unknown' };
            }
        } else {
            my $msg = $ret->{err_msg};
            warn sprintf("%s.%s[%s]: %s\n",
                         $service, $operation, 'NG', $msg,
                        ) if $ENV{AWSCLI_DEBUG};
            $Error = { Message => $msg, Code => 'Unknown' };
        }

        return;
    }
}

# aws help | col -b | perl -ne 'if (/^AVAILABLE/.../^[A-Z]/) {  s/^\s+o\s+// or next; chomp; next if $_ eq 'help'; my $sn = $_; $sn =~ s/-/_/g; printf "sub %-18s { shift->_execute('"'"'%s'"'"', \@_) }\n", $sn, $_ }'
# aws help | col -b | perl -ne 'if (/^AVAILABLE/.../^[A-Z]/) {  s/^\s+o\s+// or next; chomp; next if $_ eq 'help'; my $sn = $_; $sn =~ s/-/_/g; printf "=item B<%s>(\$operation:Str, \$param:HashRef, %%opt:Hash)\n\n", $sn}'
# =item B<s3>($operation:Str, $path:ArrayRef, $param:HashRef, %opt:Hash)
sub accessanalyzer     { shift->_execute('accessanalyzer', @_) }
sub account            { shift->_execute('account', @_) }
sub acm                { shift->_execute('acm', @_) }
sub acm_pca            { shift->_execute('acm-pca', @_) }
sub alexaforbusiness   { shift->_execute('alexaforbusiness', @_) }
sub amp                { shift->_execute('amp', @_) }
sub amplify            { shift->_execute('amplify', @_) }
sub amplifybackend     { shift->_execute('amplifybackend', @_) }
sub amplifyuibuilder   { shift->_execute('amplifyuibuilder', @_) }
sub apigateway         { shift->_execute('apigateway', @_) }
sub apigatewaymanagementapi { shift->_execute('apigatewaymanagementapi', @_) }