Amazon-S3

 view release on metacpan or  search on metacpan

lib/Amazon/S3/CLI.pm  view on Meta::CPAN

  if ( $self->get_format eq 'json' ) {
    print {*STDOUT} JSON::PP->new->pretty->encode($rsp);
    return $SUCCESS;
  }
  elsif ( $self->get_format eq 'table' && $self->get_ascii_table ) {
    my $t = Text::ASCIITable->new( { headingText => sprintf "Deletion Report\nBucket: %s", $bucket_name } );

    $t->setCols( 'Versions', 'Delete Markers', 'Multipart Uploads Aborted', 'Total' );

    $t->addRow( @{$rsp}{qw(versions_deleted delete_markers_deleted multipart_uploads_aborted total)} );

    print {*STDOUT} $t;
    return $SUCCESS;
  }

  foreach (qw(versions_deleted delete_markers_deleted multipart_uploads_aborted total)) {
    print {*STDOUT} sprintf "%30s %s\n", $rsp->{$_};
  }

  return $SUCCESS;
}

########################################################################
sub cmd_add_key {
########################################################################
  my ($self) = @_;

  my (@args) = $self->get_args;

  my ( $bucket_name, $filename, $object_name ) = choose {
    # bucket-name filename object-name
    return @args
      if @args == 3;

    # --bucket-name bucket-name filename
    return ( @args, $args[1] )
      if @args == 2 && !$self->get_bucket_name;

    # --bucket-name bucket-name filename object-name
    return ( $self->get_bucket_name, @args )
      if $self->get_bucket_name && @args == 2;

    # --bucket-name bucket-name --key key-name filename
    return ( $self->get_bucket_name, $args[0], $self->get_key )
      if $self->get_bucket_name && $self->get_key && @args == 1;

    return ( $self->get_bucket_name, $args[0], $args[0] )
      if $self->get_bucket_name && @args == 1;

    die "ERROR: usage add-key --bucket-name bucket-name filename object-name\n";
  };

  die sprintf "ERROR: file %s does not exist\n", $filename
    if !-e $filename;

  if ( $object_name =~ m{\A[/.]}xsm ) {
    $object_name =~ s{\A[/.]+(.*)$}{$1}xsm;
  }

  $self->get_logger->debug(
    sub {
      return Dumper(
        [ bucket_name => $bucket_name,
          filename    => $filename,
          object_name => $object_name,
        ]
      );
    }
  );

  my $content_type = $self->get_content_type // guess_content_type($filename);

  my $bucket = $self->get_bucket($bucket_name);

  $self->get_logger->debug( sub { return Dumper( [ $bucket->head_key($object_name) ] ); } );

  $self->get_logger->debug( sub { return Dumper( [ $bucket, $self->get_s3->last_response ] ); } );

  $bucket->add_key_filename( $object_name, $filename, { content_type => $content_type } );

  return $SUCCESS;
}

########################################################################
sub cmd_list_directory_buckets {
########################################################################
  my ($self) = @_;

  my $buckets = $self->get_s3->list_directory_buckets();

  return $self->_list_buckets($buckets);
}

########################################################################
sub cmd_create_bucket {
########################################################################
  my ($self) = @_;

  my ($bucket_name) = $self->get_args;
  $bucket_name //= $self->get_bucket_name;

  if ( $self->get_availability_zone ) {
    $self->get_s3->use_express_one_zone;
  }

  my $response = $self->get_s3->add_bucket(
    { bucket            => $bucket_name,
      availability_zone => $self->get_availability_zone,
      region            => $self->get_region,
    }
  );

  return $SUCCESS;
}

########################################################################
sub cmd_copy_key {
########################################################################
  my ($self) = @_;

  my ( $bucket_name, $key, $new_key ) = $self->get_args;

  if ( $self->get_bucket_name ) {
    if ( $self->get_key ) {
      $key     = $self->get_key;
      $new_key = $bucket_name;
    }
    else {
      $new_key     = $key;
      $key         = $bucket_name;
      $bucket_name = $self->get_bucket_name;
    }
  }

  die "ERROR: usage: copy-key bucket-name key new-key\n"
    if !$key || !$bucket_name || !$new_key;

lib/Amazon/S3/CLI.pm  view on Meta::CPAN

  print {*STDOUT} "Bucket,Region,CreationDate\n";

  foreach my $b ( @{$data} ) {
    print {*STDOUT} sprintf qq{"%s","%s","%s"\n}, $b->bucket, $b->region, $b->creation_date;
  }

  return $SUCCESS;
}

########################################################################
sub init {
########################################################################
  my ($self) = @_;

  my %endpoint = choose {
    return ( host => $self->get_host )
      if defined $self->get_host;

    return ( endpoint_url => $self->get_endpoint_url )
      if $self->get_endpoint_url;

    return ();
  };

  $self->set_ascii_table(
    eval {
      require Text::ASCIITable;
      1;
    }
  );

  die "ERROR: --format must be one of json, text or table\n"
    if none { $self->get_format eq $_ } qw(json text table);

  my %credentials;

  my $has_amazon_credentials = eval {
    require Amazon::Credentials;
    1;
  };

  if ($has_amazon_credentials) {
    $credentials{credentials} = Amazon::Credentials->new(
      { $self->get_profile
        ? ( profile => $self->get_profile )
        : (),
      }
    );
  }
  else {
    die "ERROR: --profile requires Amazon::Credentials\n"
      if $self->get_profile;

    $credentials{aws_access_key_id}     = $ENV{AWS_ACCESS_KEY_ID};
    $credentials{aws_secret_access_key} = $ENV{AWS_SECRET_ACCESS_KEY};
    $credentials{token}                 = $ENV{AWS_SESSION_TOKEN};
  }

  my $s3 = Amazon::S3->new(
    { %credentials,
      debug            => $ENV{DEBUG},
      raise_error      => $TRUE,
      region           => $self->get_region,
      logger           => $self->get_logger,
      dns_bucket_names => $self->get_dns_bucket_names // $FALSE,
      %endpoint,
      defined $self->get_secure ? ( secure => $self->get_secure ) : (),
    }
  );

  $self->set_s3($s3);

  return;
}

