Sascha Matzke
parent
0378dda9b1
commit
b57cdefde0
|
|
@ -1,17 +0,0 @@
|
|||
! Copyright (C) 2009 Your name.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs help.markup help.syntax kernel ;
|
||||
IN: bson.reader
|
||||
|
||||
HELP: stream>assoc
|
||||
{ $values
|
||||
{ "exemplar" null }
|
||||
{ "assoc" assoc } { "bytes-read" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
ARTICLE: "bson.reader" "bson.reader"
|
||||
{ $vocab-link "bson.reader" }
|
||||
;
|
||||
|
||||
ABOUT: "bson.reader"
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
! Copyright (C) 2009 Your name.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs help.markup help.syntax kernel ;
|
||||
IN: bson.writer
|
||||
|
||||
HELP: assoc>bv
|
||||
{ $values
|
||||
{ "assoc" assoc }
|
||||
{ "byte-array" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: assoc>stream
|
||||
{ $values
|
||||
{ "assoc" assoc }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
ARTICLE: "bson.writer" "bson.writer"
|
||||
{ $vocab-link "bson.writer" }
|
||||
;
|
||||
|
||||
ABOUT: "bson.writer"
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008 Sascha Matzke.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs bson.constants byte-arrays byte-vectors
|
||||
calendar fry io io.binary io.encodings io.encodings.string
|
||||
calendar fry io io.binary io.encodings io.encodings.string io.encodings.private
|
||||
io.encodings.utf8 kernel math math.parser namespaces quotations
|
||||
sequences serialize strings tools.walker words ;
|
||||
sequences sequences.private serialize strings tools.walker words ;
|
||||
|
||||
|
||||
IN: bson.writer
|
||||
|
|
@ -20,18 +20,18 @@ CONSTANT: INT64-SIZE 8
|
|||
|
||||
: (buffer) ( -- buffer )
|
||||
shared-buffer get
|
||||
[ 4096 <byte-vector> [ shared-buffer set ] keep ] unless* ; inline
|
||||
[ 8192 <byte-vector> [ shared-buffer set ] keep ] unless* ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: reset-buffer ( buffer -- )
|
||||
0 >>length drop ; inline
|
||||
|
||||
: ensure-buffer ( -- )
|
||||
(buffer) drop ; inline
|
||||
|
||||
: reset-buffer ( -- )
|
||||
(buffer) 0 >>length drop ; inline
|
||||
|
||||
: with-buffer ( quot -- byte-vector )
|
||||
[ (buffer) ] dip [ output-stream get ] compose
|
||||
[ (buffer) [ reset-buffer ] keep dup ] dip
|
||||
with-output-stream* dup encoder? [ stream>> ] when ; inline
|
||||
|
||||
: with-length ( quot: ( -- ) -- bytes-written start-index )
|
||||
|
|
@ -41,7 +41,13 @@ PRIVATE>
|
|||
: with-length-prefix ( quot: ( -- ) -- )
|
||||
[ B{ 0 0 0 0 } write ] prepose with-length
|
||||
[ INT32-SIZE >le ] dip (buffer)
|
||||
'[ _ over [ nth ] dip _ + _ set-nth ]
|
||||
'[ _ over [ nth-unsafe ] dip _ + _ set-nth-unsafe ]
|
||||
[ INT32-SIZE ] dip each-integer ; inline
|
||||
|
||||
: with-length-prefix-excl ( quot: ( -- ) -- )
|
||||
[ B{ 0 0 0 0 } write ] prepose with-length
|
||||
[ INT32-SIZE - INT32-SIZE >le ] dip (buffer)
|
||||
'[ _ over [ nth-unsafe ] dip _ + _ set-nth-unsafe ]
|
||||
[ INT32-SIZE ] dip each-integer ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
|
@ -68,10 +74,11 @@ 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 ;
|
||||
|
||||
: write-utf8-string ( string -- ) output-stream get utf8 encoder-write ; inline
|
||||
: write-byte ( byte -- ) CHAR-SIZE >le write ; inline
|
||||
: write-int32 ( int -- ) INT32-SIZE >le write ; inline
|
||||
: write-double ( real -- ) double>bits INT64-SIZE >le write ; inline
|
||||
: write-cstring ( string -- ) utf8 encode B{ 0 } append write ; inline
|
||||
: write-cstring ( string -- ) write-utf8-string B{ 0 } write ; inline
|
||||
: write-longlong ( object -- ) INT64-SIZE >le write ; inline
|
||||
|
||||
: write-eoo ( -- ) T_EOO write-byte ; inline
|
||||
|
|
@ -85,9 +92,7 @@ M: t bson-write ( t -- )
|
|||
drop 1 write-byte ;
|
||||
|
||||
M: string bson-write ( obj -- )
|
||||
utf8 encode B{ 0 } append
|
||||
[ length write-int32 ] keep
|
||||
write ;
|
||||
'[ _ write-cstring ] with-length-prefix-excl ;
|
||||
|
||||
M: integer bson-write ( num -- )
|
||||
write-int32 ;
|
||||
|
|
@ -112,22 +117,18 @@ M: oid bson-write ( oid -- )
|
|||
[ a>> write-longlong ] [ b>> write-int32 ] bi ;
|
||||
|
||||
M: objid bson-write ( oid -- )
|
||||
id>> utf8 encode
|
||||
[ length write-int32 ] keep
|
||||
T_Binary_UUID write-byte
|
||||
write ;
|
||||
id>> '[ _ write-utf8-string ] with-length-prefix ;
|
||||
|
||||
M: objref bson-write ( objref -- )
|
||||
[ ns>> utf8 encode ]
|
||||
[ objid>> id>> utf8 encode ] bi
|
||||
append
|
||||
[ length write-int32 ] keep
|
||||
T_Binary_Custom write-byte
|
||||
write ;
|
||||
'[ _
|
||||
[ ns>> write-cstring ]
|
||||
[ objid>> id>> write-cstring ] bi ] with-length-prefix ;
|
||||
|
||||
M: mdbregexp bson-write ( regexp -- )
|
||||
[ regexp>> utf8 encode write-cstring ]
|
||||
[ options>> utf8 encode write-cstring ] bi ;
|
||||
[ regexp>> write-cstring ]
|
||||
[ options>> write-cstring ] bi ;
|
||||
|
||||
M: sequence bson-write ( array -- )
|
||||
'[ _ [ [ write-type ] dip number>string
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: calendar math fry kernel assocs math.ranges
|
||||
sequences formatting combinators namespaces io tools.time prettyprint
|
||||
accessors words mongodb.driver strings math.parser ;
|
||||
accessors words mongodb.driver strings math.parser tools.walker bson.writer ;
|
||||
|
||||
IN: mongodb.benchmark
|
||||
|
||||
|
|
@ -254,24 +254,23 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
|
|||
|
||||
: run-benchmarks ( -- )
|
||||
"db" "db" get* "host" "127.0.0.1" get* "port" 27020 get* ensure-number <mdb>
|
||||
[
|
||||
[ ensure-buffer
|
||||
print-header
|
||||
! insert
|
||||
{ small-doc-prepare medium-doc-prepare large-doc-prepare }
|
||||
! { small-doc-prepare medium-doc-prepare
|
||||
{ large-doc-prepare }
|
||||
{ { } { index } { errcheck } { index errcheck }
|
||||
{ batch } { batch errcheck }
|
||||
{ batch index errcheck } }
|
||||
run-insert-bench
|
||||
{ batch } { batch errcheck } { batch index errcheck }
|
||||
} run-insert-bench
|
||||
! find-one
|
||||
{ small-doc medium-doc large-doc }
|
||||
{ { } { index } } run-find-one-bench
|
||||
! { small-doc medium-doc large-doc }
|
||||
! { { } { index } } run-find-one-bench
|
||||
! find-all
|
||||
{ small-doc medium-doc large-doc }
|
||||
{ { } { index } } run-find-all-bench
|
||||
! { small-doc medium-doc large-doc }
|
||||
! { { } { index } } run-find-all-bench
|
||||
! find-range
|
||||
{ small-doc medium-doc large-doc }
|
||||
{ { } { index } } run-find-range-bench
|
||||
|
||||
! { small-doc medium-doc large-doc }
|
||||
! { { } { index } } run-find-range-bench
|
||||
] with-db ;
|
||||
|
||||
MAIN: run-benchmarks
|
||||
|
|
|
|||
|
|
@ -5,297 +5,315 @@ IN: mongodb.driver
|
|||
|
||||
HELP: <mdb-collection>
|
||||
{ $values
|
||||
{ "name" null }
|
||||
{ "collection" null }
|
||||
{ "name" "name of the collection" }
|
||||
{ "collection" "mdb-collection instance" }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: <mdb-cursor>
|
||||
{ $values
|
||||
{ "id" null } { "collection" null } { "return#" null }
|
||||
{ "cursor" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $description "Creates a new mdb-collection instance. Use this to create capped/limited collections. See also: " { $link mdb-collection } }
|
||||
{ $examples
|
||||
{ $example "\"mycollection\" <mdb-collection> t >>capped" } } ;
|
||||
|
||||
HELP: <mdb>
|
||||
{ $values
|
||||
{ "db" null } { "host" null } { "port" null }
|
||||
{ "mdb" null }
|
||||
{ "db" "name of the database to use" }
|
||||
{ "host" "host name or IP address" }
|
||||
{ "port" "port number" }
|
||||
{ "mdb" "mdb-db instance" }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $description "Create a new mdb-db instance and automatically resolves master/slave information in a paired MongoDB setup." }
|
||||
{ $examples
|
||||
{ $example "\"db\" \"127.0.0.1\" 27017 <mdb>" } } ;
|
||||
|
||||
HELP: <query>
|
||||
{ $values
|
||||
{ "collection" "the collection to be queried" } { "query" "query" }
|
||||
{ "mdb-query" "mdb-query-msg tuple instance" }
|
||||
{ "collection" "collection to query" }
|
||||
{ "query" "query assoc" }
|
||||
{ "mdb-query" "mdb-query-msg instance" }
|
||||
}
|
||||
{ $description "create a new query instance" } ;
|
||||
{ $description "Creates a new mdb-query-msg instance. "
|
||||
"This word must be called from within a with-db scope."
|
||||
"For more see: "
|
||||
{ $link with-db } }
|
||||
{ $examples
|
||||
{ $example "\"mycollection\" H{ } <query>" } } ;
|
||||
|
||||
HELP: <update>
|
||||
{ $values
|
||||
{ "collection" "collection to update" }
|
||||
{ "selector" "selector assoc (selects which object(s) to update" }
|
||||
{ "object" "updated object or update instruction" }
|
||||
{ "update-msg" "mdb-update-msg instance" }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: >upsert
|
||||
{ $values
|
||||
{ "mdb-update-msg" null }
|
||||
{ "mdb-update-msg" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: DIRTY?
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: MDB-GENERAL-ERROR
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: PARTIAL?
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: asc
|
||||
{ $values
|
||||
{ "key" null }
|
||||
{ "spec" null }
|
||||
{ "key" null }
|
||||
{ "spec" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: boolean
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $var-description "" } ;
|
||||
|
||||
HELP: count
|
||||
{ $values
|
||||
{ "collection" null } { "query" null }
|
||||
{ "result" null }
|
||||
{ "collection" null }
|
||||
{ "query" null }
|
||||
{ "result" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: create-collection
|
||||
{ $values
|
||||
{ "name" null }
|
||||
{ "name" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: delete
|
||||
{ $values
|
||||
{ "collection" null } { "selector" null }
|
||||
{ "collection" null }
|
||||
{ "selector" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: delete-unsafe
|
||||
{ $values
|
||||
{ "collection" null } { "selector" null }
|
||||
{ "collection" null }
|
||||
{ "selector" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: desc
|
||||
{ $values
|
||||
{ "key" null }
|
||||
{ "spec" null }
|
||||
{ "key" null }
|
||||
{ "spec" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: drop-collection
|
||||
{ $values
|
||||
{ "name" null }
|
||||
{ "name" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: drop-index
|
||||
{ $values
|
||||
{ "collection" null } { "name" null }
|
||||
{ "collection" null }
|
||||
{ "name" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: ensure-collection
|
||||
{ $values
|
||||
{ "collection" null }
|
||||
{ "fq-collection" null }
|
||||
{ "collection" null }
|
||||
{ "fq-collection" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: ensure-index
|
||||
{ $values
|
||||
{ "collection" null } { "name" null } { "spec" null }
|
||||
{ "collection" null }
|
||||
{ "name" null }
|
||||
{ "spec" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: explain
|
||||
HELP: explain.
|
||||
{ $values
|
||||
{ "mdb-query" null }
|
||||
{ "result" null }
|
||||
{ "mdb-query" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: find
|
||||
{ $values
|
||||
{ "mdb-query" null }
|
||||
{ "cursor" null } { "result" null }
|
||||
{ "mdb-query" null }
|
||||
{ "cursor" null }
|
||||
{ "result" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: find-one
|
||||
{ $values
|
||||
{ "mdb-query" null }
|
||||
{ "result" null }
|
||||
{ "mdb-query" null }
|
||||
{ "result" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: get-more
|
||||
{ $values
|
||||
{ "mdb-cursor" null }
|
||||
{ "mdb-cursor" null } { "objects" null }
|
||||
{ "mdb-cursor" null }
|
||||
{ "mdb-cursor" null }
|
||||
{ "objects" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: hint
|
||||
{ $values
|
||||
{ "mdb-query" null } { "index-hint" null }
|
||||
{ "mdb-query" null }
|
||||
{ "mdb-query" null }
|
||||
{ "index-hint" null }
|
||||
{ "mdb-query" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: lasterror
|
||||
{ $values
|
||||
|
||||
{ "error" null }
|
||||
{ "error" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: limit
|
||||
{ $values
|
||||
{ "mdb-query" null } { "limit#" null }
|
||||
{ "mdb-query" null }
|
||||
{ "mdb-query" null }
|
||||
{ "limit#" null }
|
||||
{ "mdb-query" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: load-collection-list
|
||||
{ $values
|
||||
|
||||
{ "collection-list" null }
|
||||
{ "collection-list" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: load-index-list
|
||||
{ $values
|
||||
|
||||
{ "index-list" null }
|
||||
{ "index-list" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: master>>
|
||||
{ $values
|
||||
{ "mdb" null }
|
||||
{ "inet" null }
|
||||
{ "mdb" null }
|
||||
{ "inet" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: mdb
|
||||
{ $values
|
||||
|
||||
{ "mdb" null }
|
||||
{ "mdb" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: mdb-collection
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $var-description "" } ;
|
||||
|
||||
HELP: mdb-cursor
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $var-description "" } ;
|
||||
|
||||
HELP: mdb-db
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $var-description "" } ;
|
||||
|
||||
HELP: mdb-error
|
||||
{ $values
|
||||
{ "id" null } { "msg" null }
|
||||
{ "id" null }
|
||||
{ "msg" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: mdb-instance
|
||||
{ $values
|
||||
|
||||
{ "value" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
{ $var-description "" } ;
|
||||
|
||||
HELP: mdb-node
|
||||
{ $values
|
||||
{ $var-description "" } ;
|
||||
|
||||
{ "value" null }
|
||||
HELP: r/
|
||||
{ $values
|
||||
{ "token" null }
|
||||
{ "mdbregexp" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: save
|
||||
{ $values
|
||||
{ "collection" null } { "assoc" assoc }
|
||||
{ "collection" null }
|
||||
{ "assoc" assoc }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: save-unsafe
|
||||
{ $values
|
||||
{ "collection" null } { "object" object }
|
||||
{ "collection" null }
|
||||
{ "object" object }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: skip
|
||||
{ $values
|
||||
{ "mdb-query" null } { "skip#" null }
|
||||
{ "mdb-query" null }
|
||||
{ "mdb-query" null }
|
||||
{ "skip#" null }
|
||||
{ "mdb-query" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: slave>>
|
||||
{ $values
|
||||
{ "mdb" null }
|
||||
{ "inet" null }
|
||||
{ "mdb" null }
|
||||
{ "inet" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: sort
|
||||
{ $values
|
||||
{ "mdb-query" null } { "quot" quotation }
|
||||
{ "mdb-query" null }
|
||||
{ "mdb-query" null }
|
||||
{ "quot" quotation }
|
||||
{ "mdb-query" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: update
|
||||
{ $values
|
||||
{ "collection" null } { "selector" null } { "object" object }
|
||||
{ "mdb-update-msg" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: update-unsafe
|
||||
{ $values
|
||||
{ "collection" null } { "selector" null } { "object" object }
|
||||
{ "mdb-update-msg" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: validate
|
||||
HELP: validate.
|
||||
{ $values
|
||||
{ "collection" null }
|
||||
{ "collection" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: with-db
|
||||
{ $values
|
||||
{ "mdb" null } { "quot" quotation }
|
||||
{ "..." null }
|
||||
{ "mdb" null }
|
||||
{ "quot" quotation }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
|
|
@ -304,3 +322,4 @@ ARTICLE: "mongodb.driver" "mongodb.driver"
|
|||
;
|
||||
|
||||
ABOUT: "mongodb.driver"
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: accessors assocs bson.constants bson.writer combinators
|
|||
constructors continuations destructors formatting fry io
|
||||
io.encodings.binary io.sockets io.streams.duplex kernel linked-assocs
|
||||
math math.parser memoize mongodb.msg mongodb.operations namespaces
|
||||
parser sequences sets splitting strings uuid syntax ;
|
||||
parser prettyprint sequences sets splitting strings uuid ;
|
||||
|
||||
IN: mongodb.driver
|
||||
|
||||
|
|
@ -20,7 +20,6 @@ TUPLE: mdb-collection
|
|||
{ size integer initial: -1 }
|
||||
{ max integer initial: -1 } ;
|
||||
|
||||
CONSTRUCTOR: mdb-cursor ( id collection return# -- cursor ) ;
|
||||
CONSTRUCTOR: mdb-collection ( name -- collection ) ;
|
||||
|
||||
CONSTANT: MDB-GENERAL-ERROR 1
|
||||
|
|
@ -30,24 +29,6 @@ CONSTANT: DIRTY? "dirty?"
|
|||
|
||||
ERROR: mdb-error id msg ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: mdb-socket-stream
|
||||
|
||||
: mdb-stream>> ( -- stream )
|
||||
mdb-socket-stream get ; inline
|
||||
|
||||
: check-ok ( result -- ? )
|
||||
[ "ok" ] dip key? ; inline
|
||||
|
||||
: >mdbregexp ( value -- regexp )
|
||||
first <mdbregexp> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYNTAX: r/ ( token -- mdbregexp )
|
||||
\ / [ >mdbregexp ] parse-literal ;
|
||||
|
||||
SYMBOL: mdb-instance
|
||||
|
||||
: mdb ( -- mdb )
|
||||
|
|
@ -59,13 +40,38 @@ SYMBOL: mdb-instance
|
|||
: slave>> ( mdb -- inet )
|
||||
nodes>> [ f ] dip at inet>> ;
|
||||
|
||||
: with-db ( mdb quot: ( -- * ) -- * )
|
||||
[ [ '[ ensure-buffer _ [ mdb-instance set ] keep
|
||||
master>> [ remote-address set ] keep
|
||||
binary <client> local-address set
|
||||
mdb-socket-stream set ] ] dip compose
|
||||
[ mdb-stream>> [ dispose ] when* ]
|
||||
[ ] cleanup ] with-scope ; inline
|
||||
<PRIVATE
|
||||
|
||||
CONSTRUCTOR: mdb-cursor ( id collection return# -- cursor ) ;
|
||||
|
||||
SYMBOL: mdb-socket-stream
|
||||
|
||||
: >>mdb-stream ( stream -- )
|
||||
mdb-socket-stream set ; inline
|
||||
|
||||
: mdb-stream>> ( -- stream )
|
||||
mdb-socket-stream get ; inline
|
||||
|
||||
: check-ok ( result -- ? )
|
||||
[ "ok" ] dip key? ; inline
|
||||
|
||||
: >mdbregexp ( value -- regexp )
|
||||
first <mdbregexp> ; inline
|
||||
|
||||
: prepare-mdb-session ( mdb -- stream )
|
||||
[ mdb-instance set ] keep
|
||||
master>> [ remote-address set ] keep
|
||||
binary <client> local-address set ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYNTAX: r/ ( token -- mdbregexp )
|
||||
\ / [ >mdbregexp ] parse-literal ;
|
||||
|
||||
: with-db ( mdb quot -- ... )
|
||||
[ [ prepare-mdb-session ] dip
|
||||
[ [ >>mdb-stream ] keep ] prepose
|
||||
with-disposal ] with-scope ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -184,7 +190,7 @@ PRIVATE>
|
|||
|
||||
MEMO: ensure-collection ( collection -- fq-collection )
|
||||
"." split1 over mdb name>> =
|
||||
[ [ drop ] dip ] [ drop ] if
|
||||
[ nip ] [ drop ] if
|
||||
[ ] [ reserved-namespace? ] bi
|
||||
[ [ (ensure-collection) ] keep ] unless
|
||||
[ mdb name>> ] dip "%s.%s" sprintf ; inline
|
||||
|
|
@ -223,9 +229,9 @@ M: mdb-query-msg find
|
|||
M: mdb-cursor find
|
||||
get-more ;
|
||||
|
||||
GENERIC: explain ( mdb-query -- result )
|
||||
M: mdb-query-msg explain
|
||||
t >>explain find [ drop ] dip ;
|
||||
GENERIC: explain. ( mdb-query -- )
|
||||
M: mdb-query-msg explain.
|
||||
t >>explain find nip . ;
|
||||
|
||||
|
||||
GENERIC: find-one ( mdb-query -- result )
|
||||
|
|
@ -243,14 +249,14 @@ M: assoc count
|
|||
cmd-collection H{ { "getlasterror" 1 } } <mdb-query-msg>
|
||||
find-one objects>> first [ "err" ] dip at ;
|
||||
|
||||
GENERIC: validate ( collection -- )
|
||||
M: string validate
|
||||
GENERIC: validate. ( collection -- )
|
||||
M: string validate.
|
||||
[ cmd-collection ] dip
|
||||
"validate" H{ } clone [ set-at ] keep
|
||||
<mdb-query-msg> find-one objects>> first [ check-ok ] keep
|
||||
'[ "result" _ at print ] when ;
|
||||
M: mdb-collection validate
|
||||
name>> validate ;
|
||||
M: mdb-collection validate.
|
||||
name>> validate. ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -312,7 +318,7 @@ M: assoc delete-unsafe
|
|||
|
||||
: load-index-list ( -- index-list )
|
||||
index-collection
|
||||
H{ } clone <mdb-query-msg> find [ drop ] dip ;
|
||||
H{ } clone <mdb-query-msg> find nip ;
|
||||
|
||||
: drop-collection ( name -- )
|
||||
[ cmd-collection ] dip
|
||||
|
|
|
|||
|
|
@ -1,23 +0,0 @@
|
|||
! Copyright (C) 2009 Your name.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax kernel ;
|
||||
IN: mongodb.operations
|
||||
|
||||
HELP: read-message
|
||||
{ $values
|
||||
|
||||
{ "message" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: write-message
|
||||
{ $values
|
||||
{ "message" null }
|
||||
}
|
||||
{ $description "" } ;
|
||||
|
||||
ARTICLE: "mongodb.operations" "mongodb.operations"
|
||||
{ $vocab-link "mongodb.operations" }
|
||||
;
|
||||
|
||||
ABOUT: "mongodb.operations"
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
USING: accessors bson.reader bson.writer byte-arrays byte-vectors fry
|
||||
io io.binary io.encodings.binary io.encodings.string io.encodings.utf8
|
||||
io.streams.byte-array kernel math mongodb.msg namespaces sequences
|
||||
locals assocs combinators linked-assocs ;
|
||||
USING: accessors assocs bson.reader bson.writer byte-arrays
|
||||
byte-vectors combinators formatting fry io io.binary io.encodings.private
|
||||
io.encodings.binary io.encodings.string io.encodings.utf8 io.files
|
||||
kernel locals math mongodb.msg namespaces sequences uuid ;
|
||||
|
||||
IN: alien.c-types
|
||||
|
||||
|
|
@ -41,7 +41,7 @@ SYMBOL: msg-bytes-read
|
|||
: write-byte ( byte -- ) 1 >le write ; inline
|
||||
: write-int32 ( int -- ) 4 >le write ; inline
|
||||
: write-double ( real -- ) double>bits 8 >le write ; inline
|
||||
: write-cstring ( string -- ) utf8 encode B{ 0 } append write ; inline
|
||||
: write-cstring ( string -- ) output-stream get utf8 encoder-write 0 write-byte ; inline
|
||||
: write-longlong ( object -- ) 8 >le write ; inline
|
||||
|
||||
: read-int32 ( -- int32 ) 4 [ read le> ] [ change-bytes-read ] bi ; inline
|
||||
|
|
@ -150,9 +150,14 @@ PRIVATE>
|
|||
|
||||
USE: tools.walker
|
||||
|
||||
: dump-to-file ( array -- )
|
||||
[ uuid1 "/tmp/mfb/%s.dump" sprintf binary ] dip
|
||||
'[ _ write ] with-file-writer ;
|
||||
|
||||
: (write-message) ( message quot -- )
|
||||
'[ [ [ _ write-header ] dip _ call ] with-length-prefix ] with-buffer
|
||||
write flush reset-buffer ; inline
|
||||
! [ dump-to-file ] keep
|
||||
write flush ; inline
|
||||
|
||||
: build-query-object ( query -- selector )
|
||||
[let | selector [ H{ } clone ] |
|
||||
|
|
|
|||
Loading…
Reference in New Issue