Amazon-S3-Lite

 view release on metacpan or  search on metacpan

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

  return Amazon::Signature4::Lite->new(
    access_key    => $access_key,
    secret_key    => $secret_key,
    session_token => $token,
    region        => $region // $self->region,
    service       => 's3',
  );
}

########################################################################
# Build the endpoint URL for a bucket/key
########################################################################
sub _endpoint {
########################################################################
  my ( $self, $bucket, $key ) = @_;

  my $scheme = $self->{secure} ? 'https' : 'http';
  my $host   = $self->host;

  # Path-style URL: https://s3.amazonaws.com/bucket/key
  # (virtual-hosted style omitted for simplicity; path-style works
  # everywhere and avoids SSL cert issues with dotted bucket names)
  my $url = "$scheme://$host";

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

# Returns a hashref with content_type, content_length, etag,
# last_modified, and metadata (x-amz-meta-* headers).
########################################################################
sub head_object {
########################################################################
  my ( $self, $bucket, $key ) = @_;

  croak 'bucket is required' if !defined $bucket || !length $bucket;
  croak 'key is required'    if !defined $key    || !length $key;

  my $url      = $self->_endpoint( $bucket, $key );
  my $response = $self->_request( 'HEAD', $url );

  return undef ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    if _is_not_found($response);

  $self->_croak_on_error( $response, 'head_object' );

  return $self->_extract_object_metadata( $response->{headers} );
}

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

# Returns a hashref with content_type, content_length, etag,
# last_modified, metadata, and content (unless filename is used).
########################################################################
sub get_object {
########################################################################
  my ( $self, $bucket, $key, %options ) = @_;

  croak 'bucket is required' if !defined $bucket || !length $bucket;
  croak 'key is required'    if !defined $key    || !length $key;

  my $url = $self->_endpoint( $bucket, $key );

  my %headers;
  $headers{Range} = $options{range} if defined $options{range};

  my $filename = $options{filename};
  my $extra    = {};

  if ( defined $filename ) {
    # Open the destination file before making the request so we catch
    # permission errors early, before network round-trip

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

# deletes and deletes of non-existent keys — no distinction is made.
# Croaks on network or server errors.
########################################################################
sub delete_object {
########################################################################
  my ( $self, $bucket, $key, %options ) = @_;

  croak 'bucket is required' if !defined $bucket || !length $bucket;
  croak 'key is required'    if !defined $key    || !length $key;

  my $url = $self->_endpoint( $bucket, $key );

  if ( defined $options{version_id} ) {
    $url .= '?versionId=' . uri_escape_utf8( $options{version_id} );
  }

  my $response = $self->_request( 'DELETE', $url );

  $self->_croak_on_error( $response, 'delete_object' );

  return 1;

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

# Returns true on success. Croaks on failure.
########################################################################
sub create_bucket {
########################################################################
  my ( $self, $bucket, %options ) = @_;

  croak 'bucket is required'
    if !defined $bucket || !length $bucket;

  my $region = $options{region} // $self->region;
  my $url    = $self->_endpoint($bucket);
  my %headers;

  $headers{'x-amz-acl'} = $options{acl} if $options{acl};

  my $content = q{};

  # us-east-1 is the implicit default — sending LocationConstraint for it
  # causes an error. All other regions require it.
  if ( $region ne 'us-east-1' ) {
    $content

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

#     buckets    => [
#       { name => '...', creation_date => '...' },
#       ...
#     ],
#   }
########################################################################
sub list_buckets {
########################################################################
  my ($self) = @_;

  my $url = $self->_endpoint . q{/};  # ensure canonical URI is / not empty

  my $response = $self->_request( 'GET', $url, {}, q{}, {}, 'us-east-1' );

  $self->_croak_on_error( $response, 'list_buckets' );

  return $self->_parse_list_buckets( $response->{content} );
}

########################################################################
# Parse ListAllMyBucketsResult XML

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

########################################################################
sub copy_object {
########################################################################
  my ( $self, %args ) = @_;

  for my $required (qw( src_bucket src_key dst_bucket dst_key )) {
    croak "$required is required"
      if !defined $args{$required} || !length $args{$required};
  }

  my $url = $self->_endpoint( $args{dst_bucket}, $args{dst_key} );

  # x-amz-copy-source: /src-bucket/encoded-key
  my $copy_source = '/' . $args{src_bucket} . '/' . _encode_key( $args{src_key} );

  my %headers = (
    'x-amz-copy-source'       => $copy_source,
    'x-amz-tagging-directive' => 'COPY',
    'Content-Length'          => 0,
  );

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

# Returns the ETag of the stored object. Croaks on failure.
########################################################################
sub put_object {
########################################################################
  my ( $self, $bucket, $key, $data, %options ) = @_;

  croak 'bucket is required' if !defined $bucket || !length $bucket;
  croak 'key is required'    if !defined $key    || !length $key;
  croak 'data is required'   if !defined $data;

  my $url = $self->_endpoint( $bucket, $key );

  my %headers;
  $headers{'Content-Type'} = $options{content_type} // 'application/octet-stream';

  # x-amz-acl header
  if ( $options{acl} ) {
    $headers{'x-amz-acl'} = $options{acl};
  }

  # User metadata — prefix bare keys with x-amz-meta-

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

  for my $opt ( keys %param_map ) {
    if ( defined $options{$opt} ) {
      $params{ $param_map{$opt} } = $options{$opt};
    }
  }

  # Build query string
  my $query = join q{&}, map { uri_escape_utf8($_) . q{=} . uri_escape_utf8( $params{$_} ) }
    sort keys %params;

  my $url = $self->_endpoint($bucket) . q{?} . $query;

  my $response = $self->_request( 'GET', $url );

  return undef ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    if _is_not_found($response);

  $self->_croak_on_error( $response, 'list_objects_v2' );

  return $self->_parse_list_objects_v2( $response->{content} );
}

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

  return @all_objects;
}

########################################################################
sub put_bucket_notification_configuration {
########################################################################
  my ( $self, $bucket, %options ) = @_;

  my $xml = $self->_create_notification_configuration( $bucket, %options );

  my $url = $self->_endpoint($bucket) . q{?notification=};

  my %headers = (
    'Content-Type'   => 'application/xml',
    'Content-Length' => length $xml,
    'Content-MD5'    => encode_base64( md5($xml), q{} ),
  );

  my $response = $self->_request( 'PUT', $url, \%headers, $xml );

  $self->_croak_on_error( $response, 'put_bucket_notification_configuration' );

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

########################################################################
  my ( $self, $bucket ) = @_;

  croak 'bucket is required'
    if !defined $bucket || !length $bucket;

  my $xml = <<'END_XML';
<NotificationConfiguration xmlns="http://s3.amazonaws.com/doc/2006-03-01/"/>
END_XML

  my $url = $self->_endpoint($bucket) . q{?notification=};

  my %headers = (
    'Content-Type'   => 'application/xml',
    'Content-Length' => length $xml,
    'Content-MD5'    => encode_base64( md5($xml), q{} ),
  );

  my $response = $self->_request( 'PUT', $url, \%headers, $xml );

  $self->_croak_on_error( $response, 'remove_bucket_notification_configuration' );

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

}

########################################################################
sub get_bucket_notification_configuration {
########################################################################
  my ( $self, $bucket ) = @_;

  croak 'bucket is required'
    if !defined $bucket || !length $bucket;

  my $url = $self->_endpoint($bucket) . q{?notification=};

  my $response = $self->_request( 'GET', $url );

  $self->_croak_on_error( $response, 'get_bucket_notification_configuration' );

  my $rsp = $self->_parse_notification_configuration( $response->{content} );

  $self->logger->debug(
    Dumper(
      [ response        => $response,

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

  $logger->warn(...)
  $logger->error(...)

If not supplied, the module looks for L<Log::Log4perl>. If available,
it calls C<Log::Log4perl::easy_init> with level WARN and logs to
STDERR.  If Log::Log4perl is not installed, a minimal internal logger
is used that prints WARN and above to STDERR.

=item host

Override the S3 endpoint host. Defaults to C<s3.amazonaws.com>.
Useful for S3-compatible services (MinIO, Ceph, LocalStack).

=item secure

Use HTTPS. Default is 1 (true). Set to 0 only for testing against
local S3-compatible endpoints.

=item timeout

HTTP request timeout in seconds. Default is 30.

=back

=head2 Credential resolution order

When no C<credentials> object is passed, credentials are resolved in

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

roles, ECS task roles, ~/.aws/credentials, and environment.

=item * L<Log::Log4perl> - structured logging; if present, used in
preference to the built-in minimal logger.

=back

=head1 LAMBDA USAGE NOTES

In a Lambda container, credentials come from the execution role via
the ECS credential provider endpoint (indicated by
C<AWS_CONTAINER_CREDENTIALS_RELATIVE_URI> in the environment).
L<Amazon::Credentials> handles this automatically when installed and
is the recommended approach. If you prefer not to take that
dependency, the Lambda runtime also populates C<AWS_ACCESS_KEY_ID>,
C<AWS_SECRET_ACCESS_KEY>, and C<AWS_SESSION_TOKEN> directly, which
this module picks up automatically from the environment.

B<Region note:> The C<list_buckets> method is a global S3 operation
and is always signed against C<us-east-1>, regardless of the region
supplied to the constructor. This is an S3 requirement, not a

share/README.md  view on Meta::CPAN

        $logger->warn(...)
        $logger->error(...)

    If not supplied, the module looks for [Log::Log4perl](https://metacpan.org/pod/Log%3A%3ALog4perl). If available,
    it calls `Log::Log4perl::easy_init` with level WARN and logs to
    STDERR.  If Log::Log4perl is not installed, a minimal internal logger
    is used that prints WARN and above to STDERR.

- host

    Override the S3 endpoint host. Defaults to `s3.amazonaws.com`.
    Useful for S3-compatible services (MinIO, Ceph, LocalStack).

- secure

    Use HTTPS. Default is 1 (true). Set to 0 only for testing against
    local S3-compatible endpoints.

- timeout

    HTTP request timeout in seconds. Default is 30.

## Credential resolution order

When no `credentials` object is passed, credentials are resolved in
this order:

share/README.md  view on Meta::CPAN

Optional:

- [Amazon::Credentials](https://metacpan.org/pod/Amazon%3A%3ACredentials) - automatic credential discovery from IAM
roles, ECS task roles, ~/.aws/credentials, and environment.
- [Log::Log4perl](https://metacpan.org/pod/Log%3A%3ALog4perl) - structured logging; if present, used in
preference to the built-in minimal logger.

# LAMBDA USAGE NOTES

In a Lambda container, credentials come from the execution role via
the ECS credential provider endpoint (indicated by
`AWS_CONTAINER_CREDENTIALS_RELATIVE_URI` in the environment).
[Amazon::Credentials](https://metacpan.org/pod/Amazon%3A%3ACredentials) handles this automatically when installed and
is the recommended approach. If you prefer not to take that
dependency, the Lambda runtime also populates `AWS_ACCESS_KEY_ID`,
`AWS_SECRET_ACCESS_KEY`, and `AWS_SESSION_TOKEN` directly, which
this module picks up automatically from the environment.

**Region note:** The `list_buckets` method is a global S3 operation
and is always signed against `us-east-1`, regardless of the region
supplied to the constructor. This is an S3 requirement, not a

t/01-s3-lite.t  view on Meta::CPAN

      for my $m (qw(trace debug info error)) {
        *{"MyLogger::$m"} = sub { };
      }
      *{"MyLogger::warn"} = sub { $warned++ };
    }
    my $s3l = new_s3( logger => $logger );
    isa_ok $s3l->logger, 'MyLogger', 'custom logger accepted';
  }
};

subtest '_endpoint' => sub {
  my $s3 = new_s3();
  is $s3->_endpoint,              'https://s3.amazonaws.com',           'root endpoint';
  is $s3->_endpoint('my-bucket'), 'https://s3.amazonaws.com/my-bucket', 'bucket endpoint';
  is $s3->_endpoint( 'my-bucket', 'path/to/key.txt' ),
    'https://s3.amazonaws.com/my-bucket/path/to/key.txt',
    'bucket+key endpoint';
  is $s3->_endpoint( 'my-bucket', 'path/to/my file+thing.txt' ),
    'https://s3.amazonaws.com/my-bucket/path/to/my%20file%2Bthing.txt',
    'key encoding preserves slashes, encodes special chars';
};

subtest 'list_buckets' => sub {
  my $s3       = new_s3( region => 'eu-west-1' );
  my $captured = {};
  my $xml      = <<'XML';
<?xml version="1.0" encoding="UTF-8"?>
<ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">

t/01-s3-lite.t  view on Meta::CPAN


  no warnings 'redefine';
  local *Amazon::S3::Lite::_request = mock_request(
    content => $xml,
    capture => \$captured,
  );

  my $r = $s3->list_buckets;

  is $captured->{method}, 'GET',                       'method is GET';
  is $captured->{url},    'https://s3.amazonaws.com/', 'hits root endpoint';
  is $captured->{region}, 'us-east-1',                 'always signs with us-east-1';
  is $s3->region,         'eu-west-1',                 'object region unchanged';

  is $r->{owner_id},            'owner123', 'owner_id';
  is $r->{owner_name},          'rob',      'owner_name';
  is scalar @{ $r->{buckets} }, 2,          '2 buckets';
  is $r->{buckets}[0]{name},    'bucket-a', 'first bucket name';
  is $r->{buckets}[1]{name},    'bucket-b', 'second bucket name';
  ok $r->{buckets}[0]{creation_date}, 'creation_date present';



( run in 0.415 second using v1.01-cache-2.11-cpan-524268b4103 )