diff --git a/bson/constants/constants.factor b/bson/constants/constants.factor index 8f5b61a671..fc54f62927 100644 --- a/bson/constants/constants.factor +++ b/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 new - now timestamp>micros >>a - 8 random-bits 16 shift HEX: FF0000 mask - getpid HEX: FFFF mask - bitor >>b ; - -TUPLE: dbref ns oid ; +CONSTRUCTOR: objid ( -- objid ) + uuid1 >>id ; inline +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 diff --git a/bson/reader/reader.factor b/bson/reader/reader.factor index d8b5e2b44a..f697f16691 100644 --- a/bson/reader/reader.factor +++ b/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 ; diff --git a/bson/writer/writer.factor b/bson/writer/writer.factor index c5e9b02ef8..4e07e3ab2f 100644 --- a/bson/writer/writer.factor +++ b/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 -- ) - [ a>> write-longlong ] [ b>> write-int32 ] bi ; +M: objid bson-write ( oid -- ) + id>> utf8 string>alien + [ length write-int32 ] keep + T_Binary_UUID write-byte + write ; -M: dbref bson-write ( dbref -- ) - [ ns>> utf8 string>alien - [ length write-int32 ] keep write - ] - [ oid>> bson-write ] bi ; +M: objref bson-write ( objref -- ) + [ ns>> utf8 string>alien ] + [ objid>> id>> utf8 string>alien ] bi + append + [ length write-int32 ] keep + T_Binary_Custom write-byte + write ; M: sequence bson-write ( array -- ) '[ _ [ [ write-type ] dip number>string write-cstring bson-write ] diff --git a/mongodb/persistent/persistent.factor b/mongodb/persistent/persistent.factor index 249a9d60af..f83d06905c 100644 --- a/mongodb/persistent/persistent.factor +++ b/mongodb/persistent/persistent.factor @@ -20,10 +20,8 @@ DEFER: create-mdb-command CONSTANT: MDB_INFO "_mdb_info" - - -: ( tuple -- dbref ) - [ mdb-collection>> ] [ _id>> ] bi dbref boa ; inline +: ( tuple -- objref ) + [ mdb-collection>> ] [ _id>> ] bi objref 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 - ] + ] [ dup data-tuple? _ [ ] if ] if swap _ set-at ] if @@ -76,7 +74,7 @@ CONSTANT: MDB_INFO "_mdb_info" [ ] dip dup clone swap [ tuck ] dip swap ; inline : ensure-mdb-info ( tuple -- tuple ) - dup _id>> [ >>_id ] unless ; inline + dup _id>> [ >>_id ] unless ; inline : with-op-seq ( quot -- op-seq ) [