view release on metacpan or  search on metacpan

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

  eval { $s3->list_buckets };
  like $@, qr/list_buckets failed/, '403 croaks';
};

subtest 'list_objects_v2' => sub {
  my $s3  = new_s3();
  my $xml = <<'XML';
<?xml version="1.0" encoding="UTF-8"?>
<ListBucketResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
  <Name>test-bucket</Name>
  <Prefix>logs/</Prefix>
  <KeyCount>2</KeyCount>
  <MaxKeys>1000</MaxKeys>
  <IsTruncated>false</IsTruncated>
  <Contents>
    <Key>logs/2024-01-01.gz</Key>
    <LastModified>2024-01-01T00:00:00.000Z</LastModified>
    <ETag>&quot;abc123&quot;</ETag>
    <Size>1024</Size>
    <StorageClass>STANDARD</StorageClass>
  </Contents>
  <Contents>
    <Key>logs/2024-01-02.gz</Key>
    <LastModified>2024-01-02T00:00:00.000Z</LastModified>
    <ETag>&quot;def456&quot;</ETag>
    <Size>2048</Size>
    <StorageClass>STANDARD</StorageClass>
  </Contents>
</ListBucketResult>
XML

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

  my $r = $s3->list_objects_v2( 'test-bucket', prefix => 'logs/' );

  like $captured->{url}, qr/test-bucket/,    'bucket in URL';
  like $captured->{url}, qr/list-type=2/,    'list-type=2 in query';
  like $captured->{url}, qr/prefix=logs%2F/, 'prefix encoded in query';

  is $r->{bucket},       'test-bucket', 'bucket';
  is $r->{prefix},       'logs/',       'prefix';
  is $r->{key_count},    2,             'key_count is integer';
  is $r->{is_truncated}, 0,             'not truncated';
  ok !defined $r->{next_continuation_token}, 'no next token when not truncated';
  is scalar @{ $r->{objects} }, 2, '2 objects';

  my $obj = $r->{objects}[0];
  is $obj->{key},  'logs/2024-01-01.gz', 'key';
  is $obj->{size}, 1024,                 'size is integer';
  is $obj->{etag}, 'abc123',             'etag stripped of quotes';

  # missing bucket croaks
  eval { $s3->list_objects_v2() };
  like $@, qr/bucket is required/, 'croaks without bucket';

  # 404 returns undef
  local *Amazon::S3::Lite::_request = mock_request( status => 404 );
  my $not_found = $s3->list_objects_v2('no-such-bucket');
  ok !defined $not_found, '404 returns undef';
};

subtest 'list_all_objects_v2 pagination' => sub {
  my $s3   = new_s3();
  my $page = 0;

  no warnings 'redefine';
  local *Amazon::S3::Lite::list_objects_v2 = sub {
    my ( $self, $bucket, %opts ) = @_;
    $page++;
    if ( $page == 1 ) {
      ok !exists $opts{continuation_token}, 'no token on first page';
      return {
        objects                 => [ { key => 'file1.txt', size => 100 } ],
        is_truncated            => 1,
        next_continuation_token => 'TOKEN',
        common_prefixes         => [],
      };
    }
    is $opts{continuation_token}, 'TOKEN', 'token passed on page 2';
    return {
      objects                 => [ { key => 'file2.txt', size => 200 } ],
      is_truncated            => 0,
      next_continuation_token => undef,
      common_prefixes         => [],
    };
  };

  my @all = $s3->list_all_objects_v2('test-bucket');
  is scalar @all,  2,           'all objects returned';
  is $all[0]{key}, 'file1.txt', 'first key';
  is $all[1]{key}, 'file2.txt', 'second key';
  is $page,        2,           'fetched 2 pages';

  # delimiter stripped
  $page = 0;
  local *Amazon::S3::Lite::list_objects_v2 = sub {
    my ( $self, $bucket, %opts ) = @_;
    ok !exists $opts{delimiter}, 'delimiter removed';
    return { objects => [], is_truncated => 0 };
  };
  $s3->list_all_objects_v2( 'test-bucket', delimiter => '/' );
};

