Amazon-S3
view release on metacpan or search on metacpan
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
# 301 and you'll only know the region of redirection - no location
# header provided...
if ($EVAL_ERROR) {
my $rsp = $account->last_response;
if ( $rsp->code eq $HTTP_MOVED_PERMANENTLY ) {
$self->region( $rsp->headers->{'x-amz-bucket-region'} );
}
$retval = $self->_add_key(
{ headers => $headers,
data => $value,
key => $key,
},
);
}
return $retval;
}
########################################################################
sub _add_key {
########################################################################
my ( $self, @args ) = @_;
my ( $data, $headers, $key ) = @{ $args[0] }{qw{data headers key}};
my $account = $self->account;
if ( ref $data ) {
return $account->_send_request_expect_nothing_probed(
{ method => 'PUT',
path => $self->_uri($key),
headers => $headers,
data => $data,
region => $self->region,
},
);
}
else {
return $account->_send_request_expect_nothing(
{ method => 'PUT',
path => $self->_uri($key),
headers => $headers,
data => $data,
region => $self->region,
},
);
}
}
########################################################################
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};
croak 'either data, callback or fh must be set!'
if !$parameters->{data} && !$parameters->{callback} && !$parameters->{fh};
croak 'callback must be a reference to a subroutine!'
if $parameters->{callback}
&& reftype( $parameters->{callback} ) ne 'CODE';
$parameters->{abort_on_error} //= $TRUE;
$parameters->{chunk_size} //= $MIN_MULTIPART_UPLOAD_CHUNK_SIZE;
if ( !$parameters->{callback} && !$parameters->{fh} ) {
#...but really nobody should be passing a >5MB scalar
my $data
= ref $parameters->{data} ? $parameters->{data} : \$parameters->{data};
$parameters->{fh} = IO::Scalar->new($data);
}
# ...having a file handle implies, we use this callback
if ( $parameters->{fh} ) {
my $fh = $parameters->{fh};
$fh->seek( 0, 2 );
my $length = $fh->tell;
$fh->seek( 0, 0 );
$logger->trace( sub { return sprintf 'length of object: %s', $length; } );
croak 'length of the object must be >= '
. $MIN_MULTIPART_UPLOAD_CHUNK_SIZE
if $length < $MIN_MULTIPART_UPLOAD_CHUNK_SIZE;
my $chunk_size
= ( $parameters->{chunk_size} && $parameters->{chunk_size} )
> $MIN_MULTIPART_UPLOAD_CHUNK_SIZE
? $parameters->{chunk_size}
: $MIN_MULTIPART_UPLOAD_CHUNK_SIZE;
$parameters->{callback} = sub {
return
if !$length;
my $bytes_read = 0;
my $n = $length >= $chunk_size ? $chunk_size : $length;
$logger->trace( sprintf 'reading %d bytes', $n );
my $buffer;
my $bytes = $fh->read( $buffer, $n, $bytes_read );
$logger->trace( sprintf 'read %d bytes', $bytes );
$bytes_read += $bytes;
$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,
]
);
}
);
my $request = $acct->_make_request(
{ region => $self->region,
method => 'PUT',
path => $self->_uri($key) . $params,
#path => $path,
headers => $headers,
data => $data,
},
);
my $response = $acct->_do_http($request);
$acct->_croak_if_response_error($response);
# We'll need to save the etag for later when completing the transaction
my $etag = $response->header('ETag');
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,
},
);
my $response = $acct->_do_http($request);
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;
}
########################################################################
sub head_key {
########################################################################
my ( $self, $key ) = @_;
return $self->get_key( $key, 'HEAD' );
}
########################################################################
sub get_key_v2 {
########################################################################
my ( $self, $key, $method, $headers ) = @_;
return $self->_get_key( $key, $method, undef, $headers );
}
########################################################################
sub get_key {
########################################################################
my ( $self, @args ) = @_;
my ( $key, $method, $headers, $uri_params );
if ( ref $args[0] ) {
( $key, $method, $headers, $uri_params )
= @{ $args[0] }{qw(key method headers uri_params)};
}
else {
( $key, $method, $headers, $uri_params ) = @args;
}
return $self->_get_key(
key => $key,
method => $method,
filename => undef,
headers => $headers,
uri_params => $uri_params,
);
}
########################################################################
sub _get_key {
########################################################################
my ( $self, @args ) = @_;
my $parameters = get_parameters(@args);
my ( $key, $method, $filename, $headers, $uri_params )
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
########################################################################
sub err {
########################################################################
my ($self) = @_;
return $self->account->err;
}
########################################################################
sub errstr {
########################################################################
my ($self) = @_;
return $self->account->errstr;
}
########################################################################
sub error {
########################################################################
my ($self) = @_;
return $self->account->error;
}
########################################################################
sub _content_sub {
########################################################################
my ( $filename, $buffer_size ) = @_;
my $stat = stat $filename;
my $remaining = $stat->size;
my $blksize = $stat->blksize || $buffer_size;
croak "$filename not a readable file with fixed size"
if !-r $filename || !$remaining;
my $fh = IO::File->new( $filename, 'r' )
or croak "Could not open $filename: $OS_ERROR";
$fh->binmode;
return sub {
my $buffer;
# upon retries the file is closed and we must reopen it
if ( !$fh->opened ) {
$fh = IO::File->new( $filename, 'r' )
or croak "Could not open $filename: $OS_ERROR";
$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},
};
}
return create_xml_request(
{ CompleteMultipartUpload => { Part => \@parts } } );
}
1;
__END__
=pod
=head1 NAME
Amazon::S3::Bucket - A container class for a S3 bucket and its contents.
=head1 SYNOPSIS
use Amazon::S3;
# creates bucket object (no "bucket exists" check)
my $bucket = $s3->bucket("foo");
# create resource with meta data (attributes)
my $keyname = 'testing.txt';
my $value = 'T';
$bucket->add_key(
$keyname, $value,
{ content_type => 'text/plain',
'x-amz-meta-colour' => 'orange',
}
);
# list keys in the bucket
$response = $bucket->list
or die $s3->err . ": " . $s3->errstr;
print $response->{bucket}."\n";
for my $key (@{ $response->{keys} }) {
print "\t".$key->{key}."\n";
}
# check if resource exists.
print "$keyname exists\n" if $bucket->head_key($keyname);
# delete key from bucket
$bucket->delete_key($keyname);
=head1 DESCRIPTION
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
Returns a boolean indicating the operations success.
=head2 get_location_constraint
Returns the location constraint (region the bucket resides in) for a
bucket. Returns undef if there is no location constraint.
Valid values that may be returned:
af-south-1
ap-east-1
ap-northeast-1
ap-northeast-2
ap-northeast-3
ap-south-1
ap-southeast-1
ap-southeast-2
ca-central-1
cn-north-1
cn-northwest-1
EU
eu-central-1
eu-north-1
eu-south-1
eu-west-1
eu-west-2
eu-west-3
me-south-1
sa-east-1
us-east-2
us-gov-east-1
us-gov-west-1
us-west-1
us-west-2
For more information on location constraints, refer to the
documentation for
L<GetBucketLocation|https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetBucketLocation.html>.
=head2 err
The S3 error code for the last error the account encountered.
=head2 errstr
A human readable error string for the last error the account encountered.
=head2 error
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
Scalar object that contains the data to write to S3.
=item callback
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>
=head1 AUTHOR
Please see the L<Amazon::S3> manpage for author, copyright, and
license information.
=head1 CONTRIBUTORS
Rob Lauer
Jojess Fournier
Tim Mullin
Todd Rinaldo
luiserd97
=cut
( run in 0.607 second using v1.01-cache-2.11-cpan-b16cb0d3907 )