Changeset 15829 in project


Ignore:
Timestamp:
09/12/09 01:27:59 (10 years ago)
Author:
sjamaan
Message:

Add some more tests

Location:
release/4/estraier-client
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/estraier-client/estraier-client.scm

    r15822 r15829  
    4141(module estraier-client
    4242  (node-info node-cache-usage node-optimize node-sync document-uri->id
    43    list-documents put-document update-document delete-document
    44    get-document document-attribute document-keywords find-documents
     43   list-documents put-document delete-document get-document
     44   update-attributes document-attribute document-keywords find-documents
    4545   delete-user register-admin register-guest
    4646
     
    130130                 method: 'POST major: 1 minor: 0
    131131                 headers: (headers '((content-type text/x-estraier-draft))))
    132    (lambda (in) (read-string #f in))
     132   discard-output
    133133   (call-with-output-string ; use string because it wants content-length
    134134     (lambda (out)
    135135       (for-each
    136136        (lambda (attrib)
    137           (fprintf out "~A=~A\r\n" (car attrib) (cdr attrib)))
     137          ;; If control commands or the @digest attribute are sent
     138          ;; back, the node will silently ignore the document...
     139          (unless (or (string-prefix? "#" (->string attrib))
     140                      (eq? attrib '@digest))
     141            (fprintf out "~A=~A\r\n" (car attrib) (cdr attrib))))
    138142        attribs)
    139143       (fprintf out "\r\n")
    140        (display contents out)))))
    141 
    142 ;; This requires the _full_ document plus all the old attribs, it simply
    143 ;; replaces the document.  This also means it requires both @uri and @id!
    144 ;; Anything not present is reset or removed.
    145 (define (update-document node contents attribs)
    146   (exec
    147    (make-request uri: (node-uri node "edit_doc")
    148                  method: 'POST major: 1 minor: 0
    149                  headers: (headers '((content-type text/x-estraier-draft))))
    150    (lambda (in) (read-string #f in))
    151    (call-with-output-string ; use string because it wants content-length
    152      (lambda (out)
    153        (for-each
    154         (lambda (attrib)
    155           (fprintf out "~A=~A\r\n" (car attrib) (cdr attrib)))
    156         attribs)
    157        (fprintf out "\r\n")
    158        (display contents out)))))
     144       ;; What if there's a newline in the text?
     145       (for-each (lambda (line) (fprintf out "~A\r\n" line)) contents)))))
    159146
    160147(define (delete-document node #!key id uri)
     
    181168          (node-uri node "get_doc" query: (id/uri->alist id uri))
    182169          (lambda (in)
    183             (let ((metadata (map split-attrib-line (read-block in)))
    184                   (document (read-string #f in)))
     170            (let ((metadata (map split-attrib-line
     171                                 ;; Remove control commands like %VECTOR for now
     172                                 (filter (lambda (line)
     173                                           (string-index line #\=))
     174                                         (read-block in))))
     175                  (document (read-lines in)))
    185176              (list document metadata))))))
     177
     178;; This requires the new attributes plus all the old attribs, it
     179;; simply replaces the document's attributes.  This also means it
     180;; requires both @uri and @id!  Anything not present is reset or
     181;; removed.
     182(define (update-attributes node attribs)
     183  (exec
     184   (make-request uri: (node-uri node "edit_doc")
     185                 method: 'POST major: 1 minor: 0
     186                 headers: (headers '((content-type text/x-estraier-draft))))
     187   discard-output
     188   (call-with-output-string ; use string because it wants content-length
     189     (lambda (out)
     190       (for-each
     191        (lambda (attrib)
     192          (fprintf out "~A=~A\r\n" (car attrib) (cdr attrib)))
     193        attribs)))))
    186194
    187195(define (document-attribute node attrib #!key id uri)
  • release/4/estraier-client/tests/run.scm

    r15822 r15829  
    11(load "../estraier-client.scm")
    22
    3 (use test posix)
     3(use test posix http-client)
    44
    55(import estraier-client)
     
    7474  (test-assert "Putting documents with URIs succeed"
    7575               (begin
    76                  (put-document node-uri "Just a test for estraier"
    77                                '((@uri . "/test1")))
    78                  (put-document node-uri "Another test for estraier"
    79                                '((@uri . "/test2")))
     76                 (put-document node-uri '("Just a test for estraier")
     77                               '((@uri . "/test1") (my-tag . "something")))
     78                 (put-document node-uri '("Another test for estraier")
     79                               '((@uri . "/test2") (my-tag . "whatever")))
    8080                 #t))
    8181  ;; If we don't sync, the newly added docs don't (always?) show up...
     
    9999        (map (lambda (l) (alist-ref '@uri l))
    100100             (list-documents node-uri max: 1)))
     101  (test "Document keywords are correct"
     102        '("a" "estraier" "for" "just" "test")
     103        (sort (map car (document-keywords node-uri uri: "/test1")) string<?))
     104
     105  (receive (doc meta)
     106    (get-document node-uri uri: "/test1")
     107    (test "Get-document returns document"
     108          '("Just a test for estraier")
     109          (values doc))
     110    (test "Get-document returns attributes"
     111          '("/test1" "something")
     112          (list (alist-ref '@uri meta) (alist-ref 'my-tag meta)))
     113    (test-assert "Updating gives no error"
     114                 (begin
     115                   (update-attributes
     116                    node-uri (alist-update! 'my-tag "or other" meta))
     117                   #t))
     118    (receive (doc meta)
     119      (get-document node-uri uri: "/test1")
     120      (test "Get-document returns updated attributes"
     121            "or other"
     122            (alist-ref 'my-tag meta))
     123      ;; XXX For some reason I can't seem to be able to update an existing
     124      ;; document...
     125      (test-assert "Putting a modified doc gives no error"
     126                   (begin
     127                     (put-document node-uri
     128                                   '("Simply a test for estraier")
     129                                   meta)
     130                     (node-sync node-uri)
     131                    #t))
     132      (receive (doc meta)
     133        (get-document node-uri uri: "/test1")
     134        (test "Updated document is accepted"
     135              '("Simply a test for estraier")
     136              (values doc)))))
     137
     138  (test "Document-attribute returns correct attributes"
     139        "or other"
     140        (document-attribute node-uri 'my-tag uri: "/test1"))
    101141
    102142  (receive (results meta-data)
     
    113153          (document-uri->id node-uri "/test1")))
    114154
     155  (test "Deleted documents are not listed"
     156        '("/test1")
     157        (begin
     158          (delete-document node-uri uri: "/test2")
     159          (map (lambda (l) (alist-ref '@uri l)) (list-documents node-uri))))
     160 
    115161  (test "Clearing node results in empty document list"
    116162        '()
     
    118164               (list-documents node-uri))))
    119165
     166;; TODO: Test search options (especially attributes)
     167
    120168(test-group "cleanup"
    121169 (test-assert "Clean shutdown" (begin (master-shutdown master-uri) #t))
Note: See TracChangeset for help on using the changeset viewer.