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

nicer output

db4
Sascha Matzke 2009-01-29 13:52:37 +01:00
parent e5ba1d2509
commit 050b77d44c
1 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
mongodb/mmm/mmm.factor
View File

@ -1,6 +1,7 @@
USING: accessors fry io io.encodings.binary io.servers.connection USING: accessors fry io io.encodings.binary io.servers.connection
io.sockets io.streams.byte-array kernel math mongodb.msg classes formatting io.sockets io.streams.byte-array kernel math mongodb.msg classes formatting
mongodb.msg.private namespaces prettyprint tools.walker calendar calendar.format ; mongodb.msg.private namespaces prettyprint tools.walker calendar calendar.format
json.writer ;
IN: mongodb.mmm IN: mongodb.mmm
@ -48,22 +49,33 @@ GENERIC: dump-message ( message -- )
[ mmm-dump-output get ] dip [ mmm-dump-output get ] dip
'[ _ binary [ read-message dump-message ] with-byte-reader ] with-output-stream ; '[ _ binary [ read-message dump-message ] with-byte-reader ] with-output-stream ;
: message-prefix ( message -- tst name message ) : message-prefix ( message -- prefix message )
[ now timestamp>http-string ] dip [ now timestamp>http-string ] dip
[ class name>> ] keep ; inline [ class name>> ] keep
[ "%s: %s" sprintf ] dip ; inline
M: mdb-query-msg dump-message ( message -- ) M: mdb-query-msg dump-message ( message -- )
message-prefix message-prefix
collection>> [ collection>> ] keep
"%s: %s -> %s \n" printf ; query>> >json
"%s -> %s: %s \n" printf ;
M: mdb-insert-msg dump-message ( message -- ) M: mdb-insert-msg dump-message ( message -- )
message-prefix message-prefix
collection>> [ collection>> ] keep
"%s: %s -> %s \n" printf ; objects>> >json
"%s -> %s : %s \n" printf ;
M: mdb-reply-msg dump-message ( message -- )
message-prefix
[ cursor>> ] keep
[ start#>> ] keep
[ returned#>> ] keep
objects>> >json
"%s -> cursor: %d, start: %d, returned#: %d, -> %s \n" printf ;
M: mdb-msg dump-message ( message -- ) M: mdb-msg dump-message ( message -- )
message-prefix drop "%s: %s \n" printf ; message-prefix drop "%s \n" printf ;
: forward-reply ( binary -- ) : forward-reply ( binary -- )
write flush ; write flush ;