Changeset 12999 in project


Ignore:
Timestamp:
01/12/09 21:17:11 (11 years ago)
Author:
sjamaan
Message:

Change the procedure names; replace "uri-common" by "uri", so these procedures replace the ones exported by uri-generic

Location:
release/4/uri-common/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-common/trunk/tests/run.scm

    r12986 r12999  
    44
    55(define internal-representation-cases
    6   `(("scheme" ,uri-common-scheme ; Only a few tests; uri-common doesn't do much
     6  `(("scheme" ,uri-scheme ; Only a few tests; uri-common doesn't do much
    77     ("http:" http)
    88     ("" #f))
    9     ("username" ,uri-common-username
     9    ("username" ,uri-username
    1010     ("//foo" #f)
    1111     ("//@" "")
     
    1616     ("//foo%3Abar:qux@" "foo:bar")
    1717     ("//foo%2Ebar@" "foo.bar" "//foo.bar@"))
    18     ("password ",uri-common-password
     18    ("password ",uri-password
    1919     ("//foo" #f)
    2020     ("//@" #f)
     
    2424     ("//foo:bar%20qux@" "bar qux")
    2525     ("//foo:bar%2Equx@" "bar.qux" "//foo:bar.qux@"))
    26     ("path" ,uri-common-path
     26    ("path" ,uri-path
    2727     ("//foo" ())   ; Can path ever be #f?
    2828     ("foo%20bar" ("foo bar"))
     
    3535     ("/foo/" (/ "foo" ""))
    3636     ("/foo:bar" (/ "foo:bar")))
    37     ("query ",uri-common-query
     37    ("query ",uri-query
    3838     ("//" ())
    3939     ("?foo" ((foo . #t)))
     
    4242     ("?foo%3Fbar" ((foo?bar . #t)))
    4343     ("?foo%2Ebar" ((foo.bar . #t)) "?foo.bar"))
    44     ("fragment" ,uri-common-fragment
     44    ("fragment" ,uri-fragment
    4545     ("?foo" #f)
    4646     ("#bar" "bar")
     
    6060                                           (first u)
    6161                                           (third u)))
    62                                   (uri (uri-common-reference (first u))))
     62                                  (uri (uri-reference (first u))))
    6363                              (test (sprintf "~S decoded as ~S" in internal)
    6464                                    internal ((cadr p) uri))
    6565                              (test (sprintf "~S encoded to ~S" internal out)
    66                                     out (uri-common->string
     66                                    out (uri->string
    6767                                         uri
    6868                                         (lambda (u p)
     
    8989                                  (input (first u))
    9090                                  (oexp (second u))
    91                                   (oact (update-uri-common
    92                                          (uri-common-reference "")
     91                                  (oact (update-uri
     92                                         (uri-reference "")
    9393                                         slotname input)))
    9494                             (test (sprintf "~S -> ~S" input oexp)
    95                                    oexp (uri-common->string oact))))
     95                                   oexp (uri->string oact))))
    9696                         (cddr p))))
    9797            update-cases))
  • release/4/uri-common/trunk/uri-common.scm

    r12989 r12999  
    4141
    4242(module uri-common
    43   (uri-common-reference absolute-uri-common
    44    uri-common->uri-generic uri-common->uri-generic
    45    update-uri-common uri-common?
    46    uri-common-scheme uri-common-username uri-common-password
    47    uri-common-host uri-common-port uri-common-path uri-common-query
    48    uri-common-fragment
    49    uri-common->string form-urlencode form-urldecode
    50    uri-common-relative-to uri-common-relative-from
    51    uri-common-normalize-path-segments uri-common-normalize-case
     43  (uri-reference absolute-uri uri->uri-generic uri-generic->uri
     44   update-uri uri? uri-scheme uri-username uri-password
     45   uri-host uri-port uri-path uri-query uri-fragment
     46   uri->string form-urlencode form-urldecode
     47   uri-relative-to uri-relative-from
     48   uri-normalize-path-segments uri-normalize-case
    5249   char-set:query/fragment)
    5350
    5451(import chicken scheme)
    5552(require-extension srfi-1 srfi-13 srfi-14 extras data-structures
    56                    defstruct uri-generic matchable)
     53                   defstruct matchable)
     54(require-library uri-generic)
     55(import (prefix uri-generic generic:))
    5756
    5857;; We could use the hostinfo egg for this, but that would be yet another
     
    8281
    8382(define (decode-string* s)
    84   (and s (uri-decode-string s)))
    85 
    86 (define (uri-common-reference u)
    87   (uri-generic->uri-common (uri-reference u)))
    88 (define (absolute-uri-common u)
    89   (uri-generic->uri-common (absolute-uri u)))
    90 
    91 (define (uri-generic->uri-common uri)
     83  (and s (generic:uri-decode-string s)))
     84
     85(define (uri-reference u)
     86  (uri-generic->uri (generic:uri-reference u)))
     87(define (absolute-uri u)
     88  (uri-generic->uri (generic:absolute-uri u)))
     89
     90(define (uri-generic->uri uri)
    9291  (make-URI-common generic: uri
    93                    username: (decode-string* (uri-username uri))
    94                    password: (decode-string* (uri-password uri))
    95                    host:     (decode-string* (uri-host uri))
    96                    path:     (decode-path (uri-path uri))
    97                    query:    (form-urldecode (uri-query uri))
    98                    fragment: (decode-string* (uri-fragment uri))))
    99 
    100 (define (uri-common->uri-generic uri)
     92                   username: (decode-string* (generic:uri-username uri))
     93                   password: (decode-string* (generic:uri-password uri))
     94                   host:     (decode-string* (generic:uri-host uri))
     95                   path:     (decode-path (generic:uri-path uri))
     96                   query:    (form-urldecode (generic:uri-query uri))
     97                   fragment: (decode-string* (generic:uri-fragment uri))))
     98
     99(define (uri->uri-generic uri)
    101100  (URI-common-generic uri))
    102101
    103102;; Accessors
    104 (define uri-common?         URI-common?)
    105 (define uri-common-scheme   (compose uri-scheme URI-common-generic))
    106 (define uri-common-username URI-common-username)
    107 (define uri-common-password URI-common-password)
    108 (define uri-common-host     URI-common-host)
    109 (define uri-common-path     URI-common-path)
    110 (define uri-common-query    URI-common-query)
    111 (define uri-common-fragment URI-common-fragment)
    112 
    113 (define (uri-common-port uc)
     103(define uri?         URI-common?)
     104(define uri-scheme   (compose generic:uri-scheme URI-common-generic))
     105(define uri-username URI-common-username)
     106(define uri-password URI-common-password)
     107(define uri-host     URI-common-host)
     108(define uri-path     URI-common-path)
     109(define uri-query    URI-common-query)
     110(define uri-fragment URI-common-fragment)
     111
     112(define (uri-port uc)
    114113  (let ((u (URI-common-generic uc)))
    115     (or (uri-port u)
    116         (alist-ref (uri-scheme u) default-ports))))
     114    (or (generic:uri-port u)
     115        (alist-ref (generic:uri-scheme u) default-ports))))
    117116
    118117;; Normalize an URI, but only if there's a scheme present
     
    120119;; - Make path empty path if not specified
    121120(define (normalize-uri u)
    122   (let ((port (uri-port u)))
    123     (when (uri-scheme u)
    124      (when (eqv? port (alist-ref (uri-scheme u) default-ports))
    125        (set! u (update-uri u port: #f))))
    126     (when (or (not (uri-path u)) (null? (uri-path u)))
    127       (set! u (update-uri u uri-path: '(/ ""))))
     121  (let ((port (generic:uri-port u)))
     122    (when (generic:uri-scheme u)
     123     (when (eqv? port (alist-ref (generic:uri-scheme u) default-ports))
     124       (set! u (generic:update-uri u port: #f))))
     125    (when (or (not (generic:uri-path u)) (null? (generic:uri-path u)))
     126      (set! u (generic:update-uri u uri-path: '(/ ""))))
    128127    u))
    129128
    130129(define (encode-string* s . rest)
    131   (and s (apply uri-encode-string s rest)))
    132 
    133 (define update-uri-common
     130  (and s (apply generic:uri-encode-string s rest)))
     131
     132(define update-uri
    134133  (let ((unset (list 'unset)))
    135134    (lambda (uc #!key
     
    139138        (unless (eq? scheme unset)
    140139          (URI-common-generic-set!
    141            uc (update-uri (URI-common-generic uc) scheme: scheme)))
     140           uc (generic:update-uri (URI-common-generic uc) scheme: scheme)))
    142141        (unless (eq? username unset)
    143142          (URI-common-generic-set!
    144            uc (update-uri (URI-common-generic uc)
    145                           username: (encode-string* username)))
     143           uc (generic:update-uri (URI-common-generic uc)
     144                                  username: (encode-string* username)))
    146145          (URI-common-username-set! uc username))
    147146        (unless (eq? password unset)
    148147          (URI-common-generic-set!
    149            uc (update-uri (URI-common-generic uc)
    150                           password: (encode-string* password)))
     148           uc (generic:update-uri (URI-common-generic uc)
     149                                  password: (encode-string* password)))
    151150          (URI-common-password-set! uc password))
    152151        (unless (eq? host unset)
    153152          (URI-common-generic-set!
    154            uc (update-uri (URI-common-generic uc)
    155                           host: (encode-string* host)))
     153           uc (generic:update-uri (URI-common-generic uc)
     154                                  host: (encode-string* host)))
    156155          (URI-common-host-set! uc host))
    157156        (unless (eq? path unset)
    158157          (URI-common-generic-set!
    159            uc (update-uri (URI-common-generic uc)
    160                           path: (encode-path path)))
     158           uc (generic:update-uri (URI-common-generic uc)
     159                                  path: (encode-path path)))
    161160          (URI-common-path-set! uc path))
    162161        (unless (eq? query unset)
    163162          (URI-common-generic-set!
    164            uc (update-uri (URI-common-generic uc)
    165                           query: (form-urlencode query)))
     163           uc (generic:update-uri (URI-common-generic uc)
     164                                  query: (form-urlencode query)))
    166165          (URI-common-query-set! uc query))
    167166        (unless (eq? fragment unset)
    168167          (URI-common-generic-set!
    169            uc (update-uri (URI-common-generic uc)
    170                           fragment: (encode-string* fragment
    171                                                     char-set:query/fragment)))
     168           uc (generic:update-uri (URI-common-generic uc)
     169                                  fragment: (encode-string*
     170                                             fragment
     171                                             char-set:query/fragment)))
    172172          (URI-common-fragment-set! uc fragment))
    173173        uc))))
     
    175175(define (encode-path p)
    176176  (and p (match p
    177                 (('/ . rst) (cons '/ (map uri-encode-string rst)))
    178                 (else (map uri-encode-string p)))))
     177                (('/ . rst) (cons '/ (map generic:uri-encode-string rst)))
     178                (else (map generic:uri-encode-string p)))))
    179179
    180180;; Characters allowed in queries and fragments
    181181(define char-set:query/fragment
    182182  (char-set-difference
    183    (char-set-complement char-set:uri-unreserved)
     183   (char-set-complement generic:char-set:uri-unreserved)
    184184   (string->char-set ":@?/")
    185    char-set:sub-delims))
     185   generic:char-set:sub-delims))
    186186
    187187;; Handling of application/x-www-form-urlencoded data
     
    218218              (enc (lambda (s)
    219219                     (string-translate*
    220                       (uri-encode-string
     220                      (generic:uri-encode-string
    221221                       s
    222222                       (char-set-union separator-chars
     
    244244             (let ((idx (string-index part #\=))
    245245                   (decode (lambda (s)
    246                              (uri-decode-string
     246                             (generic:uri-decode-string
    247247                              (string-translate* s '(("+" . "%20")))))))
    248248               (if idx
     
    256256(define (decode-path p)
    257257  (and p (match p
    258                 (('/ . rst) (cons '/ (map uri-decode-string rst)))
    259                 (else (map uri-decode-string p)))))
     258                (('/ . rst) (cons '/ (map generic:uri-decode-string rst)))
     259                (else (map generic:uri-decode-string p)))))
    260260
    261261
    262262;; Simple convenience procedures
    263 (define (uri-common->string uri . args)
    264   (apply uri->string (URI-common-generic uri) args))
     263(define (uri->string uri . args)
     264  (apply generic:uri->string (URI-common-generic uri) args))
    265265
    266266(define (wrap proc)
    267267  (lambda args
    268     (uri-generic->uri-common (apply proc (map URI-common-generic args)))))
    269 
    270 (define uri-common-relative-to             (wrap uri-relative-to))
    271 (define uri-common-relative-from           (wrap uri-relative-from))
    272 (define uri-common-normalize-case          (wrap uri-normalize-case))
    273 (define uri-common-normalize-path-segments (wrap uri-normalize-path-segments))
     268    (uri-generic->uri (apply proc (map URI-common-generic args)))))
     269
     270(define uri-relative-to             (wrap generic:uri-relative-to))
     271(define uri-relative-from           (wrap generic:uri-relative-from))
     272(define uri-normalize-case          (wrap generic:uri-normalize-case))
     273(define uri-normalize-path-segments (wrap generic:uri-normalize-path-segments))
    274274
    275275)
Note: See TracChangeset for help on using the changeset viewer.