Changeset 12811 in project


Ignore:
Timestamp:
12/11/08 19:40:04 (13 years ago)
Author:
sjamaan
Message:

Merge release 4 uri-generic changes into release 3

Location:
release/3/uri-generic/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/uri-generic/trunk

  • release/3/uri-generic/trunk/tests/run.scm

    r12724 r12811  
    175175  '(("/foo" (path: ("/bar")) "/bar")
    176176    ("/foo" (host: "localhost") "//localhost/foo")
    177     ("http://foo" (query: ((a . "b") (c . #t) (d . "e"))) "http://foo?a=b&c&d=e")
     177    ("http://foo" (query: "a=b&c&d?=%2fe") "http://foo?a=b&c&d?=%2fe")
    178178    ("http://foo" (host: #f) "http:")
    179179    ("http://foo" (authority: #f) "http:")))
  • release/3/uri-generic/trunk/uri-generic.scm

    r12724 r12811  
    291291                                               (else (list #f rst)))))
    292292                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
    293                                   path: (map uri-char-list->string up) query: (and uq (filter-map query->alist uq))
     293                                  path: (map uri-char-list->string up) query: (and uq (uri-char-list->string uq))
    294294                                  fragment: (and uf (uri-char-list->string uf)))))
    295295         (else #f))))
     
    610610
    611611;;  RFC3986, section 3.4
    612 
    613 
    614 (define query0  (many (schar ":@/?!$'()*+,;=")))
    615 (define (query1 s)
    616   (match s ((#\& . rst) (query0 rst))
    617          (else #f)))
    618 
     612;;
     613;;   query         = *( pchar / "/" / "?" )
     614
     615(define query0  (many (uchar ":@/?")))
    619616(define (query s)
    620617  (match (query0 s)
    621          ((q1 rst)   
    622                      (match ((consume query1) rst)
    623                             ((qs rst)  (list (cons q1 qs) rst))
    624                             (else (list (list q1) rst))))
    625          (else #f)))
    626 
    627 (define query-part (many (schar ":@/?!$'()*+,;")))
    628 
    629 ;; Convert an internal parser representation of a query to an alist
    630 ;; of symbol-string pairs
    631 (define (query->alist s)
    632   (match (query-part s)
    633          ((p1 (#\= . rst))  (match (query-part rst)
    634                                    ((p2 _) `(,(string->symbol (uri-char-list->string p1)) . ,(uri-char-list->string p2)))
    635                                    (else #f)))
    636          ((p1 ())   `(,(string->symbol (uri-char-list->string p1)) . #t))
    637          (else #f)))
    638  
     618         ((ss rst)  (list ss rst))
     619         (else #f)))
    639620
    640621;;  RFC3986, section 3.5
    641 
     622;;   fragment         = *( pchar / "/" / "?" )
    642623
    643624(define fragment0  (many (uchar ":@/?")))
     
    672653                                         (else (list #f rst)))))
    673654                   (make-URI scheme: #f authority: ua path: (map uri-char-list->string up)
    674                              query: (and uq (filter-map query->alist uq))
     655                             query: (and uq (uri-char-list->string uq))
    675656                             fragment: (and uf (uri-char-list->string uf))))))
    676657
     
    696677                                              (else (list #f rst)))))
    697678                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
    698                                   path: (map uri-char-list->string up) query: (and uq (filter-map query->alist uq))
     679                                  path: (map uri-char-list->string up) query: (and uq (uri-char-list->string uq))
    699680                                  fragment: #f)))
    700681           (error 'absolute-uri "no scheme found in URI string"))))
     
    716697                 "")
    717698             (string-concatenate path)
    718              (if (and query (not (null? query))) (string-concatenate (cons "?" (intersperse (map (lambda (p) (if (eq? (cdr p) #t) (symbol->string (car p)) (conc (car p) "=" (cdr p)))) query) "&"))) "")
     699             (if query (string-append "?" query) "")
    719700             (if fragment (string-append  "#" fragment) "")))
    720701           (else #f))))
Note: See TracChangeset for help on using the changeset viewer.