From ab6ba12a2f75a76d58079485cd6cd53b5b496417 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Wed, 15 Apr 2009 10:54:10 +1000 Subject: [PATCH] Working minimal couchdb. Tests will fail unless couchdb is running. --- extra/couchdb/couchdb-tests.factor | 3 ++- extra/couchdb/couchdb.factor | 21 ++++++++++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/extra/couchdb/couchdb-tests.factor b/extra/couchdb/couchdb-tests.factor index 7e38f5c2ee..d7161a14cd 100644 --- a/extra/couchdb/couchdb-tests.factor +++ b/extra/couchdb/couchdb-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: assocs couchdb kernel namespaces sequences strings tools.test ; +USING: accessors assocs couchdb kernel namespaces sequences strings tools.test ; IN: couchdb.tests ! You must have a CouchDB server (currently only the version from svn will @@ -16,6 +16,7 @@ IN: couchdb.tests [ ] [ couch get ensure-db ] unit-test [ 0 ] [ couch get db-info "doc_count" swap at ] unit-test [ ] [ couch get compact-db ] unit-test + [ t ] [ couch get server>> next-uuid string? ] unit-test [ ] [ H{ { "Subject" "I like Planktion" } { "Tags" { "plankton" "baseball" "decisions" } } diff --git a/extra/couchdb/couchdb.factor b/extra/couchdb/couchdb.factor index c586287b2e..da71acb074 100644 --- a/extra/couchdb/couchdb.factor +++ b/extra/couchdb/couchdb.factor @@ -1,6 +1,9 @@ -! Copyright (C) 2008 Alex Chapman +! Copyright (C) 2008, 2009 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs continuations debugger hashtables http http.client io json.reader json.writer kernel make math math.parser namespaces sequences strings urls urls.encoding vectors ; +USING: accessors arrays assocs continuations debugger hashtables http +http.client io io.encodings.string io.encodings.utf8 json.reader +json.writer kernel make math math.parser namespaces sequences strings +urls urls.encoding vectors ; IN: couchdb ! NOTE: This code only works with the latest couchdb (0.9.*), because old @@ -27,7 +30,7 @@ PREDICATE: file-exists-error < couchdb-error : couch-http-request ( request -- data ) [ http-request ] [ dup download-failed? [ - data>> json> throw + response>> body>> json> throw ] [ rethrow ] if @@ -46,7 +49,7 @@ PREDICATE: file-exists-error < couchdb-error couch-request ; : couch-delete ( url -- assoc ) - "DELETE" couch-request ; + couch-request ; : response-ok ( assoc -- assoc ) "ok" over delete-at* and t assert= ; @@ -79,11 +82,11 @@ TUPLE: server { host string } { port integer } { uuids vector } { uuids-to-cache : uuids-url ( server -- url ) [ dup server-url % "_uuids?count=" % uuids-to-cache>> number>string % ] "" make ; -: uuids-post ( server -- uuids ) - uuids-url f swap couch-post "uuids" swap at >vector ; +: uuids-get ( server -- uuids ) + uuids-url couch-get "uuids" swap at >vector ; : get-uuids ( server -- server ) - dup uuids-post [ nip ] curry change-uuids ; + dup uuids-get [ nip ] curry change-uuids ; : ensure-uuids ( server -- server ) dup uuids>> empty? [ get-uuids ] when ; @@ -123,7 +126,7 @@ C: db db-url "_all_docs" append couch-get ; : ( assoc -- post-data ) - >json "application/json" swap >>data ; + >json utf8 encode "application/json" swap >>data ; ! documents : id> ( assoc -- id ) "_id" swap at ; @@ -189,7 +192,7 @@ C: db ! construct-attachment H{ } clone ! TODO: -! - startkey, count, descending, etc. +! - startkey, limit, descending, etc. ! - loading specific revisions ! - views ! - attachments