Amazon-S3
view release on metacpan or search on metacpan
* NEWS.md: updated
* .gitignore: *.log
* src/main/perl/run-test: new from test.localstack
* src/main/perl/S3TestUtils.pm
(set_s3_host): AMAZON_S3_SKIP_ACLS, not SKIP_PERMISSIONS
* src/main/perl/t/01-api.t
- likewise
(like_acl_allrusers_read):
- dump flag
* src/main/perl/t/04-list-buckets.t: whitespace
* src/main/perl/t/06-list-multipart-uploads.t
- ignore case on status header (LocalStack <> AWS)
Mon Apr 22 15:14:36 2024 Rob Lauer <rlauer6@comcast.net>
[2.0.1]:
* VERSION: 2.0.1
* NEWS.md: notes on version 2
* README.md: generated
* src/main/perl/lib/Amazon/S3/BucketV2.pm.in
- pod tweaks and additions
- whitespace
Tue Dec 26 07:58:33 2023 Rob Lauer <rlauer6@comcast.net>
[0.66]:
* README.md: generated
* src/main/perl/lib/Amazon/S3/Constants.pm.in
- + $HTTP_NO_CONTENT, $HTTP_PARTIAL_CONTENT
* src/main/perl/lib/Amazon/S3/Bucket.pm.in
(upload_part_of_multipart_upload): refactored, use create_api_uri()
(get_key_v2): new
(get_key): support list or hashref as args include uri_params
(_get_key): refactored
(get_key_filename): refactored, accept hash of args
* src/main/perl/lib/Amazon/S3.pm.in
- pod tweaks
- refactoring, use methods from Amazon::S3::Util
- some support for express one-zone
(use_express_one_zone): new
(add_bucket): refactored to use _add_bucket()
(_send_request_expect_nothing_probed): refactored
(_remember_errors): refactored
(_add_auth_header): refactored
(_merge_meta): refactored
(_encode): refactored
* src/main/perl/lib/Amazon/S3/Bucket.pm.in
- refactored
(new): refactored
(_uri): refactored
(add_key): allow for additional headers
(upload_mulipart_object)
- refactored
- allow additional headers
(initiate_multipart_upload): likewise
(upload_part_of_multipart_upload): likewise
(make_xml_document_simple): replaced with _create_multipart_upload_request()
(get_key): call _get_key() now
(_get_key)
- renamed from get_key()
- allow additional headers
(copy_object): refactored
(delete_keys)
- refactored
- allow additional headers
* src/main/perl/lib/Amazon/S3/Constants.pm.in
- + $AWS_METADATA_BASE_URL
- + markers for ListObjectVersions
* src/main/perl/t/01-api.t
- create private bucket first, then delete public access block
(list_all)
- refactored
- allow additional headers
(get_acl)
- refactored
- allow additional headers
(get_location_constraint): refactored
(_create_multipart_upload_request): new
Tue Nov 28 17:42:44 2023 Rob Lauer <rlauer6@comcast.net>
[0.65]:
* src/main/perl/lib/Amazon/S3.pm.in
(signer)
- get token from creds object always
Thu Jul 20 07:47:36 2023 Rob Lauer <rlauer6@comcast.net>
- some perlcritic refactoring
(add_key): check reftype properly
(set_acl): send conten-length
* src/main/perl/lib/Amazon/S3/Constants.pm.in
- additional constants for refactoring
- move subs from t/01-api.t to S3TestUtils.pm
* src/main/perl/t/01-api.t: refactoring
* src/main/perl/t/02-logger.t: likewise
* src/main/perl/t/03-region.t: likewise
* src/main/perl/t/04-list-buckets.t: likewise
* src/main/perl/t/05-multipart-upload.t: likewise
* src/main/perl/t/06-list-multipart-uploads.t: likewise
* src/main/perl/test.localstack: converted to bash script
* src/main/perl/S3TestUtils.pm: new
* cpan/buildspec.yml: add above to distribution
Mon Mar 27 10:47:54 2023 Rob Lauer <rlauer6@comcast.net>
[0.61 - delete_keys()]:
* VERSION: bump
* NEWS.md: updated
* README.md: generated
(error): new
(reset_errors): new
(_remember_error): set error
* src/main/perl/lib/Amazon/S3/Bucket.pm.in
- pod tweaks, corrections
(new)
- + logger attribute
- + verify_region attribute, verify region if true
(_uri): remove leading '/'
(add_key): correct region if 301 response
(upload_multipart_object): debug messages
(upload_part_of_multipart_upload): likewise
(complete_multipart_upload): likewise
(get_key): remove redundant debug message
(delete_key): pass region to _send_request_expect_nothing
(set_acl): likewise
* src/main/perl/t/01-api.t: do not bailout on early tests
(error): new
(last_response): new
* src/main/perl/t/03-region.t: default region is us-east-1
Fri Jul 22 14:47:30 2022 Rob Lauer <rlauer6@comcast.net>
[0.55 - testing, revert to XML::Simple]:
* src/main/perl/t/01-api.t: remove /r option in regex
* src/main/perl/t/04-list-buckets: likewise
* src/main/perl/lib/Amazon/S3.pm: use XML::Simple
* src/main/perl/lib/Amazon/S3/Bucket.pm.in: likewise
(make_xml_document_simple): new
* src/main/perl/t/06-list-multipart-uploads.t: XML::Simple
* configure.ac: remove Lib::XML, Lib::XML::Simple, add XML::Simple
* cpan/requires: likewise
* TODO.md: new
Thu Jul 21 11:14:16 2022 Rob Lauer <rlauer6@comcast.net>
[0.55 - CI/CD]:
* .github/workflows/build.yml: remove make cpan
* README.md: generated
* src/main/perl/lib/Amazon/S3.pm.in: update badge
(_make_request): accept hash ref as argument
(get_bucket_location): new
(reset_signer_region): new
* src/main/perl/lib/Amazon/S3/Bucket.pm.in
- document multipart methods
- send region in all _make_request calls
(_send_request): check if arg is a request
(new)
- accept region argument
- set bucket region if region not passed
(upload_multipart_object): new
* src/main/perl/lib/Amazon/S3/Signature/V4: new
* src/main/perl/lib/Makefile.am: add above to build
* src/main/perl/t/05-multpart-upload.t: new
* src/main/perl/t/06-list-multpart-upload.t: new
Thu Jul 14 06:34:56 2022 Rob Lauer <rlauer6@comcast.net>>
[0.55 - use XML::LibXML]:
* VERSION: bump
* src/main/perl/lib/Amazon/S3.pm.in: use XML::LibXML, not XML::Simple
- perlcritic cleanups
- pod cleanup
(new)
- cache_signer
lib/Amazon/S3/Util.pm
Makefile.PL
MANIFEST This list of files
README-TESTING.md
README.md
S3TestUtils.pm
t/01-api.t
t/02-logger.t
t/03-region.t
t/04-list-buckets.t
t/05-multipart-upload.t
t/06-list-multipart-uploads.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
- add\_bucket
- add\_key
- get\_key
Can now be called with a hashref which may include both a `headers`
and `uri_params` object.
- delete\_bucket
- list\_bucket
- list\_object\_versions
- upload\_multipart\_object
## Comparison to Other Perl S3 Modules
Other implementations for accessing Amazon's S3 service include
`Net::Amazon::S3` and the `Paws` project. `Amazon::S3` ostensibly
was intended to be a drop-in replacement for `Net:Amazon::S3` that
"traded some performance in return for portability". That statement is
no longer accurate as `Amazon::S3` may have changed the interface in
ways that might break your applications if you are relying on
compatibility with `Net::Amazon::S3`.
When signing API calls, the region for the specific bucket will be
used. For calls that are not regional (`buckets()`, e.g.) the default
region ('us-east-1') will be used.
- Signature Version 2
[https://docs.aws.amazon.com/AmazonS3/latest/userguide/RESTAuthentication.html](https://docs.aws.amazon.com/AmazonS3/latest/userguide/RESTAuthentication.html)
- Multipart Upload Support
There are some recently added unit tests for multipart uploads that
seem to indicate this feature is working as expected. Please report
any deviation from expected results if you are using those methods.
For more information regarding multipart uploads visit the link below.
[https://docs.aws.amazon.com/AmazonS3/latest/API/API\_CreateMultipartUpload.html](https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateMultipartUpload.html)
# METHODS AND SUBROUTINES
Unless otherwise noted methods will return an `undef` if an error
occurs. You can get more information about the error by calling
`err()` and `errstr()`.
## new
lib/Amazon/S3.pm view on Meta::CPAN
sub turn_on_special_retry {
########################################################################
my ($self) = @_;
return
if !$self->retry;
# In the field we are seeing issue of Amazon returning with a 400
# code in the case of timeout. From AWS S3 logs: REST.PUT.PART
# Backups/2017-05-04/<account>.tar.gz "PUT
# /Backups<path>?partNumber=27&uploadId=<id> - HTTP/1.1" 400
# RequestTimeout 360 20971520 20478 - "-" "libwww-perl/6.15"
my $http_codes_hr = $self->ua->codes_to_determinate();
$http_codes_hr->{$HTTP_BAD_REQUEST} = $TRUE;
return;
}
########################################################################
sub turn_off_special_retry {
########################################################################
my ($self) = @_;
return
if !$self->retry;
# In the field we are seeing issue with Amazon returning a 400
# code in the case of timeout. From AWS S3 logs: REST.PUT.PART
# Backups/2017-05-04/<account>.tar.gz "PUT
# /Backups<path>?partNumber=27&uploadId=<id> - HTTP/1.1" 400
# RequestTimeout 360 20971520 20478 - "-" "libwww-perl/6.15"
my $http_codes_hr = $self->ua->codes_to_determinate();
delete $http_codes_hr->{$HTTP_BAD_REQUEST};
return;
}
########################################################################
sub region {
########################################################################
lib/Amazon/S3.pm view on Meta::CPAN
}
}
# don't include anything after the first ? in the resource...
# $path =~ /^([^?]*)/xsm;
# $buf .= "/$1";
$path =~ /\A([^?]*)/xsm;
$buf .= "/$1";
# ...unless there any parameters we're interested in...
if ( $path =~ /[&?](acl|torrent|location|uploads|delete)([=&]|$)/xsm ) {
# if ( $path =~ /[&?](acl|torrent|location|uploads|delete)([=&])?/xsm ) {
$buf .= "?$1";
}
elsif ( my %query_params = URI->new($path)->query_form ) {
# see if the remaining parsed query string provides us with any
# query string or upload id
if ( $query_params{partNumber} && $query_params{uploadId} ) {
# re-evaluate query string, the order of the params is important
# for request signing, so we can't depend on URI to do the right
# thing
$buf .= sprintf '?partNumber=%s&uploadId=%s',
$query_params{partNumber},
$query_params{uploadId};
}
elsif ( $query_params{uploadId} ) {
$buf .= sprintf '?uploadId=%s', $query_params{uploadId};
}
}
return $buf;
}
########################################################################
sub _trim {
########################################################################
my ( $self, $value ) = @_;
lib/Amazon/S3.pm view on Meta::CPAN
Can now be called with a hashref which may include both a C<headers>
and C<uri_params> object.
=item delete_bucket
=item list_bucket
=item list_object_versions
=item upload_multipart_object
=back
=back
=head2 Comparison to Other Perl S3 Modules
Other implementations for accessing Amazon's S3 service include
C<Net::Amazon::S3> and the C<Paws> project. C<Amazon::S3> ostensibly
was intended to be a drop-in replacement for C<Net:Amazon::S3> that
lib/Amazon/S3.pm view on Meta::CPAN
region ('us-east-1') will be used.
=item Signature Version 2
L<https://docs.aws.amazon.com/AmazonS3/latest/userguide/RESTAuthentication.html>
=back
=item Multipart Upload Support
There are some recently added unit tests for multipart uploads that
seem to indicate this feature is working as expected. Please report
any deviation from expected results if you are using those methods.
For more information regarding multipart uploads visit the link below.
L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateMultipartUpload.html>
=back
=head1 METHODS AND SUBROUTINES
Unless otherwise noted methods will return an C<undef> if an error
occurs. You can get more information about the error by calling
C<err()> and C<errstr()>.
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
########################################################################
sub add_key_filename {
########################################################################
my ( $self, $key, $value, $conf ) = @_;
return $self->add_key( $key, \$value, $conf );
}
########################################################################
sub upload_multipart_object {
########################################################################
my ( $self, @args ) = @_;
my $logger = $self->logger;
my $parameters = get_parameters(@args);
croak 'no key!'
if !$parameters->{key};
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
$length -= $bytes;
$logger->trace( sprintf '%s bytes left to read', $length );
return ( \$buffer, $bytes );
};
}
my $headers = $parameters->{headers} || {};
my $id = $self->initiate_multipart_upload( $parameters->{key}, $headers );
$logger->trace( sprintf 'multipart id: %s', $id );
my $part = 1;
my %parts;
my $key = $parameters->{key};
my $retval = eval {
while (1) {
my ( $buffer, $length ) = $parameters->{callback}->();
last if !$buffer;
my $etag = $self->upload_part_of_multipart_upload(
{ id => $id,
key => $key,
data => $buffer,
part => $part,
},
);
$parts{ $part++ } = $etag;
}
$self->complete_multipart_upload( $parameters->{key}, $id, \%parts );
};
if ( $EVAL_ERROR && $parameters->{abort_on_error} ) {
$self->abort_multipart_upload( $key, $id );
%parts = ();
}
return \%parts;
}
# Initiates a multipart upload operation. This is necessary for uploading
# files > 5Gb to Amazon S3
#
# returns: upload ID assigned by Amazon (used to identify this
# particular upload in other operations)
########################################################################
sub initiate_multipart_upload {
########################################################################
my ( $self, $key, $headers ) = @_;
croak 'Object key is required'
if !$key;
my $acct = $self->account;
my $request = $acct->_make_request(
{ region => $self->region,
method => 'POST',
path => $self->_uri($key) . '?uploads=',
headers => $headers,
},
);
my $response = $acct->_do_http($request);
$acct->_croak_if_response_error($response);
my $r = $acct->_xpc_of_content( $response->content );
return $r->{UploadId};
}
#
# Upload a part of a file as part of a multipart upload operation
# Each part must be at least 5mb (except for the last piece).
# This returns the Amazon-generated eTag for the uploaded file segment.
# It is necessary to keep track of the eTag for each part number
# The complete operation will want a sequential list of all the part
# numbers along with their eTags.
#
########################################################################
sub upload_part_of_multipart_upload {
########################################################################
my ( $self, @args ) = @_;
my ( $key, $upload_id, $part_number, $data, $length );
if ( @args == 1 ) {
if ( reftype( $args[0] ) eq 'HASH' ) {
( $key, $upload_id, $part_number, $data, $length )
= @{ $args[0] }{qw{ key id part data length}};
}
elsif ( reftype( $args[0] ) eq 'ARRAY' ) {
( $key, $upload_id, $part_number, $data, $length ) = @{ $args[0] };
}
}
else {
( $key, $upload_id, $part_number, $data, $length ) = @args;
}
# argh...wish we didn't have to do this!
if ( ref $data ) {
$data = ${$data};
}
$length = $length || length $data;
croak 'Object key is required'
if !$key;
croak 'Upload id is required'
if !$upload_id;
croak 'Part Number is required'
if !$part_number;
my $headers = {};
my $acct = $self->account;
set_md5_header( data => $data, headers => $headers );
my $path = create_api_uri(
path => $self->_uri($key),
partNumber => ${part_number},
uploadId => ${upload_id}
);
my $params = $QUESTION_MARK
. create_query_string(
partNumber => ${part_number},
uploadId => ${upload_id}
);
$self->logger->debug(
sub {
return Dumper(
[ part => $part_number,
length => length $data,
path => $path,
]
);
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
if ($etag) {
$etag =~ s/^"//xsm;
$etag =~ s/"$//xsm;
}
return $etag;
}
#
# Inform Amazon that the multipart upload has been completed
# You must supply a hash of part Numbers => eTags
# For amazon to use to put the file together on their servers.
#
########################################################################
sub complete_multipart_upload {
########################################################################
my ( $self, $key, $upload_id, $parts_hr ) = @_;
$self->logger->debug( Dumper( [ $key, $upload_id, $parts_hr ] ) );
croak 'Object key is required'
if !$key;
croak 'Upload id is required'
if !$upload_id;
croak 'Part number => etag hashref is required'
if ref $parts_hr ne 'HASH';
# The complete command requires sending a block of xml containing all
# the part numbers and their associated etags (returned from the upload)
my $content = _create_multipart_upload_request($parts_hr);
$self->logger->debug("content: \n$content");
my $md5 = md5($content);
my $md5_base64 = encode_base64($md5);
chomp $md5_base64;
my $headers = {
'Content-MD5' => $md5_base64,
'Content-Length' => length $content,
'Content-Type' => 'application/xml',
};
my $acct = $self->account;
my $params = "?uploadId=${upload_id}";
my $request = $acct->_make_request(
{ region => $self->region,
method => 'POST',
path => $self->_uri($key) . $params,
headers => $headers,
data => $content,
},
);
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
if ( $response->code !~ /\A2\d\d\z/xsm ) {
$acct->_remember_errors( $response->content, 1 );
croak $response->status_line;
}
return $TRUE;
}
########################################################################
sub abort_multipart_upload {
########################################################################
my ( $self, $key, $upload_id ) = @_;
croak 'Object key is required'
if !$key;
croak 'Upload id is required'
if !$upload_id;
my $acct = $self->account;
my $params = "?uploadId=${upload_id}";
my $request = $acct->_make_request(
{ region => $self->region,
method => 'DELETE',
path => $self->_uri($key) . $params,
},
);
my $response = $acct->_do_http($request);
$acct->_croak_if_response_error($response);
return $TRUE;
}
#
# List all the uploaded parts for an ongoing multipart upload
# It returns the block of XML returned from Amazon
#
########################################################################
sub list_multipart_upload_parts {
########################################################################
my ( $self, $key, $upload_id, $headers ) = @_;
croak 'Object key is required'
if !$key;
croak 'Upload id is required'
if !$upload_id;
my $acct = $self->account;
my $params = "?uploadId=${upload_id}";
my $request = $acct->_make_request(
{ region => $self->region,
method => 'GET',
path => $self->_uri($key) . $params,
headers => $headers,
},
);
my $response = $acct->_do_http($request);
$acct->_croak_if_response_error($response);
# Just return the XML, let the caller figure out what to do with it
return $response->content;
}
# List all the currently active multipart upload operations
# Returns the block of XML returned from Amazon
########################################################################
sub list_multipart_uploads {
########################################################################
my ( $self, $headers ) = @_;
my $acct = $self->account;
my $request = $acct->_make_request(
{ region => $self->region,
method => 'GET',
path => $self->_uri() . '?uploads',
headers => $headers,
},
);
my $response = $acct->_do_http($request);
$acct->_croak_if_response_error($response);
# Just return the XML, let the caller figure out what to do with it
return $response->content;
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
$fh->binmode;
$remaining = $stat->size;
}
my $read = $fh->read( $buffer, $blksize );
if ( !$read ) {
croak
"Error while reading upload content $filename ($remaining remaining) $OS_ERROR"
if $OS_ERROR and $remaining;
$fh->close # otherwise, we found EOF
or croak "close of upload content $filename failed: $OS_ERROR";
$buffer ||= $EMPTY; # LWP expects an empty string on finish, read returns 0
}
$remaining -= length $buffer;
return $buffer;
};
}
########################################################################
sub _create_multipart_upload_request {
########################################################################
my ($parts_hr) = @_;
my @parts;
foreach my $part_num ( sort { $a <=> $b } keys %{$parts_hr} ) {
push @parts,
{
PartNumber => $part_num,
ETag => $parts_hr->{$part_num},
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
The decoded XML string as a hash object of the last error.
=head2 last_response
Returns the last C<HTTP::Response> to an API call.
=head1 MULTIPART UPLOAD SUPPORT
From Amazon's website:
I<Multipart upload allows you to upload a single object as a set of
parts. Each part is a contiguous portion of the object's data. You can
upload these object parts independently and in any order. If
transmission of any part fails, you can retransmit that part without
affecting other parts. After all parts of your object are uploaded,
Amazon S3 assembles these parts and creates the object. In general,
when your object size reaches 100 MB, you should consider using
multipart uploads instead of uploading the object in a single
operation.>
See L<https://docs.aws.amazon.com/AmazonS3/latest/userguide/mpuoverview.html> for more information about multipart uploads.
=over 5
=item * Maximum object size 5TB
=item * Maximum number of parts 10,000
=item * Part numbers 1 to 10,000 (inclusive)
=item * Part size 5MB to 5GB. There is no limit on the last part of your multipart upload.
=item * Maximum nubmer of parts returned for a list parts request - 1000
=item * Maximum number of multipart uploads returned in a list multipart uploads request - 1000
=back
A multipart upload begins by calling
C<initiate_multipart_upload()>. This will return an identifier that is
used in subsequent calls.
my $bucket = $s3->bucket('my-bucket');
my $id = $bucket->initiate_multipart_upload('some-big-object');
my $part_list = {};
my $part = 1;
my $etag = $bucket->upload_part_of_multipart_upload('my-bucket', $id, $part, $data, length $data);
$part_list{$part++} = $etag;
$bucket->complete_multipart_upload('my-bucket', $id, $part_list);
=heads upload_multipart_object
upload_multipart_object( ... )
Convenience routine C<upload_multipart_object> that encapsulates the
multipart upload process. Accepts a hash or hash reference of
arguments. If successful, a reference to a hash that contains the part
numbers and etags of the uploaded parts.
You can pass a data object, callback routine or a file handle.
=over 5
=item key
Name of the key to create.
=item data
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
Optionally provided a callback routine that will be called until you
pass a buffer with a length of 0. Your callback will receive no
arguments but should return a tuple consisting of a B<reference> to a
scalar object that contains the data to write and a scalar that
represents the length of data. Once you return a zero length buffer
the multipart process will be completed.
=item fh
File handle of an open file. The file must be greater than the minimum
chunk size for multipart uploads otherwise the method will throw an
exception.
=item abort_on_error
Indicates whether the multipart upload should be aborted if an error
is encountered. Amazon will charge you for the storage of parts that
have been uploaded unless you abort the upload.
default: true
=back
=head2 abort_multipart_upload
abort_multipart_upload(key, multpart-upload-id)
Abort a multipart upload
=head2 complete_multipart_upload
complete_multipart_upload(key, multpart-upload-id, parts)
Signal completion of a multipart upload. C<parts> is a reference to a
hash of part numbers and etags.
=head2 initiate_multipart_upload
initiate_multipart_upload(key, headers)
Initiate a multipart upload. Returns an id used in subsequent call to
C<upload_part_of_multipart_upload()>.
=head2 list_multipart_upload_parts
List all the uploaded parts of a multipart upload
=head2 list_multipart_uploads
List multipart uploads in progress
=head2 upload_part_of_multipart_upload
upload_part_of_multipart_upload(key, id, part, data, length)
Upload a portion of a multipart upload
=over 5
=item key
Name of the key in the bucket to create.
=item id
The multipart-upload id return in the C<initiate_multipart_upload> call.
=item part
The next part number (part numbers start at 1).
=item data
Scalar or reference to a scalar that contains the data to upload.
=item length (optional)
Length of the data.
=back
=head1 SEE ALSO
L<Amazon::S3>
lib/Amazon/S3/BucketV2.pm view on Meta::CPAN
put_object => $EMPTY,
put_object_acl => 'acl',
put_object_tagging => 'tagging',
put_object_retention => 'retention',
put_object_legal_hold => 'legal-hold',
put_object_lock_configuraiton => 'lock-object',
put_public_access_block => 'publicAccessBlock',
restore_object => sub {
return { method => 'POST', api => 'restore' };
},
upload_part => $EMPTY,
upload_part_copy => $EMPTY,
);
create_methods(
type => 'object',
method => 'PUT',
method_def => \@PUT_OBJECT_METHODS,
);
######################################################################
our @DELETE_OBJECT_METHODS = (
lib/Amazon/S3/BucketV2.pm view on Meta::CPAN
L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_PutObjectTagging.html>
=head2 put_public_access_block
L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_PutPublicAccessBlock.html>
=head2 restore_object
L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_RestoreObject.html>
=head2 upload_part
L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html>
=head2 upload_part_copy
L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPartCopy.html>
=head1 SEE OTHER
L<Amazon::S3>, L<Amazon::S3::Bucket>
=head1 AUTHOR
Rob Lauer - <bigfoot@cpan.org>
t/05-multipart-upload.t view on Meta::CPAN
if ( $EVAL_ERROR || !$bucket_obj ) {
BAIL_OUT( $s3->err . ": " . $s3->errstr );
} ## end if ( $EVAL_ERROR || !$bucket_obj)
########################################################################
subtest 'multipart-manual' => sub {
########################################################################
my $key = 'big-object-1';
my $id = $bucket_obj->initiate_multipart_upload($key);
my $part_list = {};
my $part = 0;
my $data = 'x' x ( 1024 * 1024 * 5 ); # 5 MB part
my $etag
= $bucket_obj->upload_part_of_multipart_upload( $key, $id, ++$part, $data,
length $data );
$part_list->{$part} = $etag;
$bucket_obj->complete_multipart_upload( $key, $id, $part_list );
my $head = $bucket_obj->head_key($key);
ok( $head, 'uploaded file' );
ok( $head->{content_length} == 5 * 1024 * 1024, 'uploaded 1 part' )
or diag( Dumper( [$head] ) );
ok( $bucket_obj->delete_key($key) );
};
########################################################################
subtest 'multipart-file' => sub {
########################################################################
my ( $fh, $file ) = tempfile();
t/05-multipart-upload.t view on Meta::CPAN
$fh->close;
if ( !open( $fh, '<', $file ) ) {
carp "could not open $file after writing";
return;
}
my $key = 'big-object-2';
$bucket_obj->upload_multipart_object( fh => $fh, key => $key );
close $fh;
my $head = $bucket_obj->head_key($key);
ok( $head, 'uploaded file' );
isa_ok( $head, 'HASH', 'head is a hash' );
ok( $head->{content_length} == 11 * 1024 * 1024, 'uploaded all parts' );
$bucket_obj->delete_key($key);
unlink $file;
};
########################################################################
subtest 'multipart-2-parts' => sub {
########################################################################
my $length = 1024 * 1024 * 7;
my $data = 'x' x $length;
my $key = 'big-object-3';
$bucket_obj->upload_multipart_object(
key => $key,
data => $data
);
my $head = $bucket_obj->head_key($key);
isa_ok( $head, 'HASH', 'head is a hash' );
ok( $head, 'uploaded data' );
ok( $head->{content_length} == $length, 'uploaded all parts' );
$bucket_obj->delete_key($key);
};
########################################################################
subtest 'multipart-callback' => sub {
########################################################################
my $key = 'big-object-4';
my @part = ( 5, 5, 5, 1 );
my $size;
$bucket_obj->upload_multipart_object(
key => $key,
callback => sub {
return ( q{}, 0 ) unless @part;
my $length = shift @part;
$length *= 1024 * 1024;
$size += $length;
my $data = 'x' x $length;
return ( \$data, $length );
}
);
my $head = $bucket_obj->head_key($key);
isa_ok( $head, 'HASH', 'head is a hash' );
ok( $head, 'uploaded data' );
ok( $head->{content_length} == $size, 'uploaded all parts' );
$bucket_obj->delete_key($key);
};
########################################################################
$bucket_obj->delete_bucket()
or diag( $s3->errstr );
1;
t/06-list-multipart-uploads.t view on Meta::CPAN
ok( ref $bucket_obj, 'created bucket - ' . $bucket_name );
if ( $EVAL_ERROR || !$bucket_obj ) {
BAIL_OUT( $s3->err . ": " . $s3->errstr );
} ## end if ( $EVAL_ERROR || !$bucket_obj)
my $id;
my $key = 'big-object-1';
########################################################################
subtest 'list-multipart-uploads' => sub {
########################################################################
my $upload_list = list_multipart_uploads($bucket_obj);
ok( !defined $upload_list, 'no in-progress uploads' )
or diag( Dumper( [$upload_list] ) );
$id = partial_upload( $key, $bucket_obj );
$upload_list = list_multipart_uploads($bucket_obj);
ok( $upload_list->{UploadId} eq $id, 'UploadId eq $id' );
};
########################################################################
subtest 'abort-multipart-upload' => sub {
########################################################################
$bucket_obj->abort_multipart_upload( $key, $id );
my $upload_list = list_multipart_uploads($bucket_obj);
ok( !defined $upload_list, 'aborted upload' );
};
########################################################################
subtest 'abort-on-error' => sub {
########################################################################
my $id = $bucket_obj->initiate_multipart_upload($key);
my $part_list = {};
my $part = 0;
my $data = 'x' x ( 1024 * 1024 * 1 ); # should be too small
# do this twice...
foreach ( 0 .. 1 ) {
my $etag
= $bucket_obj->upload_part_of_multipart_upload( $key, $id, ++$part,
$data, length $data );
$part_list->{$part} = $etag;
}
eval { $bucket_obj->complete_multipart_upload( $key, $id, $part_list ); };
ok( $EVAL_ERROR =~ /Bad Request/i, 'abort-on-error successful' )
or diag( Dumper( [ $EVAL_ERROR, $id ] ) );
$bucket_obj->abort_multipart_upload( $key, $id );
};
########################################################################
$bucket_obj->delete_bucket()
or diag( $s3->errstr );
########################################################################
sub partial_upload {
########################################################################
my ( $key, $bucket_obj, $size_in_mb ) = @_;
my $id = $bucket_obj->initiate_multipart_upload($key);
my $length = ( $size_in_mb || 5 ) * 1024 * 1024;
my $data = 'x' x $length;
my $etag
= $bucket_obj->upload_part_of_multipart_upload( $key, $id, 1, $data,
$length );
return $id;
}
########################################################################
sub list_multipart_uploads {
########################################################################
my ($bucket_obj) = @_;
my $xml = $bucket_obj->list_multipart_uploads;
ok( $xml =~ /^</xms, 'is xml result' );
my $uploads = XMLin( $xml, KeepRoot => $TRUE );
isa_ok( $uploads, 'HASH', 'made a hash object' )
or diag($uploads);
ok( defined $uploads->{ListMultipartUploadsResult},
'looks like a results object' )
or diag($xml);
my $upload_list = $uploads->{ListMultipartUploadsResult}->{Upload};
return $upload_list;
}
1;
( run in 2.429 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )