AWS-S3
view release on metacpan or search on metacpan
- Fix leading slashes defaults to off, see honor_leading_slashes arg
0.17 2019-03-01
- Fix leading slashes in key names (GH #12)
- Fix lack of location shouldn't set it to undef (GH #11)
0.16 2019-01-03
- Remove dependency on Iterator::Paged
0.15 2018-04-20
- More fixes for ->add_bucket. Fix an error when no location is provided or
us-east-1 is explicitly asked for. Patch by Dave Rolsky. (GH #9)
0.14 2018-04-13
- Fix sending of undefined location param in ->add_bucket (GH #9)
0.13 2017-02-06
- Add documentation for parameter 'prefix' for AWS::S3::FileIterator
- Add test coverage (GH #8, thanks to simbabque for these changes)
- Fix over encoding of characters in path (GH #6)
Work done by Evan Carroll (http://www.evancarroll.com)
- Migrated to Moose & removed dependencies on VSO
- Fixed bug introduced by previous commit, reverted to contenttype & all tests pass
0.028 2012-03-01
- Fixed: AWS/S3.pm required a higher version of VSO than the Makefile.PL and META.yml.
- Strange: Local testing shows $bucket->delete_multi works, but it gives me
some problems in production.
0.027 2012-02-24
- Fixed sporadic error:
"Invalid value for AWS::S3::File.size: isn't a Int: [Str] 'contenttype': Must contain only numbers 0-9"
0.026 2012-01-30
- $bucket->file( $missing_file ) was failing silently, causing strange behavior
further upstream. Now it will confess with the http response from S3.
0.025 2012-01-12
- $bucket->delete_multi( @keys ) actually works now.
0.024 2012-01-05
README.markdown view on Meta::CPAN
Returns nothing otherwise.
## add\_bucket( name => $name, location => 'us-west-1' )
Attempts to create a new bucket with the name provided. The location parameter is optional
and, as per the AWS docs, will default to "us-east-1".
On success, returns the new [AWS::S3::Bucket](https://metacpan.org/pod/AWS%3A%3AS3%3A%3ABucket)
On failure, dies with the error message.
See [AWS::S3::Bucket](https://metacpan.org/pod/AWS%3A%3AS3%3A%3ABucket) for details on how to use buckets (and access their files).
# SEE ALSO
[The Amazon S3 API Documentation](http://docs.amazonwebservices.com/AmazonS3/latest/API/)
[AWS::S3::Bucket](https://metacpan.org/pod/AWS%3A%3AS3%3A%3ABucket)
[AWS::S3::File](https://metacpan.org/pod/AWS%3A%3AS3%3A%3AFile)
lib/AWS/S3.pm view on Meta::CPAN
$type,
bucket => $args{name},
(
$args{location} ? ( location => $args{location} )
: $s->region ? ( location => $s->region )
: ()
),
);
my $response = $request->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return $s->bucket( $args{name} );
} # end add_bucket()
__PACKAGE__->meta->make_immutable;
__END__
lib/AWS/S3.pm view on Meta::CPAN
Returns nothing otherwise.
=head2 add_bucket( name => $name, location => 'us-west-1' )
Attempts to create a new bucket with the name provided. The location parameter is optional
and, as per the AWS docs, will default to "us-east-1".
On success, returns the new L<AWS::S3::Bucket>
On failure, dies with the error message.
See L<AWS::S3::Bucket> for details on how to use buckets (and access their files).
=head1 SEE ALSO
L<The Amazon S3 API Documentation|http://docs.amazonwebservices.com/AmazonS3/latest/API/>
L<AWS::S3::Bucket>
L<AWS::S3::File>
lib/AWS/S3/Bucket.pm view on Meta::CPAN
else {
die "Attempt to set an invalid value for acl: '$new_val'";
}
my $type = 'SetBucketAccessControl';
my $req = $self->s3->request( $type, %acl, bucket => $self->name, );
my $response = $req->request();
return if $response->response->code == 404;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
$self->_clear_acl;
}
);
has 'location_constraint' => (
is => 'ro',
isa => 'Str',
lib/AWS/S3/Bucket.pm view on Meta::CPAN
required => 0,
lazy => 1,
clearer => '_clear_policy',
default => sub {
my $self = shift;
my $type = 'GetBucketPolicy';
my $req = $self->s3->request( $type, bucket => $self->name, );
my $response = $req->request();
eval { $response->_parse_errors };
if ( my $msg = $response->friendly_error() ) {
if ( $response->error_code eq 'NoSuchBucketPolicy' ) {
return '';
} else {
die $msg;
} # end if()
} # end if()
return $response->response->decoded_content();
},
trigger => sub {
my ( $self, $policy ) = @_;
lib/AWS/S3/Bucket.pm view on Meta::CPAN
my $type = 'SetBucketPolicy';
my $req = $self->s3->request(
$type,
bucket => $self->name,
policy => $policy,
);
my $response = $req->request();
#warn "NewPolicy:($policy).......\n";
#warn $response->response->as_string;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
$self->_clear_policy;
}
);
# XXX: Not tested.
sub enable_cloudfront_distribution {
lib/AWS/S3/Bucket.pm view on Meta::CPAN
} # end add_file()
sub delete {
my ( $s ) = @_;
my $type = 'DeleteBucket';
my $req = $s->s3->request( $type, bucket => $s->name, );
my $response = $req->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return 1;
} # end delete()
# Working as of v0.023
sub delete_multi {
my ( $s, @keys ) = @_;
lib/AWS/S3/Bucket.pm view on Meta::CPAN
if @keys > 1000;
my $type = 'DeleteMulti';
my $req = $s->s3->request(
$type,
bucket => $s->name,
keys => \@keys,
);
my $response = $req->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return 1;
} # end delete_multi()
sub _get_property {
my ( $s, $type, %args ) = @_;
my $req = $s->s3->request( $type, bucket => $s->name, %args );
my $response = $req->request();
return if $response->response->code == 404;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return $response;
} # end _get_property()
__PACKAGE__->meta->make_immutable;
__END__
lib/AWS/S3/File.pm view on Meta::CPAN
file => $s,
contents => $ref,
content_type => $s->contenttype,
server_side_encryption => $s->is_encrypted ? 'AES256' : undef,
)->request();
( my $etag = $response->response->header( 'etag' ) ) =~ s{^"}{};
$etag =~ s{"$}{};
$s->{etag} = $etag;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
} # end _set_contents()
sub signed_url {
my $s = shift;
my $expires = shift || 3600;
# expiry for v4 signature is in seconds, not epoch time
if ( $expires > time ) {
lib/AWS/S3/File.pm view on Meta::CPAN
my $s = shift;
my $type = 'DeleteFile';
my $req = $s->bucket->s3->request(
$type,
bucket => $s->bucket->name,
key => $s->key,
);
my $response = $req->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return 1;
} # end delete()
__PACKAGE__->meta->make_immutable;
__END__
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
}
sub page_number {
my $s = shift;
@_ ? $s->{page_number} = $_[0] - 1 : $s->{page_number};
} # end page_number()
# S3 returns files 100 at a time. If we want more or less than 100, we can't
# just fetch the next page over and over - that would be inefficient and likely
# to cause errors.
# If the page size is 5 and page number is 2, then we:
# - fetch 100 items
# - store them
# - iterate internally until we get to 'page 2'
# - return the result.
# If the page size is 105 and page number is 1, then we:
# - fetch 100 items
# - fetch the next 100 items
# - return the first 105 items, keeping the remaining 95 items
lib/AWS/S3/Request/CreateBucket.pm view on Meta::CPAN
required => 0,
default => sub { shift->s3->region || $ENV{AWS_REGION} },
);
has '+_expect_nothing' => ( default => 1 );
sub request {
my $s = shift;
# By default the bucket is put in us-east-1. But if you _ask_ for
# us-east-1 you get an error.
my $xml = q{};
if ( $s->location && $s->location ne 'us-east-1' ) {
$xml = <<"XML";
<CreateBucketConfiguration xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
<LocationConstraint>@{[ $s->location ]}</LocationConstraint>
</CreateBucketConfiguration>
XML
}
my $signer = AWS::S3::Signer->new(
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
required => 1,
default => 0,
trigger => sub {
my ( $self, $expect_nothing) = @_;
if ( $expect_nothing ) {
my $code = $self->response->code;
if ( $code =~ m{^2\d\d} && !$self->response->content ) {
return; # not sure what jdrago wanted this to do originally
}
else {
if ( $self->_parse_errors() ) {
# die $self->friendly_error();
}
else {
return;
}
}
}
}
);
has 'response' => (
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
required => 1,
);
has 'libxml' => (
is => 'ro',
isa => 'XML::LibXML',
required => 1,
default => sub { return XML::LibXML->new() },
);
has 'error_code' => (
is => 'rw',
isa => 'Str',
required => 0,
);
has 'error_message' => (
is => 'rw',
isa => 'Str',
required => 0,
);
has 'xpc' => (
is => 'ro',
isa => 'XML::LibXML::XPathContext',
required => 0,
lazy => 1,
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
return unless $src =~ m/^[[:space:]]*</s;
my $doc = $self->libxml->parse_string( $src );
my $xpc = XML::LibXML::XPathContext->new( $doc );
$xpc->registerNs( 's3', 'http://s3.amazonaws.com/doc/2006-03-01/' );
return $xpc;
}
);
has 'friendly_error' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
required => 0,
default => sub {
my $s = shift;
return unless $s->error_code || $s->error_message;
$s->type . " call had errors: [" . $s->error_code . "] " . $s->error_message;
}
);
sub _parse_errors {
my $self = shift;
my $src = $self->response->content;
# Do not try to parse non-xml:
unless ( $src =~ m/^[[:space:]]*</s ) {
( my $code = $src ) =~ s/^[[:space:]]*\([0-9]*\).*$/$1/s;
$self->error_code( $code );
$self->error_message( $src );
return 1;
} # end unless()
## Originally at this point the re-setting of xpc would happen
## Does not seem to be needed but it may be a problem area
## Feel free to delete - Evan Carroll 2012/06/14
#### $s->_clear_xpc;
if ( $self->xpc->findnodes( "//Error" ) ) {
$self->error_code( $self->xpc->findvalue( "//Error/Code" ) );
$self->error_message( $self->xpc->findvalue( "//Error/Message" ) );
return 1;
}
return 0;
}
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
-secret_key An AWS secret key
-security_token A VM::EC2::Security::Token object
-service An AWS service
-region An AWS region
If a security token is provided, it overrides any values given for
-access_key or -secret_key.
If the environment variables EC2_ACCESS_KEY and/or EC2_SECRET_KEY are
set, their contents are used as defaults for -access_key and
-secret_key.
If -service and/or -region is not provided, they are automtically determined
according to endpoint.
=cut
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
request using an "X-Amz-Date header." To force the date and time to a
fixed value, include the "Date" header in the request.
The request content, or "payload" is retrieved from the HTTP::Request
object by calling its content() method.. Under some circumstances the
payload is not included directly in the request, but is in an external
file that will be uploaded as the request is executed. In this case,
you must pass a second argument containing the results of running
sha256_hex() (from the Digest::SHA module) on the content.
The method returns a true value if successful. On errors, it will
throw an exception.
=item $url = $signer->signed_url($request)
This method will generate a signed GET URL for the request. The URL
will include everything needed to perform the request.
=cut
sub sign {
t/010_basic.t view on Meta::CPAN
# use alternative update method
$new_contents = 'More new content';
$file->update( contents => \$new_contents );
is ${$bucket->file($filename)->contents}, $new_contents, "set file.update works";
};
DELETE_FILE: {
eval { $bucket->delete };
ok $@, 'bucket.delete fails when bucket is not empty.';
like $@, qr/BucketNotEmpty/, 'error looks like BucketNotEmpty';
ok $bucket->file($filename)->delete, 'file.delete';
ok ! $bucket->file($filename), 'file no longer exists in bucket';
};
ADD_MANY_FILES: {
my %info = ( );
# Add the files:
for( 0..25 )
{
is( $owner->display_name, 'webfile', '... and the owner name is correct' );
my @buckets = $s3->buckets;
cmp_deeply( \@buckets,
[ obj_isa('AWS::S3::Bucket'), obj_isa('AWS::S3::Bucket') ], '->buckets' );
ok( ! $s3->bucket( 'does not exist' ),'!->bucket' );
is( $s3->bucket( 'foo' )->name, 'foo', '->bucket' );
}
{
my $xml = get_data_section('error.xml');
local *LWP::UserAgent::Determined::request = sub {
return Mocked::HTTP::Response->new( 400,$xml );
};
throws_ok { $s3->add_bucket( name => 'too many buckets', location => 'us-west-1' ) }
qr/TooManyBuckets/, 'add_bucket throws an error';
}
__DATA__
@@ ListAllMyBucketsResult.xml
<?xml version="1.0" encoding="UTF-8"?>
<ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
<Owner>
<ID>bcaf1ffd86f41161ca5fb16fd081034f</ID>
<DisplayName>webfile</DisplayName>
</Owner>
<Buckets>
<Bucket>
<Name>foo</Name>
<CreationDate>2006-02-03T16:45:09.000Z</CreationDate>
</Bucket>
<Bucket>
<Name>bar</Name>
<CreationDate>2006-02-03T16:41:58.000Z</CreationDate>
</Bucket>
</Buckets>
</ListAllMyBucketsResult>
@@ error.xml
<?xml version="1.0" encoding="UTF-8"?>
<Error>
<Code>TooManyBuckets</Code>
<Message>You have attempted to create more buckets than allowed.</Message>
<Resource>/mybucket</Resource>
<RequestId>4442587FB7D0A2F9</RequestId>
</Error>
t/aws/s3/file.t view on Meta::CPAN
done_testing();
sub monkey_patch_module {
# monkey patching for true(r) unit tests
no warnings 'redefine';
no warnings 'once';
sub response { return shift; }
sub header { return shift; }
sub friendly_error { return; }
*AWS::S3::Request::SetFileContents::request = sub {
return bless( {},'main' );
};
}
( run in 1.275 second using v1.01-cache-2.11-cpan-49f99fa48dc )