diff --git a/mongodb/benchmark/benchmark.factor b/mongodb/benchmark/benchmark.factor index 110a4b5091..02dfa8add9 100644 --- a/mongodb/benchmark/benchmark.factor +++ b/mongodb/benchmark/benchmark.factor @@ -162,7 +162,7 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" } [ create-collection ] keep ; : prepare-index ( collection -- ) - "_x_idx" H{ { "x" 1 } } ensure-index ; + "_x_idx" [ "x" asc ] key-spec unique-index ensure-index ; : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) ) prepare-collection diff --git a/mongodb/driver/driver-docs.factor b/mongodb/driver/driver-docs.factor index 1788d81e83..48d7f7b65f 100644 --- a/mongodb/driver/driver-docs.factor +++ b/mongodb/driver/driver-docs.factor @@ -10,7 +10,8 @@ HELP: } { $description "Creates a new mdb-collection instance. Use this to create capped/limited collections. See also: " { $link mdb-collection } } { $examples - { $example "\"mycollection\" t >>capped" } } ; + { $example "! creates a mdb-collection instance capped to a maximum of 1000000 entries" + "\"mycollection\" t >>capped 1000000 >>max" } } ; HELP: { $values @@ -26,8 +27,8 @@ HELP: HELP: { $values { "collection" "collection to query" } - { "query" "query assoc" } - { "mdb-query" "mdb-query-msg instance" } + { "assoc" "query assoc" } + { "mdb-query-msg" "mdb-query-msg instance" } } { $description "Creates a new mdb-query-msg instance. " "This word must be called from within a with-db scope." @@ -41,176 +42,164 @@ HELP: { "collection" "collection to update" } { "selector" "selector assoc (selects which object(s) to update" } { "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 { $values - { "mdb-update-msg" null } - { "mdb-update-msg" null } + { "mdb-update-msg" "a mdb-update-msg" } + { "mdb-update-msg" "mdb-update-msg with the upsert indicator set to t" } } -{ $description "" } ; - -HELP: DIRTY? -{ $values - - { "value" null } -} -{ $description "" } ; - -HELP: MDB-GENERAL-ERROR -{ $values - - { "value" null } -} -{ $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: PARTIAL? -{ $values - - { "value" null } +{ $values + { "value" "partial?" } } -{ $description "" } ; +{ $description "key which refers to a partially loaded object" } ; HELP: asc { $values - { "key" null } - { "spec" null } + { "key" "sort key" } + { "spec" "sort spec" } } -{ $description "" } ; - -HELP: boolean -{ $var-description "" } ; +{ $description "indicates that the values of the specified key should be sorted in ascending order" } ; HELP: count { $values - { "collection" null } - { "query" null } - { "result" null } + { "mdb-query-msg" "query" } + { "result" "number of objects in the collection that match the query" } } -{ $description "" } ; +{ $description "count objects in a collection" } ; HELP: create-collection { $values - { "name" null } + { "name" "collection name" } } -{ $description "" } ; +{ $description "Creates a new collection with the given name." } ; HELP: delete { $values - { "collection" null } - { "selector" null } + { "collection" "a collection" } + { "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 { $values - { "collection" null } - { "selector" null } + { "collection" "a collection" } + { "selector" "assoc which identifies the objects to be removed from the collection" } } -{ $description "" } ; +{ $description "removes objects from the collection (without error check)" } ; HELP: desc { $values - { "key" null } - { "spec" null } + { "key" "sort key" } + { "spec" "sort spec" } } -{ $description "" } ; +{ $description "indicates that the values of the specified key should be sorted in descending order" } ; HELP: drop-collection { $values - { "name" null } + { "name" "a collection" } } -{ $description "" } ; +{ $description "removes the collection and all objects in it from the database" } ; HELP: drop-index { $values - { "collection" null } - { "name" null } + { "collection" "a collection" } + { "name" "an index name" } } -{ $description "" } ; +{ $description "drops the specified index from the collection" } ; HELP: ensure-collection { $values - { "collection" null } - { "fq-collection" null } + { "collection" "a collection; e.g. mycollection " } + { "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 { $values - { "collection" null } - { "name" null } - { "spec" null } + { "collection" "a collection" } + { "name" "index name" } + { "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 ensure-index" } + { $example "\"mycollection\" nameIdx [ \"name\" asc ] keyspec unique-index ensure-index" } } ; HELP: explain. { $values - { "mdb-query" null } + { "mdb-query-msg" "a query message" } } -{ $description "" } ; +{ $description "Prints the execution plan for the given query" } ; HELP: find { $values - { "mdb-query" null } - { "cursor" null } - { "result" null } + { "mdb-query" "a query" } + { "cursor" "a cursor (if there are more results) or f" } + { "result" "a sequences of objects" } } -{ $description "" } ; +{ $description "executes the given query" } +{ $examples + { $example "\"mycollection\" H{ { \"name\" \"Alfred\" } } find " } } ; HELP: find-one { $values - { "mdb-query" null } - { "result" null } + { "mdb-query" "a query" } + { "result" "a single object or f" } } -{ $description "" } ; - -HELP: get-more -{ $values - { "mdb-cursor" null } - { "mdb-cursor" null } - { "objects" null } -} -{ $description "" } ; +{ $description "Executes the query and returns one object at most" } ; HELP: hint { $values - { "mdb-query" null } - { "index-hint" null } - { "mdb-query" null } + { "mdb-query" "a query" } + { "index-hint" "a hint to an index" } + { "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 } } H{ { \"name\" 1 } } hint find" } } ; HELP: lasterror { $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 { $values - { "mdb-query" null } - { "limit#" null } - { "mdb-query" null } + { "mdb-query" "a query" } + { "limit#" "number of objects that should be returned at most" } + { "mdb-query" "modified query object" } } -{ $description "" } ; +{ $description "Limits the number of returned objects to limit#" } +{ $examples + { $example "\"mycollection\" H{ } 10 limit find" } } ; HELP: load-collection-list { $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 { $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 { $var-description "" } ; @@ -220,8 +209,7 @@ HELP: mdb-cursor HELP: mdb-error { $values - { "id" null } - { "msg" null } + { "msg" "error message" } } { $description "" } ; @@ -234,10 +222,11 @@ HELP: r/ HELP: save { $values - { "collection" null } - { "assoc" assoc } + { "collection" "a collection" } + { "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 { $values diff --git a/mongodb/driver/driver.factor b/mongodb/driver/driver.factor index 267b052928..355838b82d 100644 --- a/mongodb/driver/driver.factor +++ b/mongodb/driver/driver.factor @@ -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 io.encodings.binary io.sockets io.streams.duplex kernel linked-assocs hashtables -math math.parser memoize mongodb.connection mongodb.msg mongodb.operations namespaces -parser prettyprint sequences sets splitting strings uuid arrays ; +namespaces parser prettyprint sequences sets splitting strings uuid arrays +math math.parser memoize mongodb.connection mongodb.msg mongodb.operations ; IN: mongodb.driver @@ -10,72 +10,72 @@ TUPLE: mdb-pool < pool mdb ; TUPLE: mdb-cursor id query ; -UNION: boolean t POSTPONE: f ; - TUPLE: mdb-collection { name string } { capped boolean initial: f } { size integer initial: -1 } { max integer initial: -1 } ; -: ( name -- collection ) - [ mdb-collection new ] dip >>name ; inline +CONSTRUCTOR: mdb-collection ( name -- collection ) ; + +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 mdb>> mdb-open ; -: ( mdb -- pool ) mdb-pool swap >>mdb ; - -CONSTANT: MDB-GENERAL-ERROR 1 +: ( mdb -- pool ) [ mdb-pool ] dip >>mdb ; inline 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 ; ( id query/get-more -- cursor ) +GENERIC: ( id mdb-query-msg/mdb-getmore-msg -- mdb-cursor ) + M: mdb-query-msg mdb-cursor boa ; + M: mdb-getmore-msg query>> mdb-cursor boa ; : >mdbregexp ( value -- regexp ) first ; 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 swap [ start#>> ] [ returned#>> ] bi + >>skip# drop ; + M: mdb-getmore-msg 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 > [ [ update-query ] [ [ cursor>> ] dip ] 2bi ] [ 2drop f ] if ; 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-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 ( mdb-query-msg/mdb-getmore-msg -- mdb-cursor/f seq ) [ send-query-plain ] keep verify-query-result [ collection>> >>collection drop ] @@ -85,16 +85,27 @@ M: mdb-getmore-msg verify-query-result 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 ; + : ( db host port -- mdb ) t [ ] keep H{ } clone [ set-at ] keep [ verify-nodes ] keep ; GENERIC: create-collection ( name -- ) + M: string create-collection create-collection ; -M: mdb-collection create-collection ( mdb-collection -- ) +M: mdb-collection create-collection [ cmd-collection ] dip [ [ [ name>> "create" ] dip set-at ] @@ -116,8 +127,6 @@ M: mdb-collection create-collection ( mdb-collection -- ) [ ";$." intersect length 0 > ] keep '[ _ "%s contains invalid characters ( . $ ; )" sprintf throw ] when ; inline -USE: tools.continuations - : (ensure-collection) ( collection -- ) mdb-instance collections>> dup keys length 0 = [ load-collection-list @@ -127,10 +136,10 @@ USE: tools.continuations [ dup ] dip key? [ drop ] [ [ ensure-valid-collection-name ] keep create-collection ] if ; -MEMO: reserved-namespace? ( name -- ? ) +: reserved-namespace? ( name -- ? ) [ "$cmd" = ] [ "system" head? ] bi or ; - -MEMO: check-collection ( collection -- fq-collection ) + +: check-collection ( collection -- fq-collection ) dup mdb-collection? [ name>> ] when "." split1 over mdb-instance name>> = [ nip ] [ drop ] if @@ -140,54 +149,67 @@ MEMO: check-collection ( collection -- fq-collection ) : fix-query-collection ( mdb-query -- mdb-query ) [ check-collection ] change-collection ; inline - -PRIVATE> -: ( collection query -- mdb-query ) - ; inline +GENERIC: get-more ( mdb-cursor -- mdb-cursor seq ) -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 ) +M: mdb-cursor get-more [ [ query>> dup [ collection>> ] [ return#>> ] bi ] [ id>> ] bi swap >>query send-query ] [ f f ] if* ; -GENERIC: find ( mdb-query -- cursor result ) +PRIVATE> + +: ( collection assoc -- 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 fix-query-collection send-query ; + M: mdb-cursor find get-more ; -GENERIC: explain. ( mdb-query -- ) +GENERIC: explain. ( mdb-query-msg -- ) + M: mdb-query-msg explain. 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 fix-query-collection 1 >>return# send-query-plain objects>> dup empty? [ drop f ] [ first ] if ; -GENERIC: count ( mdb-query -- result ) +GENERIC: count ( mdb-query-msg -- result ) + M: mdb-query-msg count [ collection>> "count" H{ } clone [ set-at ] keep ] keep query>> [ over [ "query" ] dip set-at ] when* @@ -199,18 +221,20 @@ M: mdb-query-msg count find-one [ "err" ] dip at ; GENERIC: validate. ( collection -- ) + M: string validate. [ cmd-collection ] dip "validate" H{ } clone [ set-at ] keep find-one [ check-ok nip ] keep '[ "result" _ at print ] [ ] if ; + M: mdb-collection validate. name>> validate. ; @@ -224,15 +248,16 @@ M: assoc save-unsafe [ check-collection ] dip send-message ; -GENERIC: ensure-index ( collection name spec -- ) -M: assoc ensure-index - H{ } clone - [ [ uuid1 "_id" ] dip set-at ] keep - [ [ "key" ] dip set-at ] keep - [ [ "name" ] dip set-at ] keep - [ [ index-ns "ns" ] dip set-at ] keep - [ index-collection ] dip - save ; +GENERIC: ensure-index ( index-spec -- ) +M: index-spec ensure-index + [ [ uuid1 "_id" ] dip set-at ] keep + [ { [ [ name>> "name" ] dip set-at ] + [ [ ns>> index-ns "ns" ] dip set-at ] + [ [ key>> "key" ] dip set-at ] + [ swap unique?>> + [ swap [ "unique" ] dip set-at ] [ drop ] if* ] } 2cleave + ] keep + [ index-collection ] dip save ; : drop-index ( collection name -- ) H{ } clone @@ -277,6 +302,4 @@ M: assoc delete-unsafe "drop" H{ } clone [ set-at ] keep find-one drop ; -: >pwd-digest ( user password -- digest ) - "mongo" swap 3array ":" join md5-checksum ; diff --git a/mongodb/msg/msg.factor b/mongodb/msg/msg.factor index d7f8f501a5..dd8bae8438 100644 --- a/mongodb/msg/msg.factor +++ b/mongodb/msg/msg.factor @@ -91,7 +91,7 @@ M: sequence ( collection sequence -- mdb-insert-msg ) [ >>collection ] dip >>objects OP_Insert >>opcode ; -M: hashtable ( collection assoc -- mdb-insert-msg ) +M: assoc ( collection assoc -- mdb-insert-msg ) [ mdb-insert-msg new ] 2dip [ >>collection ] dip V{ } clone tuck push