From 379f34a82155a1ddd3157a61197b0846637fd698 Mon Sep 17 00:00:00 2001
From: Sascha Matzke <sascha.matzke@didolo.org>
Date: Wed, 9 Jun 2010 14:45:25 +0200
Subject: [PATCH] added new BSON types

---
 extra/bson/constants/constants.factor | 61 ++++++++++++++++-----------
 extra/bson/reader/reader.factor       | 18 ++++++--
 2 files changed, 51 insertions(+), 28 deletions(-)

diff --git a/extra/bson/constants/constants.factor b/extra/bson/constants/constants.factor
index 2d126857c3..e4bf14432a 100644
--- a/extra/bson/constants/constants.factor
+++ b/extra/bson/constants/constants.factor
@@ -19,6 +19,16 @@ TUPLE: oid { a initial: 0 } { b initial: 0 } ;
 
 TUPLE: dbref ref id db ;
 
+TUPLE: mongo-timestamp incr seconds ;
+
+: <mongo-timestamp> ( incr seconds -- mongo-timestamp )
+    mongo-timestamp boa ;
+
+TUPLE: mongo-scoped-code code object ;
+
+: <mongo-scoped-code> ( code object -- mongo-scoped-code )
+    mongo-scoped-code boa ;
+
 CONSTRUCTOR: dbref ( ref id -- dbref ) ;
 
 : dbref>assoc ( dbref -- assoc )
@@ -47,30 +57,31 @@ TUPLE: mdbregexp { regexp string } { options string } ;
 CONSTANT: MDB_OID_FIELD "_id"
 CONSTANT: MDB_META_FIELD "_mfd"
 
-CONSTANT: T_EOO  0  
-CONSTANT: T_Double  1  
-CONSTANT: T_Integer  16  
-CONSTANT: T_Boolean  8  
-CONSTANT: T_String  2  
-CONSTANT: T_Object  3  
-CONSTANT: T_Array  4  
-CONSTANT: T_Binary  5  
-CONSTANT: T_Undefined  6  
-CONSTANT: T_OID  7  
-CONSTANT: T_Date  9  
-CONSTANT: T_NULL  10  
-CONSTANT: T_Regexp  11  
-CONSTANT: T_DBRef  12  
-CONSTANT: T_Code  13  
-CONSTANT: T_ScopedCode  17  
-CONSTANT: T_Symbol  14  
-CONSTANT: T_JSTypeMax  16  
-CONSTANT: T_MaxKey  127  
-
-CONSTANT: T_Binary_Function 1   
-CONSTANT: T_Binary_Bytes 2
-CONSTANT: T_Binary_UUID 3
-CONSTANT: T_Binary_MD5 5
-CONSTANT: T_Binary_Custom 128
+CONSTANT: T_EOO     0
+CONSTANT: T_Double  HEX: 1
+CONSTANT: T_String  HEX: 2
+CONSTANT: T_Object  HEX: 3
+CONSTANT: T_Array   HEX: 4
+CONSTANT: T_Binary  HEX: 5
+CONSTANT: T_Undefined  HEX: 6
+CONSTANT: T_OID     HEX: 7
+CONSTANT: T_Boolean HEX: 8
+CONSTANT: T_Date    HEX: 9
+CONSTANT: T_NULL    HEX: A
+CONSTANT: T_Regexp  HEX: B
+CONSTANT: T_DBRef   HEX: C
+CONSTANT: T_Code    HEX: D
+CONSTANT: T_Symbol  HEX: E
+CONSTANT: T_ScopedCode HEX: F
+CONSTANT: T_Integer HEX: 10
+CONSTANT: T_Timestamp HEX: 11
+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
 
diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor
index e0cf0bc4f4..9b04b333e8 100644
--- a/extra/bson/reader/reader.factor
+++ b/extra/bson/reader/reader.factor
@@ -10,6 +10,8 @@ FROM: typed => TYPED: ;
 
 IN: bson.reader
 
+DEFER: stream>assoc
+
 <PRIVATE
 
 TUPLE: element { type integer } name ;
@@ -57,6 +59,9 @@ TYPED: read-cstring ( -- string: string )
 TYPED: read-sized-string ( length: integer -- string: string )
     read 1 head-slice* >string ; inline
 
+TYPED: read-timestamp ( -- timestamp )
+    8 read [ 4 head signed-le> ] [ 4 tail signed-le> ] bi <mongo-timestamp> ;
+
 TYPED: push-element ( type: integer name: string state: state -- )
     [ element boa ] dip elements>> push ; inline
 
@@ -91,6 +96,7 @@ TYPED: element-data-read ( type: integer -- object )
         { T_OID [ bson-oid-read ] }
         { T_String [ read-int32 read-sized-string ] }
         { T_Integer [ read-int32 ] }
+        { T_Integer64 [ read-longlong ] }
         { T_Binary [ bson-binary-read ] }
         { T_Object [ bson-object-data-read ] }
         { T_Array [ bson-object-data-read ] }
@@ -98,6 +104,9 @@ TYPED: element-data-read ( type: integer -- object )
         { T_Boolean [ read-byte 1 = ] }
         { T_Date [ read-longlong millis>timestamp ] }
         { T_Regexp [ bson-regexp-read ] }
+        { T_Timestamp [ read-timestamp ] }
+        { T_Code [ read-int32 read-sized-string ] }
+        { T_ScopedCode [ read-int32 drop read-cstring H{ } clone stream>assoc <mongo-scoped-code> ] }
         { T_NULL [ f ] }
     } case ; inline
 
@@ -135,9 +144,12 @@ TYPED: (prepare-result) ( scope: vector element: element -- result )
 TYPED: (prepare-object) ( type: integer -- object )
     [ element-data-read ] [ end-element ] bi ; inline
 
-:: (read-object) ( type name state -- )
-    state peek-scope :> scope
-    type (prepare-object) name scope set-at ; inline
+! :: (read-object) ( type name state -- )
+!    state peek-scope :> scope
+!    type (prepare-object) name scope set-at ; inline
+
+: (read-object) ( type name state -- )
+    peek-scope [ (prepare-object) ] 2dip set-at ; inline
 
 TYPED: bson-not-eoo-element-read ( type: integer -- cont?: boolean )
     read-cstring get-state