better error handling when mongod can not be reached

db4
Sascha Matzke 2010-07-31 14:15:55 +02:00
parent f9b3c1d59d
commit 19c78de60f
1 changed files with 18 additions and 16 deletions

View File

@ -1,9 +1,9 @@
USING: accessors arrays assocs byte-vectors checksums USING: accessors arrays assocs byte-vectors checksums
checksums.md5 constructors destructors fry hashtables checksums.md5 constructors continuations destructors fry
io.encodings.binary io.encodings.string io.encodings.utf8 hashtables io.encodings.binary io.encodings.string
io.sockets io.streams.duplex kernel locals math math.parser io.encodings.utf8 io.sockets io.streams.duplex kernel locals
mongodb.cmd mongodb.msg namespaces sequences math math.parser mongodb.cmd mongodb.msg mongodb.operations
splitting ; namespaces sequences splitting ;
IN: mongodb.connection IN: mongodb.connection
: md5-checksum ( string -- digest ) : md5-checksum ( string -- digest )
@ -101,9 +101,9 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
] with-connection ; inline ] with-connection ; inline
: open-connection ( mdb-connection node -- mdb-connection ) : open-connection ( mdb-connection node -- mdb-connection )
[ >>node ] [ address>> ] bi [ >>node ] [ address>> ] bi
[ >>remote ] keep binary <client> [ >>remote ] keep binary <client>
[ >>handle ] dip >>local 4096 <byte-vector> >>buffer ; [ >>handle ] dip >>local 4096 <byte-vector> >>buffer ;
: get-ismaster ( -- result ) : get-ismaster ( -- result )
"admin.$cmd" H{ { "ismaster" 1 } } send-query-1result ; "admin.$cmd" H{ { "ismaster" 1 } } send-query-1result ;
@ -119,8 +119,8 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
: check-node ( mdb node -- ) : check-node ( mdb node -- )
[ <mdb-connection> &dispose ] dip [ <mdb-connection> &dispose ] dip
[ open-connection ] keep swap [ [ open-connection ] [ 3drop f ] recover ] keep swap
[ get-ismaster eval-ismaster-result ] with-connection ; [ [ get-ismaster eval-ismaster-result ] with-connection ] [ drop ] if* ;
: nodelist>table ( seq -- assoc ) : nodelist>table ( seq -- assoc )
[ [ master?>> ] keep 2array ] map >hashtable ; [ [ master?>> ] keep 2array ] map >hashtable ;
@ -134,19 +134,21 @@ PRIVATE>
mdb node1 remote>> mdb node1 remote>>
[ [ check-node ] keep ] [ [ check-node ] keep ]
[ drop f ] if* :> node2 [ drop f ] if* :> node2
node1 [ acc push ] when* node1 [ acc push ] when*
node2 [ acc push ] when* node2 [ acc push ] when*
mdb acc nodelist>table >>nodes drop mdb acc nodelist>table >>nodes drop
] with-destructors ; ] with-destructors ;
ERROR: mongod-connection-error address message ;
: mdb-open ( mdb -- mdb-connection ) : mdb-open ( mdb -- mdb-connection )
clone [ <mdb-connection> ] keep clone [ verify-nodes ] [ <mdb-connection> ] [ ] tri
master-node open-connection master-node [
[ authenticate-connection ] keep ; open-connection [ authenticate-connection ] keep
] [ drop nip address>> "Could not open connection to mongod" mongod-connection-error ] recover ;
: mdb-close ( mdb-connection -- ) : mdb-close ( mdb-connection -- )
[ dispose f ] change-handle drop ; [ [ dispose ] when* f ] change-handle drop ;
M: mdb-connection dispose M: mdb-connection dispose
mdb-close ; mdb-close ;