r24845 - in /branches/upstream/libnet-amazon-s3-perl/current: CHANGES META.yml Makefile.PL lib/Net/Amazon/S3.pm lib/Net/Amazon/S3/Bucket.pm t/01api.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Sep 6 16:53:14 UTC 2008
Author: gregoa
Date: Sat Sep 6 16:53:11 2008
New Revision: 24845
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24845
Log:
[svn-upgrade] Integrating new upstream version, libnet-amazon-s3-perl (0.45)
Modified:
branches/upstream/libnet-amazon-s3-perl/current/CHANGES
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/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/CHANGES?rev=24845&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/CHANGES (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/CHANGES Sat Sep 6 16:53:11 2008
@@ -1,4 +1,17 @@
Revision history for Perl module Net::Amazon::S3:
+
+0.45 Wed Aug 20 17:06:49 BST 2008
+ - make add_key, head_key etc. return all the headers, not
+ just the X-Amazon ones (patch by Andrew Hanenkamp)
+ - require IO::File 1.14 (noticed by tsw)
+ - remove DateTime::Format::Strptime prerequisite as it was not
+ being used (noticed by Yen-Ming Lee)
+ - do not try and parse non-XML errors (patch by lostlogic)
+ - make it possible to store and delete the key "0"
+ (patch by Joey Hess)
+ - make it possible to store empty files (patch by BDOLAN)
+ - add Copy support (patch by BDOLAN)
+ - add s3cl for command-line access (patch by Leo Lapworth)
0.44 Thu Mar 27 08:35:59 GMT 2008
- fix bug with storing files consisting of "0" (thanks to
Modified: branches/upstream/libnet-amazon-s3-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/META.yml?rev=24845&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/META.yml (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/META.yml Sat Sep 6 16:53:11 2008
@@ -1,18 +1,18 @@
--- #YAML:1.0
name: Net-Amazon-S3
-version: 0.44
+version: 0.45
abstract: ~
license: perl
author:
- Leon Brocard <acme at astray.com>
-generated_by: ExtUtils::MakeMaker version 6.42
+generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
Class::Accessor::Fast: 0
- DateTime::Format::Strptime: 0
Digest::HMAC_SHA1: 0
Digest::MD5::File: 0
HTTP::Date: 0
+ IO::File: 1.14
LWP::UserAgent::Determined: 0
MIME::Base64: 0
Test::More: 0.01
Modified: branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL?rev=24845&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL Sat Sep 6 16:53:11 2008
@@ -9,10 +9,10 @@
LICENSE => 'perl',
PREREQ_PM => {
'Class::Accessor::Fast' => '0',
- 'DateTime::Format::Strptime' => '0',
'Digest::MD5::File' => '0',
'Digest::HMAC_SHA1' => '0',
'HTTP::Date' => '0',
+ 'IO::File' => '1.14',
'LWP::UserAgent::Determined' => '0',
'MIME::Base64' => '0',
'Test::More' => '0.01',
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3.pm?rev=24845&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 Sat Sep 6 16:53:11 2008
@@ -112,7 +112,7 @@
__PACKAGE__->mk_accessors(
qw(libxml aws_access_key_id aws_secret_access_key secure ua err errstr timeout retry)
);
-our $VERSION = '0.44';
+our $VERSION = '0.45';
my $AMAZON_HEADER_PREFIX = 'x-amz-';
my $METADATA_PREFIX = 'x-amz-meta-';
@@ -792,8 +792,16 @@
# returns 1 if errors were found
sub _remember_errors {
my ( $self, $src ) = @_;
+
+ # Do not try to parse non-xml
+ unless ( ref $src || $src =~ m/^[[:space:]]*</ ) {
+ ( my $code = $src ) =~ s/^[[:space:]]*\([0-9]*\).*$/$1/;
+ $self->err($code);
+ $self->errstr($src);
+ return 1;
+ }
+
my $xpc = ref $src ? $src : $self->_xpc_of_content($src);
-
if ( $xpc->findnodes("//Error") ) {
$self->err( $xpc->findvalue("//Error/Code") );
$self->errstr( $xpc->findvalue("//Error/Message") );
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Bucket.pm?rev=24845&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 Sat Sep 6 16:53:11 2008
@@ -89,36 +89,45 @@
: $self->bucket . "/";
}
-=head2 add_key
-
-Takes three positional parameters:
-
-=over
-
-=item key
-
-=item value
-
-=item configuration
-
-A hash of configuration data for this key. (See synopsis);
-
-=back
-
-Returns a boolean.
-
-=cut
-
-# returns bool
-sub add_key {
- my ( $self, $key, $value, $conf ) = @_;
- croak 'must specify key' unless $key && length $key;
+sub _conf_to_headers {
+ my ($self, $conf) = @_;
+ $conf = {} unless defined $conf;
+ $conf = { %$conf }; # clone it so as not to clobber the caller's copy
if ( $conf->{acl_short} ) {
$self->account->_validate_acl_short( $conf->{acl_short} );
$conf->{'x-amz-acl'} = $conf->{acl_short};
delete $conf->{acl_short};
}
+
+ return $conf;
+}
+
+=head2 add_key
+
+Takes three positional parameters:
+
+=over
+
+=item key
+
+=item value
+
+=item configuration
+
+A hash of configuration data for this key. (See synopsis);
+
+=back
+
+Returns a boolean.
+
+=cut
+
+# returns bool
+sub add_key {
+ my ( $self, $key, $value, $conf ) = @_;
+ croak 'must specify key' unless defined $key && length $key;
+ $conf = $self->_conf_to_headers($conf);
if ( ref($value) eq 'SCALAR' ) {
$conf->{'Content-Length'} ||= -s $$value;
@@ -165,6 +174,81 @@
return $self->add_key( $key, \$value, $conf );
}
+=head2 copy_key
+
+Creates (or replaces) a key, copying its contents from another key elsewhere in S3.
+Takes the following parameters:
+
+=over
+
+=item key
+
+The key to (over)write
+
+=item source
+
+Where to copy the key from. Should be in the form C</I<bucketname>/I<keyname>>/.
+
+=item conf
+
+Optional configuration hash. If present and defined, the configuration (ACL
+and headers) there will be used for the new key; otherwise it will be copied
+from the source key.
+
+=back
+
+=cut
+
+sub copy_key {
+ my ( $self, $key, $source, $conf ) = @_;
+
+ if (defined $conf) {
+ $conf = $self->_conf_to_headers($conf);
+ $conf->{'x-amz-metadata-directive'} = 'REPLACE';
+ } else {
+ $conf = {};
+ }
+
+ $conf->{'x-amz-copy-source'} = $source;
+
+ my $acct = $self->account;
+ my $request = $acct->_make_request('PUT', $self->_uri($key), $conf);
+ my $response = $acct->_do_http($request);
+ my $xpc = $acct->_xpc_of_content($response->content);
+
+ if (!$response->is_success || !$xpc || $xpc->findnodes("//Error")) {
+ $acct->_remember_errors($response->content);
+ return 0;
+ }
+
+ return 1;
+}
+
+=head2 edit_metadata
+
+Changes the metadata associated with an existing key. Arguments:
+
+=over
+
+=item key
+
+The key to edit
+
+=item conf
+
+The new configuration hash to use
+
+=back
+
+=cut
+
+sub edit_metadata {
+ my ($self, $key, $conf) = @_;
+ croak "Need configuration hash" unless defined $conf;
+
+ return $self->copy_key($key, "/".$self->bucket."/".$key, $conf);
+}
+
=head2 head_key KEY
Takes the name of a key in this bucket and returns its configuration hash
@@ -187,7 +271,8 @@
On success:
-Returns a hashref of { content_type, etag, value, @meta } on success
+Returns a hashref of { content_type, etag, value, @meta } on success. Other
+values from the server are there too, with the key being lowercased.
=cut
@@ -212,17 +297,14 @@
$etag =~ s/"$//;
}
- my $return = {
- content_length => $response->content_length || 0,
- content_type => $response->content_type,
- etag => $etag,
- value => $response->content,
- };
-
+ my $return;
foreach my $header ( $response->headers->header_field_names ) {
- next unless $header =~ /x-amz-meta-/i;
$return->{ lc $header } = $response->header($header);
}
+ $return->{content_length} = $response->content_length || 0;
+ $return->{content_type} = $response->content_type;
+ $return->{etag} = $etag;
+ $return->{value} = $response->content;
return $return;
@@ -260,7 +342,7 @@
# returns bool
sub delete_key {
my ( $self, $key ) = @_;
- croak 'must specify key' unless $key && length $key;
+ croak 'must specify key' unless defined $key && length $key;
return $self->account->_send_request_expect_nothing( 'DELETE',
$self->_uri($key), {} );
}
@@ -460,7 +542,7 @@
my $blksize = $stat->blksize || 4096;
croak "$filename not a readable file with fixed size"
- unless -r $filename and $remaining;
+ unless -r $filename and ( -f _ || $remaining );
my $fh = IO::File->new( $filename, 'r' )
or croak "Could not open $filename: $!";
$fh->binmode;
Modified: branches/upstream/libnet-amazon-s3-perl/current/t/01api.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/t/01api.t?rev=24845&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/t/01api.t (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/t/01api.t Sat Sep 6 16:53:11 2008
@@ -9,7 +9,7 @@
unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
plan skip_all => 'Testing this module for real costs money.';
} else {
- plan tests => 63 * 2 + 4;
+ plan tests => 71 * 2 + 4;
}
use_ok('Net::Amazon::S3');
@@ -38,7 +38,7 @@
local $TODO = "These tests only work if you're leon";
like( $response->{owner_id}, qr/^46a801915a1711f/ );
- is( $response->{owner_displayname}, '_acme_' );
+ is( $response->{owner_displayname}, '_acme_' );
is( scalar @{ $response->{buckets} }, 2 );
}
@@ -55,7 +55,7 @@
location_constraint => $location
}
) or die $s3->err . ": " . $s3->errstr;
- is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
+ is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
is( $bucket_obj->get_location_constraint, $location );
like_acl_allusers_read($bucket_obj);
@@ -176,6 +176,41 @@
$bucket_obj->delete_key($keyname2);
+ }
+
+ {
+
+ # Copy a key, keeping metadata
+ my $keyname2 = 'testing2.txt';
+
+ $bucket_obj->copy_key( $keyname2, "/$bucketname/$keyname" );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname2",
+ 403, "cannot access the private key" );
+
+ # Overwrite, making publically readable
+ $bucket_obj->copy_key( $keyname2, "/$bucketname/$keyname",
+ { acl_short => 'public-read' } );
+
+ sleep 1;
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname2",
+ 200, "can access the publicly readable key" );
+
+ # Now copy it over itself, making it private
+ $bucket_obj->edit_metadata( $keyname2, { short_acl => 'private' } );
+
+ is_request_response_code(
+ "http://$bucketname.s3.amazonaws.com/$keyname2",
+ 403, "cannot access the private key" );
+
+ # Get rid of it, bringing us back to only one key
+ $bucket_obj->delete_key($keyname2);
+
+ # Expect a nonexistent key copy to fail
+ ok( !$bucket_obj->copy_key( "newkey", "/$bucketname/$keyname2" ),
+ "Copying a nonexistent key fails" );
}
# list keys in the bucket
@@ -240,6 +275,19 @@
is( $response->{content_type}, 'binary/octet-stream' );
is( $response->{content_length}, 0 );
$bucket_obj->delete_key($keyname);
+
+ # how about using add_key_filename?
+ $keyname .= '4';
+ open FILE, ">", "t/empty" or die "Can't open t/empty for write: $!";
+ close FILE;
+ $bucket_obj->add_key_filename( $keyname, 't/empty' );
+ $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);
+ unlink 't/empty';
# fetch contents of the bucket
# note prefix, marker, max_keys options can be passed in
More information about the Pkg-perl-cvs-commits
mailing list