subtest 'head_object' => sub {
  my $s3 = new_s3();

  no warnings 'redefine';

  # 404 returns undef
  local *Amazon::S3::Lite::_request = mock_request( status => 404 );
  ok !defined $s3->head_object( 'b', 'k' ), '404 returns undef';

  # success
  local *Amazon::S3::Lite::_request = mock_request(
    headers => {
      'content-type'      => 'text/plain',
      'content-length'    => '42',
      'etag'              => '"abc123"',
      'last-modified'     => 'Wed, 01 Jan 2025 00:00:00 GMT',
      'x-amz-meta-source' => 'lambda',
    },
  );
  my $r = $s3->head_object( 'test-bucket', 'hello.txt' );
  is $r->{content_type},   'text/plain', 'content_type';
  is $r->{content_length}, 42,           'content_length is integer';
  is $r->{etag},           'abc123',     'etag stripped of quotes';
  ok !exists $r->{content}, 'no content key for HEAD';
  is $r->{metadata}{source}, 'lambda', 'x-amz-meta stripped to bare key';

  # missing args
  eval { $s3->head_object() };
  like $@, qr/bucket is required/, 'croaks without bucket';
  eval { $s3->head_object('b') };
  like $@, qr/key is required/, 'croaks without key';
};

subtest 'get_object' => sub {
  my $s3 = new_s3();

  no warnings 'redefine';

  # 404 returns undef
  local *Amazon::S3::Lite::_request = mock_request( status => 404 );
  ok !defined $s3->get_object( 'b', 'k' ), '404 returns undef';

  # in-memory success
  local *Amazon::S3::Lite::_request = mock_request(
    content => 'hello world',
    headers => {
      'content-type'   => 'text/plain',
      'content-length' => '11',
      'etag'           => '"abc123"',
      'last-modified'  => 'Wed, 01 Jan 2025 00:00:00 GMT',
    },
  );
  my $r = $s3->get_object( 'test-bucket', 'hello.txt' );
  is $r->{content},      'hello world', 'content returned';
  is $r->{content_type}, 'text/plain',  'content_type';
  is $r->{etag},         'abc123',      'etag clean';

  # range header passed through
  my $captured = {};
  local *Amazon::S3::Lite::_request = mock_request(
    status  => 206,
    content => 'hello',
    headers => { 'content-type' => 'text/plain', 'content-length' => '5', 'etag' => '"abc"' },
    capture => \$captured,
  );
  $s3->get_object( 'test-bucket', 'hello.txt', range => 'bytes=0-4' );
  is $captured->{headers}{Range}, 'bytes=0-4', 'Range header set';

  # filename — streaming to disk
  {
    my ( $fh, $fname ) = tempfile( UNLINK => 1 );
    close $fh;

    local *Amazon::S3::Lite::_request = sub {
      my ( $self, $method, $url, $headers, $content, $extra ) = @_;
      $extra->{data_callback}->('hello ') if $extra->{data_callback};
      $extra->{data_callback}->('world')  if $extra->{data_callback};
      return {
        status  => 200,
        reason  => 'OK',
        headers => { 'content-type' => 'text/plain', 'content-length' => '11', 'etag' => '"abc"' },
        content => '',
      };
    };

    my $meta = $s3->get_object( 'test-bucket', 'hello.txt', filename => $fname );
    ok !exists $meta->{content}, 'no content key when filename used';
    ok -f $fname,                'file created';
    open my $in, '<', $fname or die $!;
    is do { local $/; <$in> }, 'hello world', 'file content correct';
  }
};

