AWS-S3
view release on metacpan or search on metacpan
- Add signed_url method to AWS::S3::File and tests
- Fix load / hash order bugs in AWS::S3::Signer
- Resolve https://rt.cpan.org/Ticket/Display.html?id=92423
0.03_01 2012-06-14
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.
lib/AWS/S3/Bucket.pm view on Meta::CPAN
use Carp 'confess';
use Moose;
use IO::Socket::INET;
use AWS::S3::ResponseParser;
use AWS::S3::FileIterator;
has 's3' => (
is => 'ro',
isa => 'AWS::S3',
required => 1,
);
has 'name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'creation_date' => (
is => 'ro',
isa => 'Str',
required => 0,
);
use MooseX::Types -declare => [qw/ACLShorts/];
has 'acl' => (
is => 'rw',
isa => 'Str',
required => 0,
lazy => 1,
clearer => '_clear_acl',
default => sub {
my $self = shift;
my $type = 'GetBucketAccessControl';
return $self->_get_property( $type )->response->decoded_content();
},
trigger => sub {
my ( $self, $new_val, $old_val ) = @_;
lib/AWS/S3/Bucket.pm view on Meta::CPAN
die $msg;
} # end if()
$self->_clear_acl;
}
);
has 'location_constraint' => (
is => 'ro',
isa => 'Str',
required => 0,
lazy => 1,
default => sub {
my $self = shift;
my $type = 'GetBucketLocationConstraint';
my $response = $self->_get_property( $type );
my $constraint = $response->xpc->findvalue( '//s3:LocationConstraint' );
if ( defined $constraint && $constraint eq '' ) {
return;
} else {
return $constraint;
}
}
);
has 'policy' => (
is => 'rw',
isa => 'Str',
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 };
lib/AWS/S3/File.pm view on Meta::CPAN
via {
my $ref = $_[0];
my $v = $ref->();
ref $v ? $v : \$v
}
;
has 'key' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'bucket' => (
is => 'ro',
isa => 'AWS::S3::Bucket',
required => 1,
weak_ref => 0,
);
has 'size' => (
is => 'ro',
isa => 'Int',
required => 0,
default => sub {
my $self = shift;
return length ${$self->contents};
}
);
has 'etag' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has 'owner' => (
is => 'ro',
isa => 'AWS::S3::Owner',
required => 0,
weak_ref => 1,
);
has 'storage_class' => (
is => 'ro',
isa => 'Str',
default => 'STANDARD',
required => 1,
);
has 'lastmodified' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has 'contenttype' => (
is => 'rw',
isa => 'Str',
required => 0,
default => 'binary/octet-stream'
);
has 'is_encrypted' => (
is => 'rw',
isa => 'Bool',
required => 1,
lazy => 1,
default => sub {
my $s = shift;
my $type = 'GetFileInfo';
my $req = $s->bucket->s3->request(
$type,
bucket => $s->bucket->name,
key => $s->key,
);
return $req->request->response->header( 'x-amz-server-side-encryption' ) ? 1 : 0;
},
);
has 'contents' => (
is => 'rw',
isa => fileContents,
required => 0,
lazy => 1,
coerce => 1,
default => \&_get_contents,
trigger => \&_set_contents
);
sub BUILD {
my $s = shift;
return unless $s->etag;
lib/AWS/S3/HTTPRequest.pm view on Meta::CPAN
with 'AWS::S3::Roles::Bucket';
my $METADATA_PREFIX = 'x-amz-meta-';
my $AMAZON_HEADER_PREFIX = 'x-amz-';
enum 'HTTPMethod' => [qw( HEAD GET PUT POST DELETE )];
has 's3' => (
is => 'ro',
required => 1,
isa => 'AWS::S3',
);
has 'method' => (
is => 'ro',
required => 1,
isa => 'HTTPMethod'
);
has 'path' => (
is => 'ro',
required => 1,
isa => 'Str',
);
class_type( 'HTTP::Headers' );
coerce 'HTTP::Headers'
=> from 'HashRef'
=> via { my $h = HTTP::Headers->new( %$_ ) };
has 'headers' => (
is => 'ro',
required => 1,
isa => 'HTTP::Headers',
lazy => 1,
default => sub { HTTP::Headers->new() },
coerce => 1,
);
has 'content' => (
is => 'ro',
required => 1,
isa => 'Str|ScalarRef|CodeRef',
default => '',
);
has 'metadata' => (
is => 'ro',
required => 1,
isa => 'HashRef',
default => sub { {} },
);
has 'contenttype' => (
is => 'ro',
required => 0,
isa => 'Str',
);
# Make the HTTP::Request object:
sub http_request {
my $s = shift;
my $method = $s->method;
my $headers = $s->headers;
my $content = $s->content;
my $metadata = $s->metadata;
lib/AWS/S3/Owner.pm view on Meta::CPAN
package AWS::S3::Owner;
use Moose;
has 'id' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'display_name' => (
is => 'ro',
isa => 'Str',
required => 1,
);
__PACKAGE__->meta->make_immutable;
__END__
=pod
=head1 NAME
lib/AWS/S3/Request/CreateBucket.pm view on Meta::CPAN
package AWS::S3::Request::CreateBucket;
use Moose;
use AWS::S3::Signer;
with 'AWS::S3::Roles::Request';
has 'bucket' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'location' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
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.
lib/AWS/S3/Request/DeleteBucket.pm view on Meta::CPAN
package AWS::S3::Request::DeleteBucket;
use Moose;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'DELETE' );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_expect_nothing' => ( default => 1 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/DeleteFile.pm view on Meta::CPAN
package AWS::S3::Request::DeleteFile;
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'DELETE' );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_expect_nothing' => ( default => 1 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/DeleteMulti.pm view on Meta::CPAN
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::Request';
has 'bucket' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'keys' => (
is => 'ro',
isa => 'ArrayRef[Str]',
required => 1,
);
has '_subresource' => (
is => 'ro',
isa => 'Str',
init_arg => undef,
default => 'delete'
);
lib/AWS/S3/Request/GetBucketAccessControl.pm view on Meta::CPAN
package AWS::S3::Request::GetBucketAccessControl;
use Moose;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'GET' );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has '_subresource' => (
is => 'ro',
isa => 'Str',
init_arg => undef,
default => 'acl'
);
has '+_expect_nothing' => ( default => 0 );
lib/AWS/S3/Request/GetBucketLocationConstraint.pm view on Meta::CPAN
package AWS::S3::Request::GetBucketLocationConstraint;
use Moose;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_action' => ( default => 'GET' );
has '_subresource' => (
is => 'ro',
isa => 'Str',
init_arg => undef,
default => 'location'
);
lib/AWS/S3/Request/GetBucketPolicy.pm view on Meta::CPAN
package AWS::S3::Request::GetBucketPolicy;
use Moose;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'GET' );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has '_subresource' => (
is => 'ro',
isa => 'Str',
init_arg => undef,
default => 'policy'
);
has '+_expect_nothing' => ( default => 0 );
lib/AWS/S3/Request/GetFileContents.pm view on Meta::CPAN
package AWS::S3::Request::GetFileContents;
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_action' => ( default => 'GET' );
has '+_expect_nothing' => ( default => 0 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/GetFileInfo.pm view on Meta::CPAN
package AWS::S3::Request::GetFileInfo;
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_action' => ( default => 'HEAD' );
has '+_expect_nothing' => ( default => 0 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/GetPreSignedUrl.pm view on Meta::CPAN
package AWS::S3::Request::GetPreSignedUrl;
use Moose;
use AWS::S3::Signer;
use URI::Escape qw(uri_escape);
with 'AWS::S3::Roles::Request';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has 'expires' => ( is => 'ro', isa => 'Int', required => 1 );
sub request {
my $s = shift;
return $s->signerv4->signed_url(
$s->_uri,
$s->expires,
'GET',
);
}
lib/AWS/S3/Request/ListBucket.pm view on Meta::CPAN
use Moose;
use AWS::S3::Signer;
use URI::Escape qw/ uri_escape /;
with 'AWS::S3::Roles::Request';
with 'AWS::S3::Roles::Bucket';
has 'bucket' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'max_keys' => (
is => 'ro',
isa => 'Int',
required => 1,
);
has 'marker' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has 'prefix' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has 'delimiter' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has '+_expect_nothing' => ( default => 0 );
sub request {
my $s = shift;
my @params = ();
push @params, 'max-keys=' . $s->max_keys;
push @params, 'marker=' . uri_escape( $s->marker ) if $s->marker;
lib/AWS/S3/Request/SetBucketAccessControl.pm view on Meta::CPAN
package AWS::S3::Request::SetBucketAccessControl;
use Moose;
use AWS::S3::Signer;
with 'AWS::S3::Roles::Request';
has 'bucket' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'acl_short' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has 'acl_xml' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has '+_expect_nothing' => ( default => 1 );
sub request {
my $s = shift;
if ( $s->acl_short ) {
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
lib/AWS/S3/Request/SetBucketPolicy.pm view on Meta::CPAN
package AWS::S3::Request::SetBucketPolicy;
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
use JSON::XS;
with 'AWS::S3::Roles::Request';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has '_subresource' => (
is => 'ro',
isa => 'Str',
init_arg => undef,
default => 'policy'
);
has 'policy' => (
is => 'ro',
isa => 'Maybe[Str]',
required => 1,
# Evan Carroll 6/14/2012
# COMMENTED THIS OUT, not sure if it ever worked on VSO
# Must be able to decode the JSON string:
# where => sub {
# eval { decode_json( $_ ); 1 };
# }
);
has '+_expect_nothing' => ( default => 1 );
lib/AWS/S3/Request/SetFileContents.pm view on Meta::CPAN
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::Request';
has 'bucket' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'file' => (
is => 'ro',
isa => 'AWS::S3::File',
required => 1,
);
has 'content_type' => (
is => 'ro',
isa => 'Str',
required => 1,
lazy => 1,
default => sub { 'binary/octet-stream' },
);
has '+_expect_nothing' => ( default => 0 );
sub request {
my $s = shift;
my $contents;
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
package AWS::S3::ResponseParser;
use Moose;
use XML::LibXML;
use XML::LibXML::XPathContext;
has 'expect_nothing' => (
is => 'ro',
isa => 'Bool',
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() ) {
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
return;
}
}
}
}
);
has 'response' => (
is => 'ro',
isa => 'HTTP::Response',
required => 1,
);
has 'type' => (
is => 'ro',
isa => 'Str',
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,
clearer => '_clear_xpc',
default => sub {
my $self = shift;
my $src = $self->response->content;
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;
lib/AWS/S3/Roles/Request.pm view on Meta::CPAN
use Moose::Role;
use HTTP::Request;
use AWS::S3::ResponseParser;
use MooseX::Types::URI qw(Uri);
use URI::Escape qw/ uri_escape /;
use AWS::S3::Signer::V4;
has 's3' => (
is => 'ro',
isa => 'AWS::S3',
required => 1,
);
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'protocol' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
shift->s3->secure ? 'https' : 'http';
}
);
has 'endpoint' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
shift->s3->endpoint;
}
);
# XXX should be required=>1; https://rt.cpan.org/Ticket/Display.html?id=77863
has "_action" => (
isa => 'Str',
is => 'ro',
init_arg => undef,
#required => 1
);
has '_expect_nothing' => ( isa => 'Bool', is => 'ro', init_arg => undef );
has '_uri' => (
isa => Uri,
is => 'ro',
lazy => 1,
default => sub {
my $self = shift;
lib/AWS/S3/Signer.pm view on Meta::CPAN
use MIME::Base64 qw(encode_base64);
use Digest::HMAC_SHA1;
use Digest::MD5 'md5';
use Moose::Util::TypeConstraints qw(enum);
use MooseX::Types::URI qw(Uri);
has 's3' => (
is => 'ro',
isa => 'AWS::S3',
required => 1,
);
has 'method' => (
is => 'ro',
isa => enum([qw/ HEAD GET PUT POST DELETE /]),
required => 1,
);
has 'bucket_name' => (
is => 'ro',
isa => 'Str',
required => 1,
lazy => 1,
default => sub {
my $s = shift;
my $endpoint = $s->s3->endpoint;
if ( my ( $name ) = $s->uri->host =~ m{^(.+?)\.\Q$endpoint\E} ) {
return $name;
} else {
return '';
} # end if()
}
);
has 'uri' => (
is => 'ro',
isa => Uri,
required => 1,
coerce => 1,
);
has 'headers' => (
is => 'ro',
isa => 'ArrayRef[Str]',
lazy => 1,
default => sub { [] },
);
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
),
},
ref $self || $self;
}
sub access_key { shift->{access_key} }
sub secret_key { shift->{secret_key} }
=item $signer->sign($request [,$region] [,$payload_sha256_hex])
Given an HTTP::Request object, add the headers required by AWS and
then sign it with a version 4 signature by adding an "Authorization"
header.
The request must include a URL from which the AWS endpoint and service
can be derived, such as "ec2.us-east-1.amazonaws.com." In some cases
(e.g. S3 bucket operations) the endpoint does not indicate the
region. In this case, the region can be forced by passing a defined
value for $region. The current date and time will be added to the
request using an "X-Amz-Date header." To force the date and time to a
fixed value, include the "Date" header in the request.
t/001_compiles_pod.t view on Meta::CPAN
use warnings;
use Test::More;
use File::Find;
use Moose;
if(($ENV{HARNESS_PERL_SWITCHES} || '') =~ /Devel::Cover/) {
plan skip_all => 'HARNESS_PERL_SWITCHES =~ /Devel::Cover/';
}
if(!eval 'use Test::Pod; 1') {
*Test::Pod::pod_file_ok = sub { SKIP: { skip "pod_file_ok(@_) (Test::Pod is required)", 1 } };
}
if(!eval 'use Test::Pod::Coverage; 1') {
*Test::Pod::Coverage::pod_coverage_ok = sub { SKIP: { skip "pod_coverage_ok(@_) (Test::Pod::Coverage is required)", 1 } };
}
my @files;
find(
{
wanted => sub { /\.pm$/ and push @files, $File::Find::name },
no_chdir => 1
},
-e 'blib' ? 'blib' : 'lib',
t/002_changes.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use Test::More;
eval 'use Test::CPAN::Changes';
plan skip_all => 'Test::CPAN::Changes required for this test' if $@;
changes_ok();
( run in 0.957 second using v1.01-cache-2.11-cpan-0a6323c29d9 )