From 0497499ece58cdf9b4aa74d753c71f2bcbba41f4 Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Wed, 23 Jul 2014 13:33:37 +0200
Subject: [PATCH 1/7] correct and sort MANIFEST file

currently perl Makefile.PL gives:

	Checking if your kit is complete...
	Warning: the following files are missing in your kit:
			lib/AWS/S3/Request.pm
	Please inform the author.

it appears the lib/AWS/S3/Request.pm has been moved to Roles/ so
correct the MANIFEST file (also added missing BucketAction.pm)
---
 MANIFEST | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/MANIFEST b/MANIFEST
index 5d5e221..5fff960 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,8 @@
 Changes
+MANIFEST
+META.yml
+Makefile.PL
+README.markdown
 inc/Module/Install.pm
 inc/Module/Install/Base.pm
 inc/Module/Install/Can.pm
@@ -13,7 +17,6 @@ lib/AWS/S3/File.pm
 lib/AWS/S3/FileIterator.pm
 lib/AWS/S3/HTTPRequest.pm
 lib/AWS/S3/Owner.pm
-lib/AWS/S3/Request.pm
 lib/AWS/S3/Request/CreateBucket.pm
 lib/AWS/S3/Request/DeleteBucket.pm
 lib/AWS/S3/Request/DeleteFile.pm
@@ -29,9 +32,7 @@ lib/AWS/S3/Request/SetBucketAccessControl.pm
 lib/AWS/S3/Request/SetBucketPolicy.pm
 lib/AWS/S3/Request/SetFileContents.pm
 lib/AWS/S3/ResponseParser.pm
+lib/AWS/S3/Roles/BucketAction.pm
+lib/AWS/S3/Roles/Request.pm
 lib/AWS/S3/Signer.pm
-Makefile.PL
-MANIFEST			This list of files
-META.yml
-README.markdown
 t/010-basic/010-basic.t

From 4e7d93bdb661c64b464b0f1c0c23d6de647e004b Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Wed, 23 Jul 2014 14:09:48 +0200
Subject: [PATCH 2/7] resolve rt.cpan.org #92423 - add endpoint attribute

currently this is hardcoded to s3.amazonaws.com, which is no good
if you want to hit one of the alternative endpoints:

	http://docs.aws.amazon.com/govcloud-us/latest/UserGuide/using-govcloud-endpoints.html

there is also the ability, with this change, to create an emulator
locally so you don't have to go out to the real Amazon endpoint for
testing - this may go someway to addressing the issue that there is
zero test coverage without having the AWS_ACCESS_KEY_ID and
AWS_SECRET_ACCESS_KEY environment variables set. this is problematic
as the module will install cleanly through cpan/cpanm but may not
be actually working as expected

add t/020_endpoint.t test to check the set endpoint attribute is
used - currently this uses a bad hostname and then checks the error
raised when the connection to it fails

update the README.markdown file using pod2markdown to bring it up
to date with the current POD, along with adding the documentation
for the changes in this commit

add Makefile.old to .gitignore
---
 .gitignore                                   |  1 +
 MANIFEST                                     |  1 +
 README.markdown                              | 70 +++++++++-----------
 lib/AWS/S3.pm                                | 17 +++++
 lib/AWS/S3/HTTPRequest.pm                    |  5 +-
 lib/AWS/S3/Request/CreateBucket.pm           |  6 +-
 lib/AWS/S3/Request/ListBucket.pm             |  2 +-
 lib/AWS/S3/Request/SetBucketAccessControl.pm |  4 +-
 lib/AWS/S3/Request/SetFileContents.pm        |  2 +-
 lib/AWS/S3/Roles/Request.pm                  | 12 +++-
 t/020_endpoint.t                             | 30 +++++++++
 11 files changed, 104 insertions(+), 46 deletions(-)
 create mode 100644 t/020_endpoint.t

diff --git a/.gitignore b/.gitignore
index 7ac93f8..ba9106b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,4 @@
 /Makefile
 MYMETA.yml
 MYMETA.json
+Makefile.old
diff --git a/MANIFEST b/MANIFEST
index 5fff960..8f90c9a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -36,3 +36,4 @@ lib/AWS/S3/Roles/BucketAction.pm
 lib/AWS/S3/Roles/Request.pm
 lib/AWS/S3/Signer.pm
 t/010-basic/010-basic.t
+t/020_endpoint.t
diff --git a/README.markdown b/README.markdown
index 9e42870..933abf5 100644
--- a/README.markdown
+++ b/README.markdown
@@ -6,30 +6,25 @@ AWS::S3 - Lightweight interface to Amazon S3 (Simple Storage Service)
 
     use AWS::S3;
     
-
     my $s3 = AWS::S3->new(
       access_key_id     => 'E654SAKIASDD64ERAF0O',
       secret_access_key => 'LgTZ25nCD+9LiCV6ujofudY1D6e2vfK0R4GLsI4H',
     );
     
-
     # Add a bucket:
     my $bucket = $s3->add_bucket(
       name    => 'foo-bucket',
     );
     
-
     # Set the acl:
     $bucket->acl( 'private' );
     
-
     # Add a file:
     my $new_file = $bucket->add_file(
       key       => 'foo/bar.txt',
       contents  => \'This is the contents of the file',
     );
     
-
     # You can also set the contents with a coderef:
     # Coderef should eturn a reference, not the actual string of content:
     $new_file = $bucket->add_file(
@@ -37,28 +32,22 @@ AWS::S3 - Lightweight interface to Amazon S3 (Simple Storage Service)
       contents  => sub { return \"This is the contents" }
     );
     
