r6968 - in /branches/upstream/libnet-amazon-s3-perl/current: Build.PL CHANGES MANIFEST META.yml Makefile.PL lib/Net/Amazon/S3.pm lib/Net/Amazon/S3/Bucket.pm t/01api.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Mon Aug 20 06:38:20 UTC 2007
Author: dmn
Date: Mon Aug 20 06:38:20 2007
New Revision: 6968
URL: http://svn.debian.org/wsvn/?sc=1&rev=6968
Log:
[svn-upgrade] Integrating new upstream version, libnet-amazon-s3-perl (0.39)
Removed:
branches/upstream/libnet-amazon-s3-perl/current/Build.PL
Modified:
branches/upstream/libnet-amazon-s3-perl/current/CHANGES
branches/upstream/libnet-amazon-s3-perl/current/MANIFEST
branches/upstream/libnet-amazon-s3-perl/current/META.yml
branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm
branches/upstream/libnet-amazon-s3-perl/current/t/01api.t
Modified: branches/upstream/libnet-amazon-s3-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/CHANGES?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/CHANGES (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/CHANGES Mon Aug 20 06:38:20 2007
@@ -1,4 +1,10 @@
Revision history for Perl module Net::Amazon::S3:
+
+0.39 Sun Aug 19 14:47:01 BST 2007
+ - add add_key_filename and get_key_filename which send files
+ directly from disk - good for large files (Jim Blomo)
+ - support UTF8 keys (Jim Blomo)
+ - switch back from Build.PL to Makefile.PL
0.38 Sun Mar 4 16:43:28 GMT 2007
- use http_proxy and https_proxy environment variables for proxy
Modified: branches/upstream/libnet-amazon-s3-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/MANIFEST?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/MANIFEST Mon Aug 20 06:38:20 2007
@@ -1,4 +1,3 @@
-Build.PL
CHANGES
lib/Net/Amazon/S3.pm
lib/Net/Amazon/S3/Bucket.pm
Modified: branches/upstream/libnet-amazon-s3-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/META.yml?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/META.yml (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/META.yml Mon Aug 20 06:38:20 2007
@@ -1,9 +1,24 @@
--- #YAML:1.0
-name: Net-Amazon-S3
-version: 0.38
+name: Net-Amazon-S3
+version: 0.39
+abstract: ~
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.32
+distribution_type: module
+requires:
+ Class::Accessor::Fast: 0
+ DateTime::Format::Strptime: 0
+ Digest::HMAC_SHA1: 0
+ Digest::MD5::File: 0
+ HTTP::Date: 0
+ LWP::UserAgent: 0
+ MIME::Base64: 0
+ Test::More: 0.01
+ URI::Escape: 0
+ XML::LibXML: 0
+ XML::LibXML::XPathContext: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
author:
- - Leon Brocard <acme at astray.com> and unknown Amazon Digital Services programmers.
- - Brad Fitzpatrick <brad at danga.com> - return values, Bucket object
-abstract: Use the Amazon S3 - Simple Storage Service
-license: perl
-generated_by: Module::Build version 0.2612, without YAML.pm
+ - Leon Brocard <acme at astray.com>
Modified: branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL Mon Aug 20 06:38:20 2007
@@ -1,22 +1,24 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
+#!perl
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
-WriteMakefile
-(
- 'NAME' => 'Net::Amazon::S3',
- 'VERSION_FROM' => 'lib/Net/Amazon/S3.pm',
- 'PREREQ_PM' => {
- 'Class::Accessor::Fast' => '0',
- 'DateTime::Format::Strptime' => '0',
- 'Digest::HMAC_SHA1' => '0',
- 'HTTP::Date' => '0',
- 'LWP::UserAgent' => '0',
- 'MIME::Base64' => '0',
- 'Test::More' => '0.01',
- 'URI::Escape' => '0',
- 'XML::LibXML' => '0',
- 'XML::LibXML::XPathContext' => '0'
- },
- 'INSTALLDIRS' => 'site',
- 'PL_FILES' => {}
- )
-;
+WriteMakefile(
+ NAME => 'Net::Amazon::S3',
+ VERSION_FROM => 'lib/Net/Amazon/S3.pm',
+ AUTHOR => 'Leon Brocard <acme at astray.com>',
+ LICENSE => 'perl',
+ PREREQ_PM => {
+ 'Class::Accessor::Fast' => '0',
+ 'DateTime::Format::Strptime' => '0',
+ 'Digest::MD5::File' => '0',
+ 'Digest::HMAC_SHA1' => '0',
+ 'HTTP::Date' => '0',
+ 'LWP::UserAgent' => '0',
+ 'MIME::Base64' => '0',
+ 'Test::More' => '0.01',
+ 'XML::LibXML' => '0',
+ 'XML::LibXML::XPathContext' => '0',
+ 'URI::Escape' => '0',
+ }
+);
+
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm Mon Aug 20 06:38:20 2007
@@ -150,7 +150,7 @@
use MIME::Base64 qw(encode_base64);
use Net::Amazon::S3::Bucket;
use LWP::UserAgent;
-use URI::Escape;
+use URI::Escape qw(uri_escape_utf8);
use XML::LibXML;
use XML::LibXML::XPathContext;
@@ -158,7 +158,7 @@
__PACKAGE__->mk_accessors(
qw(libxml aws_access_key_id aws_secret_access_key secure ua err errstr timeout)
);
-our $VERSION = '0.38';
+our $VERSION = '0.39';
my $AMAZON_HEADER_PREFIX = 'x-amz-';
my $METADATA_PREFIX = 'x-amz-meta-';
@@ -229,7 +229,7 @@
sub buckets {
my $self = shift;
- my $xpc = $self->_send_request( 'GET', '', {} );
+ my $xpc = $self->_send_request( 'GET', '', {} );
return undef unless $xpc && !$self->_remember_errors($xpc);
@@ -240,7 +240,7 @@
foreach my $node ( $xpc->findnodes(".//s3:Bucket") ) {
push @buckets,
Net::Amazon::S3::Bucket->new(
- { bucket => $xpc->findvalue( ".//s3:Name", $node ),
+ { bucket => $xpc->findvalue( ".//s3:Name", $node ),
creation_date =>
$xpc->findvalue( ".//s3:CreationDate", $node ),
account => $self,
@@ -280,15 +280,17 @@
my $bucket = $conf->{bucket};
croak 'must specify bucket' unless $bucket;
- if ($conf->{acl_short}){
- $self->_validate_acl_short($conf->{acl_short});
- }
-
- my $header_ref = ($conf->{acl_short})
- ? {'x-amz-acl' => $conf->{acl_short}}
+ if ( $conf->{acl_short} ) {
+ $self->_validate_acl_short( $conf->{acl_short} );
+ }
+
+ my $header_ref =
+ ( $conf->{acl_short} )
+ ? { 'x-amz-acl' => $conf->{acl_short} }
: {};
- return 0 unless $self->_send_request_expect_nothing( 'PUT', $bucket,
+ return 0
+ unless $self->_send_request_expect_nothing( 'PUT', $bucket,
$header_ref );
return $self->bucket($bucket);
@@ -485,18 +487,18 @@
if (%$conf) {
$path .= "?"
. join( '&',
- map { $_."=" . $self->_urlencode( $conf->{$_} ) } keys %$conf );
+ map { $_ . "=" . $self->_urlencode( $conf->{$_} ) } keys %$conf );
}
my $xpc = $self->_send_request( 'GET', $path, {} );
return undef unless $xpc && !$self->_remember_errors($xpc);
my $return = {
- bucket => $xpc->findvalue("//s3:ListBucketResult/s3:Name"),
- prefix => $xpc->findvalue("//s3:ListBucketResult/s3:Prefix"),
- marker => $xpc->findvalue("//s3:ListBucketResult/s3:Marker"),
- next_marker => $xpc->findvalue("//s3:ListBucketResult/s3:NextMarker"),
- max_keys => $xpc->findvalue("//s3:ListBucketResult/s3:MaxKeys"),
+ bucket => $xpc->findvalue("//s3:ListBucketResult/s3:Name"),
+ prefix => $xpc->findvalue("//s3:ListBucketResult/s3:Prefix"),
+ marker => $xpc->findvalue("//s3:ListBucketResult/s3:Marker"),
+ next_marker => $xpc->findvalue("//s3:ListBucketResult/s3:NextMarker"),
+ max_keys => $xpc->findvalue("//s3:ListBucketResult/s3:MaxKeys"),
is_truncated => (
scalar $xpc->findvalue("//s3:ListBucketResult/s3:IsTruncated") eq
'true'
@@ -548,11 +550,12 @@
my $all = $response;
while (1) {
- my $next_marker = $response->{next_marker} || $response->{keys}->[-1]->{key};
+ my $next_marker = $response->{next_marker}
+ || $response->{keys}->[-1]->{key};
$conf->{marker} = $next_marker;
$conf->{bucket} = $bucket;
- $response = $self->list_bucket($conf);
- push @{$all->{keys}}, @{$response->{keys}};
+ $response = $self->list_bucket($conf);
+ push @{ $all->{keys} }, @{ $response->{keys} };
last unless $response->{is_truncated};
}
@@ -624,8 +627,9 @@
sub _validate_acl_short {
my ( $self, $policy_name ) = @_;
- if ( ! grep( { $policy_name eq $_ }
- qw(private public-read public-read-write authenticated-read) ) ){
+ if (!grep( { $policy_name eq $_ }
+ qw(private public-read public-read-write authenticated-read) ) )
+ {
croak "$policy_name is not a supported canned access policy";
}
}
@@ -677,12 +681,12 @@
# centralize all HTTP work, for debugging
sub _do_http {
- my ( $self, $request ) = @_;
+ my ( $self, $request, $filename ) = @_;
# convenient time to reset any error conditions
$self->err(undef);
$self->errstr(undef);
- return $self->ua->request($request);
+ return $self->ua->request( $request, $filename );
}
sub _send_request_expect_nothing {
@@ -842,9 +846,8 @@
sub _urlencode {
my ( $self, $unencoded ) = @_;
- return uri_escape( $unencoded, '^A-Za-z0-9_-' );
-}
-
+ return uri_escape_utf8( $unencoded, '^A-Za-z0-9_-' );
+}
1;
@@ -877,7 +880,6 @@
Doesn't matter what you set it to. Just has to be set
-
=item AWS_ACCESS_KEY_ID
Your AWS access key
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm Mon Aug 20 06:38:20 2007
@@ -2,6 +2,7 @@
use strict;
use warnings;
use Carp;
+use File::stat;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw(bucket creation_date account));
@@ -33,8 +34,7 @@
my ( $self, $key ) = @_;
return ($key)
? $self->bucket . "/" . $self->account->_urlencode($key)
- : $self->bucket
- ;
+ : $self->bucket;
}
=head2 add_key
@@ -62,14 +62,43 @@
my ( $self, $key, $value, $conf ) = @_;
croak 'must specify key' unless $key && length $key;
- if ($conf->{acl_short}) {
- $self->account->_validate_acl_short($conf->{acl_short});
+ if ( $conf->{acl_short} ) {
+ $self->account->_validate_acl_short( $conf->{acl_short} );
$conf->{'x-amz-acl'} = $conf->{acl_short};
delete $conf->{acl_short};
}
+ if ( ref($value) eq 'SCALAR' ) {
+ $conf->{'Content-Length'} ||= -s $$value;
+ $value = _content_sub($$value);
+ }
+
return $self->account->_send_request_expect_nothing( 'PUT',
$self->_uri($key), $conf, $value );
+}
+
+=head2 add_key_filename
+
+Use this to upload a large file to S3. Takes three positional parameters:
+
+=over
+
+=item key
+
+=item filename
+
+=item configuration
+
+A hash of configuration data for this key. (See synopsis);
+
+=back
+
+Returns a boolean.
+
+=cut
+sub add_key_filename {
+ my ( $self, $key, $value, $conf ) = @_;
+ return $self->add_key($key, \$value, $conf);
}
=head2 head_key KEY
@@ -99,12 +128,13 @@
=cut
sub get_key {
- my ( $self, $key, $method ) = @_;
+ my ( $self, $key, $method, $filename ) = @_;
$method ||= "GET";
+ $filename = $$filename if ref $filename;
my $acct = $self->account;
- my $request = $acct->_make_request( $method, $self->_uri($key), {} );
- my $response = $acct->_do_http($request);
+ my $request = $acct->_make_request( $method, $self->_uri($key), {} );
+ my $response = $acct->_do_http( $request, $filename );
if ( $response->code == 404 ) {
return undef;
@@ -131,6 +161,27 @@
return $return;
+}
+
+=head2 get_key_filename $key_name $method $filename
+
+Use this to download large files from S3. Takes a key name and an optional
+HTTP method (which defaults to C<GET>. Fetches the key from AWS and writes
+it to the filename. THe value returned will be empty.
+
+On failure:
+
+Returns undef on missing content, throws an exception (dies) on server errors.
+
+On success:
+
+Returns a hashref of { content_type, etag, value, @meta } on success
+
+=cut
+
+sub get_key_filename {
+ my ( $self, $key, $method, $filename ) = @_;
+ return $self->get_key($key, $method, \$filename);
}
=head2 delete_key $key_name
@@ -216,7 +267,8 @@
my ( $self, $key ) = @_;
my $acct = $self->account;
- my $request = $acct->_make_request( 'GET', $self->_uri($key) . '?acl', {} );
+ my $request
+ = $acct->_make_request( 'GET', $self->_uri($key) . '?acl', {} );
my $response = $acct->_do_http($request);
if ( $response->code == 404 ) {
@@ -275,25 +327,25 @@
my ( $self, $conf ) = @_;
$conf ||= {};
- unless ($conf->{acl_xml} || $conf->{acl_short}){
+ unless ( $conf->{acl_xml} || $conf->{acl_short} ) {
croak "need either acl_xml or acl_short";
}
- if ($conf->{acl_xml} && $conf->{acl_short}){
+ if ( $conf->{acl_xml} && $conf->{acl_short} ) {
croak "cannot provide both acl_xml and acl_short";
}
- my $path = $self->_uri($conf->{key}) . '?acl';
-
- my $hash_ref = ($conf->{acl_short})
+ my $path = $self->_uri( $conf->{key} ) . '?acl';
+
+ my $hash_ref =
+ ( $conf->{acl_short} )
? { 'x-amz-acl' => $conf->{acl_short} }
- : { }
- ;
+ : {};
my $xml = $conf->{acl_xml} || '';
- return $self->account->_send_request_expect_nothing( 'PUT',
- $path, $hash_ref, $xml );
+ return $self->account->_send_request_expect_nothing( 'PUT', $path,
+ $hash_ref, $xml );
}
@@ -314,6 +366,38 @@
=cut
sub errstr { $_[0]->account->errstr }
+
+sub _content_sub {
+ my $filename = shift;
+ my $stat = stat($filename);
+ my $remaining = $stat->size;
+ my $blksize = $stat->blksize || 4096;
+
+ croak "$filename not a readable file with fixed size"
+ unless -r $filename and $remaining;
+ open DATA, "< $filename" or croak "Could not open $filename: $!";
+
+ return sub {
+ my $buffer;
+
+ # warn "read remaining $remaining";
+ unless ( my $read = read( DATA, $buffer, $blksize ) ) {
+
+# warn "read $read buffer $buffer remaining $remaining";
+ croak
+ "Error while reading upload content $filename ($remaining remaining) $!"
+ if $! and $remaining;
+
+ # otherwise, we found EOF
+ close DATA
+ or croak "close of upload content $filename failed: $!";
+ $buffer ||= ''
+ ; # LWP expects an emptry string on finish, read returns 0
+ }
+ $remaining -= length($buffer);
+ return $buffer;
+ };
+}
1;
@@ -373,3 +457,4 @@
=head1 SEE ALSO
L<Net::Amazon::S3>
+
Modified: branches/upstream/libnet-amazon-s3-perl/current/t/01api.t
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/t/01api.t?rev=6968&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/t/01api.t (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/t/01api.t Mon Aug 20 06:38:20 2007
@@ -2,18 +2,17 @@
use warnings;
use strict;
+use lib 'lib';
+use Digest::MD5::File qw(file_md5_hex);
use Test::More;
- unless( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ){
- plan skip_all => 'Testing this module for real costs money.';
- }
- else {
- plan tests => 51;
- }
-
-
-
-use_ok ('Net::Amazon::S3');
+unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
+ plan skip_all => 'Testing this module for real costs money.';
+} else {
+ plan tests => 60;
+}
+
+use_ok('Net::Amazon::S3');
# this synopsis is presented as a test file
@@ -37,9 +36,9 @@
TODO: {
local $TODO = "These tests only work if you're leon";
- like( $response->{owner_id}, qr/^46a801915a1711f/ );
+ like( $response->{owner_id}, qr/^46a801915a1711f/ );
is( $response->{owner_displayname}, '_acme_' );
- is_deeply( $response->{buckets}, [] );
+ is( scalar @{ $response->{buckets} }, 2 );
}
# create a bucket
@@ -69,36 +68,34 @@
is( $response->{is_truncated}, 0 );
is_deeply( $response->{keys}, [] );
-is(undef, $bucket_obj->get_key("non-existing-key"));
+is( undef, $bucket_obj->get_key("non-existing-key") );
my $keyname = 'testing.txt';
{
+
# Create a publicly readable key, then turn it private with a short acl.
# This key will persist past the end of the block.
- my $value = 'T';
+ my $value = 'T';
$bucket_obj->add_key(
- $keyname, $value,
- { content_type => 'text/plain',
- 'x-amz-meta-colour' => 'orange',
- acl_short => 'public-read',
- }
+ $keyname, $value,
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'orange',
+ acl_short => 'public-read',
+ }
);
is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
200, "can access the publicly readable key" );
- like_acl_allusers_read($bucket_obj, $keyname);
-
- ok( $bucket_obj->set_acl(
- { key => $keyname, acl_short => 'private' }
- )
- );
+ like_acl_allusers_read( $bucket_obj, $keyname );
+
+ ok( $bucket_obj->set_acl( { key => $keyname, acl_short => 'private' } ) );
is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
403, "cannot access the private key" );
- unlike_acl_allusers_read($bucket_obj, $keyname);
+ unlike_acl_allusers_read( $bucket_obj, $keyname );
ok( $bucket_obj->set_acl(
{ key => $keyname,
@@ -110,7 +107,7 @@
is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
200, "can access the publicly readable key after acl_xml set" );
- like_acl_allusers_read($bucket_obj, $keyname);
+ like_acl_allusers_read( $bucket_obj, $keyname );
ok( $bucket_obj->set_acl(
{ key => $keyname,
@@ -122,29 +119,31 @@
is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
403, "cannot access the private key after acl_xml set" );
- unlike_acl_allusers_read($bucket_obj, $keyname);
+ unlike_acl_allusers_read( $bucket_obj, $keyname );
}
{
+
# Create a private key, then make it publicly readable with a short
# acl. Delete it at the end so we're back to having a single key in
# the bucket.
my $keyname2 = 'testing2.txt';
- my $value = 'T2';
+ my $value = 'T2';
$bucket_obj->add_key(
- $keyname2, $value,
- { content_type => 'text/plain',
- 'x-amz-meta-colour' => 'blue',
- acl_short => 'private',
- }
+ $keyname2,
+ $value,
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'blue',
+ acl_short => 'private',
+ }
);
is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname2",
403, "cannot access the private key" );
- unlike_acl_allusers_read($bucket_obj, $keyname2);
+ unlike_acl_allusers_read( $bucket_obj, $keyname2 );
ok( $bucket_obj->set_acl(
{ key => $keyname2, acl_short => 'public-read' }
@@ -154,7 +153,7 @@
is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname2",
200, "can access the publicly readable key" );
- like_acl_allusers_read($bucket_obj, $keyname2);
+ like_acl_allusers_read( $bucket_obj, $keyname2 );
$bucket_obj->delete_key($keyname2);
@@ -185,6 +184,30 @@
$bucket_obj->delete_key($keyname);
+# now play with the file methods
+$keyname .= "2";
+$bucket_obj->add_key_filename(
+ $keyname, 'README',
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'orangy',
+ }
+);
+$response = $bucket_obj->get_key($keyname);
+is( $response->{content_type}, 'text/plain' );
+like( $response->{value}, qr/and unknown Amazon/ );
+is( $response->{etag}, '7ad9ac8f950a8e29d7f83c4bff903f08' );
+is( $response->{'x-amz-meta-colour'}, 'orangy' );
+
+unlink('t/README');
+$response = $bucket_obj->get_key_filename( $keyname, undef, 't/README' );
+is( $response->{content_type}, 'text/plain' );
+is( $response->{value}, '' );
+is( $response->{etag}, '7ad9ac8f950a8e29d7f83c4bff903f08' );
+is( file_md5_hex('t/README'), '7ad9ac8f950a8e29d7f83c4bff903f08' );
+is( $response->{'x-amz-meta-colour'}, 'orangy' );
+
+$bucket_obj->delete_key($keyname);
+
# fetch contents of the bucket
# note prefix, marker, max_keys options can be passed in
$response = $bucket_obj->list
@@ -202,29 +225,30 @@
# local test methods
sub is_request_response_code {
- my ($url, $code, $message) = @_;
+ my ( $url, $code, $message ) = @_;
my $request = HTTP::Request->new( 'GET', $url );
+
#warn $request->as_string();
my $response = $s3->ua->request($request);
is( $response->code, $code, $message );
}
sub like_acl_allusers_read {
- my ($bucketobj, $keyname) = @_;
- my $message = acl_allusers_read_message('like', @_);
- like ($bucket_obj->get_acl($keyname) , qr(AllUsers.+READ), $message);
+ my ( $bucketobj, $keyname ) = @_;
+ my $message = acl_allusers_read_message( 'like', @_ );
+ like( $bucket_obj->get_acl($keyname), qr(AllUsers.+READ), $message );
}
sub unlike_acl_allusers_read {
- my ($bucketobj, $keyname) = @_;
- my $message = acl_allusers_read_message('unlike', @_);
- unlike ($bucket_obj->get_acl($keyname) , qr(AllUsers.+READ), $message);
+ my ( $bucketobj, $keyname ) = @_;
+ my $message = acl_allusers_read_message( 'unlike', @_ );
+ unlike( $bucket_obj->get_acl($keyname), qr(AllUsers.+READ), $message );
}
sub acl_allusers_read_message {
- my ($like_or_unlike, $bucketobj, $keyname) = @_;
- my $message = $like_or_unlike ."_acl_allusers_read: "
- . $bucketobj->bucket;
+ my ( $like_or_unlike, $bucketobj, $keyname ) = @_;
+ my $message
+ = $like_or_unlike . "_acl_allusers_read: " . $bucketobj->bucket;
$message .= " - $keyname" if $keyname;
return $message;
}
@@ -233,7 +257,7 @@
my $acl_short = shift || 'private';
my $public_read = '';
- if ($acl_short eq 'public-read'){
+ if ( $acl_short eq 'public-read' ) {
$public_read = qq~
<Grant>
<Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
@@ -263,4 +287,4 @@
$public_read
</AccessControlList>
</AccessControlPolicy>~;
-}
+}
More information about the Pkg-perl-cvs-commits
mailing list