1 ! Copyright (C) 2010 Sascha Matzke.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs bson.constants calendar combinators
4 combinators.short-circuit io io.binary kernel math locals
5 io.encodings.utf8 io.encodings io.files sequences.extras
6 namespaces sequences serialize strings vectors byte-arrays ;
8 FROM: io.encodings.binary => binary ;
9 FROM: io.streams.byte-array => with-byte-reader ;
10 FROM: typed => TYPED: ;
18 ERROR: unknown-bson-type type msg ;
24 : read-int32 ( -- int32 )
25 4 read signed-le> ; inline
27 : read-longlong ( -- longlong )
28 8 read signed-le> ; inline
30 : read-double ( -- double )
31 8 read le> bits>double ; inline
33 : read-byte-raw ( -- byte-raw )
36 : read-byte ( -- byte )
37 read-byte-raw first ; inline
39 : read-cstring ( -- string )
40 input-stream get utf8 <decoder>
41 "\0" swap stream-read-until drop ; inline
43 : read-sized-string ( length -- string )
44 read binary [ read-cstring ] with-byte-reader ; inline
46 : read-timestamp ( -- timestamp )
47 8 read [ 4 head signed-le> ] [ 4 tail signed-le> ] bi <mongo-timestamp> ;
49 : object-result ( quot -- object )
52 [ clear-assoc ] [ ] [ ] tri state
53 ] dip with-variable ; inline
55 : bson-object-data-read ( -- ? )
56 read-int32 [ f ] [ drop read-elements t ] if-zero ; inline recursive
58 : bson-binary-read ( -- binary )
61 { T_Binary_Default [ read ] }
62 { T_Binary_Bytes_Deprecated [ drop read-int32 read ] }
63 { T_Binary_Custom [ read bytes>object ] }
64 { T_Binary_Function [ read-sized-string ] }
65 { T_Binary_MD5 [ read >string ] }
66 { T_Binary_UUID [ read >string ] }
67 [ "unknown binary sub-type" unknown-bson-type ]
70 TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp )
72 read-cstring >>regexp read-cstring >>options ; inline
74 TYPED: bson-oid-read ( -- oid: oid )
75 read-longlong read-int32 oid boa ; inline
77 : check-object ( assoc -- object )
78 dup dbref-assoc? [ assoc>dbref ] when ; inline
80 TYPED: element-data-read ( type: integer -- object )
82 { T_OID [ bson-oid-read ] }
83 { T_String [ read-int32 read-sized-string ] }
84 { T_Integer [ read-int32 ] }
85 { T_Integer64 [ read-longlong ] }
86 { T_Binary [ bson-binary-read ] }
87 { T_Object [ [ bson-object-data-read drop ] object-result check-object ] }
88 { T_Array [ [ bson-object-data-read drop ] object-result values ] }
89 { T_Double [ read-double ] }
90 { T_Boolean [ read-byte 1 = ] }
91 { T_Date [ read-longlong millis>timestamp ] }
92 { T_Regexp [ bson-regexp-read ] }
93 { T_Timestamp [ read-timestamp ] }
94 { T_Code [ read-int32 read-sized-string ] }
95 { T_ScopedCode [ read-int32 drop read-cstring H{ } clone stream>assoc <mongo-scoped-code> ] }
97 [ "type unknown" unknown-bson-type ]
98 } case ; inline recursive
100 TYPED: (read-object) ( type: integer name: string -- )
101 [ element-data-read ] dip state get set-at ; inline recursive
103 TYPED: (element-read) ( type: integer -- cont?: boolean )
105 [ read-cstring (read-object) t ]
106 [ drop f ] if ; inline recursive
108 : read-elements ( -- )
109 read-byte (element-read)
110 [ read-elements ] when ; inline recursive
114 : stream>assoc ( exemplar -- assoc/f )
116 state [ bson-object-data-read ] with-variable
117 ] keep swap [ drop f ] unless ;
119 : path>bson-sequence ( path -- assoc )
121 [ H{ } stream>assoc ] loop>array