From dc825d21c565c320d27354c8e2042d12c93881c9 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Tue, 16 Dec 2008 14:17:00 +0100 Subject: [PATCH] working round-trip bson (tuples - strings, numbers, other tuples as members ) >bson/bson> --- mongodb/bson/bson.factor | 7 ++ mongodb/bson/constants/constants.factor | 53 ++++++++++++ mongodb/bson/reader/reader.factor | 104 ++++++++++++++++++++++++ mongodb/bson/writer/writer.factor | 100 +++++++++++++++++++++++ 4 files changed, 264 insertions(+) create mode 100644 mongodb/bson/bson.factor create mode 100644 mongodb/bson/constants/constants.factor create mode 100644 mongodb/bson/reader/reader.factor create mode 100644 mongodb/bson/writer/writer.factor diff --git a/mongodb/bson/bson.factor b/mongodb/bson/bson.factor new file mode 100644 index 0000000000..f6cd002b48 --- /dev/null +++ b/mongodb/bson/bson.factor @@ -0,0 +1,7 @@ +IN: mongodb.bson +USE: vocabs.loader + +SINGLETON: bson-null + +"mongodb.bson.reader" require +"mongodb.bson.writer" require diff --git a/mongodb/bson/constants/constants.factor b/mongodb/bson/constants/constants.factor new file mode 100644 index 0000000000..9163d06ba4 --- /dev/null +++ b/mongodb/bson/constants/constants.factor @@ -0,0 +1,53 @@ +USING: alien.c-types ; + +IN: mongodb.bson.constants + + +: T_EOO ( -- type ) 0 ; inline +: T_Double ( -- type ) 1 ; inline +: T_Integer ( -- type ) 16 ; inline +: T_Boolean ( -- type ) 8 ; inline +: T_String ( -- type ) 2 ; inline +: T_Object ( -- type ) 3 ; inline +: T_Array ( -- type ) 4 ; inline +: T_Binary ( -- type ) 5 ; inline +: T_Undefined ( -- type ) 6 ; inline +: T_OID ( -- type ) 7 ; inline +: T_Date ( -- type ) 9 ; inline +: T_NULL ( -- type ) 10 ; inline +: T_Regexp ( -- type ) 11 ; inline +: T_DBRef ( -- type ) 12 ; inline +: T_Code ( -- type ) 13 ; inline +: T_ScopedCode ( -- type ) 17 ; inline +: T_Symbol ( -- type ) 14 ; inline +: T_JSTypeMax ( -- type ) 16 ; inline +: T_MaxKey ( -- type ) 127 ; inline + + + +! todo Move to mongo vocab + +: OP_Reply ( -- const ) + 1 ; inline + +: OP_Message ( -- const ) + 1000 ; inline + +: OP_Update ( -- const ) + 2001 ; inline + +: OP_Insert ( -- const ) + 2002 ; inline + +: OP_Query ( -- const ) + 2004 ; inline + +: OP_GetMore ( -- const ) + 2005 ; inline + +: OP_Delete ( -- const ) + 2006 ; inline + +: OP_KillCursors ( -- const ) + 2007 ; inline + \ No newline at end of file diff --git a/mongodb/bson/reader/reader.factor b/mongodb/bson/reader/reader.factor new file mode 100644 index 0000000000..abbb1a2c12 --- /dev/null +++ b/mongodb/bson/reader/reader.factor @@ -0,0 +1,104 @@ +USING: io io.encodings.utf8 io.encodings.binary math match kernel sequences + splitting accessors io.streams.byte-array namespaces prettyprint + mongodb.bson.constants assocs alien.c-types alien.strings fry ; + +IN: mongodb.bson.reader + +ERROR: size-mismatch actual declared ; + + ( -- state ) + state new H{ } clone [ >>result ] [ >>scope ] bi ; + +PREDICATE: bson-eoo < integer T_EOO = ; +PREDICATE: bson-not-eoo < integer T_EOO > ; +PREDICATE: bson-double < integer T_Double = ; +PREDICATE: bson-integer < integer T_Integer = ; +PREDICATE: bson-string < integer T_String = ; +PREDICATE: bson-object < integer T_Object = ; +PREDICATE: bson-array < integer T_Array = ; +PREDICATE: bson-binary < integer T_Binary = ; +PREDICATE: bson-oid < integer T_OID = ; +PREDICATE: bson-boolean < integer T_Boolean = ; +PREDICATE: bson-date < integer T_Date = ; +PREDICATE: bson-null < integer T_NULL = ; +PREDICATE: bson-ref < integer T_DBRef = ; + +GENERIC: element-read ( type -- cont? ) + +GENERIC: element-data-read ( type -- object ) + +: get-state ( -- state ) + state get ; + +: count-bytes ( count -- ) + [ get-state ] dip '[ _ + ] change-read drop ; + +: read-int32 ( -- int32 ) + 4 [ read *int ] [ count-bytes ] bi ; + +: read-byte-raw ( -- byte-raw ) + 1 [ read ] [ count-bytes ] bi ; + +: read-byte ( -- byte ) + read-byte-raw *char ; + +: (read-cstring) ( acc -- acc ) + read-byte-raw dup + B{ 0 } = + [ append ] + [ append (read-cstring) ] if ; + +: read-cstring ( -- string ) + B{ } clone + (read-cstring) utf8 alien>string ; + + +: object-size ( -- size ) + read-int32 ; + + +: read-element-type ( -- type ) + read-byte ; + +: element-name ( -- name ) + read-cstring ; + +: read-elements ( -- ) + read-element-type + element-read + [ read-elements ] when ; + + +M: bson-eoo element-read ( type -- cont? ) + drop + f ; + +M: bson-not-eoo element-read ( type -- cont? ) + [ element-name ] dip + element-data-read + swap + get-state scope>> + set-at + t ; + + +M: bson-string element-data-read ( type -- object ) + drop + read-int32 drop + read-cstring ; + +M: bson-integer element-data-read ( type -- object ) + drop + read-int32 ; + +PRIVATE> + +: bson> ( arr -- ht ) + binary + [ dup state + [ object-size >>size read-elements ] with-variable + ] with-byte-reader ; diff --git a/mongodb/bson/writer/writer.factor b/mongodb/bson/writer/writer.factor new file mode 100644 index 0000000000..8550a720fe --- /dev/null +++ b/mongodb/bson/writer/writer.factor @@ -0,0 +1,100 @@ +! Copyright (C) 2008 Sascha Matzke. +! See http://factorcode.org/license.txt for BSD license. +USING: mongodb.bson mongodb.bson.constants accessors kernel io.streams.string io.encodings.binary + io.encodings.utf8 strings splitting math.parser + sequences math assocs classes words make fry + prettyprint hashtables mirrors bson alien.strings alien.c-types + io.streams.byte-array io ; + +IN: mongodb.bson.writer + + write ] keep ; + +: write-cstring ( string -- ) + utf8 string>alien write ; + +PRIVATE> + +#! Writes the object out to a stream in BSON format +GENERIC: bson-print ( obj -- ) + +: (>bson) ( obj -- byte-array ) + '[ _ bson-print ] binary swap with-byte-writer ; + +GENERIC: >bson ( obj -- byte-aray ) + +M: tuple >bson ( tuble -- byte-array ) + (>bson) ; + +M: hashtable >bson ( hashmap -- byte-array ) + (>bson) ; + +M: f bson-print ( f -- ) + drop 0 write ; + +M: t bson-print ( t -- ) + drop 1 write ; + +M: bson-null bson-print ( null -- ) + drop ; + +M: string bson-print ( obj -- ) + utf8 string>alien + [ length write ] keep + write ; + +M: integer bson-print ( num -- ) + write ; + +M: real bson-print ( num -- ) + >float write ; + +M: sequence bson-print ( array -- ) + '[ _ [ [ write-type ] dip number>string write-cstring bson-print ] + each-index ] + binary swap with-byte-writer + [ length 5 + bson-print ] keep + write + T_EOO write ; + + +M: tuple bson-print ( tuple -- ) + '[ _ [ write-type [ write-cstring ] dip bson-print ] assoc-each ] + binary swap with-byte-writer + [ length 5 + bson-print ] keep write + T_EOO bson-print ; + +M: hashtable bson-print ( hashtable -- ) + '[ _ [ write-type [ write-cstring ] dip bson-print ] assoc-each ] + binary swap with-byte-writer + [ length 5 + bson-print ] keep write + T_EOO bson-print ; + +M: word bson-print name>> bson-print ;