AWS-S3
view release on metacpan or search on metacpan
t/002_changes.t
t/010_basic.t
t/aws/s3.t
t/aws/s3/file.t
t/aws/s3/signer.t
t/aws/s3/bucket.t
t/aws/s3/file_iterator.t
t/aws/s3/http_request.t
t/aws/s3/signer/v4.t
t/aws/s3/signer/v4_parse_host.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
use strict;
use warnings 'all';
use Carp 'confess';
use AWS::S3::Owner;
use AWS::S3::File;
sub new {
my ($class, %args) = @_;
my $s = bless {
data => [ ],
page_number => 0,
idx => 0,
%args,
}, $class;
$s->_init;
return $s;
}
sub _init {
my ( $s ) = @_;
foreach ( qw( bucket page_size page_number ) ) {
confess "Required argument '$_' was not provided"
unless $s->{$_};
} # end foreach()
$s->{page_number}--;
$s->{marker} = '' unless defined( $s->{marker} );
$s->{__fetched_first_page} = 0;
$s->{data} = [];
$s->{pattern} ||= qr(.*);
} # end _init()
sub marker { shift->{marker} }
sub pattern { shift->{pattern} }
sub bucket { shift->{bucket} }
sub page_size { shift->{page_size} }
sub prefix { shift->{prefix} }
sub has_prev {
my $s = shift;
return $s->page_number > 1;
} # end has_prev()
sub has_next { shift->{has_next} }
sub next {
my $s = shift;
if( exists( $s->{data}->[ $s->{idx} ] ) ) {
return $s->{data}->[ $s->{idx}++ ];
} else {
# End of the current resultset, see if we can get another page of records:
if( my $page = $s->next_page ) {
$s->{data} = $page;
$s->{idx} = 0;
return $s->{data}->[ $s->{idx}++ ];
} else {
# No more pages, no more data:
return;
}
}
}
sub reset {
my $s = shift;
$s->{idx} = 0;
}
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
$s->{page_number}++;
return unless @out;
wantarray ? @out : \@out;
} # end next_page()
sub _next {
my $s = shift;
if ( my $item = shift( @{ $s->{data} } ) ) {
return $item;
} else {
if ( my @chunk = $s->_fetch() ) {
push @{ $s->{data} }, @chunk;
return shift( @{ $s->{data} } );
} else {
return;
} # end if()
} # end if()
} # end _next()
sub _fetch {
my ( $s ) = @_;
my $path = $s->{bucket}->name . '/';
lib/AWS/S3/HTTPRequest.pm view on Meta::CPAN
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;
my $uri = $s->bucket_uri( $s->path );
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => $method,
uri => $uri,
content => $content ? \$content : undef,
headers => [ $headers->flatten ],
);
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
}
sub parse_host {
my $self = shift;
my $host = shift;
my $region = shift;
# this entire thing should probably refactored into its own
# distribution, a la https://github.com/zirkelc/amazon-s3-url
# https://docs.aws.amazon.com/prescriptive-guidance/latest/defining-bucket-names-data-lakes/faq.html
# Only lowercase letters, numbers, dashes, and dots are allowed in S3 bucket names.
# Bucket names must be three to 63 characters in length,
# must begin and end with a number or letter,
# and cannot be in an IP address format.
my $bucket_re = '[a-z0-9][a-z0-9\-\.]{1,61}[a-z0-9]';
my $domain_re = 'amazonaws\.com';
my $region_re = '(?:af|ap|ca|eu|il|me|mx|sa|us)-[a-z]+-\d';
my ( $service, $url_style );
sub content { return shift->{_msg}; }
1;
package main;
use Test::More 'no_plan';
use Test::Deep;
use Test::Exception;
use Data::Section::Simple 'get_data_section';
use Carp 'confess';
$SIG{__DIE__} = \&confess;
use_ok('AWS::S3');
my $s3 = AWS::S3->new(
access_key_id => $ENV{AWS_ACCESS_KEY_ID} // 'foo',
secret_access_key => $ENV{AWS_SECRET_ACCESS_KEY} // 'bar',
endpoint => 'bad.hostname.',
$i++;
return Mocked::HTTP::Response->new( 200, q{} );
}
else {
# there is a call to ->bucket, which does ->buckets, which is empty.
is( $req->method, 'GET', '->buckets with GET' );
is( $req->uri->as_string, 'http://bad.hostname./', '... and with correct URI' );
# we need to return XML in the body or xpc doesn't work
return Mocked::HTTP::Response->new( 200,
get_data_section('ListAllMyBucketsResult.xml') );
}
};
my $bucket = $s3->add_bucket( name => 'bar' );
isa_ok( $bucket, 'AWS::S3::Bucket' );
is( $bucket->name, 'bar', '... and the right bucket got returned' );
};
# list all buckets and owner
{
my $xml = get_data_section('ListAllMyBucketsResult.xml');
local *LWP::UserAgent::Determined::request = sub {
return Mocked::HTTP::Response->new( 200,$xml );
};
isa_ok( my $owner = $s3->owner,'AWS::S3::Owner' );
is( $owner->id, 'bcaf1ffd86f41161ca5fb16fd081034f', '... and the owner id correct' );
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
t/aws/s3/file_iterator.t view on Meta::CPAN
sub is_success { 1 }
sub header { $_[1] =~ /content-length/i ? 1 : 'header' }
1;
package main;
use Test::More;
use Test::Deep;
use Test::Exception;
use FindBin qw/ $Script /;
use Data::Section::Simple 'get_data_section';
use Carp 'confess';
$SIG{__DIE__} = \&confess;
use_ok('AWS::S3');
use_ok('AWS::S3::FileIterator');
use_ok('AWS::S3::Bucket');
my $s3 = AWS::S3->new(
access_key_id => $ENV{AWS_ACCESS_KEY_ID} // 'foo',
t/aws/s3/file_iterator.t view on Meta::CPAN
page_size => 1,
bucket => $bucket,
marker => 'foo',
pattern => qr/\d/,
);
is( $iterator2->marker,'foo','marker passed');
is( $iterator2->pattern,qr/\d/,'pattern passed');
is( $iterator2->prefix,undef,'!prefix' );
}
my $mocked_response = Mocked::HTTP::Response->new( 200,get_data_section('ListBucketResult.xml') );
local *LWP::UserAgent::Determined::request = sub { $mocked_response };
my @pages = $iterator->next_page; # to check wantarray
cmp_deeply( \@pages,[ obj_isa('AWS::S3::File') ],'next_page returns one ::File' );
is( $pages[0]->key,'img/my image.jpg','... and it is the one expected' );
is( $iterator->next_page->[0]->key,'img/my-third-image.jpg','next_page second item' );
is( $iterator->next_page->[0]->key,'img/my image.jpg','next_page new request, first item' );
$mocked_response = Mocked::HTTP::Response->new( 200,get_data_section('EmptyResult') );
ok( $iterator->next_page,'next_page second item' );
ok( ! $iterator->next_page,'no more items' );
}
subtest 'advance to page X before processing' => sub {
my $iterator = AWS::S3::FileIterator->new(
page_number => 5,
page_size => 1,
bucket => $bucket,
pattern => qr/\d+/,
);
my $number_of_request;
my $xml = get_data_section('LongResult');
my $mocked_response = Mocked::HTTP::Response->new( 200,$xml );
local *LWP::UserAgent::Determined::request = sub { $number_of_request++; return $mocked_response };
is( $iterator->next_page->[0]->key,5,'start at file 5' );
is( $iterator->next_page->[0]->key,6,'... file 6' );
is( $iterator->next_page->[0]->key,7,'... file 7' );
is( $iterator->next_page->[0]->key,8,'... file 8' );
is( $iterator->next_page->[0]->key,9,'... file 9' );
is( $iterator->next_page->[0]->key,0,'do a new request and get file 0' );
is( $number_of_request,2,'did two requests' );
t/aws/s3/http_request.t view on Meta::CPAN
);
can_ok(
$request,
qw/
s3
method
path
headers
content
metadata
contenttype
/,
);
isa_ok( $request->http_request,'HTTP::Request' );
is( $request->is_dns_bucket( 'foo' ),1,'_is_dns_bucket' );
is( $request->is_dns_bucket( 'Foo' ),0,'_! is_dns_bucket' );
is( $request->is_dns_bucket( 'bar123boz' ),1,'_is_dns_bucket' );
is( $request->is_dns_bucket( 'bar123Boz' ),0,'! _is_dns_bucket' );
( run in 0.378 second using v1.01-cache-2.11-cpan-8d75d55dd25 )