Permalink
Browse files

added gridfs implementation, reworked mongodb commands, some minor pe…

…rformance improvements
  • Loading branch information...
1 parent be0655d commit 25ee2dbd0ee8e33dc5df9a61775f5d5343ffd631 @x6j8x x6j8x committed Jan 12, 2010
@@ -1,4 +1,4 @@
-USING: bson.reader bson.writer byte-arrays io.encodings.binary
+USING: bson.reader bson.writer bson.constants byte-arrays io.encodings.binary
io.streams.byte-array tools.test literals calendar kernel math ;
IN: bson.tests
@@ -17,6 +17,9 @@ IN: bson.tests
[ H{ { "a quotation" [ 1 2 + ] } } ]
[ H{ { "a quotation" [ 1 2 + ] } } turnaround ] unit-test
+[ H{ { "ref" T{ dbref f "a" "b" "c" } } } ]
+[ H{ { "ref" T{ dbref f "a" "b" "c" } } } turnaround ] unit-test
+
[ H{ { "a date" T{ timestamp { year 2009 }
{ month 7 }
{ day 11 }
@@ -34,10 +37,12 @@ IN: bson.tests
] unit-test
[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
+ { "ref" T{ dbref f "a" "b" "c" } }
{ "array" H{ { "a list" { 1 2.234 "hello world" } } } }
{ "quot" [ 1 2 + ] } }
]
[ H{ { "nested" H{ { "a" "a string" } { "b" H{ { "a" "a string" } } } } }
+ { "ref" T{ dbref f "a" "b" "c" } }
{ "array" H{ { "a list" { 1 2.234 "hello world" } } } }
{ "quot" [ 1 2 + ] } } turnaround ] unit-test
@@ -1,3 +1,5 @@
+! Copyright (C) 2010 Sascha Matzke.
+! See http://factorcode.org/license.txt for BSD license.
USING: vocabs.loader ;
IN: bson
@@ -1,15 +1,42 @@
-USING: accessors constructors kernel strings uuid ;
-
+! Copyright (C) 2010 Sascha Matzke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar combinators
+combinators.short-circuit constructors kernel linked-assocs
+math math.bitwise random strings uuid ;
IN: bson.constants
: <objid> ( -- objid )
uuid1 ; inline
TUPLE: oid { a initial: 0 } { b initial: 0 } ;
-TUPLE: objref ns objid ;
+: <oid> ( -- oid )
+ oid new
+ now timestamp>micros >>a
+ 8 random-bits 16 shift HEX: FF0000 mask
+ 16 random-bits HEX: FFFF mask
+ bitor >>b ;
+
+TUPLE: dbref ref id db ;
+
+CONSTRUCTOR: dbref ( ref id -- dbref ) ;
+
+: dbref>assoc ( dbref -- assoc )
+ [ <linked-hash> ] dip over
+ {
+ [ [ ref>> "$ref" ] [ set-at ] bi* ]
+ [ [ id>> "$id" ] [ set-at ] bi* ]
+ [ over db>> [
+ [ db>> "$db" ] [ set-at ] bi*
+ ] [ 2drop ] if ]
+ } 2cleave ; inline
+
+: assoc>dbref ( assoc -- dbref )
+ [ "$ref" swap at ] [ "$id" swap at ] [ "$db" swap at ] tri
+ dbref boa ; inline
-CONSTRUCTOR: objref ( ns objid -- objref ) ;
+: dbref-assoc? ( assoc -- ? )
+ { [ "$ref" swap key? ] [ "$id" swap key? ] } 1&& ; inline
TUPLE: mdbregexp { regexp string } { options string } ;
@@ -1,10 +1,10 @@
-USING: accessors assocs bson.constants calendar fry io io.binary
-io.encodings io.encodings.utf8 kernel math math.bitwise namespaces
-sequences serialize locals ;
-
-FROM: kernel.private => declare ;
-FROM: io.encodings.private => (read-until) ;
-
+! Copyright (C) 2010 Sascha Matzke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs bson.constants calendar combinators
+combinators.short-circuit fry io io.binary kernel locals math
+namespaces sequences serialize tools.continuations strings ;
+FROM: io.encodings.binary => binary ;
+FROM: io.streams.byte-array => with-byte-reader ;
IN: bson.reader
<PRIVATE
@@ -40,10 +40,6 @@ PREDICATE: bson-binary-function < integer T_Binary_Function = ;
PREDICATE: bson-binary-uuid < integer T_Binary_UUID = ;
PREDICATE: bson-binary-custom < integer T_Binary_Custom = ;
-GENERIC: element-read ( type -- cont? )
-GENERIC: element-data-read ( type -- object )
-GENERIC: element-binary-read ( length type -- object )
-
: get-state ( -- state )
state get ; inline
@@ -57,16 +53,16 @@ GENERIC: element-binary-read ( length type -- object )
8 read le> bits>double ; inline
: read-byte-raw ( -- byte-raw )
- 1 read ; inline
+ 1 read ;
: read-byte ( -- byte )
read-byte-raw first ; inline
: read-cstring ( -- string )
- "\0" read-until drop "" like ; inline
+ "\0" read-until drop >string ; inline
: read-sized-string ( length -- string )
- read 1 head-slice* "" like ; inline
+ read 1 head-slice* >string ; inline
: read-element-type ( -- type )
read-byte ; inline
@@ -80,106 +76,75 @@ GENERIC: element-binary-read ( length type -- object )
: peek-scope ( -- ht )
get-state scope>> last ; inline
-: read-elements ( -- )
- read-element-type
- element-read
- [ read-elements ] when ; inline recursive
-
-GENERIC: fix-result ( assoc type -- result )
-
-M: bson-object fix-result ( assoc type -- result )
- drop ;
-
-M: bson-array fix-result ( assoc type -- result )
- drop values ;
-
-GENERIC: end-element ( type -- )
-
-M: bson-object end-element ( type -- )
- drop ;
-
-M: bson-array end-element ( type -- )
- drop ;
-
-M: object end-element ( type -- )
- pop-element 2drop ;
-
-M:: bson-eoo element-read ( type -- cont? )
+: bson-object-data-read ( -- object )
+ read-int32 drop get-state
+ [ exemplar>> clone ] [ scope>> ] bi
+ [ push ] keep ; inline
+
+: bson-binary-read ( -- binary )
+ read-int32 read-byte
+ bson-binary-bytes? [ read ] [ read bytes>object ] if ; inline
+
+: bson-regexp-read ( -- mdbregexp )
+ mdbregexp new
+ read-cstring >>regexp read-cstring >>options ; inline
+
+: bson-oid-read ( -- oid )
+ read-longlong read-int32 oid boa ; inline
+
+: element-data-read ( type -- object )
+ {
+ { T_OID [ bson-oid-read ] }
+ { T_String [ read-int32 read-sized-string ] }
+ { T_Integer [ read-int32 ] }
+ { T_Binary [ bson-binary-read ] }
+ { T_Object [ bson-object-data-read ] }
+ { T_Array [ bson-object-data-read ] }
+ { T_Double [ read-double ] }
+ { T_Boolean [ read-byte 1 = ] }
+ { T_Date [ read-longlong millis>timestamp ] }
+ { T_Regexp [ bson-regexp-read ] }
+ { T_NULL [ f ] }
+ } case ; inline
+
+: fix-result ( assoc type -- result )
+ {
+ { [ dup T_Array = ] [ drop values ] }
+ {
+ [ dup T_Object = ]
+ [ drop dup dbref-assoc? [ assoc>dbref ] when ]
+ }
+ } cond ; inline
+
+: end-element ( type -- )
+ { [ bson-object? ] [ bson-array? ] } 1||
+ [ pop-element drop ] unless ; inline
+
+:: bson-eoo-element-read ( type -- cont? )
pop-element :> element
get-state scope>>
[ pop element type>> fix-result ] [ empty? ] bi
[ [ get-state ] dip >>result drop f ]
- [ element name>> peek-scope set-at t ] if ;
+ [ element name>> peek-scope set-at t ] if ; inline
-M:: bson-not-eoo element-read ( type -- cont? )
+:: bson-not-eoo-element-read ( type -- cont? )
peek-scope :> scope
type read-cstring [ push-element ] 2keep
[ [ element-data-read ] [ end-element ] bi ]
- [ scope set-at t ] bi* ;
-
-: [scope-changer] ( state -- state quot )
- dup exemplar>> '[ [ [ _ clone ] dip push ] keep ] ; inline
-
-: (object-data-read) ( type -- object )
- drop
- read-int32 drop
- get-state
- [scope-changer] change-scope
- scope>> last ; inline
-
-M: bson-object element-data-read ( type -- object )
- (object-data-read) ;
-
-M: bson-string element-data-read ( type -- object )
- drop
- read-int32 read-sized-string ;
-
-M: bson-array element-data-read ( type -- object )
- (object-data-read) ;
-
-M: bson-integer element-data-read ( type -- object )
- drop
- read-int32 ;
-
-M: bson-double element-data-read ( type -- double )
- drop
- read-double ;
-
-M: bson-boolean element-data-read ( type -- boolean )
- drop
- read-byte 1 = ;
-
-M: bson-date element-data-read ( type -- timestamp )
- drop
- read-longlong millis>timestamp ;
-
-M: bson-binary element-data-read ( type -- binary )
- drop
- read-int32 read-byte element-binary-read ;
-
-M: bson-regexp element-data-read ( type -- mdbregexp )
- drop mdbregexp new
- read-cstring >>regexp read-cstring >>options ;
-
-M: bson-null element-data-read ( type -- bf )
- drop f ;
-
-M: bson-oid element-data-read ( type -- oid )
- drop
- read-longlong
- read-int32 oid boa ;
-
-M: bson-binary-bytes element-binary-read ( size type -- bytes )
- drop read ;
-
-M: bson-binary-custom element-binary-read ( size type -- quot )
- drop read bytes>object ;
+ [ scope set-at t ] bi* ; inline
-PRIVATE>
+: (element-read) ( type -- cont? )
+ dup bson-not-eoo?
+ [ bson-not-eoo-element-read ]
+ [ bson-eoo-element-read ] if ; inline
-USE: tools.continuations
+: read-elements ( -- )
+ read-element-type
+ (element-read) [ read-elements ] when ; inline recursive
+
+PRIVATE>
: stream>assoc ( exemplar -- assoc )
<state> dup state
- [ read-int32 >>size read-elements ] with-variable
- result>> ;
+ [ read-int32 >>size read-elements ] with-variable
+ result>> ; inline
@@ -1 +1 @@
-BSON reader and writer
+BSON (http://en.wikipedia.org/wiki/BSON) reader and writer
Oops, something went wrong.

0 comments on commit 25ee2db

Please sign in to comment.