}
{ $description "Creates a new mdb-collection instance. Use this to create capped/limited collections. See also: " { $link mdb-collection } }
{ $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>
{ $values
HELP: <query>
{ $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."
{ "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 <index-spec> ensure-index" }
+ { $example "\"mycollection\" nameIdx [ \"name\" asc ] keyspec <index-spec> 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\" } } <query> find " } } ;
HELP: find-one
{ $values
- { "mdb-query" null }
- { "result" null }
-}
-{ $description "" } ;
-
-HELP: get-more
-{ $values
- { "mdb-cursor" null }
- { "mdb-cursor" null }
- { "objects" null }
+ { "mdb-query" "a query" }
+ { "result" "a single object or f" }
}
-{ $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 } } <query> 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{ } <query> 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 "" } ;
HELP: mdb-error
{ $values
- { "id" null }
- { "msg" null }
+ { "msg" "error message" }
}
{ $description "" } ;
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
-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
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 } ;
-: <mdb-collection> ( 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 ) mdb-pool <pool> swap >>mdb ;
-
-CONSTANT: MDB-GENERAL-ERROR 1
+: <mdb-pool> ( mdb -- pool ) [ mdb-pool <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 ;
<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>
mdb-cursor boa ;
+
M: mdb-getmore-msg <mdb-cursor>
query>> mdb-cursor boa ;
: >mdbregexp ( value -- regexp )
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
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 <mdb-cursor> ] 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 ]
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 )
<inet> t [ <mdb-node> ] keep
H{ } clone [ set-at ] keep <mdb-db>
[ verify-nodes ] keep ;
GENERIC: create-collection ( name -- )
+
M: string create-collection
<mdb-collection> create-collection ;
-M: mdb-collection create-collection ( mdb-collection -- )
+M: mdb-collection create-collection
[ cmd-collection ] dip
<linked-hash> [
[ [ name>> "create" ] dip set-at ]
[ ";$." 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
[ 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
: fix-query-collection ( mdb-query -- mdb-query )
[ check-collection ] change-collection ; inline
-
+
+GENERIC: get-more ( mdb-cursor -- mdb-cursor seq )
+
+M: mdb-cursor get-more
+ [ [ query>> dup [ collection>> ] [ return#>> ] bi ]
+ [ id>> ] bi <mdb-getmore-msg> swap >>query send-query ]
+ [ f f ] if* ;
+
PRIVATE>
-: <query> ( collection query -- mdb-query )
+: <query> ( collection assoc -- mdb-query-msg )
<mdb-query-msg> ; inline
-GENERIC# limit 1 ( mdb-query limit# -- mdb-query )
-M: mdb-query-msg limit ( query limit# -- mdb-query )
+GENERIC# limit 1 ( mdb-query-msg limit# -- mdb-query )
+
+M: mdb-query-msg limit
>>return# ; inline
-GENERIC# skip 1 ( mdb-query skip# -- mdb-query )
-M: mdb-query-msg skip ( query skip# -- mdb-query )
+GENERIC# skip 1 ( mdb-query-msg skip# -- mdb-query-msg )
+
+M: mdb-query-msg skip
>>skip# ; inline
-: asc ( key -- spec ) [ 1 ] dip H{ } clone [ set-at ] keep ; inline
-: desc ( key -- spec ) [ -1 ] dip H{ } clone [ set-at ] keep ; inline
+: asc ( key -- spec ) 1 2array ; inline
+: desc ( key -- spec ) -1 2array ; inline
+
+GENERIC# sort 1 ( mdb-query-msg sort-quot -- mdb-query-msg )
-GENERIC# sort 1 ( mdb-query quot -- mdb-query )
-M: mdb-query-msg sort ( query qout -- mdb-query )
- [ { } ] dip with-datastack >>orderby ;
+M: mdb-query-msg sort
+ output>array >>orderby ; inline
-GENERIC# hint 1 ( mdb-query index-hint -- mdb-query )
-M: mdb-query-msg hint ( mdb-query index-hint -- mdb-query )
+: 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: get-more ( mdb-cursor -- mdb-cursor objects )
-M: mdb-cursor get-more ( mdb-cursor -- mdb-cursor objects )
- [ [ query>> dup [ collection>> ] [ return#>> ] bi ]
- [ id>> ] bi <mdb-getmore-msg> swap >>query send-query ]
- [ f f ] if* ;
+GENERIC: find ( mdb-query-msg/mdb-cursor -- mdb-cursor seq )
-GENERIC: find ( mdb-query -- cursor result )
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*
find-one [ "err" ] dip at ;
GENERIC: validate. ( collection -- )
+
M: string validate.
[ cmd-collection ] dip
"validate" H{ } clone [ set-at ] keep
<mdb-query-msg> find-one [ check-ok nip ] keep
'[ "result" _ at print ] [ ] if ;
+
M: mdb-collection validate.
name>> validate. ;
<PRIVATE
: send-message-check-error ( message -- )
- send-message lasterror [ [ MDB-GENERAL-ERROR ] dip mdb-error ] when* ;
+ send-message lasterror [ mdb-error ] when* ;
PRIVATE>
[ check-collection ] dip
<mdb-insert-msg> 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
+ <linked-hash> [ [ 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
"drop" H{ } clone [ set-at ] keep
<mdb-query-msg> find-one drop ;
-: >pwd-digest ( user password -- digest )
- "mongo" swap 3array ":" join md5-checksum ;
projects / factor.git / commitdiff