r11339 - in /branches/upstream/libnet-amazon-s3-perl/current: CHANGES MANIFEST META.yml lib/Net/Amazon/S3.pm lib/Net/Amazon/S3/Bucket.pm t/01api.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Mon Dec 17 20:42:47 UTC 2007
Author: gregoa-guest
Date: Mon Dec 17 20:42:47 2007
New Revision: 11339
URL: http://svn.debian.org/wsvn/?sc=1&rev=11339
Log:
[svn-upgrade] Integrating new upstream version, libnet-amazon-s3-perl (0.41)
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/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=11339&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/CHANGES (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/CHANGES Mon Dec 17 20:42:47 2007
@@ -1,4 +1,8 @@
Revision history for Perl module Net::Amazon::S3:
+
+0.41 Fri Nov 30 10:42:26 GMT 2007
+ - fix the expensive tests (patch by BDOLAN)
+ - added support for EU buckets (patch by BDOLAN)
0.40 Tue Oct 30 11:40:42 GMT 2007
- fix for content length with empty keys by Mark A. Hershberger
Modified: branches/upstream/libnet-amazon-s3-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libnet-amazon-s3-perl/current/MANIFEST?rev=11339&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/MANIFEST Mon Dec 17 20:42:47 2007
@@ -3,8 +3,8 @@
lib/Net/Amazon/S3/Bucket.pm
Makefile.PL
MANIFEST This list of files
-META.yml
README
t/01api.t
t/99-pod-coverage.t
t/99-pod.t
+META.yml Module meta-data (added by MakeMaker)
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=11339&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/META.yml (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/META.yml Mon Dec 17 20:42:47 2007
@@ -1,9 +1,11 @@
--- #YAML:1.0
name: Net-Amazon-S3
-version: 0.40
+version: 0.41
abstract: ~
license: perl
-generated_by: ExtUtils::MakeMaker version 6.32
+author:
+ - Leon Brocard <acme at astray.com>
+generated_by: ExtUtils::MakeMaker version 6.38
distribution_type: module
requires:
Class::Accessor::Fast: 0
@@ -18,7 +20,5 @@
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>
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
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=11339&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 Dec 17 20:42:47 2007
@@ -111,7 +111,7 @@
__PACKAGE__->mk_accessors(
qw(libxml aws_access_key_id aws_secret_access_key secure ua err errstr timeout)
);
-our $VERSION = '0.40';
+our $VERSION = '0.41';
my $AMAZON_HEADER_PREFIX = 'x-amz-';
my $METADATA_PREFIX = 'x-amz-meta-';
@@ -166,7 +166,10 @@
$self->secure(0) if not defined $self->secure;
$self->timeout(30) if not defined $self->timeout;
- my $ua = LWP::UserAgent->new( keep_alive => $KEEP_ALIVE_CACHESIZE );
+ my $ua = LWP::UserAgent->new(
+ keep_alive => $KEEP_ALIVE_CACHESIZE,
+ requests_redirectable => [qw(GET HEAD DELETE PUT)],
+ );
$ua->timeout( $self->timeout );
$ua->env_proxy;
$self->ua($ua);
@@ -222,6 +225,12 @@
See the set_acl subroutine for documenation on the acl_short options
+=item location_constraint (option)
+
+Sets the location constraint of the new bucket. If left unspecified, the
+default S3 datacenter location will be used. Otherwise, you can set it
+to 'EU' for a European data center - note that costs are different.
+
=back
Returns 0 on failure, Net::Amazon::S3::Bucket object on success
@@ -237,14 +246,22 @@
$self->_validate_acl_short( $conf->{acl_short} );
}
- my $header_ref =
- ( $conf->{acl_short} )
+ my $header_ref
+ = ( $conf->{acl_short} )
? { 'x-amz-acl' => $conf->{acl_short} }
: {};
+ my $data = '';
+ if ( defined $conf->{location_constraint} ) {
+ $data
+ = "<CreateBucketConfiguration><LocationConstraint>"
+ . $conf->{location_constraint}
+ . "</LocationConstraint></CreateBucketConfiguration>";
+ }
+
return 0
- unless $self->_send_request_expect_nothing( 'PUT', $bucket,
- $header_ref );
+ unless $self->_send_request_expect_nothing( 'PUT', "$bucket/",
+ $header_ref, $data );
return $self->bucket($bucket);
}
@@ -290,7 +307,7 @@
$bucket = $conf->{bucket};
}
croak 'must specify bucket' unless $bucket;
- return $self->_send_request_expect_nothing( 'DELETE', $bucket, {} );
+ return $self->_send_request_expect_nothing( 'DELETE', $bucket . "/", {} );
}
=head2 list_bucket
@@ -435,7 +452,7 @@
croak 'must specify bucket' unless $bucket;
$conf ||= {};
- my $path = $bucket;
+ my $path = $bucket . "/";
if (%$conf) {
$path .= "?"
. join( '&',
@@ -602,6 +619,27 @@
}
}
+# EU buckets must be accessed via their DNS name. This routine figures out if
+# a given bucket name can be safely used as a DNS name.
+sub _is_dns_bucket {
+ my $bucketname = $_[0];
+
+ if ( length $bucketname > 63 ) {
+ return 0;
+ }
+ if ( length $bucketname < 3 ) {
+ return;
+ }
+ return 0 unless $bucketname =~ m{^[a-z0-9][a-z0-9.-]+$};
+ my @components = split /\./, $bucketname;
+ for my $c (@components) {
+ return 0 if $c =~ m{^-};
+ return 0 if $c =~ m{-$};
+ return 0 if $c eq '';
+ }
+ return 1;
+}
+
# make the HTTP::Request object
sub _make_request {
my ( $self, $method, $path, $headers, $data, $metadata ) = @_;
@@ -616,8 +654,12 @@
$self->_add_auth_header( $http_headers, $method, $path )
unless exists $headers->{Authorization};
my $protocol = $self->secure ? 'https' : 'http';
- my $url = "$protocol://s3.amazonaws.com/$path";
- my $request = HTTP::Request->new( $method, $url, $http_headers );
+ my $url = "$protocol://s3.amazonaws.com/$path";
+ if ( $path =~ m{^([^/?]+)(.*)} && _is_dns_bucket($1) ) {
+ $url = "$protocol://$1.s3.amazonaws.com$2";
+ }
+
+ my $request = HTTP::Request->new( $method, $url, $http_headers );
$request->content($data);
# my $req_as = $request->as_string;
@@ -663,6 +705,42 @@
my $response = $self->_do_http($request);
my $content = $response->content;
+
+ return 1 if $response->code =~ /^2\d\d$/;
+
+ # anything else is a failure, and we save the parsed result
+ $self->_remember_errors( $response->content );
+ return 0;
+}
+
+# Send a HEAD request first, to find out if we'll be hit with a 307 redirect.
+# Since currently LWP does not have true support for 100 Continue, it simply
+# slams the PUT body into the socket without waiting for any possible redirect.
+# Thus when we're reading from a filehandle, when LWP goes to reissue the request
+# having followed the redirect, the filehandle's already been closed from the
+# first time we used it. Thus, we need to probe first to find out what's going on,
+# before we start sending any actual data.
+sub _send_request_expect_nothing_probed {
+ my $self = shift;
+ my ( $method, $path, $conf, $value ) = @_;
+ my $request = $self->_make_request( 'HEAD', $path );
+ my $override_uri = undef;
+
+ my $old_redirectable = $self->ua->requests_redirectable;
+ $self->ua->requests_redirectable( [] );
+
+ my $response = $self->_do_http($request);
+
+ if ( $response->code =~ /^3/ && defined $response->header('Location') ) {
+ $override_uri = $response->header('Location');
+ }
+ $request = $self->_make_request(@_);
+ $request->uri($override_uri) if defined $override_uri;
+
+ $response = $self->_do_http($request);
+ $self->ua->requests_redirectable($old_redirectable);
+
+ my $content = $response->content;
return 1 if $response->code =~ /^2\d\d$/;
@@ -786,6 +864,8 @@
$buf .= '?acl';
} elsif ( $path =~ /[&?]torrent($|=|&)/ ) {
$buf .= '?torrent';
+ } elsif ( $path =~ /[&?]location($|=|&)/ ) {
+ $buf .= '?location';
}
return $buf;
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=11339&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 Dec 17 20:42:47 2007
@@ -85,7 +85,7 @@
my ( $self, $key ) = @_;
return ($key)
? $self->bucket . "/" . $self->account->_urlencode($key)
- : $self->bucket;
+ : $self->bucket . "/";
}
=head2 add_key
@@ -126,8 +126,17 @@
$conf->{'Content-Length'} ||= length $value;
}
- return $self->account->_send_request_expect_nothing( 'PUT',
- $self->_uri($key), $conf, $value );
+ # If we're pushing to a bucket that's under DNS flux, we might get a 307
+ # Since LWP doesn't support actually waiting for a 100 Continue response,
+ # we'll just send a HEAD first to see what's going on
+
+ if ( ref($value) ) {
+ return $self->account->_send_request_expect_nothing_probed( 'PUT',
+ $self->_uri($key), $conf, $value );
+ } else {
+ return $self->account->_send_request_expect_nothing( 'PUT',
+ $self->_uri($key), $conf, $value );
+ }
}
=head2 add_key_filename
@@ -392,8 +401,8 @@
my $path = $self->_uri( $conf->{key} ) . '?acl';
- my $hash_ref =
- ( $conf->{acl_short} )
+ my $hash_ref
+ = ( $conf->{acl_short} )
? { 'x-amz-acl' => $conf->{acl_short} }
: {};
@@ -402,6 +411,27 @@
return $self->account->_send_request_expect_nothing( 'PUT', $path,
$hash_ref, $xml );
+}
+
+=head2 get_location_constraint
+
+Retrieves the location constraint set when the bucket was created. Returns a
+string (eg, 'EU'), or undef if no location constraint was set.
+
+=cut
+
+sub get_location_constraint {
+ my ($self) = @_;
+
+ my $xpc = $self->account->_send_request( 'GET',
+ $self->bucket . '/?location' );
+ return undef unless $xpc && !$self->account->_remember_errors($xpc);
+
+ my $lc = $xpc->findvalue("//s3:LocationConstraint");
+ if ( defined $lc && $lc eq '' ) {
+ $lc = undef;
+ }
+ return $lc;
}
# proxy up the err requests
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=11339&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/t/01api.t (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/t/01api.t Mon Dec 17 20:42:47 2007
@@ -9,7 +9,7 @@
unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
plan skip_all => 'Testing this module for real costs money.';
} else {
- plan tests => 66;
+ plan tests => 63 * 2 + 4;
}
use_ok('Net::Amazon::S3');
@@ -41,197 +41,218 @@
is( scalar @{ $response->{buckets} }, 2 );
}
-# create a bucket
-my $bucketname = $aws_access_key_id . '-net-amazon-s3-test';
-my $bucket_obj
- = $s3->add_bucket( { bucket => $bucketname, acl_short => 'public-read' } )
- or die $s3->err . ": " . $s3->errstr;
-is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
-
-like_acl_allusers_read($bucket_obj);
-ok( $bucket_obj->set_acl( { acl_short => 'private' } ) );
-unlike_acl_allusers_read($bucket_obj);
-
-# another way to get a bucket object (does no network I/O,
-# assumes it already exists). Read Net::Amazon::S3::Bucket.
-$bucket_obj = $s3->bucket($bucketname);
-is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
-
-# fetch contents of the bucket
-# note prefix, marker, max_keys options can be passed in
-$response = $bucket_obj->list
- or die $s3->err . ": " . $s3->errstr;
-is( $response->{bucket}, $bucketname );
-is( $response->{prefix}, '' );
-is( $response->{marker}, '' );
-is( $response->{max_keys}, 1_000 );
-is( $response->{is_truncated}, 0 );
-is_deeply( $response->{keys}, [] );
-
-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';
- $bucket_obj->add_key(
- $keyname, $value,
+for my $location ( undef, 'EU' ) {
+
+ # create a bucket
+ # make sure it's a valid hostname for EU testing
+ # we use the same bucket name for both in order to force one or the other to
+ # have stale DNS
+ my $bucketname = 'net-amazon-s3-test-' . lc $aws_access_key_id;
+ my $bucket_obj = $s3->add_bucket(
+ { bucket => $bucketname,
+ acl_short => 'public-read',
+ location_constraint => $location
+ }
+ ) or die $s3->err . ": " . $s3->errstr;
+ is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
+ is( $bucket_obj->get_location_constraint, $location );
+
+ like_acl_allusers_read($bucket_obj);
+ ok( $bucket_obj->set_acl( { acl_short => 'private' } ) );
+ unlike_acl_allusers_read($bucket_obj);
+
+ # another way to get a bucket object (does no network I/O,
+ # assumes it already exists). Read Net::Amazon::S3::Bucket.
+ $bucket_obj = $s3->bucket($bucketname);
+ is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
+
+ # fetch contents of the bucket
+ # note prefix, marker, max_keys options can be passed in
+ $response = $bucket_obj->list
+ or die $s3->err . ": " . $s3->errstr;
+ is( $response->{bucket}, $bucketname );
+ is( $response->{prefix}, '' );
+ is( $response->{marker}, '' );
+ is( $response->{max_keys}, 1_000 );
+ is( $response->{is_truncated}, 0 );
+ is_deeply( $response->{keys}, [] );
+
+ 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';
+ $bucket_obj->add_key(
+ $keyname, $value,
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'orange',
+ acl_short => 'public-read',
+ }
+ );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$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' }
+ )
+ );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname",
+ 403, "cannot access the private key" );
+
+ unlike_acl_allusers_read( $bucket_obj, $keyname );
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname,
+ acl_xml => acl_xml_from_acl_short('public-read')
+ }
+ )
+ );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname",
+ 200, "can access the publicly readable key after acl_xml set" );
+
+ like_acl_allusers_read( $bucket_obj, $keyname );
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname,
+ acl_xml => acl_xml_from_acl_short('private')
+ }
+ )
+ );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname",
+ 403, "cannot access the private key after acl_xml set" );
+
+ 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';
+ $bucket_obj->add_key(
+ $keyname2,
+ $value,
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'blue',
+ acl_short => 'private',
+ }
+ );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname2",
+ 403, "cannot access the private key" );
+
+ unlike_acl_allusers_read( $bucket_obj, $keyname2 );
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname2, acl_short => 'public-read' }
+ )
+ );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname2",
+ 200, "can access the publicly readable key" );
+
+ like_acl_allusers_read( $bucket_obj, $keyname2 );
+
+ $bucket_obj->delete_key($keyname2);
+
+ }
+
+ # list keys in the bucket
+ $response = $bucket_obj->list
+ or die $s3->err . ": " . $s3->errstr;
+ is( $response->{bucket}, $bucketname );
+ is( $response->{prefix}, '' );
+ is( $response->{marker}, '' );
+ is( $response->{max_keys}, 1_000 );
+ is( $response->{is_truncated}, 0 );
+ my @keys = @{ $response->{keys} };
+ is( @keys, 1 );
+ my $key = $keys[0];
+ is( $key->{key}, $keyname );
+
+ # the etag is the MD5 of the value
+ is( $key->{etag}, 'b9ece18c950afbfa6b0fdbfa4ff731d3' );
+ is( $key->{size}, 1 );
+
+ is( $key->{owner_id}, $OWNER_ID );
+ is( $key->{owner_displayname}, $OWNER_DISPLAYNAME );
+
+ # You can't delete a bucket with things in it
+ ok( !$bucket_obj->delete_bucket() );
+
+ $bucket_obj->delete_key($keyname);
+
+ # now play with the file methods
+ my $readme_md5 = file_md5_hex('README');
+ my $readme_size = -s 'README';
+ $keyname .= "2";
+ $bucket_obj->add_key_filename(
+ $keyname, 'README',
{ content_type => 'text/plain',
- 'x-amz-meta-colour' => 'orange',
- acl_short => 'public-read',
+ 'x-amz-meta-colour' => 'orangy',
}
);
-
- 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' } ) );
-
- is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
- 403, "cannot access the private key" );
-
- unlike_acl_allusers_read( $bucket_obj, $keyname );
-
- ok( $bucket_obj->set_acl(
- { key => $keyname,
- acl_xml => acl_xml_from_acl_short('public-read')
- }
- )
- );
-
- 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 );
-
- ok( $bucket_obj->set_acl(
- { key => $keyname,
- acl_xml => acl_xml_from_acl_short('private')
- }
- )
- );
-
- 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 );
-
-}
-
-{
-
- # 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';
- $bucket_obj->add_key(
- $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 );
-
- ok( $bucket_obj->set_acl(
- { key => $keyname2, acl_short => 'public-read' }
- )
- );
-
- is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname2",
- 200, "can access the publicly readable key" );
-
- like_acl_allusers_read( $bucket_obj, $keyname2 );
-
- $bucket_obj->delete_key($keyname2);
-
-}
-
-# list keys in the bucket
-$response = $bucket_obj->list
- or die $s3->err . ": " . $s3->errstr;
-is( $response->{bucket}, $bucketname );
-is( $response->{prefix}, '' );
-is( $response->{marker}, '' );
-is( $response->{max_keys}, 1_000 );
-is( $response->{is_truncated}, 0 );
-my @keys = @{ $response->{keys} };
-is( @keys, 1 );
-my $key = $keys[0];
-is( $key->{key}, $keyname );
-
-# the etag is the MD5 of the value
-is( $key->{etag}, 'b9ece18c950afbfa6b0fdbfa4ff731d3' );
-is( $key->{size}, 1 );
-
-is( $key->{owner_id}, $OWNER_ID );
-is( $key->{owner_displayname}, $OWNER_DISPLAYNAME );
-
-# You can't delete a bucket with things in it
-ok( !$bucket_obj->delete_bucket() );
-
-$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' );
-is( $response->{content_length}, 13_396 );
-
-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' );
-is( $response->{content_length}, 13_396 );
-
-$bucket_obj->delete_key($keyname);
-
-# try empty files
-$keyname .= "3";
-$bucket_obj->add_key( $keyname, '' );
-$response = $bucket_obj->get_key($keyname);
-is( $response->{value}, '' );
-is( $response->{etag}, 'd41d8cd98f00b204e9800998ecf8427e' );
-is( $response->{content_type}, 'binary/octet-stream' );
-is( $response->{content_length}, 0 );
-$bucket_obj->delete_key($keyname);
-
-# fetch contents of the bucket
-# note prefix, marker, max_keys options can be passed in
-$response = $bucket_obj->list
- or die $s3->err . ": " . $s3->errstr;
-is( $response->{bucket}, $bucketname );
-is( $response->{prefix}, '' );
-is( $response->{marker}, '' );
-is( $response->{max_keys}, 1_000 );
-is( $response->{is_truncated}, 0 );
-is_deeply( $response->{keys}, [] );
-
-ok( $bucket_obj->delete_bucket() );
+ $response = $bucket_obj->get_key($keyname);
+ is( $response->{content_type}, 'text/plain' );
+ like( $response->{value}, qr/and unknown Amazon/ );
+ is( $response->{etag}, $readme_md5 );
+ is( $response->{'x-amz-meta-colour'}, 'orangy' );
+ is( $response->{content_length}, $readme_size );
+
+ 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}, $readme_md5 );
+ is( file_md5_hex('t/README'), $readme_md5 );
+ is( $response->{'x-amz-meta-colour'}, 'orangy' );
+ is( $response->{content_length}, $readme_size );
+
+ $bucket_obj->delete_key($keyname);
+
+ # try empty files
+ $keyname .= "3";
+ $bucket_obj->add_key( $keyname, '' );
+ $response = $bucket_obj->get_key($keyname);
+ is( $response->{value}, '' );
+ is( $response->{etag}, 'd41d8cd98f00b204e9800998ecf8427e' );
+ is( $response->{content_type}, 'binary/octet-stream' );
+ is( $response->{content_length}, 0 );
+ $bucket_obj->delete_key($keyname);
+
+ # fetch contents of the bucket
+ # note prefix, marker, max_keys options can be passed in
+ $response = $bucket_obj->list
+ or die $s3->err . ": " . $s3->errstr;
+ is( $response->{bucket}, $bucketname );
+ is( $response->{prefix}, '' );
+ is( $response->{marker}, '' );
+ is( $response->{max_keys}, 1_000 );
+ is( $response->{is_truncated}, 0 );
+ is_deeply( $response->{keys}, [] );
+
+ ok( $bucket_obj->delete_bucket() );
+}
# see more docs in Net::Amazon::S3::Bucket
@@ -248,13 +269,13 @@
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 );
+ like( $bucketobj->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 );
+ unlike( $bucketobj->get_acl($keyname), qr(AllUsers.+READ), $message );
}
sub acl_allusers_read_message {
More information about the Pkg-perl-cvs-commits
mailing list