extra/bson/reader/reader.factor

   1 ! Copyright (C) 2010 Sascha Matzke.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs bson.constants calendar combinators
   4 combinators.short-circuit io io.binary kernel math locals
   5 io.encodings.utf8 io.encodings io.files sequences.extras
   6 namespaces sequences serialize strings vectors byte-arrays ;
   7
   8 FROM: io.encodings.binary => binary ;
   9 FROM: io.streams.byte-array => with-byte-reader ;
  10 FROM: typed => TYPED: ;
  11
  12 IN: bson.reader
  13
  14 SYMBOL: state
  15
  16 DEFER: stream>assoc
  17
  18 ERROR: unknown-bson-type type msg ;
  19
  20 <PRIVATE
  21
  22 DEFER: read-elements
  23
  24 : read-int32 ( -- int32 )
  25     4 read signed-le> ; inline
  26
  27 : read-longlong ( -- longlong )
  28     8 read signed-le> ; inline
  29
  30 : read-double ( -- double )
  31     8 read le> bits>double ; inline
  32
  33 : read-byte-raw ( -- byte-raw )
  34     1 read ; inline
  35
  36 : read-byte ( -- byte )
  37     read-byte-raw first ; inline
  38
  39 : read-cstring ( -- string )
  40     input-stream get utf8 <decoder>
  41     "\0" swap stream-read-until drop ; inline
  42
  43 : read-sized-string ( length -- string )
  44     read binary [ read-cstring ] with-byte-reader ; inline
  45
  46 : read-timestamp ( -- timestamp )
  47     8 read [ 4 head signed-le> ] [ 4 tail signed-le> ] bi <mongo-timestamp> ;
  48
  49 : object-result ( quot -- object )
  50     [
  51         state get clone
  52         [ clear-assoc ] [ ] [ ] tri state
  53     ] dip with-variable ; inline
  54
  55 : bson-object-data-read ( -- ? )
  56     read-int32 [ f ] [ drop read-elements t ] if-zero ; inline recursive
  57
  58 : bson-binary-read ( -- binary )
  59    read-int32 read-byte
  60    {
  61         { T_Binary_Default [ read ] }
  62         { T_Binary_Bytes_Deprecated [ drop read-int32 read ] }
  63         { T_Binary_Custom [ read bytes>object ] }
  64         { T_Binary_Function [ read-sized-string ] }
  65         { T_Binary_MD5 [ read >string ] }
  66         { T_Binary_UUID [ read >string ] }
  67         [ "unknown binary sub-type" unknown-bson-type ]
  68    } case ; inline
  69
  70 TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp )
  71    mdbregexp new
  72    read-cstring >>regexp read-cstring >>options ; inline
  73
  74 TYPED: bson-oid-read ( -- oid: oid )
  75     read-longlong read-int32 oid boa ; inline
  76
  77 : check-object ( assoc -- object )
  78     dup dbref-assoc? [ assoc>dbref ] when ; inline
  79
  80 TYPED: element-data-read ( type: integer -- object )
  81     {
  82         { T_OID         [ bson-oid-read ] }
  83         { T_String      [ read-int32 read-sized-string ] }
  84         { T_Integer     [ read-int32 ] }
  85         { T_Integer64   [ read-longlong ] }
  86         { T_Binary      [ bson-binary-read ] }
  87         { T_Object      [ [ bson-object-data-read drop ] object-result check-object ] }
  88         { T_Array       [ [ bson-object-data-read drop ] object-result values ] }
  89         { T_Double      [ read-double ] }
  90         { T_Boolean     [ read-byte 1 = ] }
  91         { T_Date        [ read-longlong millis>timestamp ] }
  92         { T_Regexp      [ bson-regexp-read ] }
  93         { T_Timestamp   [ read-timestamp ] }
  94         { T_Code        [ read-int32 read-sized-string ] }
  95         { T_ScopedCode  [ read-int32 drop read-cstring H{ } clone stream>assoc <mongo-scoped-code> ] }
  96         { T_NULL        [ f ] }
  97         [ "type unknown" unknown-bson-type ]
  98     } case ; inline recursive
  99
 100 TYPED: (read-object) ( type: integer name: string -- )
 101     [ element-data-read ] dip state get set-at ; inline recursive
 102
 103 TYPED: (element-read) ( type: integer -- cont?: boolean )
 104     dup T_EOO >
 105     [ read-cstring (read-object) t ]
 106     [ drop f ] if ; inline recursive
 107
 108 : read-elements ( -- )
 109     read-byte (element-read)
 110     [ read-elements ] when ; inline recursive
 111
 112 PRIVATE>
 113
 114 : stream>assoc ( exemplar -- assoc/f )
 115     clone [
 116         state [ bson-object-data-read ] with-variable
 117     ] keep swap [ drop f ] unless ;
 118
 119 : path>bson-sequence ( path -- assoc )
 120     binary [
 121         [ H{ } stream>assoc ] loop>array
 122     ] with-file-reader ;