added functionality to deal with dead cursors (requery with offset=already read objects)

diff --git a/mongodb/driver/driver.factor b/mongodb/driver/driver.factor
index 42ee62f1d5dcf52f18aa1754128f29c66bdc6603..267b0529288a27ac7eadd2ecc472950a945fe37a 100644 (file)
--- a/mongodb/driver/driver.factor
+++ b/mongodb/driver/driver.factor
@@ -8,7 +8,7 @@ IN: mongodb.driver
 
 TUPLE: mdb-pool < pool mdb ;
 
-TUPLE: mdb-cursor collection id return# ;
+TUPLE: mdb-cursor id query ;
 
 UNION: boolean t POSTPONE: f ;
 
@@ -35,7 +35,11 @@ ERROR: mdb-error id msg ;
 
 <PRIVATE
 
-CONSTRUCTOR: mdb-cursor ( id collection return# -- cursor ) ;
+GENERIC: <mdb-cursor> ( id query/get-more -- cursor )
+M: mdb-query-msg <mdb-cursor>
+    mdb-cursor boa ;
+M: mdb-getmore-msg <mdb-cursor>
+    query>> mdb-cursor boa ;
 
 : >mdbregexp ( value -- regexp )
    first <mdbregexp> ; inline
@@ -52,16 +56,32 @@ SYNTAX: r/ ( token -- mdbregexp )
     [ MDB_OID_FIELD swap at ] keep
     H{ } clone [ set-at ] keep ;
 
-: make-cursor ( mdb-result-msg -- cursor/f )
-    dup cursor>> 0 > 
-    [ [ cursor>> ] [ collection>> ] [ requested#>> ] tri <mdb-cursor> ]
-    [ drop f ] if ;
-
-: send-query ( query-message -- cursor/f result )
+GENERIC: update-query ( result query/cursor -- )
+M: mdb-query-msg update-query 
+    swap [ start#>> ] [ returned#>> ] bi + >>skip# drop ;
+M: mdb-getmore-msg update-query
+    query>> update-query ; 
+      
+: make-cursor ( mdb-result-msg query/cursor -- cursor/f )
+    over cursor>> 0 > 
+    [ [ update-query ]
+      [ [ cursor>> ] dip <mdb-cursor> ] 2bi
+    ] [ 2drop f ] if ;
+
+DEFER: send-query
+GENERIC: verify-query-result ( result query/get-more -- mdb-result-msg query/get-more ) 
+M: mdb-query-msg verify-query-result ;
+M: mdb-getmore-msg verify-query-result
+    over flags>> ResultFlag_CursorNotFound =
+    [ nip query>> [ send-query-plain ] keep ] when ;
+    
+: send-query ( query/get-more -- cursor/f result )
     [ send-query-plain ] keep
+    verify-query-result 
     [ collection>> >>collection drop ]
-    [ return#>> >>requested# ] 2bi
-    [ make-cursor ] [ objects>> ] bi ;
+    [ return#>> >>requested# ] 
+    [ make-cursor ] 2tri
+    swap objects>> ;
 
 PRIVATE>
 
@@ -147,7 +167,8 @@ M: mdb-query-msg hint ( mdb-query index-hint -- mdb-query )
 
 GENERIC: get-more ( mdb-cursor -- mdb-cursor objects )
 M: mdb-cursor get-more ( mdb-cursor -- mdb-cursor objects )
-    [ [ collection>> ] [ return#>> ] [ id>> ] tri <mdb-getmore-msg> send-query ] 
+    [ [ query>> dup [ collection>> ] [ return#>> ] bi ]
+      [ id>> ] bi <mdb-getmore-msg> swap >>query send-query ] 
     [ f f ] if* ;
 
 GENERIC: find ( mdb-query -- cursor result )

diff --git a/mongodb/msg/msg.factor b/mongodb/msg/msg.factor
index 7d1a8058b0e1ad7b4a63d38c18afd039980a3e36..d7f8f501a50aa858845cb07b74092bcdeff7a773 100644 (file)
--- a/mongodb/msg/msg.factor
+++ b/mongodb/msg/msg.factor
@@ -12,6 +12,10 @@ CONSTANT: OP_GetMore 2005
 CONSTANT: OP_Delete  2006 
 CONSTANT: OP_KillCursors 2007
 
+CONSTANT: ResultFlag_CursorNotFound  1 ! /* returned, with zero results, when getMore is called but the cursor id is not valid at the server. */
+CONSTANT: ResultFlag_ErrSet  2 ! /* { $err : ... } is being returned */
+CONSTANT: ResultFlag_ShardConfigStale 4 !  /* have to update config from the server,  usually $err is also set */
+            
 TUPLE: mdb-msg
 { opcode integer } 
 { req-id integer initial: 0 }
@@ -19,6 +23,15 @@ TUPLE: mdb-msg
 { length integer initial: 0 }     
 { flags integer initial: 0 } ;
 
+TUPLE: mdb-query-msg < mdb-msg
+{ collection string }
+{ skip# integer initial: 0 }
+{ return# integer initial: 0 }
+{ query assoc }
+{ returnfields assoc }
+{ orderby sequence }
+explain hint ;
+
 TUPLE: mdb-insert-msg < mdb-msg
 { collection string }
 { objects sequence } ;
@@ -36,21 +49,13 @@ TUPLE: mdb-delete-msg < mdb-msg
 TUPLE: mdb-getmore-msg < mdb-msg
 { collection string }
 { return# integer initial: 0 }
-{ cursor integer initial: 0 } ;
+{ cursor integer initial: 0 }
+{ query mdb-query-msg } ;
 
 TUPLE: mdb-killcursors-msg < mdb-msg
 { cursors# integer initial: 0 }
 { cursors sequence } ;
 
-TUPLE: mdb-query-msg < mdb-msg
-{ collection string }
-{ skip# integer initial: 0 }
-{ return# integer initial: 0 }
-{ query assoc }
-{ returnfields assoc }
-{ orderby sequence }
-explain hint ;
-
 TUPLE: mdb-reply-msg < mdb-msg
 { collection string }
 { cursor integer initial: 0 }