add an exists method to Net::Amazon::S3::Client (suggested by David G…

…olden)

CHANGES

@@ -4,6 +4,8 @@ Revision history for Perl module Net::Amazon::S3:
     - fix authenticated urls to work with EU buckets (patch by Edmund
       von der Burg)
     - tiny POD fix (patch by Frank Wiegand)
+    - add an exists method to Net::Amazon::S3::Client (suggested by
+      David Golden)
 
 0.52 Thu Jul  2 09:17:11 BST 2009
     - increase version prerequisites for some modules so that they

lib/Net/Amazon/S3/Client.pm

@@ -68,10 +68,16 @@ sub bucket {
     );
 }
 
+sub _send_request_raw {
+    my ( $self, $http_request, $filename ) = @_;
+
+    return $self->s3->ua->request( $http_request, $filename );
+}
+
 sub _send_request {
     my ( $self, $http_request, $filename ) = @_;
 
-    my $http_response = $self->s3->ua->request( $http_request, $filename );
+    my $http_response = $self->_send_request_raw( $http_request, $filename );
 
     my $content      = $http_response->content;
     my $content_type = $http_response->content_type;

lib/Net/Amazon/S3/Client/Object.pm

@@ -33,6 +33,20 @@ has 'content_type' => (
 
 __PACKAGE__->meta->make_immutable;
 
+sub exists {
+    my $self = shift;
+
+    my $http_request = Net::Amazon::S3::Request::GetObject->new(
+        s3     => $self->client->s3,
+        bucket => $self->bucket->name,
+        key    => $self->key,
+        method => 'HEAD',
+    )->http_request;
+
+    my $http_response = $self->client->_send_request_raw($http_request);
+    return $http_response->code == 200 ? 1 : 0;
+}
+
 sub get {
     my $self = shift;
 
@@ -271,6 +285,9 @@ Net::Amazon::S3::Client::Object - An easy-to-use Amazon S3 client object
   # to get the vaue of an object
   my $value = $object->get;
 
+  # to see if an object exists
+  if ($object->exists) { ... }
+
   # to delete an object
   $object->delete;
 
@@ -331,6 +348,11 @@ This module represents objects in buckets.
   # to delete an object
   $object->delete;
 
+=head2 exists
+
+  # to see if an object exists
+  if ($object->exists) { ... }
+
 =head2 get
 
   # to get the vaue of an object

t/02client.t

@@ -11,7 +11,7 @@ use Test::Exception;
 unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
     plan skip_all => 'Testing this module for real costs money.';
 } else {
-    plan tests => 36;
+    plan tests => 38;
 }
 
 use_ok('Net::Amazon::S3');
@@ -76,8 +76,13 @@ until ( $stream->is_done ) {
 is( $count, 0, 'newly created bucket has no objects' );
 
 my $object = $bucket->object( key => 'this is the key' );
+
+ok( !$object->exists, 'object does not exist yet' );
+
 $object->put('this is the value');
 
+ok( $object->exists, 'object now exists yet' );
+
 my @objects;
 
 @objects = ();