Changeset 11983 in project


Ignore:
Timestamp:
09/23/08 22:42:42 (13 years ago)
Author:
sjamaan
Message:

Add feeble beginnings of the new spiffy implementation based on intarweb

Location:
release/4
Files:
3 added
3 edited

Legend:

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

    r11947 r11983  
    2222(define (header-values header-name headers)
    2323  (map (cut vector-ref <> 0) (header-contents header-name headers '())))
     24
     25;; Get the value of a header, assuming it has only one value
     26(define (header-value header-name headers #!optional (default #f))
     27  (let ((contents (header-contents header-name headers '())))
     28    (if (null? contents)
     29        default
     30        (vector-ref (car contents) 0))))
    2431
    2532;; Get the value of a header which is an alist
  • release/4/intarweb/trunk/intarweb.scm

    r11947 r11983  
    6161   ;; http-header-parsers
    6262   split-multi-header unknown-header-parser single multiple parse-token
    63    header-contents header-values header-list-ref
     63   header-contents header-values header-value header-list-ref
    6464   get-quality get-value get-params get-param
    6565   natnum-parser symbol-parser-ci symbol-parser
  • release/4/intarweb/trunk/tests/run.scm

    r11947 r11983  
    128128     (let ((headers (test-read-headers "Foo: 10\r\nBar: abc\r\nQux: -10\r\nMooh: 1.6")))
    129129       (test "Simple test"
    130              10 (get-value (car (header-contents 'foo headers))))
     130             10 (header-value 'foo headers))
    131131       (test "No number defaults to 0"
    132              0 (get-value (car (header-contents 'bar headers))))
     132             0 (header-value 'bar headers))
    133133       (test "No negative numbers"
    134              0 (get-value (car (header-contents 'qux headers))))
     134             0 (header-value 'qux headers))
    135135       ;; This is a "feature" in the interest of the robustness principle
    136136       (test "Rounding of real numbers"
    137              2 (get-value (car (header-contents 'mooh headers)))))))
     137             2 (header-value 'mooh headers)))))
    138138
    139139  (test-group "Cache-control-parser"
     
    158158      (test "md5 is base64-decoded"
    159159            "Check Integrity!"
    160             (get-value (car (header-contents 'content-md5 headers))))))
     160            (header-value 'content-md5 headers))))
    161161
    162162  (test-group "Range-parser"
     
    164164      (test "Simple range"
    165165            '(500 999 1234)
    166             (get-value (car (header-contents 'content-range headers))))))
     166            (header-value 'content-range headers))))
    167167
    168168  ;; XXX SRFI-19!
     
    171171      (test "RFC822/RFC1123 time"
    172172            0
    173             (get-value (car (header-contents 'date headers)))))
     173            (header-value 'date headers)))
    174174    (let ((headers (test-read-headers "Date: Sunday, 06-Nov-94 08:49:37 GMT")))
    175175      (test "RFC850 time"
    176176            0
    177             (get-value (car (header-contents 'date headers)))))
     177            (header-value 'date headers)))
    178178    (let ((headers (test-read-headers "Date: Sun Nov  6 08:49:37 1994")))
    179179      (test "asctime time"
    180180            0
    181             (get-value (car (header-contents 'date headers))))))
     181            (header-value 'date headers))))
    182182
    183183  (test-group "entity-tag-parser"
     
    185185      (test "Strong tag"
    186186            '(strong . "foo")
    187             (get-value (car (header-contents 'etag headers)))))
     187            (header-value 'etag headers)))
    188188    (let ((headers (test-read-headers "Etag: W/\"bar\"")))
    189189      (test "Weak tag"
    190190            '(weak . "bar")
    191             (get-value (car (header-contents 'etag headers)))))
     191            (header-value 'etag headers)))
    192192    (let ((headers (test-read-headers "Etag: \"\"")))
    193193      (test "Empty tag"
    194194            '(strong . "")
    195             (get-value (car (header-contents 'etag headers)))))
     195            (header-value 'etag headers)))
    196196    (let ((headers (test-read-headers "Etag: \"W/bar\"")))
    197197        (test "Strong tag, containing W/ prefix"
    198198              '(strong . "W/bar")
    199               (get-value (car (header-contents 'etag headers))))))
     199              (header-value 'etag headers))))
    200200
    201201  (test-group "Set-Cookie-parser"
Note: See TracChangeset for help on using the changeset viewer.