Changeset 13346 in project


Ignore:
Timestamp:
02/19/09 06:01:07 (11 years ago)
Author:
Ivan Raikov
Message:

Added read-alist option to form2wiki.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/formular/trunk/form2wiki.scm

    r13341 r13346  
    9090
    9191(define (pp-submission/wiki id from-address date-seconds fields . rest)
    92   (let-optionals rest ((include-fields #f) (field-limits #f))
     92  (let-optionals rest ((include-fields #f) (field-limits #f) )
    9393    (let ((wiki-fields (filter-map identity
    9494                         (if include-fields
     
    9898      (for-each (lambda (field)
    9999                  (let ((section-limit (lookup-def (first field) field-limits))
    100                         (section-text  ((lambda (x) (if (string? x) (xml:read-string x) (->string x)) )
     100                        (section-text  ((lambda (x)
     101                                          (print "section-text: x = " x)
     102                                          (if (string? x) (xml:read-string x) (->string x)) )
    101103                                        (second field))))
     104                    (print "section-text = " section-text)
    102105                    (let ((section-title (->string (first field)))
    103106                          (section-content
     
    135138(define (pp-formular-tree/wiki tree . rest)
    136139  (let-optionals rest ((id-prefix "Form Submission") (id-order #f) (include-fields #f)
    137                        (exclude #f) (include #f) (field-limits #f))
     140                       (exclude #f) (include #f) (field-limits #f) (skip #f))
    138141   (let* ((keys  (tree 'list-keys))
    139142          (order (or id-order (inexact->exact (ceiling (log10 (length keys)))))))
    140143     ((tree 'foldi)
    141144      (lambda (from-address lst i)
     145        (print "from-address = " from-address)
    142146        (cond ((and exclude (member (s$ from-address) exclude)) i)
    143147              ((or (not include) (member (s$ from-address) include))
    144                (let loop ((lst lst))
    145                  (if (null? lst) i
    146                      (match (car lst)
    147                             (('submission ('date-seconds date-seconds) ('fields fld1 . fields))
    148                              (let* ((width (if (positive? order) order 1))
    149                                     (idnum (inexact->exact (- date-seconds 10e8)))
    150                                     (id    (let loop ((i 1) (id (make-id 1 width id-prefix idnum)))
    151                                              (if (file-exists? id)
    152                                                  (loop (+ 1 i) (make-id (+ 1 i) width id-prefix idnum)) id))))
    153                                (if (> (length lst) 1)
    154                                    (print "Multiple submissions by " from-address ": using submission from "
    155                                           (seconds->string date-seconds)))
    156                                (with-output-to-port (open-output-file id)
    157                                  (lambda ()
    158                                    (pp-submission/wiki id from-address date-seconds (cons fld1 fields)
    159                                                        include-fields field-limits)))
    160                                (+ i 1)))
    161                             (else (loop (cdr lst)))))))
     148               (if (and skip (< i skip)) (+ i 1)
     149                   (let loop ((lst lst))
     150                     (if (null? lst) i
     151                         (match (car lst)
     152                                (('submission ('date-seconds date-seconds) ('fields fld1 . fields))
     153                                 (let* ((width (if (positive? order) order 1))
     154                                        (idnum (inexact->exact (- date-seconds 10e8)))
     155                                        (id    (let loop ((i 1) (id (make-id 1 width id-prefix idnum)))
     156                                                 (if (file-exists? id)
     157                                                     (loop (+ 1 i) (make-id (+ 1 i) width id-prefix idnum)) id))))
     158                                   (print "id = " id)
     159
     160                                   (if (> (length lst) 1)
     161                                       (print "Multiple submissions by " from-address ": using submission from "
     162                                              (seconds->string date-seconds)))
     163                                   (with-output-to-port (open-output-file id)
     164                                     (lambda ()
     165                                       (pp-submission/wiki id from-address date-seconds (cons fld1 fields)
     166                                                           include-fields field-limits)))
     167                                   (+ i 1)))
     168                                (else (loop (cdr lst))))))))
    162169              (else i)))
    163170      1))))
     
    171178(define opt_fields        #f)
    172179(define opt_field-limits  (list))
     180(define opt_alist_input   #f)
     181(define opt_skip         #f)
    173182
    174183(define opts
     
    180189                       (string-append "specify a colon-separated list of entries to include (default is all )")
    181190                       (set! opt_include (map s$ (string-split (->string arg) ":"))))
     191    ,(args:make-option (skip)     (required: "N")   
     192                       (string-append "skip first N entries (ordered by submission time))")
     193                       (set! opt_skip (inexact->exact (string->number arg))))
    182194    ,(args:make-option (flimits)     (required: "FIELD1:LIMIT1,...")   
    183195                       (string-append "specify a comma-separated list of fields and character limits (default is none )")
     
    209221                       (string-append "specify prefix for wiki page title (default: " opt_title-prefix ")")
    210222                       (set! opt_title-prefix (->string arg)))
     223    ,(args:make-option (read-alist)     (required: "FILE")   
     224                       "read an alist representation from FILE"
     225                       (set! opt_alist_input  (->string arg)))
    211226    ,(args:make-option (h help)  #:none               "Print help"
    212227                       (usage))))
     
    227242(set!-values (options operands)  (args:parse args opts))
    228243
     244(define (alist->rb-tree alst)
     245  (define (s<= x y)
     246    (cond ((string-ci< x y) -1)
     247          ((string-ci= x y) 0)
     248          (else 1)))
     249  (let* ((tree    (make-rb-tree s<=))
     250         (update! (tree 'put!)))
     251    (for-each (lambda (x) (let ((k (car x))
     252                                (v (cdr x)))
     253                            (update! k v)))
     254              alst)
     255    tree))
     256                             
     257
    229258(define (main options operands)
    230   (let ((forms (mbox->form-stream opt_mbox-path)))
    231     (pp-formular-tree/wiki (form-stream->tree forms)
     259  (let ((tree  (if opt_alist_input
     260                   (alist->rb-tree (read (open-input-file opt_alist_input)))
     261                   (form-stream->tree (mbox->form-stream opt_mbox-path)))))
     262
     263    (pp-formular-tree/wiki tree
    232264                           opt_title-prefix
    233265                           opt_order
     
    236268                           opt_include
    237269                           opt_field-limits
     270                           opt_skip
    238271                           )))
    239272
    240 
    241273(main options operands)
Note: See TracChangeset for help on using the changeset viewer.