Changeset 11592 in project


Ignore:
Timestamp:
08/10/08 17:12:27 (11 years ago)
Author:
sjamaan
Message:

Rename set-header-contents! to update-header-contents! and create a nondestructive variant of it too
Fix definitions for a few header parsers

Location:
release/4/intarweb/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/header-parsers.scm

    r11579 r11592  
    152152(define (single other-parser #!optional (parameter-parsers '()))
    153153  (lambda (name contents headers)
    154     (set-header-contents!
     154    (update-header-contents!
    155155     name
    156156     ((with-params other-parser parameter-parsers) contents)
     
    248248;; This too
    249249(define (pragma-parser name value headers)
    250   (set-header-contents! name (read-parameters value 0 `()) headers))
     250  (update-header-contents! name (read-parameters value 0 `()) headers))
    251251
    252252;; This one includes q parser
    253253(define (te-parser name value headers)
    254   (set-header-contents! name (read-parameters value 0 `((q . ,quality-parser))) headers))
     254  (update-header-contents! name (read-parameters value 0 `((q . ,quality-parser))) headers))
    255255
    256256;; Cookie headers are also braindead: there can be several cookies in one header,
  • release/4/intarweb/trunk/intarweb.scm

    r11579 r11592  
    3838
    3939(module intarweb
    40   (read-line-limit set-header-contents! append-header-contents!
     40  (read-line-limit update-header-contents update-header-contents!
     41   append-header-contents append-header-contents!
    4142   string->header-name header-name->string header-name=?
    4243   header-parsers get-header-contents
     
    5758   )
    5859
    59   (import scheme chicken extras ports data-structures srfi-1 srfi-13 srfi-14
    60           regex regex-case (prefix base64 base64:))
     60  (import scheme chicken (except extras read-token) ports data-structures
     61          srfi-1 srfi-13 srfi-14 regex regex-case (prefix base64 base64:))
    6162
    6263(define read-line-limit (make-parameter 1024)) ; #f if you want no limit
    6364
    64 (define (set-header-contents! name contents headers)
     65(define (update-header-contents name contents headers)
    6566  (let loop ((h headers))
    6667    (cond
     
    7172     (else (loop (cdr h))))))
    7273
    73 (define (append-header-contents! name contents headers)
    74   (let ((old (get-header-contents name headers)))
    75     (if old
    76         (set-header-contents! name (append old contents) headers)
    77         (set-header-contents! name contents headers))))
     74(define (update-header-contents! name contents headers)
     75  (let loop ((h headers))
     76    (cond
     77     ((null? h) (cons (cons name contents) headers))
     78     ((header-name=? name (caar h))
     79      (cons (cons (caar h) contents) (cdr h)))
     80     (else (cons (car h) (loop (cdr h)))))))
     81
     82(define (make-appender updater)
     83  (lambda (name contents headers)
     84    (let ((old (get-header-contents name headers)))
     85      (if old
     86          (updater name (append old contents) headers)
     87          (updater name contents headers)))))
     88
     89(define append-header-contents  (make-appender update-header-contents))
     90(define append-header-contents! (make-appender update-header-contents!))
    7891
    7992(define (string->header-name s) (string->symbol (string-downcase! s)))
     
    109122     (host . ,(single identity))
    110123     (if-match . ,(multiple entity-tag-parser))
    111      (if-modified-since . ,rfc822-time-parser)
     124     (if-modified-since . ,(single rfc822-time-parser))
    112125     (if-none-match . ,(multiple entity-tag-parser))
    113126     (if-range . ,(multiple if-range-parser))
    114      (if-unmodified-since . ,rfc822-time-parser)
    115      (last-modified . ,rfc822-time-parser)
     127     (if-unmodified-since . ,(single rfc822-time-parser))
     128     (last-modified . ,(single rfc822-time-parser))
    116129     (location . ,(single identity))
    117130     (max-forwards . ,natnum-parser)
  • release/4/intarweb/trunk/tests/run.scm

    r11579 r11592  
    5959(test-group "Headers"
    6060  (test-group "Single headers"
    61    (parameterize ((header-parsers `((foo . ,set-header-contents!)
    62                                     (qux . ,set-header-contents!))))
     61   (parameterize ((header-parsers `((foo . ,update-header-contents!)
     62                                    (qux . ,update-header-contents!))))
    6363     (let ((headers (test-read-headers "foo: bar\r\nqux:\t   \tmooh\t   \r\n\r\n")))
    6464       (test "Basic test"
Note: See TracChangeset for help on using the changeset viewer.