Merge branch 'mongodb-changes' of git://github.com/x6j8x/factor

extra/bson/bson-tests.factor

@@ -8,8 +8,8 @@ IN: bson.tests
 
 [ H{ { "a" "a string" } } ] [ H{ { "a" "a string" } } turnaround ] unit-test
 
-[ H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } ]
-[ H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } turnaround ] unit-test
+[ H{ { "a" "a string" } { "b" H{ { "a" "アップルからの最新のニュースや情報を読む" } } } } ]
+[ H{ { "a" "a string" } { "b" H{ { "a" "アップルからの最新のニュースや情報を読む" } } } } turnaround ] unit-test
 
 [ H{ { "a list" { 1 2.234 "hello world" } } } ]
 [ H{ { "a list" { 1 2.234 "hello world" } } } turnaround ] unit-test

extra/bson/constants/constants.factor

@@ -79,9 +79,10 @@ CONSTANT: T_Integer64 HEX: 12
 CONSTANT: T_MinKey  HEX: FF
 CONSTANT: T_MaxKey  HEX: 7F
 
-CONSTANT: T_Binary_Function     HEX: 1
-CONSTANT: T_Binary_Bytes        HEX: 2
-CONSTANT: T_Binary_UUID         HEX: 3
-CONSTANT: T_Binary_MD5          HEX: 5
-CONSTANT: T_Binary_Custom       HEX: 80
+CONSTANT: T_Binary_Default                  HEX: 0
+CONSTANT: T_Binary_Function                 HEX: 1
+CONSTANT: T_Binary_Bytes_Deprecated         HEX: 2
+CONSTANT: T_Binary_UUID                     HEX: 3
+CONSTANT: T_Binary_MD5                      HEX: 5
+CONSTANT: T_Binary_Custom                   HEX: 80
 

extra/bson/reader/reader.factor

@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs bson.constants calendar combinators
 combinators.short-circuit io io.binary kernel math locals
+io.encodings.utf8 io.encodings
 namespaces sequences serialize strings vectors byte-arrays ;
 
 FROM: io.encodings.binary => binary ;
@@ -34,10 +35,11 @@ DEFER: read-elements
     read-byte-raw first ; inline
 
 : read-cstring ( -- string )
-    "\0" read-until drop >string ; inline
+    input-stream get utf8 <decoder>
+    "\0" swap stream-read-until drop ; inline
 
 : read-sized-string ( length -- string )
-    read 1 head-slice* >string ; inline
+    read binary [ read-cstring ] with-byte-reader ; inline
 
 : read-timestamp ( -- timestamp )
     8 read [ 4 head signed-le> ] [ 4 tail signed-le> ] bi <mongo-timestamp> ;
@@ -54,7 +56,8 @@ DEFER: read-elements
 : bson-binary-read ( -- binary )
    read-int32 read-byte 
    {
-        { T_Binary_Bytes [ read ] }
+        { T_Binary_Default [ read ] }
+        { T_Binary_Bytes_Deprecated [ drop read-int32 read ] }
         { T_Binary_Custom [ read bytes>object ] }
         { T_Binary_Function [ read ] }
         [ drop read >string ]

extra/bson/writer/writer.factor

@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs bson.constants byte-arrays
 calendar combinators.short-circuit fry hashtables io io.binary
+io.encodings.utf8 io.encodings io.streams.byte-array
 kernel linked-assocs literals math math.parser namespaces byte-vectors
 quotations sequences serialize strings vectors dlists alien.accessors ;
 FROM: words => word? word ;
@@ -42,8 +43,11 @@ TYPED: write-int32 ( int: integer -- ) INT32-SIZE (>le) ; inline
 
 TYPED: write-double ( real: float -- ) double>bits INT64-SIZE (>le) ; inline
 
+TYPED: write-utf8-string ( string: string -- )
+    output-stream get utf8 <encoder> stream-write ; inline
+
 TYPED: write-cstring ( string: string -- )
-    get-output [ length ] [  ] bi copy 0 write1 ; inline
+    write-utf8-string 0 write1 ; inline
 
 : write-longlong ( object -- ) INT64-SIZE (>le) ; inline
 
@@ -56,7 +60,7 @@ DEFER: write-pair
 
 TYPED: write-byte-array ( binary: byte-array -- )
     [ length write-int32 ]
-    [ T_Binary_Bytes write1 write ] bi ; inline
+    [ T_Binary_Default write1 write ] bi ; inline
 
 TYPED: write-mdbregexp ( regexp: mdbregexp -- )
    [ regexp>> write-cstring ]
@@ -94,8 +98,12 @@ TYPED: (serialize-code) ( code: code -- )
   [ length write-int32 ]
   [ T_Binary_Custom write1 write ] bi ; inline
 
+: write-string-length ( string -- )
+    [ length>> 1 + ] 
+    [ aux>> [ length ] [ 0 ] if* ] bi + write-int32 ; inline
+
 TYPED: write-string ( string: string -- )
-    '[ _ write-cstring ] with-length-prefix-excl ; inline
+    dup write-string-length write-cstring ; inline
 
 TYPED: write-boolean ( bool: boolean -- )
     [ 1 write1 ] [ 0 write1 ] if ; inline