r30937 - in /branches/upstream/libnet-amazon-s3-perl/current: ./ examples/ lib/Net/Amazon/ lib/Net/Amazon/S3/ lib/Net/Amazon/S3/Client/ lib/Net/Amazon/S3/Request/ t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Sat Feb 21 05:13:32 UTC 2009
Author: ryan52-guest
Date: Sat Feb 21 05:11:51 2009
New Revision: 30937
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=30937
Log:
[svn-upgrade] Integrating new upstream version, libnet-amazon-s3-perl (0.50)
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/examples/backup_cpan.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/lib/Net/Amazon/S3/Client.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Bucket.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Object.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/HTTPRequest.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/CreateBucket.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteBucket.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteObject.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObject.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListBucket.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/PutObject.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm
branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm
branches/upstream/libnet-amazon-s3-perl/current/t/02client.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=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/CHANGES (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/CHANGES Sat Feb 21 05:11:51 2009
@@ -1,4 +1,11 @@
Revision history for Perl module Net::Amazon::S3:
+
+0.50 Wed Jan 21 10:42:00 GMT 2009
+ - add support for an expires header when putting an object to
+ Net::Amazon::S3::Client::Object
+ - make all the classes immutable
+ - add query_string_authentication_uri() to
+ Net::Amazon::S3::Client::Object, suggested by Meng Wong
0.49 Tue Jan 13 09:04:42 GMT 2009
- add support for listing a bucket with a prefix 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=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/META.yml (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/META.yml Sat Feb 21 05:11:51 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-Amazon-S3
-version: 0.49
+version: 0.50
abstract: Use the Amazon S3 - Simple Storage Service
license: perl
author:
@@ -10,6 +10,8 @@
requires:
Class::Accessor::Fast: 0
Data::Stream::Bulk::Callback: 0
+ DateTime::Format::HTTP: 0
+ DateTime::Format::ISO8601: 0
Digest::HMAC_SHA1: 0
Digest::MD5: 0
Digest::MD5::File: 0
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=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/Makefile.PL Sat Feb 21 05:11:51 2009
@@ -11,6 +11,8 @@
PREREQ_PM => {
'Class::Accessor::Fast' => '0',
'Data::Stream::Bulk::Callback' => '0',
+ 'DateTime::Format::HTTP' => '0',
+ 'DateTime::Format::ISO8601' => '0',
'Digest::HMAC_SHA1' => '0',
'Digest::MD5' => '0',
'Digest::MD5::File' => '0',
Modified: branches/upstream/libnet-amazon-s3-perl/current/examples/backup_cpan.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/examples/backup_cpan.pl?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/examples/backup_cpan.pl (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/examples/backup_cpan.pl Sat Feb 21 05:11:51 2009
@@ -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 $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 $kiokudb
+ = KiokuDB->connect( "dbi:SQLite:dbname=md5cache.db", create => 1, );
+my $scope = $kiokudb->new_scope;
my $s3 = Net::Amazon::S3->new(
- aws_access_key_id => 'XXX',
- aws_secret_access_key => 'XXX',
+ aws_access_key_id => '0RJDWCWPV4E3660V6G82',
+ aws_secret_access_key => 'ESHMa4/1PZn/r6/2xrfBNIU481jgKkqQ0DDiD5Yp',
retry => 1,
);
@@ -38,44 +38,36 @@
);
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;
- #[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 );
+ my $md5cache = $kiokudb->lookup( $filename->stringify );
+ unless ($md5cache) {
+ $md5cache = MD5Cache->new(
+ { key => $filename->stringify,
+ md5_hex => file_md5_hex($filename)
}
);
+ $kiokudb->store( $filename->stringify => $md5cache );
+ }
- #say "miss $cachekey $md5_hex";
- }
+#say "$key " . $md5cache->md5_hex;
$files{$key} = {
filename => $filename,
key => $key,
- md5_hex => $md5_hex,
+ md5_hex => $md5cache->md5_hex,
size => -s $filename,
};
$file_set->insert($key);
-
}
}
+});
+
+die "did md5";
my %objects;
my $s3_set = Set::Object->new();
@@ -90,12 +82,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_add;
+my @to_upload;
my @to_delete;
foreach my $key ( sort keys %files ) {
@@ -104,16 +96,16 @@
if ($object) {
if ( $file->{md5_hex} eq $object->{md5_hex} ) {
- # say "$key same";
+ say "$key same";
} else {
- # say "$key different";
- push @to_add, $file;
+ say "$key different";
+ push @to_upload, $file;
}
} else {
- #say "$key missing";
- push @to_add, $file;
+ say "$key missing";
+ push @to_upload, $file;
}
}
@@ -123,17 +115,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_add;
+my $total_size = sum map { file( $_->{filename} )->stat->size } @to_upload;
$total_size += scalar(@to_delete);
my $progress = Term::ProgressBar::Simple->new($total_size);
-foreach my $file (@to_add) {
+foreach my $file (@to_upload) {
my $key = $file->{key};
my $filename = $file->{filename};
my $md5_hex = $file->{md5_hex};
@@ -152,7 +144,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: 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=30937&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 Feb 21 05:11:51 2009
@@ -140,7 +140,9 @@
has 'err' => ( is => 'rw', isa => 'Maybe[Str]', required => 0 );
has 'errstr' => ( is => 'rw', isa => 'Maybe[Str]', required => 0 );
-our $VERSION = '0.49';
+__PACKAGE__->meta->make_immutable;
+
+our $VERSION = '0.50';
my $KEEP_ALIVE_CACHESIZE = 10;
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=30937&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 Feb 21 05:11:51 2009
@@ -8,6 +8,8 @@
has 'account' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'creation_date' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 );
+
+__PACKAGE__->meta->make_immutable;
=head1 NAME
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client.pm Sat Feb 21 05:11:51 2009
@@ -14,6 +14,8 @@
type 'OwnerId' => where { $_ =~ /^[a-z0-9]{64}$/ };
has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 );
+
+__PACKAGE__->meta->make_immutable;
sub buckets {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Bucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Bucket.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Bucket.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Bucket.pm Sat Feb 21 05:11:51 2009
@@ -10,6 +10,8 @@
( is => 'ro', isa => 'DateTime', coerce => 1, required => 0 );
has 'owner_id' => ( is => 'ro', isa => 'OwnerId', required => 0 );
has 'owner_display_name' => ( is => 'ro', isa => 'Str', required => 0 );
+
+__PACKAGE__->meta->make_immutable;
sub _create {
my ( $self, %conf ) = @_;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Object.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Object.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Client/Object.pm Sat Feb 21 05:11:51 2009
@@ -1,6 +1,7 @@
package Net::Amazon::S3::Client::Object;
use Moose;
use MooseX::StrictConstructor;
+use DateTime::Format::HTTP;
use DateTime::Format::ISO8601;
use Digest::MD5 qw(md5 md5_hex);
use Digest::MD5::File qw(file_md5 file_md5_hex);
@@ -20,6 +21,8 @@
has 'size' => ( is => 'ro', isa => 'Int', required => 0 );
has 'last_modified' =>
( is => 'ro', isa => 'DateTime', coerce => 1, required => 0 );
+has 'expires' =>
+ ( is => 'rw', isa => 'DateTime', coerce => 1, required => 0 );
has 'acl_short' =>
( is => 'ro', isa => 'AclShort', required => 0, default => 'private' );
has 'content_type' => (
@@ -29,6 +32,8 @@
default => 'binary/octet-stream'
);
+__PACKAGE__->meta->make_immutable;
+
sub get {
my $self = shift;
@@ -88,6 +93,11 @@
'Content-Length' => length $value,
'Content-Type' => $self->content_type,
};
+
+ if ( $self->expires ) {
+ $conf->{Expires}
+ = DateTime::Format::HTTP->format_datetime( $self->expires );
+ }
my $http_request = Net::Amazon::S3::Request::PutObject->new(
s3 => $self->client->s3,
@@ -127,6 +137,11 @@
'Content-Type' => $self->content_type,
};
+ if ( $self->expires ) {
+ $conf->{Expires}
+ = DateTime::Format::HTTP->format_datetime( $self->expires );
+ }
+
my $http_request = Net::Amazon::S3::Request::PutObject->new(
s3 => $self->client->s3,
bucket => $self->bucket->name,
@@ -164,6 +179,16 @@
key => $self->key,
method => 'GET',
)->http_request->uri;
+}
+
+sub query_string_authentication_uri {
+ my $self = shift;
+ return Net::Amazon::S3::Request::GetObject->new(
+ s3 => $self->client->s3,
+ bucket => $self->bucket->name,
+ key => $self->key,
+ method => 'GET',
+ )->query_string_authentication_uri( $self->expires->epoch );
}
sub _content_sub {
@@ -251,11 +276,12 @@
$object->delete;
# to create a new object which is publically-accessible with a
- # content-type of text/plain
+ # content-type of text/plain which expires on 2010-01-02
my $object = $bucket->object(
key => 'this is the public key',
acl_short => 'public-read',
content_type => 'text/plain',
+ expires => '2010-01-02',
);
$object->put('this is the public value');
@@ -282,6 +308,13 @@
my $object = $bucket->object( key => 'images/my_hat.jpg' );
$object->get_filename('hat_backup.jpg');
+ # use query string authentication
+ my $object = $bucket->object(
+ key => 'images/my_hat.jpg',
+ expires => '2009-03-01',
+ );
+ my $uri = $object->query_string_authentication_uri();
+
=head1 DESCRIPTION
This module represents objects in buckets.
@@ -348,6 +381,15 @@
);
$object->put_filename('hat.jpg');
+=head2 query_string_authentication_uri
+
+ # use query string authentication
+ my $object = $bucket->object(
+ key => 'images/my_hat.jpg',
+ expires => '2009-03-01',
+ );
+ my $uri = $object->query_string_authentication_uri();
+
=head2 size
# show the size of an existing object (if fetched by listing
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/HTTPRequest.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/HTTPRequest.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/HTTPRequest.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/HTTPRequest.pm Sat Feb 21 05:11:51 2009
@@ -4,6 +4,8 @@
use HTTP::Date;
use MIME::Base64 qw(encode_base64);
use Moose::Util::TypeConstraints;
+use URI::QueryParam;
+
my $METADATA_PREFIX = 'x-amz-meta-';
my $AMAZON_HEADER_PREFIX = 'x-amz-';
@@ -19,6 +21,8 @@
has 'metadata' =>
( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } );
+__PACKAGE__->meta->make_immutable;
+
# make the HTTP::Request object
sub http_request {
my $self = shift;
@@ -47,6 +51,29 @@
# warn $req_as;
return $request;
+}
+
+sub query_string_authentication_uri {
+ my ( $self, $expires ) = @_;
+ my $method = $self->method;
+ my $path = $self->path;
+ my $headers = $self->headers;
+
+ my $aws_access_key_id = $self->s3->aws_access_key_id;
+ my $aws_secret_access_key = $self->s3->aws_secret_access_key;
+ my $canonical_string
+ = $self->_canonical_string( $method, $path, $headers, $expires );
+ my $encoded_canonical
+ = $self->_encode( $aws_secret_access_key, $canonical_string );
+
+ my $protocol = $self->s3->secure ? 'https' : 'http';
+ my $uri = URI->new("$protocol://s3.amazonaws.com/$path");
+
+ $uri->query_param( AWSAccessKeyId => $aws_access_key_id );
+ $uri->query_param( Expires => $expires );
+ $uri->query_param( Signature => $encoded_canonical );
+
+ return $uri;
}
sub _add_auth_header {
@@ -212,3 +239,7 @@
This method creates, signs and returns a HTTP::Request object.
+=head2 query_string_authentication_uri
+
+This method creates, signs and returns a query string authentication
+URI.
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request.pm Sat Feb 21 05:11:51 2009
@@ -40,6 +40,8 @@
has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 );
+__PACKAGE__->meta->make_immutable;
+
sub _uri {
my ( $self, $key ) = @_;
return ($key)
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/CreateBucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/CreateBucket.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/CreateBucket.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/CreateBucket.pm Sat Feb 21 05:11:51 2009
@@ -6,6 +6,8 @@
has 'acl_short' => ( is => 'ro', isa => 'Maybe[AclShort]', required => 0 );
has 'location_constraint' =>
( is => 'ro', isa => 'Maybe[LocationConstraint]', required => 0 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteBucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteBucket.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteBucket.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteBucket.pm Sat Feb 21 05:11:51 2009
@@ -3,6 +3,8 @@
extends 'Net::Amazon::S3::Request';
has 'bucket' => ( is => 'ro', isa => 'BucketName', required => 1 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteObject.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteObject.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/DeleteObject.pm Sat Feb 21 05:11:51 2009
@@ -5,6 +5,8 @@
has 'bucket' => ( is => 'ro', isa => 'BucketName', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm Sat Feb 21 05:11:51 2009
@@ -4,6 +4,8 @@
extends 'Net::Amazon::S3::Request';
has 'bucket' => ( is => 'ro', isa => 'BucketName', required => 1 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm Sat Feb 21 05:11:51 2009
@@ -4,6 +4,8 @@
extends 'Net::Amazon::S3::Request';
has 'bucket' => ( is => 'ro', isa => 'BucketName', required => 1 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObject.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObject.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObject.pm Sat Feb 21 05:11:51 2009
@@ -7,6 +7,8 @@
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has 'method' => ( is => 'ro', isa => 'HTTPMethod', required => 1 );
+__PACKAGE__->meta->make_immutable;
+
sub http_request {
my $self = shift;
@@ -15,6 +17,16 @@
method => $self->method,
path => $self->_uri( $self->key ),
)->http_request;
+}
+
+sub query_string_authentication_uri {
+ my ( $self, $expires ) = @_;
+
+ return Net::Amazon::S3::HTTPRequest->new(
+ s3 => $self->s3,
+ method => $self->method,
+ path => $self->_uri( $self->key ),
+ )->query_string_authentication_uri($expires);
}
1;
@@ -44,3 +56,7 @@
This method returns a HTTP::Request object.
+=head2 query_string_authentication_uri
+
+This method returns query string authentication URI.
+
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm Sat Feb 21 05:11:51 2009
@@ -5,6 +5,8 @@
has 'bucket' => ( is => 'ro', isa => 'BucketName', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm Sat Feb 21 05:11:51 2009
@@ -2,6 +2,8 @@
use Moose;
use MooseX::StrictConstructor;
extends 'Net::Amazon::S3::Request';
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListBucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListBucket.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListBucket.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/ListBucket.pm Sat Feb 21 05:11:51 2009
@@ -10,6 +10,8 @@
has 'max_keys' =>
( is => 'ro', isa => 'Maybe[Int]', required => 0, default => 1000 );
has 'marker' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/PutObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/PutObject.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/PutObject.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/PutObject.pm Sat Feb 21 05:11:51 2009
@@ -9,6 +9,8 @@
has 'acl_short' => ( is => 'ro', isa => 'Maybe[AclShort]', required => 0 );
has 'headers' =>
( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm Sat Feb 21 05:11:51 2009
@@ -6,6 +6,8 @@
has 'bucket' => ( is => 'ro', isa => 'BucketName', required => 1 );
has 'acl_short' => ( is => 'ro', isa => 'Maybe[AclShort]', required => 0 );
has 'acl_xml' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm Sat Feb 21 05:11:51 2009
@@ -7,6 +7,8 @@
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has 'acl_short' => ( is => 'ro', isa => 'Maybe[AclShort]', required => 0 );
has 'acl_xml' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 );
+
+__PACKAGE__->meta->make_immutable;
sub http_request {
my $self = shift;
Modified: branches/upstream/libnet-amazon-s3-perl/current/t/02client.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-amazon-s3-perl/current/t/02client.t?rev=30937&op=diff
==============================================================================
--- branches/upstream/libnet-amazon-s3-perl/current/t/02client.t (original)
+++ branches/upstream/libnet-amazon-s3-perl/current/t/02client.t Sat Feb 21 05:11:51 2009
@@ -11,7 +11,7 @@
unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
plan skip_all => 'Testing this module for real costs money.';
} else {
- plan tests => 33;
+ plan tests => 36;
}
use_ok('Net::Amazon::S3');
@@ -23,7 +23,6 @@
aws_access_key_id => $aws_access_key_id,
aws_secret_access_key => $aws_secret_access_key,
retry => 1,
-
);
my $readme_size = stat('README')->size;
@@ -128,14 +127,24 @@
'newly created object fetched by name has the right value'
);
+is( get( $object->uri ),
+ undef, 'newly created object cannot be fetched by uri' );
+
+$object->expires('2037-01-01');
+
+is( get( $object->query_string_authentication_uri() ),
+ 'this is the value',
+ 'newly created object can be fetch by authentication uri'
+);
+
$object->delete;
# 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',
);
$object->put('this is the public value');
is( get( $object->uri ),
@@ -144,6 +153,9 @@
);
is( ( head( $object->uri ) )[0],
'text/plain', 'newly created public object has the right content type' );
+is( ( head( $object->uri ) )[3],
+ $object->expires->epoch,
+ 'newly created public object has the right expires' );
$object->delete;
# delete a non-existant object
More information about the Pkg-perl-cvs-commits
mailing list