-
     # Get the file:
     my $same_file = $bucket->file( 'foo/bar.txt' );
     
-
     # Get the contents:
     my $scalar_ref = $same_file->contents;
     print $$scalar_ref;
     
-
     # Update the contents with a scalar ref:
     $same_file->contents( \"New file contents" );
     
-
     # Update the contents with a code ref:
     $same_file->contents( sub { return \"New file contents" } );
     
-
     # Delete the file:
     $same_file->delete();
     
-
     # Iterate through lots of files:
     my $iterator = $bucket->files(
       page_size   => 100,
@@ -76,19 +65,16 @@ AWS::S3 - Lightweight interface to Amazon S3 (Simple Storage Service)
       }# end foreach()
     }# end while()
     
-
     # You can't delete a bucket until it's empty.
     # Empty a bucket like this:
     while( my @files = $iterator->next_page )
     {
       map { $_->delete } @files;
       
-
       # Return to page 1:
       $iterator->page_number( 1 );
     }# end while()
     
-
     # Now you can delete the bucket:
     $bucket->delete();
 
@@ -96,25 +82,25 @@ AWS::S3 - Lightweight interface to Amazon S3 (Simple Storage Service)
 
 AWS::S3 attempts to provide an alternate interface to the Amazon S3 Simple Storage Service.
 
-__NOTE:__ Until AWS::S3 gets to version 1.000 it will not implement the full S3 interface.
+**NOTE:** Until AWS::S3 gets to version 1.000 it will not implement the full S3 interface.
 
