Amazon-S3-Lite

 view release on metacpan or  search on metacpan

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

    $content
      = sprintf '<CreateBucketConfiguration '
      . 'xmlns="http://s3.amazonaws.com/doc/2006-03-01/">'
      . '<LocationConstraint>%s</LocationConstraint>'
      . '</CreateBucketConfiguration>',
      $region;
    $headers{'Content-Type'}   = 'application/xml';
    $headers{'Content-Length'} = length $content;
  }

  my $response = $self->_request( 'PUT', $url, \%headers, $content, {}, $region );

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

  return 1;
}

########################################################################
# list_buckets()
#
# Lists all buckets owned by the authenticated user.

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

  # 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,
  );

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

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

  # S3 can return HTTP 200 with an XML error body for copies that fail
  # after the headers have been sent. Detect this by checking the root
  # element — a success response has <CopyObjectResult>, an error has <Error>.
  return $self->_parse_copy_response( $response->{content}, 'copy_object' );
}

########################################################################

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

    $headers{'Content-Length'} = length $body;
    $headers{'Content-MD5'}    = encode_base64( md5($body), q{} );
  }
  else {
    # --- Plain scalar path ---
    $body                      = $data;
    $headers{'Content-Length'} = length $body;
    $headers{'Content-MD5'}    = encode_base64( md5($body), q{} );
  }

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

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

  my $etag = $response->{headers}{etag};
  $etag =~ s/\A"|"\z//gxsm if defined $etag;

  return $etag;
}

########################################################################

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

  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' );

  return $TRUE;
}

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

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

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' );

  return $TRUE;
}

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

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

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