Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

mongo-groupヘルパーを追加

  • Loading branch information...
commit ec460cbc462603376bafc745d97cd3e62a38f766 1 parent 3f984ee
@ayatoy authored
Showing with 70 additions and 17 deletions.
  1. +18 −0 mongo/core.scm
  2. +24 −11 mongo/node.scm
  3. +12 −0 test/core.scm
  4. +16 −6 test/node.scm
View
18 mongo/core.scm
@@ -69,6 +69,7 @@
mongo-reindex
mongo-count
mongo-distinct
+ mongo-group
mongo-map-reduce
mongo-dbref?
mongo-dbref
@@ -602,6 +603,23 @@
:query query)
"values")))
+(define (mongo-group col key reduce initial :key keyf
+ cond
+ finalize)
+ (let* ([db (mongo-collection-database col)]
+ [m (mongo-database-server db)])
+ (mongo-available! m)
+ (assoc-ref (mongo-node-group (mongo-ref m :slave #f)
+ (mongo-database-name db)
+ (mongo-collection-name col)
+ key
+ reduce
+ initial
+ :keyf keyf
+ :cond cond
+ :finalize finalize)
+ "retval")))
+
(define (mongo-map-reduce col map reduce :key query
sort
limit
View
35 mongo/node.scm
@@ -58,9 +58,10 @@
mongo-node-auth
mongo-node-auth-by-table
mongo-node-reauth
+ mongo-node-dbref-get
mongo-node-count
mongo-node-distinct
- mongo-node-dbref-get
+ mongo-node-group
mongo-node-map-reduce
<mongo-cursor>
mongo-cursor?
@@ -465,6 +466,15 @@
:delete #t
:ignore #f))
+;;;; dbref
+
+(define (mongo-node-dbref-get node dn ref :key (slave-ok #f))
+ (mongo-node-find1 node
+ (or (assoc-ref ref "$db") dn)
+ (assoc-ref ref "$ref")
+ `(("_id" . ,(assoc-ref ref "$id")))
+ :slave-ok slave-ok))
+
;;;; aggregation
(define (mongo-node-count node dn cn :key query fields limit skip)
@@ -483,16 +493,19 @@
("key" . ,key)
,@(bson-document-part "query" query))))
-;;;; dbref
-
-(define (mongo-node-dbref-get node dn ref :key (slave-ok #f))
- (mongo-node-find1 node
- (or (assoc-ref ref "$db") dn)
- (assoc-ref ref "$ref")
- `(("_id" . ,(assoc-ref ref "$id")))
- :slave-ok slave-ok))
-
-;;;; map-reduce
+(define (mongo-node-group node dn cn key reduce initial :key keyf
+ cond
+ finalize)
+ (mongo-node-command
+ node
+ dn
+ `(("group" . (("ns" . ,cn)
+ ("key" . ,key)
+ ("$reduce" . ,reduce)
+ ("initial" . ,initial)
+ ,@(bson-document-part "keyf" keyf)
+ ,@(bson-document-part "cond" cond)
+ ,@(bson-document-part "finalize" finalize))))))
(define (mongo-node-map-reduce node dn cn map reduce :key query
sort
View
12 test/core.scm
@@ -238,6 +238,12 @@
(test* "mongo-distinct" #t
(vector? (mongo-distinct *single-col* "x")))
+(test* "mongo-group" #t
+ (vector? (mongo-group *single-col*
+ '()
+ (bson-code "function(doc,acc){acc.cnt++;}")
+ '(("cnt" . 0)))))
+
(test* "mongo-map-reduce" #t
(ok? (mongo-map-reduce *single-col*
(bson-code "function() { emit(this.i, 1); }")
@@ -451,6 +457,12 @@
(test* "mongo-distinct" #t
(vector? (mongo-distinct *rs-col* "x")))
+(test* "mongo-group" #t
+ (vector? (mongo-group *rs-col*
+ '()
+ (bson-code "function(doc,acc){acc.cnt++;}")
+ '(("cnt" . 0)))))
+
(test* "mongo-map-reduce" #t
(ok? (mongo-map-reduce *rs-col*
(bson-code "function() { emit(this.i, 1); }")
View
22 test/node.scm
@@ -429,6 +429,13 @@
(test* "mongo-node-remove-user" #t
(ok? (mongo-node-remove-user *node* *dn* *user* :safe #t)))
+(test* "mongo-node-dbref-get" #t
+ (let* ([oid (bson-object-id)]
+ [ref (% "$ref" *cn* "$id" oid "$db" *dn*)]
+ [doc (% "_id" oid "foo" "bar")])
+ (and (ok? (mongo-node-insert *node* *dn* *cn* (list doc):safe #t :w 1))
+ (equal? doc (mongo-node-dbref-get *node* "foo" ref)))))
+
(test* "mongo-node-count" #t
(let1 doc (mongo-node-count *node* *dn* *cn*)
(and (mongo-ok? doc)
@@ -439,12 +446,15 @@
(and (ok? doc)
(vector? (alref doc "values")))))
-(test* "mongo-node-dbref-get" #t
- (let* ([oid (bson-object-id)]
- [ref (% "$ref" *cn* "$id" oid "$db" *dn*)]
- [doc (% "_id" oid "foo" "bar")])
- (and (ok? (mongo-node-insert *node* *dn* *cn* (list doc):safe #t :w 1))
- (equal? doc (mongo-node-dbref-get *node* "foo" ref)))))
+(test* "mongo-node-group" #t
+ (let1 doc (mongo-node-group *node* *dn* *cn*
+ '()
+ (bson-code "function(doc,acc){acc.cnt++;}")
+ '(("cnt" . 0)))
+ (and (mongo-ok? doc)
+ (vector? (assoc-ref doc "retval"))
+ (number? (assoc-ref doc "count"))
+ (number? (assoc-ref doc "keys")))))
(test* "mongo-node-map-reduce" #t
(let* ([id (test-insert 100)]
Please sign in to comment.
Something went wrong with that request. Please try again.