steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

count word now takes a "normal" query object as argument 

refactored the creation/validation of collections
db4
Sascha Matzke 2009-04-17 08:04:49 +02:00
parent c936517c45
commit d78dc167b6
1 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
mongodb/driver/driver.factor
View File

@ -73,7 +73,9 @@ SYNTAX: r/ ( token -- mdbregexp )
: send-message ( message -- ) : send-message ( message -- )
[ mdb-connection> handle>> ] dip '[ _ write-message ] with-stream* ; [ mdb-connection> handle>> ] dip '[ _ write-message ] with-stream* ;
DEFER: check-collection
: send-query-plain ( query-message -- result ) : send-query-plain ( query-message -- result )
[ check-collection ] change-collection
[ mdb-connection> handle>> ] dip [ mdb-connection> handle>> ] dip
'[ _ write-message read-message ] with-stream* ; '[ _ write-message read-message ] with-stream* ;
@ -135,9 +137,7 @@ M: mdb-collection create-collection ( mdb-collection -- )
MEMO: reserved-namespace? ( name -- ? ) MEMO: reserved-namespace? ( name -- ? )
[ "$cmd" = ] [ "system" head? ] bi or ; [ "$cmd" = ] [ "system" head? ] bi or ;
PRIVATE> MEMO: check-collection ( collection -- fq-collection )
MEMO: ensure-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
@ -145,8 +145,9 @@ MEMO: ensure-collection ( collection -- fq-collection )
[ [ (ensure-collection) ] keep ] unless [ [ (ensure-collection) ] keep ] unless
[ mdb-instance name>> ] dip "%s.%s" sprintf ; inline [ mdb-instance name>> ] dip "%s.%s" sprintf ; inline
PRIVATE>
: <query> ( collection query -- mdb-query ) : <query> ( collection query -- mdb-query )
[ ensure-collection ] dip
<mdb-query-msg> ; inline <mdb-query-msg> ; inline
GENERIC# limit 1 ( mdb-query limit# -- mdb-query ) GENERIC# limit 1 ( mdb-query limit# -- mdb-query )
@ -183,19 +184,18 @@ GENERIC: explain. ( mdb-query -- )
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 -- result/f )
M: mdb-query-msg find-one M: mdb-query-msg find-one
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 ( collection selector -- result ) GENERIC: count ( mdb-query -- result )
M: assoc count M: mdb-query-msg count
[ "count" H{ } clone [ set-at ] keep ] dip [ collection>> "count" H{ } clone [ set-at ] keep ] keep
[ over [ "query" ] dip set-at ] when* query>> [ over [ "query" ] dip set-at ] when*
[ cmd-collection ] dip <mdb-query-msg> find-one [ cmd-collection ] dip <mdb-query-msg> find-one
[ check-ok ] keep '[ "n" _ at >fixnum ] [ f ] if ; [ check-ok ] keep '[ "n" _ at >fixnum ] [ f ] if ;
: lasterror ( -- error ) : lasterror ( -- error )
cmd-collection H{ { "getlasterror" 1 } } <mdb-query-msg> cmd-collection H{ { "getlasterror" 1 } } <mdb-query-msg>
find-one [ "err" ] dip at ; find-one [ "err" ] dip at ;
@ -218,12 +218,12 @@ PRIVATE>
GENERIC: save ( collection assoc -- ) GENERIC: save ( collection assoc -- )
M: assoc save M: assoc save
[ ensure-collection ] dip [ check-collection ] dip
<mdb-insert-msg> send-message-check-error ; <mdb-insert-msg> send-message-check-error ;
GENERIC: save-unsafe ( collection object -- ) GENERIC: save-unsafe ( collection object -- )
M: assoc save-unsafe M: assoc save-unsafe
[ ensure-collection ] dip [ check-collection ] dip
<mdb-insert-msg> send-message ; <mdb-insert-msg> send-message ;
GENERIC: ensure-index ( collection name spec -- ) GENERIC: ensure-index ( collection name spec -- )
@ -244,7 +244,7 @@ M: assoc ensure-index
check-ok [ "could not drop index" throw ] unless ; check-ok [ "could not drop index" throw ] unless ;
: <update> ( collection selector object -- update-msg ) : <update> ( collection selector object -- update-msg )
[ ensure-collection ] 2dip <mdb-update-msg> ; [ check-collection ] 2dip <mdb-update-msg> ;
: >upsert ( mdb-update-msg -- mdb-update-msg ) : >upsert ( mdb-update-msg -- mdb-update-msg )
1 >>upsert? ; 1 >>upsert? ;
@ -259,18 +259,21 @@ M: mdb-update-msg update-unsafe
GENERIC: delete ( collection selector -- ) GENERIC: delete ( collection selector -- )
M: assoc delete M: assoc delete
[ ensure-collection ] dip [ check-collection ] dip
<mdb-delete-msg> send-message-check-error ; <mdb-delete-msg> send-message-check-error ;
GENERIC: delete-unsafe ( collection selector -- ) GENERIC: delete-unsafe ( collection selector -- )
M: assoc delete-unsafe M: assoc delete-unsafe
[ ensure-collection ] dip [ check-collection ] dip
<mdb-delete-msg> send-message ; <mdb-delete-msg> send-message ;
: load-index-list ( -- index-list ) : load-index-list ( -- index-list )
index-collection index-collection
H{ } clone <mdb-query-msg> find nip ; H{ } clone <mdb-query-msg> find nip ;
: ensure-collection ( name -- )
check-collection drop ;
: drop-collection ( name -- ) : drop-collection ( name -- )
[ cmd-collection ] dip [ cmd-collection ] dip
"drop" H{ } clone [ set-at ] keep "drop" H{ } clone [ set-at ] keep