Resolve https://rt.cpan.org/Ticket/Display.html?id=92423

.gitignore

@@ -4,3 +4,4 @@
 /Makefile
 MYMETA.yml
 MYMETA.json
+Makefile.old

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,8 @@ 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
+t/020_endpoint.t

README.markdown

@@ -6,59 +6,48 @@ 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(
       key       => 'foo/bar.txt',
       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,45 +65,42 @@ 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();
 
 # DESCRIPTION
 
 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,75 +112,85 @@ 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.
 
 ## secure
 
 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.
+Copyright John Drago 2011 all rights reserved.

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.

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(

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 => {

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 => {

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',
         );

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 ],

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 )