Changeset 15853 in project


Ignore:
Timestamp:
09/13/09 14:06:16 (10 years ago)
Author:
sjamaan
Message:

Make list-nodes return node info in an alist so it looks more like get-node-info

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

Legend:

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

    r15852 r15853  
    9898          (string-drop attrib-line (add1 idx)))))
    9999
     100(define (line->node-info line)
     101  (let ((info (string-split line "\t" #t)))
     102    `((name . ,(first info))
     103      (label . ,(second info))
     104      (document-count . ,(string->number (third info)))
     105      (word-count . ,(string->number (fourth info)))
     106      (size . ,(string->number (fifth info))))))
     107
     108;; Flatten all whitespace types to one regular whitespace.  Draft syntax
     109;; assigns special meaning to tabs/newlines but has no way to escape that.
     110(define (kill-special-whitespace str)
     111  (string-substitute '(+ whitespace) " " str))
     112
     113(define (write-attributes outport attributes)
     114  (for-each (lambda (attrib)
     115              (fprintf outport "~A=~A\r\n"
     116                       (kill-special-whitespace (->string (car attrib)))
     117                       (kill-special-whitespace (->string (cdr attrib)))))
     118            attributes))
     119
     120;; Write out a document in "draft" format to the specified output port.
     121(define (write-draft outport attributes contents)
     122  (write-attributes outport attributes)
     123  (fprintf outport "\r\n")
     124  (for-each (lambda (line)
     125              (fprintf outport "~A\r\n" (kill-special-whitespace line)))
     126            contents))
     127
     128(define (read-attributes inport)
     129  (map split-attrib-line
     130       ;; Remove control commands like %VECTOR for now
     131       (filter (lambda (line)
     132                 (string-index line #\=))
     133               (read-block inport))))
     134
     135;; Read a document in "draft" format from the specified input port.
     136(define (read-draft inport)
     137  (let* ((metadata (read-attributes inport))
     138         (document (read-lines inport)))
     139    (values document metadata)))
     140
    100141;; Helper procedure for checking that id xor uri is supplied
    101142(define (id/uri->alist loc id uri)
     
    121162   #f
    122163   (lambda (in)
    123      (let* ((db-info (string-split (car (read-block in)) "\t" #t))
     164     (let* ((node-info (line->node-info (car (read-block in))))
    124165            (admins (read-block in))
    125166            (guests (read-block in)))
     
    127168       ;; seem to get this, so let's just read out just to be sure (for now)
    128169       (discard-output in)
    129        `((name . ,(first db-info))
    130          (label . ,(second db-info))
    131          (document-count . ,(string->number (third db-info)))
    132          (word-count . ,(string->number (fourth db-info)))
    133          (size . ,(string->number (fifth db-info)))
    134          (admin-users . ,admins)
    135          (guest-users . ,guests))))))
     170       `(,@node-info (admin-users . ,admins) (guest-users . ,guests))))))
    136171
    137172(define (get-cache-usage base-uri node)
     
    156191                      (string-split line "\t" #t)))
    157192               (read-lines in)))))
    158 
    159 ;; Flatten all whitespace types to one regular whitespace.  Draft syntax
    160 ;; assigns special meaning to tabs/newlines but has no way to escape that.
    161 (define (kill-special-whitespace str)
    162   (string-substitute '(+ whitespace) " " str))
    163 
    164 (define (write-attributes outport attributes)
    165   (for-each (lambda (attrib)
    166               (fprintf outport "~A=~A\r\n"
    167                        (kill-special-whitespace (->string (car attrib)))
    168                        (kill-special-whitespace (->string (cdr attrib)))))
    169             attributes))
    170 
    171 ;; Write out a document in "draft" format to the specified output port.
    172 (define (write-draft outport attributes contents)
    173   (write-attributes outport attributes)
    174   (fprintf outport "\r\n")
    175   (for-each (lambda (line)
    176               (fprintf outport "~A\r\n" (kill-special-whitespace line)))
    177             contents))
    178 
    179 (define (read-attributes inport)
    180   (map split-attrib-line
    181        ;; Remove control commands like %VECTOR for now
    182        (filter (lambda (line)
    183                  (string-index line #\=))
    184                (read-block inport))))
    185 
    186 ;; Read a document in "draft" format from the specified input port.
    187 (define (read-draft inport)
    188   (let* ((metadata (read-attributes inport))
    189          (document (read-lines inport)))
    190     (values document metadata)))
    191193
    192194(define (put-document base-uri node contents attribs)
     
    369371
    370372(define (list-nodes base-uri)
    371   (map (lambda (line)
    372          (string-split line "\t" #t))
     373  (map line->node-info
    373374       (exec 'list-nodes (master-uri base-uri "nodelist") #f read-lines)))
    374375
  • release/4/estraier-client/tests/run.scm

    r15848 r15853  
    2323    (test "After adding two nodes, they show up"
    2424          '("testnode" "testnode2")
    25           (map car nodes))
     25          (map (lambda (n) (alist-ref 'name n)) nodes))
    2626    (test "Node label is accepted"
    2727          '("testnode" "testlabel")
    28           (map cadr nodes)))
     28          (map (lambda (n) (alist-ref 'label n)) nodes)))
    2929  (test "After deleting a node, it is gone"
    3030        '("testnode")
    3131        (begin (delete-node base-uri "testnode2")
    32                (map car (list-nodes base-uri))))
     32               (map (lambda (n) (alist-ref 'name n)) (list-nodes base-uri))))
    3333  (let ((users (begin (add-user base-uri "testuser" "password"
    3434                                fullname: "Joe testuser"
     
    189189               (list-documents base-uri "testnode"))))
    190190
    191 ;; TODO: Test search options (especially attributes)
    192 
    193191(test-group "cleanup"
    194192 (test-assert "Clean shutdown" (begin (shutdown-master base-uri) #t))
Note: See TracChangeset for help on using the changeset viewer.