view release on metacpan or  search on metacpan

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

  # 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(
    headers => { etag => '"newetag"' },
    capture => \$captured,
  );
  my $etag = $s3->put_object(
    'test-bucket', 'hello.txt', 'hello world',
    content_type => 'text/plain',
    metadata     => { source => 'test' },
  );
  is $etag,                                     'newetag',    'returns clean etag';
  is $captured->{headers}{'Content-Type'},      'text/plain', 'Content-Type set';
  is $captured->{headers}{'Content-Length'},    11,           'Content-Length set';
  is $captured->{headers}{'x-amz-meta-source'}, 'test',       'metadata prefixed';
  ok defined $captured->{headers}{'Content-MD5'}, 'Content-MD5 set for scalar';

  # scalar ref
  local *Amazon::S3::Lite::_request = mock_request(
    headers => { etag => '"x"' },
    capture => \$captured,
  );
  my $data = 'from scalar ref';
  $s3->put_object( 'test-bucket', 'k', \$data );
  is $captured->{body}, $data, 'scalar ref dereferenced';

  # real filehandle
  {
    my ( $fh, $fname ) = tempfile( UNLINK => 1 );
    print $fh 'file content';
    close $fh;