extra/mongodb/msg/msg.factor

   1 USING: accessors assocs hashtables constructors kernel linked-assocs math
   2 sequences strings ;
   3
   4 IN: mongodb.msg
   5
   6 CONSTANT: OP_Reply   1
   7 CONSTANT: OP_Message 1000
   8 CONSTANT: OP_Update  2001
   9 CONSTANT: OP_Insert  2002
  10 CONSTANT: OP_Query   2004
  11 CONSTANT: OP_GetMore 2005
  12 CONSTANT: OP_Delete  2006
  13 CONSTANT: OP_KillCursors 2007
  14
  15 CONSTANT: ResultFlag_CursorNotFound  1 ! /* returned, with zero results, when getMore is called but the cursor id is not valid at the server. */
  16 CONSTANT: ResultFlag_ErrSet  2 ! /* { $err : ... } is being returned */
  17 CONSTANT: ResultFlag_ShardConfigStale 4 !  /* have to update config from the server,  usually $err is also set */
  18
  19 TUPLE: mdb-msg
  20     { opcode integer }
  21     { req-id integer initial: 0 }
  22     { resp-id integer initial: 0 }
  23     { length integer initial: 0 }
  24     { flags integer initial: 0 } ;
  25
  26 TUPLE: mdb-query-msg < mdb-msg
  27     { collection string }
  28     { skip# integer initial: 0 }
  29     { return# integer initial: 0 }
  30     { query assoc }
  31     { returnfields assoc }
  32     { orderby assoc }
  33     explain hint ;
  34
  35 TUPLE: mdb-insert-msg < mdb-msg
  36     { collection string }
  37     { objects sequence } ;
  38
  39 TUPLE: mdb-update-msg < mdb-msg
  40     { collection string }
  41     { update-flags integer initial: 0 }
  42     { selector assoc }
  43     { object assoc } ;
  44
  45 TUPLE: mdb-delete-msg < mdb-msg
  46     { collection string }
  47     { delete-flags integer initial: 0 }
  48     { selector assoc } ;
  49
  50 TUPLE: mdb-getmore-msg < mdb-msg
  51     { collection string }
  52     { return# integer initial: 0 }
  53     { cursor integer initial: 0 }
  54     { query mdb-query-msg } ;
  55
  56 TUPLE: mdb-killcursors-msg < mdb-msg
  57     { cursors# integer initial: 0 }
  58     { cursors sequence } ;
  59
  60 TUPLE: mdb-reply-msg < mdb-msg
  61     { collection string }
  62     { cursor integer initial: 0 }
  63     { start# integer initial: 0 }
  64     { requested# integer initial: 0 }
  65     { returned# integer initial: 0 }
  66     { objects sequence } ;
  67
  68
  69 CONSTRUCTOR: <mdb-getmore-msg> mdb-getmore-msg ( collection return# cursor -- mdb-getmore-msg )
  70     OP_GetMore >>opcode ; inline
  71
  72 CONSTRUCTOR: <mdb-delete-msg> mdb-delete-msg ( collection selector -- mdb-delete-msg )
  73     OP_Delete >>opcode ; inline
  74
  75 CONSTRUCTOR: <mdb-query-msg> mdb-query-msg ( collection query -- mdb-query-msg )
  76     OP_Query >>opcode ; inline
  77
  78 GENERIC: <mdb-killcursors-msg> ( object -- mdb-killcursors-msg )
  79
  80 M: sequence <mdb-killcursors-msg> ( sequences -- mdb-killcursors-msg )
  81     [ mdb-killcursors-msg new ] dip
  82     [ length >>cursors# ] keep
  83     >>cursors OP_KillCursors >>opcode ; inline
  84
  85 M: integer <mdb-killcursors-msg> ( integer -- mdb-killcursors-msg )
  86     V{ } clone [ push ] keep <mdb-killcursors-msg> ;
  87
  88 GENERIC: <mdb-insert-msg> ( collection objects -- mdb-insert-msg )
  89
  90 M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
  91     [ mdb-insert-msg new ] 2dip
  92     [ >>collection ] dip
  93     >>objects OP_Insert >>opcode ;
  94
  95 M: assoc <mdb-insert-msg> ( collection assoc -- mdb-insert-msg )
  96     [ mdb-insert-msg new ] 2dip
  97     [ >>collection ] dip
  98     [ V{ } clone ] dip suffix!
  99     >>objects OP_Insert >>opcode ;
 100
 101
 102 CONSTRUCTOR: <mdb-update-msg> mdb-update-msg ( collection selector object -- mdb-update-msg )
 103     OP_Update >>opcode ; inline
 104
 105 CONSTRUCTOR: <mdb-reply-msg> mdb-reply-msg ( -- mdb-reply-msg ) ; inline