dropped oid and dbref support from bson; now using uuid (v1) for objid (Binary, Subtype: UUID)

and custom binary format for objrefs (ns, objid - Binary, Subtype: Custom)

bson/constants/constants.factor

@@ -1,18 +1,14 @@
-USING: alien.c-types accessors kernel calendar random math.bitwise math unix ;
+USING: alien.c-types accessors kernel calendar random math.bitwise math unix
+constructors uuid ;
 
 IN: bson.constants
 
-TUPLE: oid { a initial: 0 } { b initial: 0 } ;
+TUPLE: objid id ;
 
-: <oid> ( -- oid )
+CONSTRUCTOR: objid ( -- objid )
-    oid new
+   uuid1 >>id ; inline
-    now timestamp>micros >>a
-    8 random-bits 16 shift HEX: FF0000 mask
-    getpid HEX: FFFF mask
-    bitor >>b ;
-
-TUPLE: dbref ns oid ;
 
+TUPLE: objref ns objid ;
 
 CONSTANT: T_EOO  0  
 CONSTANT: T_Double  1  
@@ -34,7 +30,10 @@ CONSTANT: T_Symbol  14
 CONSTANT: T_JSTypeMax  16  
 CONSTANT: T_MaxKey  127  
 
-CONSTANT: T_Binary_Bytes 2  
 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
 
 

bson/reader/reader.factor

@@ -29,6 +29,8 @@ PREDICATE: bson-array   < integer T_Array = ;
 PREDICATE: bson-binary  < integer T_Binary = ;
 PREDICATE: bson-binary-bytes < integer T_Binary_Bytes = ;
 PREDICATE: bson-binary-function < integer T_Binary_Function = ;
+PREDICATE: bson-binary-uuid < integer T_Binary_UUID = ;
+PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
 PREDICATE: bson-oid     < integer T_OID = ;
 PREDICATE: bson-boolean < integer T_Boolean = ;
 PREDICATE: bson-date    < integer T_Date = ;
@@ -134,12 +136,6 @@ M: bson-not-eoo element-read ( type -- cont? )
     set-at
     t ;
 
-M: bson-oid element-data-read ( type -- object )
-    drop
-    read-longlong
-    read-int32
-    oid boa ;
-
 : [scope-changer] ( state -- state quot )
     dup exemplar>> '[ [ [ _ clone ] dip push ] keep ] ; inline
 
@@ -172,13 +168,6 @@ M: bson-boolean element-data-read ( type -- boolean )
     drop
     read-byte t = ;
 
-M: bson-ref element-data-read ( type -- dbref )
-    drop
-    read-int32
-    read-sized-string
-    T_OID element-data-read
-    dbref boa ;
-
 M: bson-binary element-data-read ( type -- binary )
     drop
     read-int32 read-byte element-binary-read ;
@@ -187,6 +176,17 @@ M: bson-null element-data-read ( type -- bf  )
     drop
     f ;
 
+M: bson-binary-custom element-binary-read ( size type -- dbref )
+    2drop
+    read-cstring
+    read-cstring objid boa
+    objref boa ;
+
+M: bson-binary-uuid element-binary-read ( size type -- object )
+    drop
+    read-sized-string
+    objid boa ;
+
 M: bson-binary-bytes element-binary-read ( size type -- bytes )
     drop read ;
 

bson/writer/writer.factor

@@ -5,7 +5,7 @@ USING: bson bson.constants accessors kernel io.streams.string
        io.encodings.utf8 strings splitting math.parser 
        sequences math assocs classes words make fry 
        prettyprint hashtables mirrors alien.strings alien.c-types
-       io.streams.byte-array io ;
+       io.streams.byte-array io alien.strings ;
 
 IN: bson.writer
 
@@ -19,15 +19,16 @@ GENERIC: bson-write ( obj -- )
 M: t bson-type? ( boolean -- type ) drop T_Boolean ; 
 M: f bson-type? ( boolean -- type ) drop T_Boolean ; 
 
-M: oid bson-type? ( word -- type ) drop T_OID ;
-M: dbref bson-type? ( dbref -- type ) drop T_DBRef ;
 M: real bson-type? ( real -- type ) drop T_Double ; 
 M: word bson-type? ( word -- type ) drop T_String ; 
 M: tuple bson-type? ( tuple -- type ) drop T_Object ;  
 M: assoc bson-type? ( hashtable -- type ) drop T_Object ; 
 M: string bson-type? ( string -- type ) drop T_String ; 
 M: integer bson-type? ( integer -- type ) drop T_Integer ; 
-M: sequence bson-type? ( seq -- type ) drop T_Array ; 
+M: sequence bson-type? ( seq -- type ) drop T_Array ;
+
+M: objid bson-type? ( objid -- type ) drop T_Binary ;
+M: objref bson-type? ( objref -- type ) drop T_Binary ;
 M: quotation bson-type? ( quotation -- type ) drop T_Binary ; 
 M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ; 
 
@@ -69,14 +70,19 @@ M: quotation bson-write ( quotation -- )
     T_Binary_Function write-byte
     write ; 
 
-M: oid bson-write ( oid -- )
+M: objid bson-write ( oid -- )
-    [ a>> write-longlong ] [ b>> write-int32 ] bi ;
+    id>> utf8 string>alien
+    [ length write-int32 ] keep
+    T_Binary_UUID write-byte
+    write ;
 
-M: dbref bson-write ( dbref -- )
+M: objref bson-write ( objref -- )
-    [ ns>> utf8 string>alien 
+    [ ns>> utf8 string>alien ]
-      [ length write-int32 ] keep write
+    [ objid>> id>> utf8 string>alien ] bi
-    ]
+    append
-    [ oid>> bson-write ] bi ;
+    [ length write-int32 ] keep
+    T_Binary_Custom write-byte
+    write ;
     
 M: sequence bson-write ( array -- )
     '[ _ [ [ write-type ] dip number>string write-cstring bson-write ]

mongodb/persistent/persistent.factor

@@ -20,10 +20,8 @@ DEFER: create-mdb-command
 
 CONSTANT: MDB_INFO "_mdb_info"
 
-
+: <objref> ( tuple -- objref )
-
+    [ mdb-collection>> ] [ _id>> ] bi objref boa ; inline
-: <dbref> ( tuple -- dbref )
-    [ mdb-collection>> ] [ _id>> ] bi dbref boa ; inline
 
 : mdbinfo>tuple-class ( mdbinfo -- class )
     [ first ] keep second lookup ; inline
@@ -66,7 +64,7 @@ CONSTANT: MDB_INFO "_mdb_info"
          [ _ keep
            [ mdb-collection>> ] keep
            [ create-mdb-command ] dip
-           <dbref> ]
+           <objref> ]
          [ dup data-tuple? _ [ ] if ] if
          swap _ set-at
        ] if
@@ -76,7 +74,7 @@ CONSTANT: MDB_INFO "_mdb_info"
     [ <mirror> ] dip dup clone swap [ tuck ] dip swap ; inline
     
 : ensure-mdb-info ( tuple -- tuple )    
-    dup _id>> [ <oid> >>_id ] unless ; inline
+    dup _id>> [ <objid> >>_id ] unless ; inline
   
 : with-op-seq ( quot -- op-seq )
     [