r30939 - in /trunk/libnet-amazon-s3-perl: ./ debian/ 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:15:57 UTC 2009


Author: ryan52-guest
Date: Sat Feb 21 05:15:53 2009
New Revision: 30939

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=30939
Log:
Another new upstream release

Modified:
    trunk/libnet-amazon-s3-perl/CHANGES
    trunk/libnet-amazon-s3-perl/META.yml
    trunk/libnet-amazon-s3-perl/Makefile.PL
    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/Bucket.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.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/CreateBucket.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteBucket.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteObject.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObject.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListBucket.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/PutObject.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm
    trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetObjectAccessControl.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=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/CHANGES (original)
+++ trunk/libnet-amazon-s3-perl/CHANGES Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/META.yml?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/META.yml (original)
+++ trunk/libnet-amazon-s3-perl/META.yml Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/Makefile.PL?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/Makefile.PL (original)
+++ trunk/libnet-amazon-s3-perl/Makefile.PL Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/debian/changelog?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/debian/changelog (original)
+++ trunk/libnet-amazon-s3-perl/debian/changelog Sat Feb 21 05:15:53 2009
@@ -1,7 +1,8 @@
-libnet-amazon-s3-perl (0.49-1) UNRELEASED; urgency=low
+libnet-amazon-s3-perl (0.50-1) UNRELEASED; urgency=low
 
   NEEDS Data::Stream::Bulk::Callback
-  
+
+  [ gregor herrmann ]
   * New upstream release.
   * debian/control: Changed: Switched Vcs-Browser field to ViewSVN
     (source stanza).
@@ -10,7 +11,10 @@
   * Make (build) dependency on libxml-libxml-perl versioned, thanks to Juan
     Augusto Rossi for the bug report (closes: #509824).
 
- -- gregor herrmann <gregoa at debian.org>  Sun, 16 Nov 2008 20:45:14 +0100
+  [ Ryan Niebur ]
+  * Another new upstream release
+
+ -- Ryan Niebur <ryanryan52 at gmail.com>  Fri, 20 Feb 2009 21:14:57 -0800
 
 libnet-amazon-s3-perl (0.45-1) unstable; urgency=low
 

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=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl (original)
+++ trunk/libnet-amazon-s3-perl/examples/backup_cpan.pl Sat Feb 21 05:15:53 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: 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=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm Sat Feb 21 05:15:53 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: 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=30939&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 Sat Feb 21 05:15:53 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: 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=30939&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 Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Bucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Bucket.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Bucket.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Client/Bucket.pm Sat Feb 21 05:15:53 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: 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=30939&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 Sat Feb 21 05:15:53 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: 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=30939&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 Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/CreateBucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/CreateBucket.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/CreateBucket.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/CreateBucket.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteBucket.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteBucket.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteBucket.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteBucket.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteObject.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteObject.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/DeleteObject.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObject.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObject.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObject.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm Sat Feb 21 05:15:53 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: 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=30939&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 Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/PutObject.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/PutObject.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/PutObject.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/PutObject.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm Sat Feb 21 05:15:53 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: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm?rev=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm Sat Feb 21 05:15:53 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: 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=30939&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/t/02client.t (original)
+++ trunk/libnet-amazon-s3-perl/t/02client.t Sat Feb 21 05:15:53 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