subtest 'put_object' => sub {
  my $s3       = new_s3();
  my $captured = {};

  no warnings 'redefine';

  # scalar
  local *Amazon::S3::Lite::_request = mock_request(

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

};

########################################################################
# Integration tests — require LocalStack
########################################################################

SKIP: {
  skip 'LocalStack not available', 5 unless localstack_available();

  my $s3 = new_localstack_s3();

  my $r            = eval { $s3->list_buckets };
  my @bucket_names = map { $_->{name} } @{ $r->{buckets} // [] };

  skip 'test-bucket not found in LocalStack - create it first', 5
    if !grep { $_ eq 'test-bucket' } @bucket_names;

  # Each subtest is wrapped in eval so one failure doesn't kill the harness
  subtest 'LocalStack - list_buckets' => sub {
    my $r = eval { $s3->list_buckets };
    if ($@) { fail "list_buckets threw: $@"; return }
    ok ref $r->{buckets} eq 'ARRAY', 'buckets is arrayref';
    my @names = map { $_->{name} } @{ $r->{buckets} };
    ok( ( grep { $_ eq 'test-bucket' } @names ), 'test-bucket exists' );
  };

  subtest 'LocalStack - put, head, get, delete' => sub {
    my $key     = 'test/hello.txt';
    my $content = 'Hello from Amazon::S3::Lite!';

    # put
    my $etag = $s3->put_object(
      'test-bucket', $key, $content,
      content_type => 'text/plain',
      metadata     => { author => 'rob' },
    );
    ok defined $etag, 'put_object returns etag';

    # head
    my $meta = $s3->head_object( 'test-bucket', $key );
    ok defined $meta, 'head_object finds the object';
    is $meta->{content_type},     'text/plain',     'content_type correct';
    is $meta->{content_length},   length($content), 'content_length correct';
    is $meta->{metadata}{author}, 'rob',            'metadata preserved';

    # get in-memory
    my $obj = $s3->get_object( 'test-bucket', $key );
    ok defined $obj, 'get_object finds the object';
    is $obj->{content}, $content, 'content matches';
    is $obj->{etag},    $etag,    'etag matches';

    # get to file
    my ( $fh, $fname ) = tempfile( UNLINK => 1 );
    close $fh;
    my $file_meta = $s3->get_object( 'test-bucket', $key, filename => $fname );
    ok defined $file_meta,            'get_object with filename returns meta';
    ok !exists $file_meta->{content}, 'no content key';
    open my $in, '<', $fname or die $!;
    is do { local $/; <$in> }, $content, 'file content correct';

    # 404
    my $missing = $s3->get_object( 'test-bucket', 'no/such/key.txt' );
    ok !defined $missing, '404 returns undef';

    # delete
    ok $s3->delete_object( 'test-bucket', $key ), 'delete_object returns true';

    # confirm gone
    my $gone = $s3->head_object( 'test-bucket', $key );
    ok !defined $gone, 'object gone after delete';
  };

  subtest 'LocalStack - list_objects_v2' => sub {
    # seed some objects
    for my $i ( 1 .. 3 ) {
      $s3->put_object( 'test-bucket', "list-test/file$i.txt", "content $i" );
    }

    my $r = $s3->list_objects_v2( 'test-bucket', prefix => 'list-test/' );
    ok $r->{key_count} >= 3, 'at least 3 objects';
    my @keys = map { $_->{key} } @{ $r->{objects} };
    ok( ( grep { $_ eq 'list-test/file1.txt' } @keys ), 'file1 in list' );

    # list_all_objects_v2
    my @all = $s3->list_all_objects_v2( 'test-bucket', prefix => 'list-test/' );
    ok scalar @all >= 3, 'list_all returns all objects';

    # max_keys pagination
    my $page = $s3->list_objects_v2(
      'test-bucket',
      prefix   => 'list-test/',
      max_keys => 2,
    );
    is scalar @{ $page->{objects} }, 2, 'max_keys respected';

    my @all_paginated = $s3->list_all_objects_v2(
      'test-bucket',
      prefix   => 'list-test/',
      max_keys => 2,
    );
    ok scalar @all_paginated >= 3, 'list_all_objects_v2 auto-paginates correctly';

    # cleanup
    for my $obj (@all) {
      $s3->delete_object( 'test-bucket', $obj->{key} );
    }
  };

  subtest 'LocalStack - copy_object' => sub {
    $s3->put_object( 'test-bucket', 'copy-src.txt', 'original content' );

    my $r = $s3->copy_object(
      src_bucket => 'test-bucket',
      src_key    => 'copy-src.txt',
      dst_bucket => 'test-bucket',
      dst_key    => 'copy-dst.txt',
    );
    ok defined $r->{etag}, 'copy_object returns etag';

    my $dst = $s3->get_object( 'test-bucket', 'copy-dst.txt' );
    is $dst->{content}, 'original content', 'copied content matches';

    $s3->delete_object( 'test-bucket', 'copy-src.txt' );