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

added update message

db4
Sascha Matzke 2009-01-30 12:51:46 +01:00
parent 7179e2f84b
commit af9f0f32df
1 changed files with 31 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
mongodb/msg/msg.factor
View File

@ -18,6 +18,7 @@ CONSTANT: OP_KillCursors 2007
PREDICATE: mdb-reply-op < integer OP_Reply = ; PREDICATE: mdb-reply-op < integer OP_Reply = ;
PREDICATE: mdb-query-op < integer OP_Query = ; PREDICATE: mdb-query-op < integer OP_Query = ;
PREDICATE: mdb-insert-op < integer OP_Insert = ; PREDICATE: mdb-insert-op < integer OP_Insert = ;
PREDICATE: mdb-update-op < integer OP_Update = ;
PREDICATE: mdb-delete-op < integer OP_Delete = ; PREDICATE: mdb-delete-op < integer OP_Delete = ;
PREDICATE: mdb-getmore-op < integer OP_GetMore = ; PREDICATE: mdb-getmore-op < integer OP_GetMore = ;
PREDICATE: mdb-killcursors-op < integer OP_KillCursors = ; PREDICATE: mdb-killcursors-op < integer OP_KillCursors = ;
@ -35,6 +36,12 @@ TUPLE: mdb-insert-msg < mdb-msg
{ collection string } { collection string }
{ objects sequence } ; { objects sequence } ;
TUPLE: mdb-update-msg < mdb-msg
{ collection string }
{ upsert? integer initial: 1 }
{ selector assoc }
{ object assoc } ;
TUPLE: mdb-delete-msg < mdb-msg TUPLE: mdb-delete-msg < mdb-msg
{ collection string } { collection string }
{ selector assoc } ; { selector assoc } ;
@ -104,6 +111,12 @@ M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
[ >>collection ] dip [ >>collection ] dip
>>objects OP_Insert >>opcode ; >>objects OP_Insert >>opcode ;
: <mdb-update-msg> ( collection object -- mdb-update-msg )
[ mdb-update-msg new ] 2dip
[ >>collection ] dip
[ [ "_id" ] dip at "_id" H{ } clone [ set-at ] keep >>selector ] keep
>>object OP_Update >>opcode ;
: <mdb-reply-msg> ( -- mdb-reply-msg ) : <mdb-reply-msg> ( -- mdb-reply-msg )
mdb-reply-msg new ; inline mdb-reply-msg new ; inline
@ -197,6 +210,14 @@ M: mdb-killcursors-op (read-message) ( msg-stub opcode -- message )
[ [ cursors#>> ] keep [ [ cursors#>> ] keep
'[ read-longlong _ cursors>> push ] times ] keep ; '[ read-longlong _ cursors>> push ] times ] keep ;
M: mdb-update-op (read-message) ( msg-stub opcode -- message )
drop
[ mdb-update-msg new ] dip copy-header
read-cstring >>collection
read-int32 >>upsert?
H{ } stream>assoc change-bytes-read >>selector
H{ } stream>assoc change-bytes-read >>object ;
M: mdb-reply-op (read-message) ( msg-stub opcode -- message ) M: mdb-reply-op (read-message) ( msg-stub opcode -- message )
drop drop
[ <mdb-reply-msg> ] dip copy-header [ <mdb-reply-msg> ] dip copy-header
@ -253,6 +274,16 @@ M: mdb-insert-msg write-message ( message -- )
objects>> [ assoc>array write ] each objects>> [ assoc>array write ] each
] (write-message) ; ] (write-message) ;
M: mdb-update-msg write-message ( message -- )
dup
'[ _
[ flags>> write-int32 ] keep
[ collection>> write-cstring ] keep
[ upsert?>> write-int32 ] keep
[ selector>> assoc>array write ] keep
object>> assoc>array write
] (write-message) ;
M: mdb-delete-msg write-message ( message -- ) M: mdb-delete-msg write-message ( message -- )
dup dup
'[ _ '[ _