view release on metacpan or  search on metacpan

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

};

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',