reworked index creation

added documentation for most of mongodb.driver
db4
Sascha Matzke 2009-05-01 14:04:25 +02:00
parent 661ec38c02
commit 8c0927f17a
4 changed files with 184 additions and 172 deletions

View File

@ -162,7 +162,7 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
[ create-collection ] keep ; [ create-collection ] keep ;
: prepare-index ( collection -- ) : prepare-index ( collection -- )
"_x_idx" H{ { "x" 1 } } ensure-index ; "_x_idx" [ "x" asc ] key-spec <index-spec> unique-index ensure-index ;
: insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) ) : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
prepare-collection prepare-collection

View File

@ -10,7 +10,8 @@ HELP: <mdb-collection>
} }
{ $description "Creates a new mdb-collection instance. Use this to create capped/limited collections. See also: " { $link mdb-collection } } { $description "Creates a new mdb-collection instance. Use this to create capped/limited collections. See also: " { $link mdb-collection } }
{ $examples { $examples
{ $example "\"mycollection\" <mdb-collection> t >>capped" } } ; { $example "! creates a mdb-collection instance capped to a maximum of 1000000 entries"
"\"mycollection\" <mdb-collection> t >>capped 1000000 >>max" } } ;
HELP: <mdb> HELP: <mdb>
{ $values { $values
@ -26,8 +27,8 @@ HELP: <mdb>
HELP: <query> HELP: <query>
{ $values { $values
{ "collection" "collection to query" } { "collection" "collection to query" }
{ "query" "query assoc" } { "assoc" "query assoc" }
{ "mdb-query" "mdb-query-msg instance" } { "mdb-query-msg" "mdb-query-msg instance" }
} }
{ $description "Creates a new mdb-query-msg instance. " { $description "Creates a new mdb-query-msg instance. "
"This word must be called from within a with-db scope." "This word must be called from within a with-db scope."
@ -41,176 +42,164 @@ HELP: <update>
{ "collection" "collection to update" } { "collection" "collection to update" }
{ "selector" "selector assoc (selects which object(s) to update" } { "selector" "selector assoc (selects which object(s) to update" }
{ "object" "updated object or update instruction" } { "object" "updated object or update instruction" }
{ "update-msg" "mdb-update-msg instance" } { "mdb-update-msg" "mdb-update-msg instance" }
} }
{ $description "" } ; { $description "Creates an update message for the object(s) identified by the given selector."
"MongoDB supports full object updates as well as partial update modifiers such as $set, $inc or $push"
"For more information see: " { $url "http://www.mongodb.org/display/DOCS/Updates" } } ;
HELP: >upsert HELP: >upsert
{ $values { $values
{ "mdb-update-msg" null } { "mdb-update-msg" "a mdb-update-msg" }
{ "mdb-update-msg" null } { "mdb-update-msg" "mdb-update-msg with the upsert indicator set to t" }
} }
{ $description "" } ; { $description "Marks a mdb-update-msg as upsert operation"
"(inserts object identified by the update selector if it doesn't exist in the collection)" } ;
HELP: DIRTY?
{ $values
{ "value" null }
}
{ $description "" } ;
HELP: MDB-GENERAL-ERROR
{ $values
{ "value" null }
}
{ $description "" } ;
HELP: PARTIAL? HELP: PARTIAL?
{ $values { $values
{ "value" "partial?" }
{ "value" null }
} }
{ $description "" } ; { $description "key which refers to a partially loaded object" } ;
HELP: asc HELP: asc
{ $values { $values
{ "key" null } { "key" "sort key" }
{ "spec" null } { "spec" "sort spec" }
} }
{ $description "" } ; { $description "indicates that the values of the specified key should be sorted in ascending order" } ;
HELP: boolean
{ $var-description "" } ;
HELP: count HELP: count
{ $values { $values
{ "collection" null } { "mdb-query-msg" "query" }
{ "query" null } { "result" "number of objects in the collection that match the query" }
{ "result" null }
} }
{ $description "" } ; { $description "count objects in a collection" } ;
HELP: create-collection HELP: create-collection
{ $values { $values
{ "name" null } { "name" "collection name" }
} }
{ $description "" } ; { $description "Creates a new collection with the given name." } ;
HELP: delete HELP: delete
{ $values { $values
{ "collection" null } { "collection" "a collection" }
{ "selector" null } { "selector" "assoc which identifies the objects to be removed from the collection" }
} }
{ $description "" } ; { $description "removes objects from the collection (with lasterror check)" } ;
HELP: delete-unsafe HELP: delete-unsafe
{ $values { $values
{ "collection" null } { "collection" "a collection" }
{ "selector" null } { "selector" "assoc which identifies the objects to be removed from the collection" }
} }
{ $description "" } ; { $description "removes objects from the collection (without error check)" } ;
HELP: desc HELP: desc
{ $values { $values
{ "key" null } { "key" "sort key" }
{ "spec" null } { "spec" "sort spec" }
} }
{ $description "" } ; { $description "indicates that the values of the specified key should be sorted in descending order" } ;
HELP: drop-collection HELP: drop-collection
{ $values { $values
{ "name" null } { "name" "a collection" }
} }
{ $description "" } ; { $description "removes the collection and all objects in it from the database" } ;
HELP: drop-index HELP: drop-index
{ $values { $values
{ "collection" null } { "collection" "a collection" }
{ "name" null } { "name" "an index name" }
} }
{ $description "" } ; { $description "drops the specified index from the collection" } ;
HELP: ensure-collection HELP: ensure-collection
{ $values { $values
{ "collection" null } { "collection" "a collection; e.g. mycollection " }
{ "fq-collection" null } { "fq-collection" "full qualified collection name; e.g. db.mycollection" }
} }
{ $description "" } ; { $description "ensures that the collection exists in the database and returns its full qualified name" } ;
HELP: ensure-index HELP: ensure-index
{ $values { $values
{ "collection" null } { "collection" "a collection" }
{ "name" null } { "name" "index name" }
{ "spec" null } { "spec" "index spec" }
} }
{ $description "" } ; { $description "Ensures the existence of the given index. "
"For more information on MongoDB indexes see: " { $url "http://www.mongodb.org/display/DOCS/Indexes" } }
{ $examples
{ $example "\"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> ensure-index" }
{ $example "\"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> unique-index ensure-index" } } ;
HELP: explain. HELP: explain.
{ $values { $values
{ "mdb-query" null } { "mdb-query-msg" "a query message" }
} }
{ $description "" } ; { $description "Prints the execution plan for the given query" } ;
HELP: find HELP: find
{ $values { $values
{ "mdb-query" null } { "mdb-query" "a query" }
{ "cursor" null } { "cursor" "a cursor (if there are more results) or f" }
{ "result" null } { "result" "a sequences of objects" }
} }
{ $description "" } ; { $description "executes the given query" }
{ $examples
{ $example "\"mycollection\" H{ { \"name\" \"Alfred\" } } <query> find " } } ;
HELP: find-one HELP: find-one
{ $values { $values
{ "mdb-query" null } { "mdb-query" "a query" }
{ "result" null } { "result" "a single object or f" }
} }
{ $description "" } ; { $description "Executes the query and returns one object at most" } ;
HELP: get-more
{ $values
{ "mdb-cursor" null }
{ "mdb-cursor" null }
{ "objects" null }
}
{ $description "" } ;
HELP: hint HELP: hint
{ $values { $values
{ "mdb-query" null } { "mdb-query" "a query" }
{ "index-hint" null } { "index-hint" "a hint to an index" }
{ "mdb-query" null } { "mdb-query" "modified query object" }
} }
{ $description "" } ; { $description "Annotates the query with a hint to an index. "
"For detailed information see: " { $url "http://www.mongodb.org/display/DOCS/Optimizing+Mongo+Performance#OptimizingMongoPerformance-Hint" } }
{ $examples
{ $example "\"mycollection\" H{ { \"name\" \"Alfred\" } { \"age\" 70 } } <query> H{ { \"name\" 1 } } hint find" } } ;
HELP: lasterror HELP: lasterror
{ $values { $values
{ "error" null } { "error" "error message or f" }
} }
{ $description "" } ; { $description "Checks if the last operation resulted in an error on the MongoDB side"
"For more information see: " { $url "http://www.mongodb.org/display/DOCS/Mongo+Commands#MongoCommands-LastErrorCommands" } } ;
HELP: limit HELP: limit
{ $values { $values
{ "mdb-query" null } { "mdb-query" "a query" }
{ "limit#" null } { "limit#" "number of objects that should be returned at most" }
{ "mdb-query" null } { "mdb-query" "modified query object" }
} }
{ $description "" } ; { $description "Limits the number of returned objects to limit#" }
{ $examples
{ $example "\"mycollection\" H{ } <query> 10 limit find" } } ;
HELP: load-collection-list HELP: load-collection-list
{ $values { $values
{ "collection-list" null } { "collection-list" "list of collections in the current database" }
} }
{ $description "" } ; { $description "Returns a list of all collections that exist in the current database" } ;
HELP: load-index-list HELP: load-index-list
{ $values { $values
{ "index-list" null } { "index-list" "list of indexes" }
} }
{ $description "" } ; { $description "Returns a list of all indexes that exist in the current database" } ;
HELP: mdb-collection HELP: mdb-collection
{ $var-description "" } ; { $var-description "" } ;
@ -220,8 +209,7 @@ HELP: mdb-cursor
HELP: mdb-error HELP: mdb-error
{ $values { $values
{ "id" null } { "msg" "error message" }
{ "msg" null }
} }
{ $description "" } ; { $description "" } ;
@ -234,10 +222,11 @@ HELP: r/
HELP: save HELP: save
{ $values { $values
{ "collection" null } { "collection" "a collection" }
{ "assoc" assoc } { "assoc" "object" }
} }
{ $description "" } ; { $description "Saves the object to the given collection."
" If the object contains a field name \"_id\" this command automatically performs an update (with upsert) instead of a plain save" } ;
HELP: save-unsafe HELP: save-unsafe
{ $values { $values

View File

@ -1,8 +1,8 @@
USING: accessors assocs bson.constants bson.writer combinators USING: accessors assocs bson.constants bson.writer combinators combinators.smart
constructors continuations destructors formatting fry io io.pools constructors continuations destructors formatting fry io io.pools
io.encodings.binary io.sockets io.streams.duplex kernel linked-assocs hashtables io.encodings.binary io.sockets io.streams.duplex kernel linked-assocs hashtables
math math.parser memoize mongodb.connection mongodb.msg mongodb.operations namespaces namespaces parser prettyprint sequences sets splitting strings uuid arrays
parser prettyprint sequences sets splitting strings uuid arrays ; math math.parser memoize mongodb.connection mongodb.msg mongodb.operations ;
IN: mongodb.driver IN: mongodb.driver
@ -10,72 +10,72 @@ TUPLE: mdb-pool < pool mdb ;
TUPLE: mdb-cursor id query ; TUPLE: mdb-cursor id query ;
UNION: boolean t POSTPONE: f ;
TUPLE: mdb-collection TUPLE: mdb-collection
{ name string } { name string }
{ capped boolean initial: f } { capped boolean initial: f }
{ size integer initial: -1 } { size integer initial: -1 }
{ max integer initial: -1 } ; { max integer initial: -1 } ;
: <mdb-collection> ( name -- collection ) CONSTRUCTOR: mdb-collection ( name -- collection ) ;
[ mdb-collection new ] dip >>name ; inline
TUPLE: index-spec
{ ns string } { name string } { key hashtable } { unique? boolean initial: f } ;
CONSTRUCTOR: index-spec ( ns name key -- index-spec ) ;
: unique-index ( index-spec -- index-spec )
t >>unique? ;
M: mdb-pool make-connection M: mdb-pool make-connection
mdb>> mdb-open ; mdb>> mdb-open ;
: <mdb-pool> ( mdb -- pool ) mdb-pool <pool> swap >>mdb ; : <mdb-pool> ( mdb -- pool ) [ mdb-pool <pool> ] dip >>mdb ; inline
CONSTANT: MDB-GENERAL-ERROR 1
CONSTANT: PARTIAL? "partial?" CONSTANT: PARTIAL? "partial?"
CONSTANT: DIRTY? "dirty?"
ERROR: mdb-error id msg ; ERROR: mdb-error msg ;
: >pwd-digest ( user password -- digest )
"mongo" swap 3array ":" join md5-checksum ;
<PRIVATE <PRIVATE
GENERIC: <mdb-cursor> ( id query/get-more -- cursor ) GENERIC: <mdb-cursor> ( id mdb-query-msg/mdb-getmore-msg -- mdb-cursor )
M: mdb-query-msg <mdb-cursor> M: mdb-query-msg <mdb-cursor>
mdb-cursor boa ; mdb-cursor boa ;
M: mdb-getmore-msg <mdb-cursor> M: mdb-getmore-msg <mdb-cursor>
query>> mdb-cursor boa ; query>> mdb-cursor boa ;
: >mdbregexp ( value -- regexp ) : >mdbregexp ( value -- regexp )
first <mdbregexp> ; inline first <mdbregexp> ; inline
PRIVATE> GENERIC: update-query ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- )
SYNTAX: r/ ( token -- mdbregexp )
\ / [ >mdbregexp ] parse-literal ;
: with-db ( mdb quot -- ... )
'[ _ mdb-open &dispose _ with-connection ] with-destructors ; inline
: build-id-selector ( assoc -- selector )
[ MDB_OID_FIELD swap at ] keep
H{ } clone [ set-at ] keep ;
GENERIC: update-query ( result query/cursor -- )
M: mdb-query-msg update-query M: mdb-query-msg update-query
swap [ start#>> ] [ returned#>> ] bi + >>skip# drop ; swap [ start#>> ] [ returned#>> ] bi + >>skip# drop ;
M: mdb-getmore-msg update-query M: mdb-getmore-msg update-query
query>> update-query ; query>> update-query ;
: make-cursor ( mdb-result-msg query/cursor -- cursor/f ) : make-cursor ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- mdb-cursor/f )
over cursor>> 0 > over cursor>> 0 >
[ [ update-query ] [ [ update-query ]
[ [ cursor>> ] dip <mdb-cursor> ] 2bi [ [ cursor>> ] dip <mdb-cursor> ] 2bi
] [ 2drop f ] if ; ] [ 2drop f ] if ;
DEFER: send-query DEFER: send-query
GENERIC: verify-query-result ( result query/get-more -- mdb-result-msg query/get-more )
GENERIC: verify-query-result ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- mdb-result-msg mdb-query-msg/mdb-getmore-msg )
M: mdb-query-msg verify-query-result ; M: mdb-query-msg verify-query-result ;
M: mdb-getmore-msg verify-query-result M: mdb-getmore-msg verify-query-result
over flags>> ResultFlag_CursorNotFound = over flags>> ResultFlag_CursorNotFound =
[ nip query>> [ send-query-plain ] keep ] when ; [ nip query>> [ send-query-plain ] keep ] when ;
: send-query ( query/get-more -- cursor/f result ) : send-query ( mdb-query-msg/mdb-getmore-msg -- mdb-cursor/f seq )
[ send-query-plain ] keep [ send-query-plain ] keep
verify-query-result verify-query-result
[ collection>> >>collection drop ] [ collection>> >>collection drop ]
@ -85,16 +85,27 @@ M: mdb-getmore-msg verify-query-result
PRIVATE> PRIVATE>
SYNTAX: r/ ( token -- mdbregexp )
\ / [ >mdbregexp ] parse-literal ;
: with-db ( mdb quot -- * )
'[ _ mdb-open &dispose _ with-connection ] with-destructors ; inline
: >id-selector ( assoc -- selector )
[ MDB_OID_FIELD swap at ] keep
H{ } clone [ set-at ] keep ;
: <mdb> ( db host port -- mdb ) : <mdb> ( db host port -- mdb )
<inet> t [ <mdb-node> ] keep <inet> t [ <mdb-node> ] keep
H{ } clone [ set-at ] keep <mdb-db> H{ } clone [ set-at ] keep <mdb-db>
[ verify-nodes ] keep ; [ verify-nodes ] keep ;
GENERIC: create-collection ( name -- ) GENERIC: create-collection ( name -- )
M: string create-collection M: string create-collection
<mdb-collection> create-collection ; <mdb-collection> create-collection ;
M: mdb-collection create-collection ( mdb-collection -- ) M: mdb-collection create-collection
[ cmd-collection ] dip [ cmd-collection ] dip
<linked-hash> [ <linked-hash> [
[ [ name>> "create" ] dip set-at ] [ [ name>> "create" ] dip set-at ]
@ -116,8 +127,6 @@ M: mdb-collection create-collection ( mdb-collection -- )
[ ";$." intersect length 0 > ] keep [ ";$." intersect length 0 > ] keep
'[ _ "%s contains invalid characters ( . $ ; )" sprintf throw ] when ; inline '[ _ "%s contains invalid characters ( . $ ; )" sprintf throw ] when ; inline
USE: tools.continuations
: (ensure-collection) ( collection -- ) : (ensure-collection) ( collection -- )
mdb-instance collections>> dup keys length 0 = mdb-instance collections>> dup keys length 0 =
[ load-collection-list [ load-collection-list
@ -127,10 +136,10 @@ USE: tools.continuations
[ dup ] dip key? [ drop ] [ dup ] dip key? [ drop ]
[ [ ensure-valid-collection-name ] keep create-collection ] if ; [ [ ensure-valid-collection-name ] keep create-collection ] if ;
MEMO: reserved-namespace? ( name -- ? ) : reserved-namespace? ( name -- ? )
[ "$cmd" = ] [ "system" head? ] bi or ; [ "$cmd" = ] [ "system" head? ] bi or ;
MEMO: check-collection ( collection -- fq-collection ) : check-collection ( collection -- fq-collection )
dup mdb-collection? [ name>> ] when dup mdb-collection? [ name>> ] when
"." split1 over mdb-instance name>> = "." split1 over mdb-instance name>> =
[ nip ] [ drop ] if [ nip ] [ drop ] if
@ -141,53 +150,66 @@ MEMO: check-collection ( collection -- fq-collection )
: fix-query-collection ( mdb-query -- mdb-query ) : fix-query-collection ( mdb-query -- mdb-query )
[ check-collection ] change-collection ; inline [ check-collection ] change-collection ; inline
PRIVATE> GENERIC: get-more ( mdb-cursor -- mdb-cursor seq )
: <query> ( collection query -- mdb-query ) M: mdb-cursor get-more
<mdb-query-msg> ; inline
GENERIC# limit 1 ( mdb-query limit# -- mdb-query )
M: mdb-query-msg limit ( query limit# -- mdb-query )
>>return# ; inline
GENERIC# skip 1 ( mdb-query skip# -- mdb-query )
M: mdb-query-msg skip ( query skip# -- mdb-query )
>>skip# ; inline
: asc ( key -- spec ) [ 1 ] dip H{ } clone [ set-at ] keep ; inline
: desc ( key -- spec ) [ -1 ] dip H{ } clone [ set-at ] keep ; inline
GENERIC# sort 1 ( mdb-query quot -- mdb-query )
M: mdb-query-msg sort ( query qout -- mdb-query )
[ { } ] dip with-datastack >>orderby ;
GENERIC# hint 1 ( mdb-query index-hint -- mdb-query )
M: mdb-query-msg hint ( mdb-query index-hint -- mdb-query )
>>hint ;
GENERIC: get-more ( mdb-cursor -- mdb-cursor objects )
M: mdb-cursor get-more ( mdb-cursor -- mdb-cursor objects )
[ [ query>> dup [ collection>> ] [ return#>> ] bi ] [ [ query>> dup [ collection>> ] [ return#>> ] bi ]
[ id>> ] bi <mdb-getmore-msg> swap >>query send-query ] [ id>> ] bi <mdb-getmore-msg> swap >>query send-query ]
[ f f ] if* ; [ f f ] if* ;
GENERIC: find ( mdb-query -- cursor result ) PRIVATE>
: <query> ( collection assoc -- mdb-query-msg )
<mdb-query-msg> ; inline
GENERIC# limit 1 ( mdb-query-msg limit# -- mdb-query )
M: mdb-query-msg limit
>>return# ; inline
GENERIC# skip 1 ( mdb-query-msg skip# -- mdb-query-msg )
M: mdb-query-msg skip
>>skip# ; inline
: asc ( key -- spec ) 1 2array ; inline
: desc ( key -- spec ) -1 2array ; inline
GENERIC# sort 1 ( mdb-query-msg sort-quot -- mdb-query-msg )
M: mdb-query-msg sort
output>array >>orderby ; inline
: key-spec ( spec-quot -- spec-assoc )
output>array >hashtable ; inline
GENERIC# hint 1 ( mdb-query-msg index-hint -- mdb-query-msg )
M: mdb-query-msg hint
>>hint ;
GENERIC: find ( mdb-query-msg/mdb-cursor -- mdb-cursor seq )
M: mdb-query-msg find M: mdb-query-msg find
fix-query-collection send-query ; fix-query-collection send-query ;
M: mdb-cursor find M: mdb-cursor find
get-more ; get-more ;
GENERIC: explain. ( mdb-query -- ) GENERIC: explain. ( mdb-query-msg -- )
M: mdb-query-msg explain. M: mdb-query-msg explain.
t >>explain find nip . ; t >>explain find nip . ;
GENERIC: find-one ( mdb-query -- result/f ) GENERIC: find-one ( mdb-query-msg -- result/f )
M: mdb-query-msg find-one M: mdb-query-msg find-one
fix-query-collection fix-query-collection
1 >>return# send-query-plain objects>> 1 >>return# send-query-plain objects>>
dup empty? [ drop f ] [ first ] if ; dup empty? [ drop f ] [ first ] if ;
GENERIC: count ( mdb-query -- result ) GENERIC: count ( mdb-query-msg -- result )
M: mdb-query-msg count M: mdb-query-msg count
[ collection>> "count" H{ } clone [ set-at ] keep ] keep [ collection>> "count" H{ } clone [ set-at ] keep ] keep
query>> [ over [ "query" ] dip set-at ] when* query>> [ over [ "query" ] dip set-at ] when*
@ -199,18 +221,20 @@ M: mdb-query-msg count
find-one [ "err" ] dip at ; find-one [ "err" ] dip at ;
GENERIC: validate. ( collection -- ) GENERIC: validate. ( collection -- )
M: string validate. M: string validate.
[ cmd-collection ] dip [ cmd-collection ] dip
"validate" H{ } clone [ set-at ] keep "validate" H{ } clone [ set-at ] keep
<mdb-query-msg> find-one [ check-ok nip ] keep <mdb-query-msg> find-one [ check-ok nip ] keep
'[ "result" _ at print ] [ ] if ; '[ "result" _ at print ] [ ] if ;
M: mdb-collection validate. M: mdb-collection validate.
name>> validate. ; name>> validate. ;
<PRIVATE <PRIVATE
: send-message-check-error ( message -- ) : send-message-check-error ( message -- )
send-message lasterror [ [ MDB-GENERAL-ERROR ] dip mdb-error ] when* ; send-message lasterror [ mdb-error ] when* ;
PRIVATE> PRIVATE>
@ -224,15 +248,16 @@ M: assoc save-unsafe
[ check-collection ] dip [ check-collection ] dip
<mdb-insert-msg> send-message ; <mdb-insert-msg> send-message ;
GENERIC: ensure-index ( collection name spec -- ) GENERIC: ensure-index ( index-spec -- )
M: assoc ensure-index M: index-spec ensure-index
H{ } clone <linked-hash> [ [ uuid1 "_id" ] dip set-at ] keep
[ [ uuid1 "_id" ] dip set-at ] keep [ { [ [ name>> "name" ] dip set-at ]
[ [ "key" ] dip set-at ] keep [ [ ns>> index-ns "ns" ] dip set-at ]
[ [ "name" ] dip set-at ] keep [ [ key>> "key" ] dip set-at ]
[ [ index-ns "ns" ] dip set-at ] keep [ swap unique?>>
[ index-collection ] dip [ swap [ "unique" ] dip set-at ] [ drop ] if* ] } 2cleave
save ; ] keep
[ index-collection ] dip save ;
: drop-index ( collection name -- ) : drop-index ( collection name -- )
H{ } clone H{ } clone
@ -277,6 +302,4 @@ M: assoc delete-unsafe
"drop" H{ } clone [ set-at ] keep "drop" H{ } clone [ set-at ] keep
<mdb-query-msg> find-one drop ; <mdb-query-msg> find-one drop ;
: >pwd-digest ( user password -- digest )
"mongo" swap 3array ":" join md5-checksum ;

View File

@ -91,7 +91,7 @@ M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
[ >>collection ] dip [ >>collection ] dip
>>objects OP_Insert >>opcode ; >>objects OP_Insert >>opcode ;
M: hashtable <mdb-insert-msg> ( collection assoc -- mdb-insert-msg ) M: assoc <mdb-insert-msg> ( collection assoc -- mdb-insert-msg )
[ mdb-insert-msg new ] 2dip [ mdb-insert-msg new ] 2dip
[ >>collection ] dip [ >>collection ] dip
V{ } clone tuck push V{ } clone tuck push