-__Disclaimer:__ Several portions of AWS::S3 have been adopted from [Net::Amazon::S3](http://search.cpan.org/perldoc?Net::Amazon::S3).
+**Disclaimer:** Several portions of AWS::S3 have been adopted from [Net::Amazon::S3](https://metacpan.org/pod/Net::Amazon::S3).
 
-__NOTE:__ AWS::S3 is NOT a drop-in replacement for [Net::Amazon::S3](http://search.cpan.org/perldoc?Net::Amazon::S3).
+**NOTE:** AWS::S3 is NOT a drop-in replacement for [Net::Amazon::S3](https://metacpan.org/pod/Net::Amazon::S3).
 
-__TODO:__ CloudFront integration.
+**TODO:** CloudFront integration.
 
 # CONSTRUCTOR
 
 Call `new()` with the following parameters.
 
-## access_key_id
+## access\_key\_id
 
 Required.  String.
 
 Provided by Amazon, this is your access key id.
 
-## secret_access_key
+## secret\_access\_key
 
 Required.  String.
 
@@ -126,19 +112,25 @@ Optional.  Boolean.
 
 Default is `0`
 
+## endpoint
+
+Optional.  String.
+
+Default is `s3.amazonaws.com`
+
 ## ua
 
-Optional.  Should be an instance of [LWP::UserAgent](http://search.cpan.org/perldoc?LWP::UserAgent) or a subclass of it.
+Optional.  Should be an instance of [LWP::UserAgent](https://metacpan.org/pod/LWP::UserAgent) or a subclass of it.
 
-Defaults to creating a new instance of [LWP::UserAgent::Determined](http://search.cpan.org/perldoc?LWP::UserAgent::Determined)
+Defaults to creating a new instance of [LWP::UserAgent::Determined](https://metacpan.org/pod/LWP::UserAgent::Determined)
 
 # PUBLIC PROPERTIES
 
-## access_key_id
+## access\_key\_id
 
 String.  Read-only
 
-## secret_access_key
+## secret\_access\_key
 
 String.  Read-only.
 
@@ -146,55 +138,59 @@ String.  Read-only.
 
 Boolean.  Read-only.
 
+## endpoint
+
+String.  Read-only.
+
 ## ua
 
-[LWP::UserAgent](http://search.cpan.org/perldoc?LWP::UserAgent) object.  Read-only.
+[LWP::UserAgent](https://metacpan.org/pod/LWP::UserAgent) object.  Read-only.
 
 ## owner
 
-[AWS::S3::Owner](http://search.cpan.org/perldoc?AWS::S3::Owner) object.  Read-only.
+[AWS::S3::Owner](https://metacpan.org/pod/AWS::S3::Owner) object.  Read-only.
 
 # PUBLIC METHODS
 
 ## buckets
 
-Returns an array of [AWS::S3::Bucket](http://search.cpan.org/perldoc?AWS::S3::Bucket) objects.
+Returns an array of [AWS::S3::Bucket](https://metacpan.org/pod/AWS::S3::Bucket) objects.
 
 ## bucket( $name )
 
-Returns the [AWS::S3::Bucket](http://search.cpan.org/perldoc?AWS::S3::Bucket) object matching `$name` if found.
+Returns the [AWS::S3::Bucket](https://metacpan.org/pod/AWS::S3::Bucket) object matching `$name` if found.
 
 Returns nothing otherwise.
 
-## add_bucket( name => $name )
+## add\_bucket( name => $name )
 
 Attempts to create a new bucket with the name provided.
 
-On success, returns the new [AWS::S3::Bucket](http://search.cpan.org/perldoc?AWS::S3::Bucket)
+On success, returns the new [AWS::S3::Bucket](https://metacpan.org/pod/AWS::S3::Bucket)
 
 On failure, dies with the error message.
 
-See [AWS::S3::Bucket](http://search.cpan.org/perldoc?AWS::S3::Bucket) for details on how to use buckets (and access their files).
+See [AWS::S3::Bucket](https://metacpan.org/pod/AWS::S3::Bucket) for details on how to use buckets (and access their files).
 
 # SEE ALSO
 
 [The Amazon S3 API Documentation](http://docs.amazonwebservices.com/AmazonS3/latest/API/)
 
-[AWS::S3::Bucket](http://search.cpan.org/perldoc?AWS::S3::Bucket)
+[AWS::S3::Bucket](https://metacpan.org/pod/AWS::S3::Bucket)
 
-[AWS::S3::File](http://search.cpan.org/perldoc?AWS::S3::File)
+[AWS::S3::File](https://metacpan.org/pod/AWS::S3::File)
 
-[AWS::S3::FileIterator](http://search.cpan.org/perldoc?AWS::S3::FileIterator)
+[AWS::S3::FileIterator](https://metacpan.org/pod/AWS::S3::FileIterator)
 
-[AWS::S3::Owner](http://search.cpan.org/perldoc?AWS::S3::Owner)
+[AWS::S3::Owner](https://metacpan.org/pod/AWS::S3::Owner)
 
 # AUTHOR
 
-John Drago <jdrago_999@yahoo.com>
+John Drago <jdrago\_999@yahoo.com>
 
 # LICENSE AND COPYRIGHT
 
 This software is Free software and may be used and redistributed under the same
 terms as any version of perl itself.
 
-Copyright John Drago 2011 all rights reserved.
\ No newline at end of file
+Copyright John Drago 2011 all rights reserved.
diff --git a/lib/AWS/S3.pm b/lib/AWS/S3.pm
index 328d54a..3edb022 100644
--- a/lib/AWS/S3.pm
+++ b/lib/AWS/S3.pm
@@ -24,6 +24,13 @@ has 'secure' => (
     default => 0
 );
 
+has 'endpoint' => (
+    is      => 'ro',
+    isa     => 'Str',
+    lazy    => 1,
+    default => sub { 's3.amazonaws.com' },
+);
+
 has 'ua' => (
     is      => 'ro',
     isa     => 'LWP::UserAgent',
@@ -214,6 +221,12 @@ Optional.  Boolean.
 
 Default is C<0>
 
+=head2 endpoint
+
+Optional.  String.
+
+Default is C<s3.amazonaws.com>
+
 =head2 ua
 
 Optional.  Should be an instance of L<LWP::UserAgent> or a subclass of it.
@@ -234,6 +247,10 @@ String.  Read-only.
 
 Boolean.  Read-only.
 
+=head2 endpoint
+
+String.  Read-only.
+
 =head2 ua
 
 L<LWP::UserAgent> object.  Read-only.
diff --git a/lib/AWS/S3/HTTPRequest.pm b/lib/AWS/S3/HTTPRequest.pm
index a10f1e2..0179f3e 100644
--- a/lib/AWS/S3/HTTPRequest.pm
+++ b/lib/AWS/S3/HTTPRequest.pm
@@ -75,9 +75,10 @@ sub http_request {
     my $metadata = $s->metadata;
 
     my $protocol = $s->s3->secure ? 'https' : 'http';
-    my $uri = "$protocol://s3.amazonaws.com/$path";
+	my $endpoint = $s->s3->endpoint;
+    my $uri = "$protocol://$endpoint/$path";
     if ( $path =~ m{^([^/?]+)(.*)} && _is_dns_bucket( $1 ) ) {
-        $uri = "$protocol://$1.s3.amazonaws.com$2";
+        $uri = "$protocol://$1.$endpoint$2";
     }    # end if()
 
     my $signer = AWS::S3::Signer->new(
diff --git a/lib/AWS/S3/Request/CreateBucket.pm b/lib/AWS/S3/Request/CreateBucket.pm
index 8c29c2c..e8f094b 100644
--- a/lib/AWS/S3/Request/CreateBucket.pm
+++ b/lib/AWS/S3/Request/CreateBucket.pm
@@ -2,6 +2,8 @@
 package AWS::S3::Request::CreateBucket;
 use Moose;
 
+use AWS::S3::Signer;
+
 with 'AWS::S3::Roles::Request';
 
 has 'bucket' => (
@@ -30,7 +32,7 @@ XML
         my $signer = AWS::S3::Signer->new(
             s3           => $s->s3,
             method       => 'PUT',
-            uri          => $s->protocol . '://' . $s->bucket . '.s3.amazonaws.com/',
+            uri          => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/',
             content_type => 'text/plain',
             content_md5  => '',
             content      => \$xml,
@@ -48,7 +50,7 @@ XML
         my $signer = AWS::S3::Signer->new(
             s3     => $s->s3,
             method => 'PUT',
-            uri    => $s->protocol . '://s3.amazonaws.com/' . $s->bucket,
+            uri    => $s->protocol . '://' . $s->endpoint . '/' . $s->bucket,
         );
         return $s->_send_request(
             $signer->method => $signer->uri => {
diff --git a/lib/AWS/S3/Request/ListBucket.pm b/lib/AWS/S3/Request/ListBucket.pm
index 12a8dfe..9208e25 100644
--- a/lib/AWS/S3/Request/ListBucket.pm
+++ b/lib/AWS/S3/Request/ListBucket.pm
@@ -48,7 +48,7 @@ sub request {
     my $signer = AWS::S3::Signer->new(
         s3     => $s->s3,
         method => 'GET',
-        uri => $s->protocol . '://' . $s->bucket . '.s3.amazonaws.com/' . ( @params ? '?' . join( '&', @params ) : '' ),
+        uri => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/' . ( @params ? '?' . join( '&', @params ) : '' ),
     );
     $s->_send_request(
         $signer->method => $signer->uri => {
diff --git a/lib/AWS/S3/Request/SetBucketAccessControl.pm b/lib/AWS/S3/Request/SetBucketAccessControl.pm
index 1c849e0..ba8e6e3 100644
--- a/lib/AWS/S3/Request/SetBucketAccessControl.pm
+++ b/lib/AWS/S3/Request/SetBucketAccessControl.pm
@@ -33,7 +33,7 @@ sub request {
         my $signer = AWS::S3::Signer->new(
             s3      => $s->s3,
             method  => 'PUT',
-            uri     => $s->protocol . '://' . $s->bucket . '.s3.amazonaws.com/?acl',
+            uri     => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/?acl',
             headers => [ 'x-amz-acl' => $s->acl_short ]
         );
         return $s->_send_request(
@@ -48,7 +48,7 @@ sub request {
         my $signer = AWS::S3::Signer->new(
             s3             => $s->s3,
             method         => 'PUT',
-            uri            => $s->protocol . '://' . $s->bucket . '.s3.amazonaws.com/?acl',
+            uri            => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/?acl',
             content        => \$s->acl_xml,
             'content-type' => 'text/xml',
         );
diff --git a/lib/AWS/S3/Request/SetFileContents.pm b/lib/AWS/S3/Request/SetFileContents.pm
index 87554fa..8cc6aab 100644
--- a/lib/AWS/S3/Request/SetFileContents.pm
+++ b/lib/AWS/S3/Request/SetFileContents.pm
@@ -45,7 +45,7 @@ sub request {
     my $signer = AWS::S3::Signer->new(
         s3           => $s->s3,
         method       => 'PUT',
-        uri          => $s->protocol . '://' . $s->bucket . '.s3.amazonaws.com/' . $s->file->key,
+        uri          => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/' . $s->file->key,
         content_type => $s->content_type,
         content      => $contents,
         headers      => [ 'x-amz-storage-class', $s->file->storage_class ],
diff --git a/lib/AWS/S3/Roles/Request.pm b/lib/AWS/S3/Roles/Request.pm
index 004dd33..8a533c8 100644
--- a/lib/AWS/S3/Roles/Request.pm
+++ b/lib/AWS/S3/Roles/Request.pm
@@ -25,6 +25,15 @@ has 'protocol' => (
     }
 );
 
+has 'endpoint' => (
+    is      => 'ro',
+    isa     => 'Str',
+    lazy    => 1,
+    default => sub {
+        shift->s3->endpoint;
+    }
+);
+
 # XXX should be required=>1; https://rt.cpan.org/Ticket/Display.html?id=77863
 has "_action" => (
     isa       => 'Str',
@@ -46,7 +55,8 @@ has '_uri' => (
         my $uri = URI->new(
             $self->protocol . '://'
             . ( $m->has_attribute('bucket') ? $self->bucket . '.' : '' )
-            . 's3.amazonaws.com/'
+            . $self->endpoint
+            . '/'
         );
 
         $uri->path( $self->key )
diff --git a/t/020_endpoint.t b/t/020_endpoint.t
new file mode 100644
index 0000000..c05ba98
--- /dev/null
+++ b/t/020_endpoint.t
@@ -0,0 +1,30 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use FindBin qw/ $Bin /;
+
+use Carp 'confess';
+$SIG{__DIE__} = \&confess;
+
+use_ok('AWS::S3');
+
+my $s3 = AWS::S3->new(
+  access_key_id     => $ENV{AWS_ACCESS_KEY_ID}     // 'foo',
+  secret_access_key => $ENV{AWS_SECRET_ACCESS_KEY} // 'bar',
+  endpoint          => 'bad.hostname',
+);
+
+my $bucket_name = "aws-s3-test-" . int(rand() * 1_000_000) . '-' . time() . "-foo";
+
+eval {
+    my $bucket = $s3->add_bucket( name => $bucket_name, location => 'us-west-1' ),
+};
+
+like(
+    $@,
+    qr/Can't connect to aws-s3-test-.*?bad\.hostname/,
+    'endpoint was used'
+);

From 63410a323f2f4a9c3b281b48e08a3dd52def511d Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Thu, 24 Jul 2014 10:09:25 +0200
Subject: [PATCH 3/7] allow AWS_TEST_BUCKET to be set in tests

since we may only have permission to access a particular bucket so
the random bucket name used in this test may not work
---
 t/010-basic/010-basic.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/t/010-basic/010-basic.t b/t/010-basic/010-basic.t
index 1f01d9a..1278f24 100644
--- a/t/010-basic/010-basic.t
+++ b/t/010-basic/010-basic.t
@@ -33,7 +33,7 @@ isa_ok $owner, 'AWS::S3::Owner';
 ok $owner->id, 'owner.id';
 ok $owner->display_name, 'owner.display_name';
 
-my $bucket_name = "aws-s3-test-" . int(rand() * 1_000_000) . '-' . time() . "-foo";
+my $bucket_name = $ENV{AWS_TEST_BUCKET} || "aws-s3-test-" . int(rand() * 1_000_000) . '-' . time() . "-foo";
 ok my $bucket = $s3->add_bucket( name => $bucket_name, location => 'us-west-1' ), "created bucket '$bucket_name'";
 
 #exit;

From 96b6b1bac72293cd19cb039279c723789b6cf0d3 Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Thu, 24 Jul 2014 10:47:53 +0200
Subject: [PATCH 4/7] add test for AWS::S3::Signer, sporadically failing

this reveals (suspected) hash or load order bugs as, even though we
pass a method and content to the constructor, when we call the
content_type attribute sometimes it is defined and sometimes it is
not. run the test multiple times and you will see this behaviour:

	/Volumes/code_partition/AWS-S3 > prove -Ilib t/030_signer.t
	t/030_signer.t .. ok
	All tests successful.
	Files=1, Tests=7,  0 wallclock secs ( 0.02 usr  0.00 sys +  0.30 cusr  0.02 csys =  0.34 CPU)
	Result: PASS

	[leejohnson@lees-macbook-air J1 C2783 10:49:52 * lee/up_test_coverage]
	/Volumes/code_partition/AWS-S3 > prove -Ilib t/030_signer.t
	t/030_signer.t .. 1/?
	#   Failed test 'content_type'
	#   at t/030_signer.t line 32.
	#          got: ''
	#     expected: 'text/plain'
	# Looks like you failed 1 test of 7.
	t/030_signer.t .. Dubious, test returned 1 (wstat 256, 0x100)
	Failed 1/7 subtests

	Test Summary Report
	-------------------
	t/030_signer.t (Wstat: 256 Tests: 7 Failed: 1)
	  Failed test:  4
	  Non-zero exit status: 1
	Files=1, Tests=7,  0 wallclock secs ( 0.02 usr  0.01 sys +  0.37 cusr  0.02 csys =  0.42 CPU)
	Result: FAIL

sometimes the test will pass but raise an uninitialized variable
warning, sometimes that will be absent. so there are clear hash or
load ordering bugs here (tested with perl 5.18)
---
 t/030_signer.t | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 t/030_signer.t

diff --git a/t/030_signer.t b/t/030_signer.t
new file mode 100644
index 0000000..d9b39a1
--- /dev/null
+++ b/t/030_signer.t
@@ -0,0 +1,36 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use FindBin qw/ $Bin /;
+
+use Carp 'confess';
+$SIG{__DIE__} = \&confess;
+
+use_ok('AWS::S3');
+
+my $s3 = AWS::S3->new(
+  access_key_id     => $ENV{AWS_ACCESS_KEY_ID}     // 'foo',
+  secret_access_key => $ENV{AWS_SECRET_ACCESS_KEY} // 'bar',
+  endpoint          => $ENV{AWS_ENDPOINT}          // 'baz',
+);
+
+use_ok('AWS::S3::Signer');
+
+isa_ok(
+	my $signer = AWS::S3::Signer->new(
+		method  => 'HEAD',
+		s3      => $s3,
+		uri     => "http://baz/boz",
+		content => \'hello world',
+	),
+	'AWS::S3::Signer'
+);
+
+is( $signer->content_type,'text/plain','content_type' );
+is( $signer->method,'HEAD','method' );
+is( ${ $signer->content },'hello world','content' );
+
+like( $signer->auth_header,qr/AWS foo:.{28}/,'auth_header' );

From d9f13a367be1f9382077094e3b82476fceef21d8 Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Thu, 24 Jul 2014 11:45:04 +0200
Subject: [PATCH 5/7] resolve jdrago999/AWS-S3 #7 - load order bugs in
 Signer.pm

update test coverage on the AWS::S3::Signer module, which when run
under perl 5.18 and above shows load/hash order bugs in the module

these can be fixed by making any attributes that have a default set
to lazy => 1, as these depend on other attributes that may or may
not have been set when they are called within these defaults. if we
set these to lazy we make sure the other attributes have been set
first

remove commented out code, and remove the required => 1 from any
attributes that have default or lazy set as this doesn't make sense
in all but the narrowest use case (which isn't in use here)

remove the _urlencode method as it isn't called from anywhere within
this distribution

modify the bucket_name attribute to use the ->endpoint attribute in
its regexp rather than hard coding this
---
 Makefile.PL          |  1 +
 lib/AWS/S3/Signer.pm | 39 ++++----------------------
 t/030_signer.t       | 66 ++++++++++++++++++++++++++++++++++++--------
 3 files changed, 60 insertions(+), 46 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index aa1eb44..d4db7d7 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -23,6 +23,7 @@ requires 'MIME::Base64';
 requires 'URI::Escape';
 requires 'Digest::HMAC_SHA1';
 requires 'Iterator::Paged';
+requires 'Test::Deep';
 
 resources(
   'repository'  => 'https://github.com/jdrago999/AWS-S3'
diff --git a/lib/AWS/S3/Signer.pm b/lib/AWS/S3/Signer.pm
index d44de8a..0e63edb 100644
--- a/lib/AWS/S3/Signer.pm
+++ b/lib/AWS/S3/Signer.pm
@@ -5,13 +5,9 @@ use Moose;
 use HTTP::Request::Common;
 use HTTP::Date 'time2str';
 use MIME::Base64 qw(encode_base64);
-use URI::Escape qw(uri_escape_utf8);
 use Digest::HMAC_SHA1;
 use Digest::MD5 'md5';
 
-my $METADATA_PREFIX      = 'x-amz-meta-';
-my $AMAZON_HEADER_PREFIX = 'x-amz-';
-
 use Moose::Util::TypeConstraints qw(enum);
 use MooseX::Types::URI qw(Uri);
 
@@ -27,7 +23,6 @@ has 'method' => (
     required => 1,
 );
 
-## Why is this both required, and does it have a default... slight confusion
 has 'bucket_name' => (
     is       => 'ro',
     isa      => 'Str',
@@ -35,7 +30,8 @@ has 'bucket_name' => (
     lazy     => 1,
     default  => sub {
         my $s = shift;
-        if ( my ( $name ) = $s->uri->host =~ m{^(.+?)\.s3\.amazonaws} ) {
+        my $endpoint = $s->s3->endpoint;
+        if ( my ( $name ) = $s->uri->host =~ m{^(.+?)\.\Q$endpoint\E} ) {
             return $name;
         } else {
             return '';
@@ -50,18 +46,9 @@ has 'uri' => (
     coerce   => 1,
 );
 
-#has 'headers' => (
-#  is        => 'ro',
-#  isa       => 'HTTP::Headers',
-#  required  => 1,
-#  lazy      => 1,
-#  default   => sub { HTTP::Headers->new }
-#);
-
 has 'headers' => (
     is       => 'ro',
     isa      => 'ArrayRef[Str]',
-    required => 1,
     lazy     => 1,
     default  => sub { [] },
 );
@@ -69,7 +56,6 @@ has 'headers' => (
 has 'date' => (
     is       => 'ro',
     isa      => 'Str',
-    required => 1,
     default  => sub {
         time2str( time );
     }
@@ -78,7 +64,6 @@ has 'date' => (
 has 'string_to_sign' => (
     is       => 'ro',
     isa      => 'Str',
-    required => 1,
     lazy     => 1,
     default  => sub {
         my $s = shift;
@@ -100,13 +85,6 @@ has 'canonicalized_amz_headers' => (
     default => sub {
         my $s = shift;
 
-        # Add the x-amz-* headers if they don't already exist:
-        #    if( my $md5 = $s->content_md5 )
-        #    {
-        #      $s->headers->header( 'x-amz-content-md5' => $md5 );
-        #      $s->headers->header( 'content-md5' => $md5 );
-        #    }# end if()
-
         my @h   = @{ $s->headers };
         my %out = ();
         while ( my ( $k, $v ) = splice( @h, 0, 2 ) ) {
@@ -152,7 +130,7 @@ has 'canonicalized_resource' => (
 has 'content_type' => (
     is       => 'ro',
     isa      => 'Str',
-    required => 1,
+	lazy     => 1,
     default  => sub {
         my $s = shift;
         return '' if $s->method eq 'GET';
@@ -164,10 +142,10 @@ has 'content_type' => (
 has 'content_md5' => (
     is       => 'ro',
     isa      => 'Str',
-    required => 1,
+    lazy     => 1,
     default  => sub {
         my $s = shift;
-        return '' unless my $type = $s->content;
+        return '' unless $s->content;
         return encode_base64( md5( ${ $s->content } ), '' );
     }
 );
@@ -175,13 +153,11 @@ has 'content_md5' => (
 has 'content' => (
     is       => 'ro',
     isa      => 'Maybe[ScalarRef]',
-    required => 0,
 );
 
 has 'content_length' => (
     is       => 'ro',
     isa      => 'Int',
-    required => 0,
     lazy     => 1,
     default  => sub { length( ${ shift->content } ) }
 );
@@ -189,7 +165,6 @@ has 'content_length' => (
 has 'signature' => (
     is       => 'ro',
     isa      => 'Str',
-    required => 1,
     lazy     => 1,
     default  => sub {
         my $s    = shift;
@@ -212,8 +187,4 @@ sub _trim {
     return $value;
 }    # end _trim()
 
-sub _urlencode {
-    my ( $unencoded ) = @_;
-    return uri_escape_utf8( $unencoded, '^A-Za-z0-9_-' );
-}    # end _urlencode()
 1;
diff --git a/t/030_signer.t b/t/030_signer.t
index d9b39a1..114f640 100644
--- a/t/030_signer.t
+++ b/t/030_signer.t
@@ -3,7 +3,8 @@
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::More;
+use Test::Deep;
 use FindBin qw/ $Bin /;
 
 use Carp 'confess';
@@ -11,26 +12,67 @@ $SIG{__DIE__} = \&confess;
 
 use_ok('AWS::S3');
 
+note( "construction" );
 my $s3 = AWS::S3->new(
-  access_key_id     => $ENV{AWS_ACCESS_KEY_ID}     // 'foo',
-  secret_access_key => $ENV{AWS_SECRET_ACCESS_KEY} // 'bar',
-  endpoint          => $ENV{AWS_ENDPOINT}          // 'baz',
+    access_key_id     => $ENV{AWS_ACCESS_KEY_ID}     // 'foo',
+    secret_access_key => $ENV{AWS_SECRET_ACCESS_KEY} // 'bar',
+    endpoint          => $ENV{AWS_ENDPOINT}          // 's3.baz.com',
 );
 
 use_ok('AWS::S3::Signer');
 
 isa_ok(
-	my $signer = AWS::S3::Signer->new(
-		method  => 'HEAD',
-		s3      => $s3,
-		uri     => "http://baz/boz",
-		content => \'hello world',
-	),
-	'AWS::S3::Signer'
+    my $signer = AWS::S3::Signer->new(
+        method  => 'HEAD',
+        s3      => $s3,
+        uri     => "http://maibucket.s3.baz.com/boz",
+        content => \'hello world',
+    ),
+    'AWS::S3::Signer'
 );
 
-is( $signer->content_type,'text/plain','content_type' );
+can_ok(
+    $signer,
+    qw/
+        s3
+        method
+        bucket_name
+        uri
+        headers
+        date
+        string_to_sign
+        canonicalized_amz_headers
+        canonicalized_resource
+        content_type
+        content_md5
+        content
+        content_length
+        signature
+    /,
+);
+
+
+note( "attributes" );
+isa_ok( $signer->s3,'AWS::S3' );
 is( $signer->method,'HEAD','method' );
+is( $signer->bucket_name,'maibucket','bucket_name' );
+isa_ok( $signer->uri,'URI' );
+cmp_deeply( $signer->headers,[],'headers' );
+like( $signer->date,qr/\w+, +\d{1,2} \w+ \d{4} \d{2}:\d{2}:\d{2}/,'date' );
+is(
+    $signer->string_to_sign,
+    "HEAD\nXrY7u+Ae7tCTyyK7j1rNww==\ntext/plain\n".$signer->date."\n/maibucket/boz",
+    'string_to_sign'
+);
+is( $signer->canonicalized_amz_headers,'','canonicalized_amz_headers' );
+is( $signer->canonicalized_resource,'/maibucket/boz','canonicalized_resource' );
+is( $signer->content_type,'text/plain','content_type' );
+is( $signer->content_md5,'XrY7u+Ae7tCTyyK7j1rNww==','content_md5' );
 is( ${ $signer->content },'hello world','content' );
+is( $signer->content_length,11,'content_length' );
+like( $signer->signature,qr/^.{28}$/,'signature' );
 
+note( "methods" );
 like( $signer->auth_header,qr/AWS foo:.{28}/,'auth_header' );
+
+done_testing();

From 967d5df5c054cb90fac053cb1bedf5b8dcff498c Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Tue, 29 Jul 2014 14:33:24 +0200
Subject: [PATCH 6/7] add test for AWS::S3::File

monkey patching some routines to make it a unit tests without it
going out to Amazon
---
 lib/AWS/S3/File.pm |  1 +
 t/040_file.t       | 87 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 88 insertions(+)
 create mode 100644 t/040_file.t

diff --git a/lib/AWS/S3/File.pm b/lib/AWS/S3/File.pm
index 5225aed..4b18475 100644
--- a/lib/AWS/S3/File.pm
+++ b/lib/AWS/S3/File.pm
@@ -118,6 +118,7 @@ sub update {
     if ( @args_ok ) {
         $s->{$_} = $args{$_} for @args_ok;
         $s->_set_contents();
+        return 1;
     }
     return;
 }    # end update()
diff --git a/t/040_file.t b/t/040_file.t
new file mode 100644
index 0000000..5c43232
--- /dev/null
+++ b/t/040_file.t
@@ -0,0 +1,87 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use FindBin qw/ $Bin $Script /;
+
+use Carp 'confess';
+$SIG{__DIE__} = \&confess;
+
+use_ok('AWS::S3');
+
+note( "construction" );
+my $s3 = AWS::S3->new(
+    access_key_id     => $ENV{AWS_ACCESS_KEY_ID}     // 'foo',
+    secret_access_key => $ENV{AWS_SECRET_ACCESS_KEY} // 'bar',
+    endpoint          => $ENV{AWS_ENDPOINT}          // 's3.baz.com',
+);
+
+use_ok('AWS::S3::File');
+use_ok('AWS::S3::Bucket');
+use_ok('AWS::S3::Request::SetFileContents');
+
+monkey_patch_module();
+
+isa_ok(
+    my $file = AWS::S3::File->new(
+        key          => "$Script",
+        contents     => sub { 'test file contents' },
+        is_encrypted => 0,
+        bucket       => AWS::S3::Bucket->new(
+            s3   => $s3,
+            name => $ENV{AWS_TEST_BUCKET} // 'maibucket',
+        ),
+    ),
+    'AWS::S3::File'
+);
+
+can_ok(
+    $file,
+    qw/
+        key
+        bucket
+        size
+        etag
+        owner
+        storage_class
+        lastmodified
+        contenttype
+        is_encrypted
+        contents
+    /,
+);
+
+note( "attributes" );
+isa_ok( $file->bucket,'AWS::S3::Bucket','bucket' );
+is( $file->key,$Script,'key' );
+is( $file->size,'18','size' );
+isa_ok( $file->etag,'main','etag' );
+is( $file->owner,undef,'owner' );
+is( $file->storage_class,'STANDARD','storage_class' );
+is( $file->lastmodified,undef,'lastmodified' );
+is( $file->contenttype,'binary/octet-stream','contenttype' );
+is( $file->is_encrypted,0,'is_encrypted' );
+isa_ok( $file->contents,'SCALAR','contents' );
+
+note( "methods" );
+ok( !$file->update,'update without args' );
+ok( $file->update( contents => \'new contents' ),'update with args' );
+
+done_testing();
+
+sub monkey_patch_module {
+    # monkey patching for true(r) unit tests
+    no warnings 'redefine';
+    no warnings 'once';
+
+    sub response { return shift; }
+    sub header { return shift; }
+    sub friendly_error { return; }
+
+    *AWS::S3::Request::SetFileContents::request = sub {
+        return bless( {},'main' );
+    };
+}

From 5846502eebde1b639f008be0e309c4bf32eb345c Mon Sep 17 00:00:00 2001
From: Lee Johnson <lee@givengain.ch>
Date: Wed, 30 Jul 2014 10:40:33 +0200
Subject: [PATCH 7/7] add signed_url method to AWS::S3::File and tests

this returns the signed URL for public access to the file, the expiry
time can be passed into the method or will default to now + 1 hour in
the future. add perldoc and tests for these changes, update MANIFEST

although the URL is built on the client side this has been implemented
using the same structure as other requests with a GetPreSignedUrl class
that uses the AWS::S3:Roles::Request role to get at the _uri attribute

we don't actually go out to AWS for this method, but who knows what the
future holds?
---
 MANIFEST                              |  1 +
 lib/AWS/S3/File.pm                    | 23 ++++++++++++++++
 lib/AWS/S3/Request/GetPreSignedUrl.pm | 38 +++++++++++++++++++++++++++
 t/040_file.t                          |  8 +++++-
 4 files changed, 69 insertions(+), 1 deletion(-)
 create mode 100644 lib/AWS/S3/Request/GetPreSignedUrl.pm

diff --git a/MANIFEST b/MANIFEST
index 8f90c9a..aff93cf 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -37,3 +37,4 @@ lib/AWS/S3/Roles/Request.pm
 lib/AWS/S3/Signer.pm
 t/010-basic/010-basic.t
 t/020_endpoint.t
+t/040_file.t
diff --git a/lib/AWS/S3/File.pm b/lib/AWS/S3/File.pm
index 4b18475..39ea6a0 100644
--- a/lib/AWS/S3/File.pm
+++ b/lib/AWS/S3/File.pm
@@ -159,6 +159,21 @@ sub _set_contents {
     }    # end if()
 }    # end _set_contents()
 
+sub signed_url {
+    my $s       = shift;
+    my $expires = shift || time + 3600;
+
+    my $type = "GetPreSignedUrl";
+    my $uri  = $s->bucket->s3->request(
+        $type,
+        bucket  => $s->bucket->name,
+        key     => $s->key,
+        expires => $expires,
+    )->request;
+
+    return $uri;
+}
+
 sub delete {
     my $s = shift;
 
@@ -216,6 +231,9 @@ AWS::S3::File - A single file in Amazon S3
     contents => \'New contents', # optional
     contenttype => 'text/plain'  # optional
   );
+
+  # Get signed URL for the file for public access
+  print $file->signed_url( $expiry_time );
   
   # Delete the file:
   $file->delete();
@@ -299,6 +317,11 @@ Deletes the file from Amazon S3.
 
 Update contents and/or contenttype of the file.
 
+=head2 signed_url( $expiry_time )
+
+Will return a signed URL for public access to the file. $expiry_time should be a
+Unix seconds since epoch, and will default to now + 1 hour is not passed
+
 =head1 SEE ALSO
 
 L<The Amazon S3 API Documentation|http://docs.amazonwebservices.com/AmazonS3/latest/API/>
diff --git a/lib/AWS/S3/Request/GetPreSignedUrl.pm b/lib/AWS/S3/Request/GetPreSignedUrl.pm
new file mode 100644
index 0000000..06a0f02
--- /dev/null
+++ b/lib/AWS/S3/Request/GetPreSignedUrl.pm
@@ -0,0 +1,38 @@
+
+package AWS::S3::Request::GetPreSignedUrl;
+use Moose;
+
+use AWS::S3::Signer;
+
+with 'AWS::S3::Roles::Request';
+
+has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
+has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
+has 'expires' => ( is => 'ro', isa => 'Int', required => 1 );
+
+sub request {
+    my $s = shift;
+
+    my $uri = $s->_uri;
+
+    my $req = "GET\n\n\n"
+        . $s->expires . "\n/"
+        . $s->bucket . "/"
+        . $s->key;
+
+    my $signer = AWS::S3::Signer->new(
+        s3             => $s->s3,
+        method         => "GET",
+        uri            => $uri,
+        string_to_sign => $req,
+    );
+
+    my $signed_uri = $uri->as_string
+        . '?AWSAccessKeyId=' . $s->s3->access_key_id
+        . '&Expires=' . $s->expires
+        . '&Signature=' . $signer->signature;
+
+    return $signed_uri;
+}
+
+__PACKAGE__->meta->make_immutable;
diff --git a/t/040_file.t b/t/040_file.t
index 5c43232..841184c 100644
--- a/t/040_file.t
+++ b/t/040_file.t
@@ -27,7 +27,7 @@ monkey_patch_module();
 
 isa_ok(
     my $file = AWS::S3::File->new(
-        key          => "$Script",
+        key          => $ENV{AWS_TEST_KEY} // "$Script",
         contents     => sub { 'test file contents' },
         is_encrypted => 0,
         bucket       => AWS::S3::Bucket->new(
@@ -70,6 +70,12 @@ note( "methods" );
 ok( !$file->update,'update without args' );
 ok( $file->update( contents => \'new contents' ),'update with args' );
 
+is(
+    $file->signed_url( 1406712744 ),
+    'http://maibucket.s3.baz.com/040_file.t?AWSAccessKeyId=foo&Expires=1406712744&Signature=gqOO//FsAuSTvgEwBYPp0tX1rOU=',
+    'signed_url'
+);
+
 done_testing();
 
 sub monkey_patch_module {