Merge pull request #8 from simbabque/coverage

Increase Test Coverage

Changes

@@ -1,6 +1,8 @@
 
 Changelog for perl module AWS::S3
 
+  - hidden parameter 'prefix' for AWS::S3::FileIterator is now documented
+
 0.12 2016-03-07
   - Fix DNS bucket name checking for non-valid DNS bucket nams (GH #4)
   - Fix URI escaping for filenames to avoid infinite loop on spaces (GH #5)

Makefile.PL

@@ -21,6 +21,7 @@ WriteMakefile(
         'LWP::UserAgent::Determined' => 0,
         'Carp'                       => 0,
         'HTTP::Date'                 => 0,
+        'HTTP::Headers'              => 6.07,
         'MIME::Base64'               => 0,
         'URI::Escape'                => 0,
         'Digest::HMAC_SHA1'          => 0,
@@ -31,8 +32,8 @@ WriteMakefile(
     BUILD_REQUIRES => {
         'Test::More'       => 0.31,
         'Test::Deep'       => 0.112,
-        'Test::MockObject' => 1.20140408,
         'Test::Exception'  => 0.32,
+        'Data::Section::Simple' => 0,
     },
     META_MERGE => {
         resources => {

lib/AWS/S3/FileIterator.pm

@@ -27,6 +27,7 @@ sub marker    { shift->{marker} }
 sub pattern   { shift->{pattern} }
 sub bucket    { shift->{bucket} }
 sub page_size { shift->{page_size} }
+sub prefix    { shift->{prefix} }
 
 sub has_prev {
     my $s = shift;
@@ -171,7 +172,8 @@ AWS::S3::FileIterator - Easily access and iterate through your S3 files.
     page_size   => 100,
     page_number => 1,
     # Optional params:
-    pattern     => qr(\.txt$)
+    pattern     => qr(\.txt$),
+    prefix      => 'notes',
   );
   
   while( my @files = $iter->next_page )
@@ -203,7 +205,7 @@ Boolean - read-only
 
 =head2 page_number
 
-Integer -  read-write
+Integer - read-write
 
 =head2 marker
 
@@ -217,6 +219,12 @@ Regexp - read-only
 
 If supplied to the constructor, only files which match the pattern will be returned.
 
+=head2 prefix
+
+String - read-only
+
+If supplied to the constructor, only files which begin with the indicated prefix will be returned.
+
 =head1 PUBLIC METHODS
 
 =head2 next_page()

lib/AWS/S3/HTTPRequest.pm

@@ -83,7 +83,7 @@ sub http_request {
         method  => $method,
         uri     => $uri,
         content => $content ? \$content : undef,
-        headers => $headers,
+        headers => [ $headers->flatten ],
     );
 
     $headers->header( 'Authorization'  => $signer->auth_header );

lib/AWS/S3/ResponseParser.pm

@@ -71,7 +71,7 @@ has 'xpc' => (
 
         my $src = $self->response->content;
         return unless $src =~ m/^[[:space:]]*</s;
-        my $doc = $self->libxml->parse_string( $self->response->content );
+        my $doc = $self->libxml->parse_string( $src );
 
         my $xpc = XML::LibXML::XPathContext->new( $doc );
         $xpc->registerNs( 's3', 'http://s3.amazonaws.com/doc/2006-03-01/' );

t/aws/s3.t

@@ -15,8 +15,9 @@ sub content { return shift->{_msg}; }
 package main;
 
 use Test::More 'no_plan';
-use Test::MockObject;
 use Test::Deep;
+use Test::Exception;
+use Data::Section::Simple 'get_data_section';
 
 use Carp 'confess';
 $SIG{__DIE__} = \&confess;
@@ -46,47 +47,105 @@ isa_ok(
 	'AWS::S3::Request::CreateBucket'
 );
 
-my $xml = do { local $/; <DATA> };
-
-no warnings 'once';
-*LWP::UserAgent::Determined::request = sub {
-	return Mocked::HTTP::Response->new( 200,$xml );
+subtest 'create bucket strange temporary redirect' => sub {
+    plan tests => 8;    # make sure all tests in here get run
+
+    my $i = 1;
+    local *LWP::UserAgent::Determined::request = sub {
+        my ( undef, $req ) = @_;
+
+        if ( $i == 1 ) {
+
+            # first PUT request, send a forward
+            is( $req->method, 'PUT', 'bucket creation with PUT request' );
+            is( $req->uri->as_string, 'http://bar.bad.hostname/', '... and with correct URI' );
+
+            $i++;
+            return HTTP::Response->new(
+                307,
+                'TEMPORARY REDIRECT',
+                [ Location => 'http://example.org' ],
+                '<fake>TemporaryRedirect</fake>'
+            );
+        }
+        elsif ( $i == 2 ) {
+
+            # the PUT is sent again, but to the forwarded location
+
+            is( $req->method, 'PUT', 'redirected and second PUT request' );
+            is( $req->uri->as_string, 'http://example.org', '... and to the correct URI' );
+
+            $i++;
+            return Mocked::HTTP::Response->new( 200, q{} );
+        }
+        else {
+            # there is a call to ->bucket, which does ->buckets, which is empty.
+            is( $req->method, 'GET', '->buckets with GET' );
+            is( $req->uri->as_string, 'http://bad.hostname/', '... and with correct URI' );
+
+            # we need to return XML in the body or xpc doesn't work
+            return Mocked::HTTP::Response->new( 200,
+                get_data_section('ListAllMyBucketsResult.xml') );
+        }
+    };
+
+    my $bucket = $s3->add_bucket( name => 'bar', location => 'us-west-1' );
+    isa_ok( $bucket, 'AWS::S3::Bucket' );
+    is( $bucket->name, 'bar', '... and the right bucket got returned' );
 };
 
-isa_ok( $s3->owner,'AWS::S3::Owner' );
-
-my @buckets = $s3->buckets;
-cmp_deeply( \@buckets,[],'->buckets' );
-ok( ! $s3->bucket( 'maibucket'),'->bucket' );
-
+# list all buckets and owner
+{
+    my $xml = get_data_section('ListAllMyBucketsResult.xml');
+    local *LWP::UserAgent::Determined::request = sub {
+        return Mocked::HTTP::Response->new( 200,$xml );
+    };
+
+    isa_ok( my $owner = $s3->owner,'AWS::S3::Owner' );
+    is( $owner->id, 'bcaf1ffd86f41161ca5fb16fd081034f', '... and the owner id correct' );
+    is( $owner->display_name, 'webfile', '... and the owner name is correct' );
+
+    my @buckets = $s3->buckets;
+    cmp_deeply( \@buckets,
+        [ obj_isa('AWS::S3::Bucket'), obj_isa('AWS::S3::Bucket') ], '->buckets' );
+    ok( ! $s3->bucket( 'does not exist' ),'!->bucket' );
+    is( $s3->bucket( 'foo' )->name, 'foo', '->bucket' );
+}
+
+{
+    my $xml = get_data_section('error.xml');
+
+    local *LWP::UserAgent::Determined::request = sub {
+        return Mocked::HTTP::Response->new( 400,$xml );
+    };
+
+    throws_ok { $s3->add_bucket( name => 'too many buckets', location => 'us-west-1' ) }
+    qr/TooManyBuckets/, 'add_bucket throws an error';
+}
 __DATA__
+@@ ListAllMyBucketsResult.xml
+<?xml version="1.0" encoding="UTF-8"?>
+<ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
+  <Owner>
+    <ID>bcaf1ffd86f41161ca5fb16fd081034f</ID>
+    <DisplayName>webfile</DisplayName>
+  </Owner>
+  <Buckets>
+    <Bucket>
+      <Name>foo</Name>
+      <CreationDate>2006-02-03T16:45:09.000Z</CreationDate>
+    </Bucket>
+    <Bucket>
+      <Name>bar</Name>
+      <CreationDate>2006-02-03T16:41:58.000Z</CreationDate>
+    </Bucket>
+ </Buckets>
+</ListAllMyBucketsResult>
+@@ error.xml
 <?xml version="1.0" encoding="UTF-8"?>
-<ListBucketResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
-    <Name>bucket</Name>
-    <Prefix/>
-    <Marker/>
-    <MaxKeys>1000</MaxKeys>
-    <IsTruncated>false</IsTruncated>
-    <Contents>
-        <Key>my-image.jpg</Key>
-        <LastModified>2009-10-12T17:50:30.000Z</LastModified>
-        <ETag>&quot;fba9dede5f27731c9771645a39863328&quot;</ETag>
-        <Size>434234</Size>
-        <StorageClass>STANDARD</StorageClass>
-        <Owner>
-            <ID>75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a</ID>
-            <DisplayName>mtd@amazon.com</DisplayName>
-        </Owner>
-    </Contents>
-    <Contents>
-       <Key>my-third-image.jpg</Key>
-         <LastModified>2009-10-12T17:50:30.000Z</LastModified>
-        <ETag>&quot;1b2cf535f27731c974343645a3985328&quot;</ETag>
-        <Size>64994</Size>
-        <StorageClass>STANDARD</StorageClass>
-        <Owner>
-            <ID>75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a</ID>
-            <DisplayName>mtd@amazon.com</DisplayName>
-        </Owner>
-    </Contents>
-</ListBucketResult>
+<Error>
+  <Code>TooManyBuckets</Code>
+  <Message>You have attempted to create more buckets than allowed.</Message>
+  <Resource>/mybucket</Resource>
+  <RequestId>4442587FB7D0A2F9</RequestId>
+</Error>

t/aws/s3/bucket.t

@@ -10,12 +10,12 @@ extends 'HTTP::Response';
 
 sub content        { shift->{_msg}; }
 sub code           { 200 }
-sub friendly_error {}
 sub is_success     { 1 }
 sub header         { $_[1] =~ /content-length/i ? 1 : 'header' }
 
 1;
 
+package main;
 use Test::More;
 use Test::Exception;
 use FindBin qw/ $Script /;

t/aws/s3/file.t

@@ -10,7 +10,6 @@ extends 'HTTP::Response';
 
 sub content        { shift->{_msg}; }
 sub code           { 200 }
-sub friendly_error {}
 sub is_success     { 1 }
 sub header         { $_[1] =~ /content-length/i ? 1 : 'header' }