########################################################################
sub confirm {
########################################################################
  my ( $self, $prompt ) = @_;

  print "$prompt [y/N] ";

  my $answer = <STDIN>;
  return $FALSE
    if !defined $answer;

  chomp $answer;

  return $answer =~ /\Ay(?:es)?\z/i ? $TRUE : $FALSE;
}

########################################################################
sub guess_content_type {
########################################################################
  my ($filename) = @_;

  my $has_mmagic = eval { require File::MimeInfo::Magic; 1; };

  return 'application/octet-stream'
    if !$has_mmagic || !$filename || !-f $filename;

  my $content_type = eval { return File::MimeInfo::Magic::mimetype($filename); };

  return $content_type
    if !$EVAL_ERROR && $content_type;

  return 'application/octet-stream';
}

########################################################################
sub main {
########################################################################

  my %default_options = (
    output => $EMPTY,
    region => 'us-east-1',
    format => 'text',
  );

  my @option_specs = qw(
    availability-zone=s
    bucket-name|b=s
    content-type=s
    debug
    dns-bucket-names
    endpoint-url|u=s
    force|f
    format|F=s
    help|h
    host|H=s
    key|k=s
    modified-since|m=s
    output|o=s
    prefix=s
    profile|p=s
    range|R=s
    region|r=s
    secure|s
    version-id=s
  );

  my %commands = (
    'add-key'                  => \&cmd_add_key,
    'copy-key'                 => \&cmd_copy_key,
    'create-bucket'            => \&cmd_create_bucket,
    'delete-key'               => \&cmd_delete_key,
    'empty-bucket'             => \&cmd_empty_bucket,
    'get-key'                  => \&cmd_get_key,
    'get-bucket-policy'        => \&cmd_get_bucket_policy,
    'get-bucket-acl'           => \&cmd_get_bucket_acl,
    'get-bucket-policy-status' => \&cmd_get_bucket_policy_status,
    'list-bucket-keys'         => \&cmd_list_bucket_keys,
    'list-directory-buckets'   => \&cmd_list_directory_buckets,
    'list-keys'                => 'list-bucket-keys',
    'list-object-versions'     => \&cmd_list_object_versions,
    'remove-bucket'            => \&cmd_remove_bucket,
    'list-buckets'             => \&cmd_list_buckets,
  );

  return __PACKAGE__->new(
    commands        => \%commands,
    option_specs    => \@option_specs,
    default_options => \%default_options,
    abbreviations   => $TRUE,
    extra_options   => [qw(s3 secure ascii_table)],
  )->run;
}

1;

__END__

## no critic

=pod

=encoding utf8

=head1 NAME

Amazon::S3::CLI - command line interface for common S3 operations

=head1 SYNOPSIS

lib/Amazon/S3/CLI.pm  view on Meta::CPAN

Lists general-purpose S3 buckets available to the current credentials.

=item B<list-directory-buckets>

  amzn-s3-cli list-directory-buckets

Lists S3 Express One Zone directory buckets.

=item B<list-object-versions>

  amzn-s3-cli list-object-versions bucket-name [prefix]

Lists object versions in a bucket.

The listing includes the object key, size, last-modified timestamp,
latest-version indicator, and version ID.

=item B<remove-bucket>

  amzn-s3-cli remove-bucket bucket-name

Removes a bucket.

The bucket must satisfy normal S3 deletion requirements. Use
C<empty-bucket> first when necessary.

=back

=head2 Options

Most commands accept the bucket name positionally or through
C<--bucket-name>.

Output-producing commands generally support C<text>, C<json>, and
C<table> formats. Table output requires L<Text::ASCIITable>.

Credentials are discovered through L<Amazon::Credentials> when that
module is installed. Otherwise the CLI uses the standard AWS credential
environment variables.

Use C<--endpoint-url> when working with an alternate S3-compatible
service such as LocalStack.

=head1 OPTIONS

=over

=item B<--availability-zone>

Specifies an Availability Zone when creating an S3 Express One Zone
directory bucket.

=item B<--bucket-name>, B<-b>

Specifies the bucket name.

=item B<--content-type>

Specifies the content type used when adding an object.

=item B<--debug>

Enables debug logging.

=item B<--dns-bucket-names>

Enables DNS-style bucket addressing.

=item B<--endpoint-url>, B<-u>

Specifies the complete S3 service endpoint URL.

For example:

  --endpoint-url http://localhost:4566

The URL scheme determines whether HTTP or HTTPS is used.

=item B<--force>, B<-f>

Suppresses confirmation prompts for destructive operations.

=item B<--format>, B<-F>

Selects the output format.

 text
 json
 table

The default is C<text>.

Table output requires L<Text::ASCIITable>.

=item B<--help>, B<-h>

Displays command help.

=item B<--host>, B<-H>

Specifies the S3 service host using the legacy host configuration
mechanism.

C<--endpoint-url> is preferred for alternate endpoints.

=item B<--key>, B<-k>

Specifies an object key.

=item B<--modified-since>, B<-m>

Supplies an C<If-Modified-Since> condition to C<get-key>.

=item B<--output>, B<-o>

Specifies where C<get-key> writes its result.

Use C<-> to write object data to standard output.

=item B<--prefix>

Limits object listing commands to keys beginning with the specified
prefix.