r55189 - in /trunk/libnet-amazon-s3-perl: ./ bin/ debian/ examples/ lib/Net/Amazon/ lib/Net/Amazon/S3/ lib/Net/Amazon/S3/Client/ lib/Net/Amazon/S3/Request/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Tue Mar 30 19:43:43 UTC 2010
Author: gregoa
Date: Tue Mar 30 19:43:32 2010
New Revision: 55189
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=55189
Log:
New upstream release.
Modified:
trunk/libnet-amazon-s3-perl/CHANGES
trunk/libnet-amazon-s3-perl/META.yml
trunk/libnet-amazon-s3-perl/bin/s3cl
trunk/libnet-amazon-s3-perl/debian/changelog
trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client.pm
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Object.pm
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/HTTPRequest.pm
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListBucket.pm
trunk/libnet-amazon-s3-perl/t/02client.t
Modified: trunk/libnet-amazon-s3-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/CHANGES?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/CHANGES (original)
+++ trunk/libnet-amazon-s3-perl/CHANGES Tue Mar 30 19:43:32 2010
@@ -1,4 +1,18 @@
Revision history for Perl module Net::Amazon::S3:
+
+0.53 Tue Mar 30 15:24:19 BST 2010
+ - fix authenticated urls to work with EU buckets (patch by Edmund
+ von der Burg)
+ - tiny POD fix (patch by Frank Wiegand)
+ - add an exists method to Net::Amazon::S3::Client (suggested by
+ David Golden)
+ - fix max_keys when listing buckets (spotted by Andrew Bryan)
+ - add content_encoding to Net::Amazon::S3::Object (suggested
+ by Egor Korablev)
+ - update s3cl: You need to use the module before you use it,
+ added the mkbucket command, now you can run the help without
+ your AWS secret key, add docs about the env variables you need
+ to run s3cl (patches by Jesse Vincent)
0.52 Thu Jul 2 09:17:11 BST 2009
- increase version prerequisites for some modules so that they
Modified: trunk/libnet-amazon-s3-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/META.yml?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/META.yml (original)
+++ trunk/libnet-amazon-s3-perl/META.yml Tue Mar 30 19:43:32 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-Amazon-S3
-version: 0.52
+version: 0.53
abstract: Use the Amazon S3 - Simple Storage Service
author:
- Leon Brocard <acme at astray.com>
@@ -37,7 +37,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.50
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libnet-amazon-s3-perl/bin/s3cl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/bin/s3cl?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/bin/s3cl (original)
+++ trunk/libnet-amazon-s3-perl/bin/s3cl Tue Mar 30 19:43:32 2010
@@ -4,22 +4,7 @@
use Getopt::Long;
use Pod::Usage;
use Path::Class;
-
-# TODO: read key_id and secret from config file?
-# use AppConfig;
-
-# TODO: probably nicer to put all of this in Net::Amazon::S3::CommandLine
-# and have simple call to that from here.
-
-my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'};
-my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'};
-
-my $s3 = Net::Amazon::S3->new(
- { aws_access_key_id => $aws_access_key_id,
- aws_secret_access_key => $aws_secret_access_key,
- retry => 1,
- }
-);
+use Net::Amazon::S3;
=head1 NAME
@@ -30,6 +15,7 @@
s3cl command [options]
s3cl buckets
+ s3cl mkbucket --bucket some_bucket_name --jurisdiction [EU|US]
s3cl ls <bucket>:[prefix]
s3cl cp <bucket>:<key> /path/[filename]
s3cl sync <bucket>:[prefix] /path/
@@ -41,6 +27,11 @@
We take NO responsibility for the costs incured through using
this script.
+
+ To run this script, you need to set a pair of environment variables:
+
+ AWS_ACCESS_KEY_ID
+ AWS_ACCESS_KEY_SECRET
=head1 DESCRIPTION
@@ -53,26 +44,50 @@
=cut
+my $s3;
+
my %args;
my %commands = (
- buckets => \&buckets,
- ls => \&ls,
- rm => \&rm,
- cp => \&cp,
- sync => \&sync,
- help => \&helper,
+ mkbucket => \&mk_bucket,
+ buckets => \&buckets,
+ ls => \&ls,
+ rm => \&rm,
+ cp => \&cp,
+ sync => \&sync,
+ help => \&helper,
);
-terminal();
-get_options();
main();
sub main {
+ terminal();
+ get_options();
+ init_s3();
+
my $command = shift @ARGV || "help";
$commands{$command}
or helper("Unknown command: $command");
$commands{$command}->();
+}
+
+sub init_s3 {
+
+ # TODO: read key_id and secret from config file?
+ # use AppConfig;
+
+ # TODO: probably nicer to put all of this in Net::Amazon::S3::CommandLine
+ # and have simple call to that from here.
+
+ my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'};
+ my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'};
+
+ $s3 = Net::Amazon::S3->new(
+ { aws_access_key_id => $aws_access_key_id,
+ aws_secret_access_key => $aws_secret_access_key,
+ retry => 1,
+ }
+ );
}
sub sync {
@@ -157,6 +172,15 @@
}
}
+sub mk_bucket {
+ my $bucketname = $args{bucket};
+ my $bucket
+ = $s3->add_bucket(
+ { bucket => $bucketname, location_constraint => 'EU' } )
+ or die $s3->err . ": " . $s3->errstr;
+
+}
+
sub buckets {
my $response = $s3->buckets;
my $num = scalar @{ $response->{buckets} || [] };
@@ -179,11 +203,13 @@
# TODO: Replace with AppConfig this is ick!
sub get_options {
- my $help = 0;
- my $man = 0;
- my $force = 0;
+ my $help = 0;
+ my $man = 0;
+ my $force = 0;
+ my $loc = "US";
+ my $bucket = "";
GetOptions(
- \%args, "bucket=s",
+ \%args, "bucket=s", "jurisdiction=s",
"f|force" => \$force,
"h|help|?" => \$help,
"man" => \$man,
@@ -234,6 +260,13 @@
s3cl buckets
List all buckets for this account.
+
+=item B<mkbucket>
+
+s3cl mkbucket --bucket sombucketname [--jurisdiction [EU|US]]
+
+Create a new bucket, optionally specifying what jurisdiction
+it should be created in.
=item B<ls>
Modified: trunk/libnet-amazon-s3-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/debian/changelog?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/debian/changelog (original)
+++ trunk/libnet-amazon-s3-perl/debian/changelog Tue Mar 30 19:43:32 2010
@@ -1,3 +1,9 @@
+libnet-amazon-s3-perl (0.53-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Tue, 30 Mar 2010 21:42:34 +0200
+
libnet-amazon-s3-perl (0.52-2) unstable; urgency=low
[ Ryan Niebur ]
Modified: trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl (original)
+++ trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl Tue Mar 30 19:43:32 2010
@@ -9,21 +9,21 @@
use Set::Object;
use Term::ProgressBar::Simple;
use List::Util qw(sum);
-
-#use Digest::MD5::File::Cached qw(file_md5_hex_cached);
use Digest::MD5::File qw(file_md5_hex);
+use BerkeleyDB::Manager;
use Cwd;
use Config;
-use KiokuDB;
-use MD5Cache;
-my $kiokudb
- = KiokuDB->connect( "dbi:SQLite:dbname=md5cache.db", create => 1, );
-my $scope = $kiokudb->new_scope;
+my $m = BerkeleyDB::Manager->new(
+ home => Path::Class::Dir->new(cwd),
+ db_class => 'BerkeleyDB::Hash',
+ create => 1,
+);
+my $db = $m->open_db( file => 'md5_cache' );
my $s3 = Net::Amazon::S3->new(
- aws_access_key_id => '0RJDWCWPV4E3660V6G82',
- aws_secret_access_key => 'ESHMa4/1PZn/r6/2xrfBNIU481jgKkqQ0DDiD5Yp',
+ aws_access_key_id => 'XXX',
+ aws_secret_access_key => 'XXX',
retry => 1,
);
@@ -38,36 +38,44 @@
);
my %files;
-
-$kiokudb->txn_do( sub {
my $file_set = Set::Object->new();
until ( $file_stream->is_done ) {
foreach my $filename ( $file_stream->items ) {
my $key = $filename->relative($root)->stringify;
- my $md5cache = $kiokudb->lookup( $filename->stringify );
- unless ($md5cache) {
- $md5cache = MD5Cache->new(
- { key => $filename->stringify,
- md5_hex => file_md5_hex($filename)
+ #[rootname]path/to/file.txt:<ctime>,<mtime>,<size>,<inodenum>
+ my $stat = $filename->stat;
+ my $ctime = $stat->ctime;
+ my $mtime = $stat->mtime;
+ my $size = $stat->size;
+ my $inodenum = $stat->ino;
+ my $cachekey = "$key:$ctime,$mtime,$size,$inodenum";
+
+ $db->db_get( $cachekey, my $md5_hex );
+ if ($md5_hex) {
+
+ #say "hit $cachekey $md5hex";
+ } else {
+ $md5_hex = file_md5_hex($filename)
+ || die "Failed to find MD5 for $filename";
+ $m->txn_do(
+ sub {
+ $db->db_put( $cachekey, $md5_hex );
}
);
- $kiokudb->store( $filename->stringify => $md5cache );
+
+ #say "miss $cachekey $md5_hex";
}
-
-#say "$key " . $md5cache->md5_hex;
$files{$key} = {
filename => $filename,
key => $key,
- md5_hex => $md5cache->md5_hex,
+ md5_hex => $md5_hex,
size => -s $filename,
};
$file_set->insert($key);
+
}
}
-});
-
-die "did md5";
my %objects;
my $s3_set = Set::Object->new();
@@ -82,12 +90,12 @@
size => $object->size,
};
- say $object->key . ' ' . $object->size . ' ' . $object->etag;
+ # say $object->key . ' ' . $object->size . ' ' . $object->etag;
$s3_set->insert( $object->key );
}
}
-my @to_upload;
+my @to_add;
my @to_delete;
foreach my $key ( sort keys %files ) {
@@ -96,16 +104,16 @@
if ($object) {
if ( $file->{md5_hex} eq $object->{md5_hex} ) {
- say "$key same";
+ # say "$key same";
} else {
- say "$key different";
- push @to_upload, $file;
+ # say "$key different";
+ push @to_add, $file;
}
} else {
- say "$key missing";
- push @to_upload, $file;
+ #say "$key missing";
+ push @to_add, $file;
}
}
@@ -115,17 +123,17 @@
if ($file) {
} else {
- say "$key to delete";
+ # say "$key to delete";
push @to_delete, $object;
}
}
-my $total_size = sum map { file( $_->{filename} )->stat->size } @to_upload;
+my $total_size = sum map { file( $_->{filename} )->stat->size } @to_add;
$total_size += scalar(@to_delete);
my $progress = Term::ProgressBar::Simple->new($total_size);
-foreach my $file (@to_upload) {
+foreach my $file (@to_add) {
my $key = $file->{key};
my $filename = $file->{filename};
my $md5_hex = $file->{md5_hex};
@@ -144,7 +152,7 @@
foreach my $object (@to_delete) {
my $key = $object->{key};
my $filename = $object->{filename};
- my $object = $bucket->object( key => $key );
+ my $object = $bucket->object(key => $key);
# say "delete $key";
$object->delete;
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm Tue Mar 30 19:43:32 2010
@@ -142,7 +142,7 @@
__PACKAGE__->meta->make_immutable;
-our $VERSION = '0.52';
+our $VERSION = '0.53';
my $KEEP_ALIVE_CACHESIZE = 10;
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm Tue Mar 30 19:43:32 2010
@@ -383,7 +383,7 @@
Fails if the bucket has anything in it.
-This is an alias for C<$s3->delete_bucket($bucket)>
+This is an alias for C<< $s3->delete_bucket($bucket) >>
=cut
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client.pm?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client.pm Tue Mar 30 19:43:32 2010
@@ -68,10 +68,16 @@
);
}
+sub _send_request_raw {
+ my ( $self, $http_request, $filename ) = @_;
+
+ return $self->s3->ua->request( $http_request, $filename );
+}
+
sub _send_request {
my ( $self, $http_request, $filename ) = @_;
- my $http_response = $self->s3->ua->request( $http_request, $filename );
+ my $http_response = $self->_send_request_raw( $http_request, $filename );
my $content = $http_response->content;
my $content_type = $http_response->content_type;
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Object.pm?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Object.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Object.pm Tue Mar 30 19:43:32 2010
@@ -30,8 +30,27 @@
required => 0,
default => 'binary/octet-stream'
);
+has 'content_encoding' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 0,
+);
__PACKAGE__->meta->make_immutable;
+
+sub exists {
+ my $self = shift;
+
+ my $http_request = Net::Amazon::S3::Request::GetObject->new(
+ s3 => $self->client->s3,
+ bucket => $self->bucket->name,
+ key => $self->key,
+ method => 'HEAD',
+ )->http_request;
+
+ my $http_response = $self->client->_send_request_raw($http_request);
+ return $http_response->code == 200 ? 1 : 0;
+}
sub get {
my $self = shift;
@@ -96,6 +115,9 @@
if ( $self->expires ) {
$conf->{Expires}
= DateTime::Format::HTTP->format_datetime( $self->expires );
+ }
+ if ( $self->content_encoding ) {
+ $conf->{'Content-Encoding'} = $self->content_encoding;
}
my $http_request = Net::Amazon::S3::Request::PutObject->new(
@@ -139,6 +161,9 @@
if ( $self->expires ) {
$conf->{Expires}
= DateTime::Format::HTTP->format_datetime( $self->expires );
+ }
+ if ( $self->content_encoding ) {
+ $conf->{'Content-Encoding'} = $self->content_encoding;
}
my $http_request = Net::Amazon::S3::Request::PutObject->new(
@@ -271,6 +296,9 @@
# to get the vaue of an object
my $value = $object->get;
+ # to see if an object exists
+ if ($object->exists) { ... }
+
# to delete an object
$object->delete;
@@ -331,6 +359,11 @@
# to delete an object
$object->delete;
+=head2 exists
+
+ # to see if an object exists
+ if ($object->exists) { ... }
+
=head2 get
# to get the vaue of an object
@@ -362,6 +395,8 @@
);
$object->put('this is the public value');
+You may also set Content-Encoding using content_encoding.
+
=head2 put_filename
# upload a file
@@ -380,6 +415,8 @@
);
$object->put_filename('hat.jpg');
+You may also set Content-Encoding using content_encoding.
+
=head2 query_string_authentication_uri
# use query string authentication
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/HTTPRequest.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/HTTPRequest.pm?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/HTTPRequest.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/HTTPRequest.pm Tue Mar 30 19:43:32 2010
@@ -67,7 +67,11 @@
= $self->_encode( $aws_secret_access_key, $canonical_string );
my $protocol = $self->s3->secure ? 'https' : 'http';
- my $uri = URI->new("$protocol://s3.amazonaws.com/$path");
+ my $uri = "$protocol://s3.amazonaws.com/$path";
+ if ( $path =~ m{^([^/?]+)(.*)} && _is_dns_bucket($1) ) {
+ $uri = "$protocol://$1.s3.amazonaws.com$2";
+ }
+ $uri = URI->new($uri);
$uri->query_param( AWSAccessKeyId => $aws_access_key_id );
$uri->query_param( Expires => $expires );
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListBucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListBucket.pm?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListBucket.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListBucket.pm Tue Mar 30 19:43:32 2010
@@ -22,7 +22,9 @@
foreach my $method qw(prefix delimiter max_keys marker) {
my $value = $self->$method;
next unless $value;
- push @post, $method . "=" . $self->_urlencode($value);
+ my $key = $method;
+ $key = 'max-keys' if $method eq 'max_keys';
+ push @post, $key . "=" . $self->_urlencode($value);
}
if (@post) {
$path .= '?' . join( '&', @post );
Modified: trunk/libnet-amazon-s3-perl/t/02client.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/t/02client.t?rev=55189&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/t/02client.t (original)
+++ trunk/libnet-amazon-s3-perl/t/02client.t Tue Mar 30 19:43:32 2010
@@ -11,7 +11,7 @@
unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
plan skip_all => 'Testing this module for real costs money.';
} else {
- plan tests => 36;
+ plan tests => 38;
}
use_ok('Net::Amazon::S3');
@@ -76,7 +76,12 @@
is( $count, 0, 'newly created bucket has no objects' );
my $object = $bucket->object( key => 'this is the key' );
+
+ok( !$object->exists, 'object does not exist yet' );
+
$object->put('this is the value');
+
+ok( $object->exists, 'object now exists yet' );
my @objects;
@@ -141,10 +146,11 @@
# upload a public object
$object = $bucket->object(
- key => 'this is the public key',
- acl_short => 'public-read',
- content_type => 'text/plain',
- expires => '2001-02-03',
+ key => 'this is the public key',
+ acl_short => 'public-read',
+ content_type => 'text/plain',
+ content_encoding => 'identity',
+ expires => '2001-02-03',
);
$object->put('this is the public value');
is( get( $object->uri ),
More information about the Pkg-perl-cvs-commits
mailing list