test case for https://rt.cpan.org/Ticket/Display.html?id=63955

lib/MongoDB/Collection.pm

@@ -526,7 +526,8 @@ sub _make_safe {
     $cursor->_init;
     $cursor->_request_id($info->{'request_id'});
 
-    $conn->recv($cursor);
+    # a reconnect is fatal here, because it's (by definition) not safe
+    $conn->recv($cursor,1);
     $cursor->started_iterating(1);
 
     my $ok = $cursor->next();

lib/MongoDB/Connection.pm

@@ -753,7 +753,7 @@ Low-level function to send a string directly to the database.  Use
 L<MongoDB::write_insert>, L<MongoDB::write_update>, L<MongoDB::write_remove>, or
 L<MongoDB::write_query> to create a valid string.
 
-=head2 recv(\%info)
+=head2 recv(\%info,$croak_on_reconnect)
 
     my $cursor = $conn->recv({ns => "foo.bar"});
 
@@ -762,6 +762,10 @@ C<MongoDB::Cursor>.  At the moment, the only required field for C<$info> is
 "ns", although "request_id" is likely to be required in the future.  The
 C<$info> hash will be automatically created for you by L<MongoDB::write_query>.
 
+C<$croak_on_reconnect> does exactly that - if you have called send and then
+a reconnect needs to take place to recv, you probably want to croak on that
+reconnect because you will not receive any response and end up timing out
+
 =cut
 
 no Any::Moose;

lib/MongoDB/Cursor.pm

@@ -257,7 +257,7 @@ sub _do_query {
     $self->_request_id($info->{'request_id'});
 
     $self->_connection->send($query);
-    $self->_connection->recv($self);
+    $self->_connection->recv($self,0);
 
     $self->started_iterating(1);
 }

mongo_link.c

@@ -283,7 +283,7 @@ static int get_header(int sock, SV *cursor_sv, SV *link_sv) {
  * Gets a reply from the MongoDB server and
  * creates a cursor for it
  */
-int mongo_link_hear(SV *cursor_sv) {
+int mongo_link_hear(SV *cursor_sv, int reconnect_fatal) {
   int sock;
   int num_returned = 0, timeout = -1;
   mongo_cursor *cursor;
@@ -295,12 +295,22 @@ int mongo_link_hear(SV *cursor_sv) {
   link = (mongo_link*)perl_mongo_get_ptr_from_instance(link_sv, &connection_vtbl);
   timeout_sv = perl_mongo_call_reader(link_sv, "query_timeout");
 
-  if ((sock = perl_mongo_master(link_sv, 0)) == -1) {
+  if ((sock = perl_mongo_master(link_sv, 1)) == -1) {
     set_disconnected(link_sv);
     SvREFCNT_dec(link_sv);
     croak("can't get db response, not connected");
   }
 
+  if (link->master->reconnected) {
+    // because we have reconnected we should return as we
+    // will just sit around waiting for no response
+    SvREFCNT_dec(link_sv);
+    if (reconnect_fatal) {
+      croak("can't get db response, reconnected");
+    }
+    return 0;
+  }
+
   timeout = SvIV(timeout_sv);
   SvREFCNT_dec(timeout_sv);
 
@@ -478,16 +488,25 @@ int perl_mongo_master(SV *link_sv, int auto_reconnect) {
   mongo_link *link;
 
   link = (mongo_link*)perl_mongo_get_ptr_from_instance(link_sv, &connection_vtbl);
+  link->master->reconnected = 0;
 
   if (link->master && link->master->connected) {
+    int size, connected;
+    struct sockaddr_in addr, check_connect;
+    size = sizeof(check_connect);
+    connected = getpeername(link->master->socket, (struct sockaddr*)&addr, &size);
+    if (connected != -1) {
       return link->master->socket;
+    }
   }
+
   // if we didn't have a connection above and this isn't a connection holder
   if (!link->copy) {
       // if this is a real connection, try to reconnect
       if (auto_reconnect && link->auto_reconnect) {
           perl_mongo_call_method(link_sv, "connect", G_DISCARD, 0);
           if (link->master && link->master->connected) {
+              link->master->reconnected = 1;
               return link->master->socket;
           }
       }

mongo_link.h

@@ -114,6 +114,7 @@ typedef struct _mongo_server {
   int port;
   int socket;
   int connected;
+  int reconnected;
 } mongo_server;
 
 /*
@@ -151,7 +152,7 @@ typedef struct {
 } mongo_cursor;
 
 int mongo_link_say(SV *self, buffer *buf);
-int mongo_link_hear(SV *self);
+int mongo_link_hear(SV *self, int reconnect_fatal);
 int perl_mongo_master(SV *self, int auto_reconnect);
 int perl_mongo_connect(char *host, int port, int timeout);
 void set_disconnected(SV *link_sv);

t/001_setup.t

@@ -0,0 +1,21 @@
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib $FindBin::Bin;
+use MongoDB_TestUtils;
+
+plan tests => 2;
+
+# check we can start/stop as some tests will need to do this
+ok( restart_mongod(),'we can start mongod' );
+ok( stop_mongod(),'we can stop mongod' );
+stop_mongod( port() );
+
+# if mongod isn't running then [try to] start it up, otherwise
+# all tests get skipped, which isn't much use
+mconnect(27017) || do {
+
+    restart_mongod(27017) || BAIL_OUT "mongod not running and couldn't be started";
+};

t/MongoDB_TestUtils.pm

@@ -0,0 +1,77 @@
+package MongoDB_TestUtils;
+
+use strict;
+use warnings;
+
+use MongoDB;
+
+use Exporter 'import';
+our @EXPORT = qw(port start_mongod stop_mongod mconnect restart_mongod );
+
+sub port        { 27272 }
+sub dbpath      { '/tmp' }
+sub host        { 'localhost' }
+sub pidfilepath { dbpath() . '/md.pid' }
+
+sub restart_mongod {
+
+    stop_mongod(@_) && start_mongod(@_) && return 1;
+    return 0;
+}
+
+sub start_mongod {
+
+    my $port    = shift || port();
+    my $dbpath  = shift || dbpath();
+    my $pidfile = shift || pidfilepath();
+
+    my $cmd = "mongod "
+        . "--dbpath $dbpath "
+        . "--port $port "
+        . "--pidfilepath $pidfile "
+        . "--fork "
+        . "--logpath $dbpath/mongod.log "
+        . "-vvvvv "
+        . " >/dev/null 2>&1"
+    ;
+
+    #print $cmd;
+    system $cmd;
+
+    sleep 3;
+
+    return !$?;
+}
+
+sub stop_mongod {
+
+    my $pidfilepath = shift || pidfilepath();
+    my $dbpath      = shift || dbpath();
+
+    $pidfilepath = "$dbpath/mongod.lock"
+        if -z $pidfilepath;
+
+    return 1 unless -e $pidfilepath;
+
+    open(my $fh, '<', $pidfilepath) || return 0;
+    my $pid = <$fh>;
+    if ($pid) {
+        system "kill $pid";
+        sleep 3;
+    }
+    return 1;
+}
+
+sub mconnect {
+
+    my $port = shift || port();
+    return eval {
+        MongoDB::Connection->new(
+            host => $ENV{MONGOD} || host(),
+            port => $port,
+            auto_reconnect => 1
+        );
+    };
+}
+
+1;

t/YYY_teardown.t

@@ -0,0 +1,17 @@
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib $FindBin::Bin;
+use MongoDB_TestUtils;
+
+plan tests => 2;
+
+# stop any mongod's we started
+for my $port ( 27017,port() ) {
+
+    mconnect($port)
+        ? ok( stop_mongod(),"stopped our mongod on port $port" )
+        : pass "we didn't start mongod on port $port";
+}

t/ZZZ_auto_reconnect.t

@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use MongoDB;
+
+use FindBin;
+use lib $FindBin::Bin;
+use MongoDB_TestUtils;
+
+my $started = restart_mongod();
+my $conn    = mconnect();
+
+($@ || !$started)
+    ? plan skip_all => ($@ || "couldn't start mongod")
+    : plan tests => 16;
+
+isa_ok( $conn,'MongoDB::Connection' );
+
+my $db = $conn->test_database;
+isa_ok($db, 'MongoDB::Database', 'get_database, initial connection');
+
+my $cl = $db->foo;
+isa_ok($cl, 'MongoDB::Collection', 'foo collection, initial connection');
+
+my $id = $cl->insert({ pre => 'stop' },{ safe => 1 });
+inserted_ok($cl,$id);
+
+restart_mongod();
+
+# reconnect on insert is not "safe" so croaks
+throws_ok(
+    sub { $id = $cl->insert({ post => 'reconnect' },{ safe => 1 }) },
+    qr/reconnected/,
+    'safe insert post reconnect errors'
+);
+
+$id = $cl->insert({ post => 'reconnect' },{ safe => 1 });
+
+# restart again to check reconnect on find isn't fatal
+restart_mongod();
+inserted_ok($cl,$id);
+
+stop_mongod();
+
+sub inserted_ok {
+
+    my ($cl, $id) = @_;
+
+    ok($id,"id returned from insert ($id)");
+
+    for ( 1 .. 2 ) {
+
+        my $res = $cl->find({_id => $id});
+        ok($res,"$id (find attempt $_)");
+
+        my $next = $res->next;
+        ok($next, "$id (find->next)");
+    }
+
+    ok($cl->find_one({_id => $id}), "$id inserted (find_one)");
+}

t/connection.t

@@ -52,7 +52,7 @@ SKIP: {
     } 'extra comma';
 
     lives_ok {
-        $conn = MongoDB::Connection->new("host" => "mongodb://localhost:27018,localhost:27019,localhost");
+        my $conn = MongoDB::Connection->new("host" => "mongodb://localhost:27018,localhost:27019,localhost");
     } 'last in line';
 }
 

xs/Connection.xs

@@ -229,17 +229,17 @@ send(self, str)
      CODE:
          RETVAL = mongo_link_say(self, &buf);
          if (RETVAL == -1) {
-           die("can't get db response, not connected");
+           croak("can't get db response, not connected");
          }
      OUTPUT:
          RETVAL
 
 
 void
-recv(self, cursor)
+recv(self, cursor, int reconnect_fatal)
          SV *cursor
      CODE:
-         mongo_link_hear(cursor);
+         mongo_link_hear(cursor, reconnect_fatal);
 
 
 void

xs/Cursor.xs

@@ -139,7 +139,7 @@ static int has_next(SV *self, mongo_cursor *cursor) {
   if(mongo_link_say(link, &buf) == -1) {
     SvREFCNT_dec(link);
     Safefree(buf.start);
-    die("can't get db response, not connected");
+    croak("can't get db response, not connected (has_next)");
     return 0;
   }
 
@@ -148,7 +148,7 @@ static int has_next(SV *self, mongo_cursor *cursor) {
   // if we have cursor->at == cursor->num && recv fails,
   // we're probably just out of results
   // mongo_link_hear returns 1 on success, 0 on failure
-  heard = mongo_link_hear(self);
+  heard = mongo_link_hear(self,0);
   SvREFCNT_dec(link);
   return heard > 0;
 }