view release on metacpan or  search on metacpan

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

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

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

  my $r = $s3->delete_object( 'test-bucket', 'hello.txt' );
  is $r,                  1,        'returns 1 on success';
  is $captured->{method}, 'DELETE', 'method is DELETE';
  like $captured->{url}, qr{test-bucket/hello\.txt}, 'URL correct';
  ok( $captured->{url} !~ /versionId/, 'no versionId without option' );

  # version_id
  $s3->delete_object( 'test-bucket', 'hello.txt', version_id => 'v123' );
  like $captured->{url}, qr/versionId=v123/, 'versionId in URL';

  # version_id with special chars
  $s3->delete_object( 'test-bucket', 'hello.txt', version_id => 'v 1+2' );
  like $captured->{url}, qr/versionId=v%201/, 'version_id encoded';

  # 5xx croaks
  local *Amazon::S3::Lite::_request = mock_request( status => 500 );
  eval { $s3->delete_object( 'test-bucket', 'hello.txt' ) };
  like $@, qr/delete_object failed/, '5xx croaks';

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

subtest 'copy_object' => sub {
  my $s3          = new_s3();
  my $captured    = {};
  my $success_xml = <<'XML';
<?xml version="1.0" encoding="UTF-8"?>
<CopyObjectResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
  <LastModified>2024-01-01T00:00:00.000Z</LastModified>
  <ETag>&quot;copietag&quot;</ETag>
</CopyObjectResult>
XML

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

  my $r = $s3->copy_object(
    src_bucket => 'src-bucket',
    src_key    => 'orig/file.json',
    dst_bucket => 'dst-bucket',
    dst_key    => 'copy/file.json',
  );

  is $captured->{method}, 'PUT', 'method is PUT';
  like $captured->{url},                          qr{dst-bucket/copy/file\.json}, 'dst URL correct';
  like $captured->{headers}{'x-amz-copy-source'}, qr{src-bucket/orig/file\.json}, 'copy-source header set';
  is $captured->{headers}{'Content-Length'}, 0, 'Content-Length is 0';

  is $r->{etag},          'copietag',                 'etag clean';
  is $r->{last_modified}, '2024-01-01T00:00:00.000Z', 'last_modified';

  # special chars in src_key
  $s3->copy_object(
    src_bucket => 'src',
    src_key    => 'path/my file.txt',
    dst_bucket => 'dst',
    dst_key    => 'copy.txt',
  );
  like $captured->{headers}{'x-amz-copy-source'}, qr/%20/,   'spaces encoded in copy-source';
  like $captured->{headers}{'x-amz-copy-source'}, qr{path/}, 'slashes preserved';

  # 200-with-error body
  my $error_xml = <<'XML';
<?xml version="1.0" encoding="UTF-8"?>
<Error>
  <Code>InternalError</Code>
  <Message>Something went wrong</Message>
</Error>
XML
  local *Amazon::S3::Lite::_request = mock_request( content => $error_xml );
  eval { $s3->copy_object( src_bucket => 'src', src_key => 'k', dst_bucket => 'dst', dst_key => 'k2', ); };
  like $@, qr/copy_object failed.*InternalError/, '200-with-error body croaks';

  # missing required args
  for my $missing (qw(src_bucket src_key dst_bucket dst_key)) {
    my %args = (
      src_bucket => 'src',
      src_key    => 'k',
      dst_bucket => 'dst',
      dst_key    => 'k2',
    );
    delete $args{$missing};
    eval { $s3->copy_object(%args) };
    like $@, qr/$missing is required/, "croaks without $missing";
  }
};

subtest 'error XML body extracted' => sub {
  my $s3        = new_s3();
  my $error_xml = <<'XML';
<?xml version="1.0" encoding="UTF-8"?>
<Error>
  <Code>AccessDenied</Code>
  <Message>Access Denied</Message>
</Error>
XML
  no warnings 'redefine';
  local *Amazon::S3::Lite::_request = mock_request(
    status  => 403,
    content => $error_xml,
  );
  eval { $s3->list_buckets };
  like $@, qr/AccessDenied/,  'error Code extracted from XML body';
  like $@, qr/Access Denied/, 'error Message extracted from XML body';