Changeset 15835 in project


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

Split out 'draft' and attribute reading/writing procedures

File:
1 edited

Legend:

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

    r15834 r15835  
    4444   update-attributes document-attribute document-keywords find-documents
    4545   unregister-user register-admin-user register-guest-user
    46    write-draft ; could be useful by itself
     46   
     47   ;; these could be useful on their own, so export them too
     48   clean-attributes read-attributes read-draft write-attributes write-draft
    4749
    4850   master-shutdown master-sync master-backup master-rotate-log
     
    132134               (read-lines in)))))
    133135
     136;; If control commands or the @digest attribute are sent back when
     137;; updating a document, the node will silently ignore the document...
     138(define (clean-attributes attributes)
     139  (filter (lambda (attrib)
     140            (and (not (string-prefix? "#" (->string (car attrib))))
     141                 (not (eq? (car attrib) '@digest))))
     142          attributes))
     143
     144(define (write-attributes outport attributes)
     145  (for-each (lambda (attrib)
     146              (fprintf outport "~A=~A\r\n" (car attrib) (cdr attrib)))
     147            attributes))
     148
    134149;; Write out a document in "draft" format to the specified output port.
    135 ;; If the CONTENTS argument is omitted, only attributes will be written.
    136 (define (write-draft outport attributes #!optional contents)
    137   (for-each
    138    (lambda (attrib)
    139      ;; If control commands or the @digest attribute are sent
    140      ;; back, the node will silently ignore the document...
    141      (unless (or (string-prefix? "#" (->string (car attrib)))
    142                  (eq? (car attrib) '@digest))
    143        (fprintf outport "~A=~A\r\n" (car attrib) (cdr attrib))))
    144    attributes)
    145   (when contents
    146     (fprintf outport "\r\n")
    147     ;; What if there's a newline in the text?
    148     (for-each (lambda (line) (fprintf outport "~A\r\n" line)) contents)))
     150(define (write-draft outport attributes contents)
     151  (write-attributes outport attributes)
     152  (fprintf outport "\r\n")
     153  ;; What if there's a newline in the text?
     154  (for-each (lambda (line) (fprintf outport "~A\r\n" line)) contents))
     155
     156(define (read-attributes inport)
     157  (map split-attrib-line
     158       ;; Remove control commands like %VECTOR for now
     159       (filter (lambda (line)
     160                 (string-index line #\=))
     161               (read-block inport))))
     162
     163;; Read a document in "draft" format from the specified input port.
     164(define (read-draft inport)
     165  (let ((metadata (read-attributes inport))
     166        (document (read-lines inport)))
     167    (values document metadata)))
    149168
    150169(define (put-document node contents attribs)
     
    154173                 headers: (headers '((content-type text/x-estraier-draft))))
    155174   (call-with-output-string ; use string because it wants content-length
    156      (lambda (out) (write-draft out attribs contents)))
     175     (lambda (out) (write-draft out (clean-attributes attribs) contents)))
    157176   discard-output))
    158177
     
    168187         (exec
    169188          (node-uri node "get_doc" query: (id/uri->alist id uri))
    170           #f
    171           (lambda (in)
    172             (let ((metadata (map split-attrib-line
    173                                  ;; Remove control commands like %VECTOR for now
    174                                  (filter (lambda (line)
    175                                            (string-index line #\=))
    176                                          (read-block in))))
    177                   (document (read-lines in)))
    178               (list document metadata))))))
     189          #f (lambda (in)
     190               (call-with-values (lambda () (read-draft in)) list)))))
    179191
    180192;; This requires the new attributes plus all the old attribs, it
     
    188200                 headers: (headers '((content-type text/x-estraier-draft))))
    189201   (call-with-output-string ; use string because it wants content-length
    190      (lambda (out) (write-draft out attribs)))
     202     (lambda (out) (write-attributes out (clean-attributes attribs))))
    191203   discard-output))
    192204
     
    246258                  (documents
    247259                   (let next-document ((docs (list)))
    248                      (let ((attribs
    249                             (map split-attrib-line
    250                                  ;; Remove control commands like %VECTOR for now
    251                                  (filter (lambda (line)
    252                                            (string-index line #\=))
    253                                          (read-block in)))))
     260                     (let ((attribs (read-attributes in)))
    254261                       (let next-line ((matches (list))
    255262                                       (line  (read-line in)))
Note: See TracChangeset for help on using the changeset viewer.