Changeset 12849 in project


Ignore:
Timestamp:
12/18/08 21:55:30 (11 years ago)
Author:
sjamaan
Message:

Code simplification, iteration 1

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-generic/trunk/uri-generic.scm

    r12841 r12849  
    243243                 (list) char-list)))
    244244
    245  
     245;; Inverse operation: 'pct-decode' a sequence of octets.
     246
     247(define (pct-decode char-list #!optional (char-set char-set:unreserved))
     248  (define (octet-decode h1 h2)
     249    (string->number (list->string (list h1 h2)) 16))
     250  (map (lambda (c)
     251        (match c
     252               ((#\% h1 h2) (let ((dc (integer->char (octet-decode h1 h2))))
     253                              (if (char-set-contains? char-set dc) dc c)))
     254               (else c)))
     255       char-list))
     256
     257
    246258;; RFC3986, section 2.2
    247259;;
     
    511523         (else #f)))
    512524
    513 (define (dec-char->num c)
    514   (case c ((#\0) 0) ((#\1) 1) ((#\2) 2) ((#\3) 3) ((#\4) 4) ((#\5) 5)
    515          ((#\6) 6) ((#\7) 7) ((#\8) 8) ((#\9) 9) (else #f)))
    516                  
    517525(define (ipv4-octet? lst)
    518   (let loop ((n (reverse (map dec-char->num lst))) (i 1) (ax 0))
    519     (if (null? n) (and (>= ax 0) (<= ax 255))
    520         (loop (cdr n) (* i 10) (+ ax (* i (car n)))))))
     526  (and (every (lambda (x) (char-set-contains? char-set:digit x)) lst)
     527       (let ((num (string->number (list->string lst))))
     528         (and num (>= num 0) (<= num 255)))))
    521529
    522530(define (dec-octet s)
     
    742750;;  Percent encoding and decoding
    743751
    744 (define (integer->octets i)
    745   (let loop ((i i) (lst (list)))
    746     (if (zero? i) lst
    747         (loop (quotient i 256) (cons (modulo i 256) lst)))))
    748 
    749 (define (pct? c) (char=? c #\%))
    750 
    751752(define (uri-encode-string str)
    752753  (let ((clst (string->list str)))
     
    754755     (pct-encode clst (char-set-union (char-set #\%) char-set:reserved)))))
    755756
    756 
    757 (define (octets->integer lst)
    758   (let loop ((i 0) (m 1) (lst (reverse lst)))
    759     (if (null? lst) i
    760         (loop (+ i (* (car lst) m)) (* m 256) (cdr lst)))))
    761 
    762 (define (pct-decode char-list #!optional (char-set char-set:unreserved))
    763   (map (lambda (c)
    764         (match c
    765                ((#\% h1 h2) (let ((dc (integer->char (octet-decode h1 h2))))
    766                               (if (char-set-contains? char-set dc) dc c)))
    767                (else c)))
    768        char-list))
    769 
    770 (define (octet-decode h1 h2)
    771   (string->number (list->string (list h1 h2)) 16))
    772 
    773757(define (uri-decode-string str)
    774   (let loop ((clst (uri-string->char-list str)) (p (list))  (nlst (list)))
    775     (if (null? clst)
    776         (uri-char-list->string (reverse nlst))
    777         (match (car clst)
    778                ((and c (? char?)) 
    779                 (if (null? p) (loop (cdr clst) p (cons c nlst))
    780                     (let ((pc (integer->char (octets->integer (reverse p)))))
    781                       (loop (cdr clst) (list) (cons* c pc nlst)))))
    782                ((#\% h1 h2) 
    783                 (loop (cdr clst) (cons (octet-decode h1 h2) p) nlst))
    784                (else (error 'uri-decode-string "invalid URI string " str))))))
     758  (uri-char-list->string (pct-decode (uri-string->char-list str) char-set:full)))
    785759   
    786760(define (uri-string->normalized-char-list str)
    787   (let ((clst (uri-string->char-list str)))
    788     (pct-decode clst)))
     761  (pct-decode (uri-string->char-list str)))
    789762
    790763
Note: See TracChangeset for help on using the changeset viewer.