From 397dab18da62594a5e36297d068d4014ebee5d29 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Sun, 27 Dec 2009 13:29:24 +0100 Subject: [PATCH 1/5] added filter-fields word which sets the returnfields slot in the current query object --- extra/mongodb/driver/driver.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index 294672523c..e1bf4f6746 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -193,6 +193,9 @@ M: mdb-query-msg skip : sort ( mdb-query-msg sort-quot -- mdb-query-msg ) output>array [ 1array >hashtable ] map >>orderby ; inline +: filter-fields ( mdb-query-msg filterseq -- mdb-query-msg ) + [ asc ] map >hashtable >>returnfields ; inline + : key-spec ( spec-quot -- spec-assoc ) output>array >hashtable ; inline From 887126fbf8c085698094c15a45db60def18006d9 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Wed, 25 Nov 2009 09:37:50 +0100 Subject: [PATCH 2/5] fixed result calculation; added ops/s value --- extra/mongodb/benchmark/benchmark.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/mongodb/benchmark/benchmark.factor b/extra/mongodb/benchmark/benchmark.factor index ad8c501605..399b5c4e8c 100644 --- a/extra/mongodb/benchmark/benchmark.factor +++ b/extra/mongodb/benchmark/benchmark.factor @@ -224,15 +224,15 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" } [ index>> bchar ] keep lasterror>> bchar trial-size ] dip - 1000000 / /i - "%-18s: {batch:%s,index:%s;errchk:%s} %10s docs/s" + 1000000000 / [ /i ] [ result get batch>> [ [ batch-size /i ] dip ] when /i ] 2bi + "%-18s: {batch:%s,index:%s;errchk:%s} %10s docs/s %10s ops/s" sprintf print flush ; : print-separator ( -- ) - "----------------------------------------------------------------" print flush ; inline + "---------------------------------------------------------------------------------" print flush ; inline : print-separator-bold ( -- ) - "================================================================" print flush ; inline + "=================================================================================" print flush ; inline : print-header ( -- ) trial-size From fccaee0fd4ff83d141ede89ca237499304f48eff Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Wed, 6 Jan 2010 15:56:38 +0100 Subject: [PATCH 3/5] removed generic words; added kill-cursor + filter-fields words --- extra/mongodb/driver/driver.factor | 50 ++++++++-------------- extra/mongodb/msg/msg.factor | 2 +- extra/mongodb/operations/operations.factor | 2 +- 3 files changed, 19 insertions(+), 35 deletions(-) diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index e1bf4f6746..78d0b62734 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -165,9 +165,7 @@ M: mdb-collection create-collection : fix-query-collection ( mdb-query -- mdb-query ) [ check-collection ] change-collection ; inline -GENERIC: get-more ( mdb-cursor -- mdb-cursor seq ) - -M: mdb-cursor get-more +: get-more ( mdb-cursor -- mdb-cursor seq ) [ [ query>> dup [ collection>> ] [ return#>> ] bi ] [ id>> ] bi swap >>query send-query ] [ f f ] if* ; @@ -177,21 +175,17 @@ PRIVATE> : ( collection assoc -- mdb-query-msg ) ; inline -GENERIC# limit 1 ( mdb-query-msg limit# -- mdb-query-msg ) - -M: mdb-query-msg limit +: limit ( mdb-query-msg limit# -- mdb-query-msg ) >>return# ; inline -GENERIC# skip 1 ( mdb-query-msg skip# -- mdb-query-msg ) - -M: mdb-query-msg skip +: skip ( mdb-query-msg skip# -- mdb-query-msg ) >>skip# ; inline : asc ( key -- spec ) 1 2array ; inline : desc ( key -- spec ) -1 2array ; inline : sort ( mdb-query-msg sort-quot -- mdb-query-msg ) - output>array [ 1array >hashtable ] map >>orderby ; inline + output>array >hashtable >>orderby ; inline : filter-fields ( mdb-query-msg filterseq -- mdb-query-msg ) [ asc ] map >hashtable >>returnfields ; inline @@ -212,21 +206,15 @@ M: mdb-query-msg find M: mdb-cursor find get-more ; -GENERIC: explain. ( mdb-query-msg -- ) - -M: mdb-query-msg explain. +: explain. ( mdb-query-msg -- ) t >>explain find nip . ; -GENERIC: find-one ( mdb-query-msg -- result/f ) - -M: mdb-query-msg find-one +: find-one ( mdb-query-msg -- result/f ) fix-query-collection 1 >>return# send-query-plain objects>> dup empty? [ drop f ] [ first ] if ; -GENERIC: count ( mdb-query-msg -- result ) - -M: mdb-query-msg count +: count ( mdb-query-msg -- result ) [ collection>> "count" H{ } clone [ set-at ] keep ] keep query>> [ over [ "query" ] dip set-at ] when* [ cmd-collection ] dip find-one @@ -254,18 +242,15 @@ M: mdb-collection validate. PRIVATE> -GENERIC: save ( collection assoc -- ) -M: assoc save +: save ( collection assoc -- ) [ check-collection ] dip send-message-check-error ; -GENERIC: save-unsafe ( collection assoc -- ) -M: assoc save-unsafe +: save-unsafe ( collection assoc -- ) [ check-collection ] dip send-message ; -GENERIC: ensure-index ( index-spec -- ) -M: index-spec ensure-index +: ensure-index ( index-spec -- ) [ [ uuid1 "_id" ] dip set-at ] keep [ { [ [ name>> "name" ] dip set-at ] [ [ ns>> index-ns "ns" ] dip set-at ] @@ -288,24 +273,23 @@ M: index-spec ensure-index : >upsert ( mdb-update-msg -- mdb-update-msg ) 1 >>upsert? ; -GENERIC: update ( mdb-update-msg -- ) -M: mdb-update-msg update +: update ( mdb-update-msg -- ) send-message-check-error ; -GENERIC: update-unsafe ( mdb-update-msg -- ) -M: mdb-update-msg update-unsafe +: update-unsafe ( mdb-update-msg -- ) send-message ; -GENERIC: delete ( collection selector -- ) -M: assoc delete +: delete ( collection selector -- ) [ check-collection ] dip send-message-check-error ; -GENERIC: delete-unsafe ( collection selector -- ) -M: assoc delete-unsafe +: delete-unsafe ( collection selector -- ) [ check-collection ] dip send-message ; +: kill-cursor ( mdb-cursor -- ) + id>> send-message ; + : load-index-list ( -- index-list ) index-collection H{ } clone find nip ; diff --git a/extra/mongodb/msg/msg.factor b/extra/mongodb/msg/msg.factor index c486346795..ada0ab42d0 100644 --- a/extra/mongodb/msg/msg.factor +++ b/extra/mongodb/msg/msg.factor @@ -29,7 +29,7 @@ TUPLE: mdb-query-msg < mdb-msg { return# integer initial: 0 } { query assoc } { returnfields assoc } -{ orderby sequence } +{ orderby assoc } explain hint ; TUPLE: mdb-insert-msg < mdb-msg diff --git a/extra/mongodb/operations/operations.factor b/extra/mongodb/operations/operations.factor index 7e99c52aac..108f610940 100644 --- a/extra/mongodb/operations/operations.factor +++ b/extra/mongodb/operations/operations.factor @@ -107,7 +107,7 @@ USE: tools.walker :: build-query-object ( query -- selector ) H{ } clone :> selector - query { [ orderby>> [ "orderby" selector set-at ] when* ] + query { [ orderby>> [ "$orderby" selector set-at ] when* ] [ explain>> [ "$explain" selector set-at ] when* ] [ hint>> [ "$hint" selector set-at ] when* ] [ query>> "query" selector set-at ] From e7b797af080ea4c1fc0b237849678dd2e74f354a Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Thu, 7 Jan 2010 08:31:32 +0100 Subject: [PATCH 4/5] added mongodb connection pool responder --- extra/furnace/mongodb/mongodb.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 extra/furnace/mongodb/mongodb.factor diff --git a/extra/furnace/mongodb/mongodb.factor b/extra/furnace/mongodb/mongodb.factor new file mode 100644 index 0000000000..a3af4191ee --- /dev/null +++ b/extra/furnace/mongodb/mongodb.factor @@ -0,0 +1,12 @@ +USING: accessors http.server http.server.filters io.pools kernel +mongodb.driver mongodb.connection namespaces unix destructors continuations ; + +IN: furnace.mongodb + +TUPLE: mdb-persistence < filter-responder pool ; + +: ( responder mdb -- responder' ) + mdb-persistence boa ; + +M: mdb-persistence call-responder* + dup pool>> [ mdb-connection set call-next-method ] with-pooled-connection ; From 640198329b9403abb4e3360c088ced2284a213ce Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Sun, 10 Jan 2010 12:04:16 +0100 Subject: [PATCH 5/5] some minor bson performance improvements --- extra/bson/reader/reader.factor | 50 +++++++++++++-------------------- extra/bson/writer/writer.factor | 12 ++++---- 2 files changed, 25 insertions(+), 37 deletions(-) diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor index e6ae0060b6..51aa5f3817 100644 --- a/extra/bson/reader/reader.factor +++ b/extra/bson/reader/reader.factor @@ -1,6 +1,6 @@ USING: accessors assocs bson.constants calendar fry io io.binary io.encodings io.encodings.utf8 kernel math math.bitwise namespaces -sequences serialize ; +sequences serialize locals ; FROM: kernel.private => declare ; FROM: io.encodings.private => (read-until) ; @@ -62,22 +62,17 @@ GENERIC: element-binary-read ( length type -- object ) : read-byte ( -- byte ) read-byte-raw first ; inline -: utf8-read-until ( seps stream encoding -- string/f sep/f ) - [ { utf8 } declare decode-char dup [ dup rot member? ] [ 2drop f t ] if ] - 3curry (read-until) ; - : read-cstring ( -- string ) - "\0" input-stream get utf8 utf8-read-until drop ; inline + "\0" read-until drop "" like ; inline : read-sized-string ( length -- string ) - drop read-cstring ; inline + read 1 head-slice* "" like ; inline : read-element-type ( -- type ) read-byte ; inline -: push-element ( type name -- element ) - element boa - [ get-state element>> push ] keep ; inline +: push-element ( type name -- ) + element boa get-state element>> push ; inline : pop-element ( -- element ) get-state element>> pop ; inline @@ -96,8 +91,7 @@ M: bson-object fix-result ( assoc type -- result ) drop ; M: bson-array fix-result ( assoc type -- result ) - drop - values ; + drop values ; GENERIC: end-element ( type -- ) @@ -108,25 +102,20 @@ M: bson-array end-element ( type -- ) drop ; M: object end-element ( type -- ) - drop - pop-element drop ; + pop-element 2drop ; -M: bson-eoo element-read ( type -- cont? ) - drop - get-state scope>> [ pop ] keep swap ! vec assoc - pop-element [ type>> ] keep ! vec assoc element - [ fix-result ] dip - rot length 0 > ! assoc element - [ name>> peek-scope set-at t ] - [ drop [ get-state ] dip >>result drop f ] if ; +M:: 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 ; -M: bson-not-eoo element-read ( type -- cont? ) - [ peek-scope ] dip ! scope type - '[ _ read-cstring push-element [ name>> ] [ type>> ] bi - [ element-data-read ] keep - end-element - swap - ] dip set-at t ; +M:: 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 @@ -173,8 +162,7 @@ M: bson-regexp element-data-read ( type -- mdbregexp ) read-cstring >>regexp read-cstring >>options ; M: bson-null element-data-read ( type -- bf ) - drop - f ; + drop f ; M: bson-oid element-data-read ( type -- oid ) drop diff --git a/extra/bson/writer/writer.factor b/extra/bson/writer/writer.factor index f9bd0eb392..a070579943 100644 --- a/extra/bson/writer/writer.factor +++ b/extra/bson/writer/writer.factor @@ -73,11 +73,9 @@ M: word bson-type? ( word -- 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 '[ _ swap char>utf8 ] each ; inline - : write-int32 ( int -- ) INT32-SIZE >le write ; inline : write-double ( real -- ) double>bits INT64-SIZE >le write ; inline -: write-cstring ( string -- ) write-utf8-string 0 write1 ; inline +: write-cstring ( string -- ) B{ } like write 0 write1 ; inline : write-longlong ( object -- ) INT64-SIZE >le write ; inline : write-eoo ( -- ) T_EOO write1 ; inline @@ -127,9 +125,11 @@ M: sequence bson-write ( array -- ) { $[ MDB_OID_FIELD MDB_META_FIELD ] } member? ; inline M: assoc bson-write ( assoc -- ) - '[ _ [ write-oid ] keep - [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each - write-eoo ] with-length-prefix ; + '[ + _ [ write-oid ] keep + [ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each + write-eoo + ] with-length-prefix ; : (serialize-code) ( code -- ) object>bytes [ length write-int32 ] keep