view release on metacpan or  search on metacpan

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

}

sub catch_error_min_delay {
    my ($self) = @_;

    my $min_delay = defined $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MIN_DELAY}
        ? $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MIN_DELAY}
        : defined $self->{param}->{catch_error_min_delay}
            ? $self->{param}->{catch_error_min_delay}
            : $DEFAULT_CATCH_ERROR_MIN_DELAY;
    
    $min_delay = $DEFAULT_CATCH_ERROR_MIN_DELAY if $min_delay < 0;

    return $min_delay;
}

sub catch_error_max_delay {
    my ($self) = @_;

    my $min_delay = $self->catch_error_min_delay;

    my $max_delay = defined $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MAX_DELAY}
        ? $ENV{AWS_CLIWRAPPER_CATCH_ERROR_MAX_DELAY}
        : defined $self->{param}->{catch_error_max_delay}
            ? $self->{param}->{catch_error_max_delay}
            : $DEFAULT_CATCH_ERROR_MAX_DELAY;
    
    $max_delay = $DEFAULT_CATCH_ERROR_MAX_DELAY if $max_delay < 0;

    $max_delay = $min_delay if $min_delay > $max_delay;

    return $max_delay;
}

sub catch_error_delay {
    my ($self) = @_;

    my $min = $self->catch_error_min_delay;
    my $max = $self->catch_error_max_delay;

    return $min == $max ? $min : $min + (int rand $max - $min);
}

sub param2opt {
    my($k, $v) = @_;

    my @v;

    $k =~ s/_/-/g;
    $k = '--'.$k;

    my $type = ref $v;
    if (! $type) {
        if ($k eq '--output-file') {
            # aws s3api get-object takes a single arg for output file path
            return $v;
        } else {
            push @v, $v;
        }
    } elsif ($type eq 'ARRAY') {
        push @v, map { ref($_) ? encode_json(_compat_kv($_)) : $_ } @$v;
    } elsif ($type eq 'HASH') {
        push @v, encode_json(_compat_kv($v));
    } elsif ($type eq 'AWS::CLIWrapper::Boolean') {
        if ($$v == 1) {
            return ($k);
        } else {
            return ();
        }
    } else {
        push @v, $v;
    }

    return ($k, @v);
}

# >= 0.14.0 : Key, Values, Value, Name
# <  0.14.0 : key, values, value, name
sub _compat_kv_uc {
    my $v = shift;
    my $type = ref $v;

    if ($type && $type eq 'HASH') {
        for my $hk (keys %$v) {
            if ($hk =~ /^(?:key|name|values|value)$/) {
                $v->{ucfirst($hk)} = delete $v->{$hk};
            }
        }
    }

    return $v;
}
# sub _compat_kv_lc {
#     my $v = shift;
#     my $type = ref $v;

#     if ($type && $type eq 'HASH') {
#         for my $hk (keys %$v) {
#             if ($hk =~ /^(?:Key|Name|Values|Values)$/) {
#                 $v->{lc($hk)} = delete $v->{$hk};
#             }
#         }
#     }

#     return $v;
# }
# Drop support < 0.14.0 for preventing execute aws command in loading this module
*_compat_kv = *_compat_kv_uc;

sub json { $_[0]->{json} }

sub _execute {
    my $self    = shift;
    my $service = shift;
    my $operation = shift;
    my @cmd = ($self->awscli_path, @{$self->{opt}}, $service, $operation);
    if ($service eq 'ec2' && $operation eq 'wait') {
        push(@cmd, shift @_);
    }
    if (ref($_[0]) eq 'ARRAY') {
        # for s3 sync FROM TO
        push @cmd, @{ shift @_ };
    }
    my($param, %opt) = @_;

    if ($service eq 'ec2' && $operation eq 'run-instances') {
        # compat: ec2 run-instances
        # >= 0.14.0 : --count N or --count MIN:MAX
        # <  0.14.0 : --min-count N and --max-count N
        if ($self->awscli_version >= 0.14.0) {
            my($min,$max) = (1,1);
            for my $hk (keys %$param) {
                if ($hk eq 'min_count') {
                    $min = delete $param->{min_count};
                } elsif ($hk eq 'max_count') {
                    $max = delete $param->{max_count};
                }
            }
            $param->{count} = "${min}:${max}" unless $param->{count}
        } else {
            my($min,$max);
            for my $hk (keys %$param) {
                if ($hk eq 'count') {
                    ($min,$max) = split /:/, delete($param->{count});
                    $max ||= $min;
                    last;
                }
            }
            $param->{min_count} = $min unless $param->{min_count};
            $param->{max_count} = $max unless $param->{max_count};
        }
    } elsif ($service eq 's3' && $self->awscli_version >= 0.15.0) {
        if ($operation !~ /^(?:cp|ls|mb|mv|rb|rm|sync|website)$/) {
            return $self->s3api($operation, @_);
        }
    } elsif ($service eq 's3api' && $self->awscli_version < 0.15.0) {
        return $self->s3($operation, @_);
    }

    while (my($k, $v) = each %$param) {
        my @o = param2opt($k, $v);
        if ($service eq 's3' && $k =~ /^(?:include|exclude)$/) {
            my $optk = shift @o;
            @o = map { $optk => $_ } @o;
        }
        push @cmd, @o;
    }
    @cmd = map { shell_quote($_) } @cmd;
    warn "cmd: ".join(' ', @cmd) if $ENV{AWSCLI_DEBUG};

    my $error_re = $self->catch_error_pattern;
    my $retries = $error_re ? $self->catch_error_retries : 0;

    RETRY: {
        $Error = { Message => '', Code => '' };

        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 {