uri-codec-unit changed internally to only remap ascii chars and to automatically escape (ala utf-8) other bytes

svn: r2475
This commit is contained in:
Robby Findler 2006-03-21 14:57:51 +00:00
parent 1f056dbc47
commit ed9d988cd8

View File

@ -84,18 +84,6 @@
(provide uri-codec@) (provide uri-codec@)
;; Macro to loop over integers from n (inclusive) to m (exclusive)
;; Extracted from iteration.ss in macro package at Schematics
(define-syntax for
(syntax-rules ()
((for (i n m) forms ...)
(let ((fixed-m m))
(let loop ((i n))
(if (< i fixed-m)
(begin
forms ...
(loop (+ i 1)))))))))
(define uri-codec@ (define uri-codec@
(unit/sig net:uri-codec^ (unit/sig net:uri-codec^
(import) (import)
@ -146,13 +134,12 @@
(define (hex-string->number hex-string) (define (hex-string->number hex-string)
(string->number (substring hex-string 1 3) 16)) (string->number (substring hex-string 1 3) 16))
(define ascii-size 128)
;; (listof (cons char char)) -> (values (vectorof string) (vectorof string)) ;; (listof (cons char char)) -> (values (vectorof string) (vectorof string))
(define (make-codec-tables alist) (define (make-codec-tables alist)
(let ((encoding-table (make-vector 256 "")) (let ((encoding-table (build-vector ascii-size number->hex-string))
(decoding-table (make-vector 256 0))) (decoding-table (build-vector ascii-size values)))
(for (i 0 256)
(vector-set! encoding-table i (number->hex-string i))
(vector-set! decoding-table i i))
(for-each (match-lambda (for-each (match-lambda
[(orig . enc) [(orig . enc)
(vector-set! encoding-table (vector-set! encoding-table
@ -179,7 +166,10 @@
(define (encode table str) (define (encode table str)
(apply string-append (apply string-append
(map (lambda (byte) (map (lambda (byte)
(vector-ref table byte)) (cond
[(< byte ascii-size)
(vector-ref table byte)]
[else (number->hex-string byte)]))
(bytes->list (string->bytes/utf-8 str))))) (bytes->list (string->bytes/utf-8 str)))))
;; vector string -> string ;; vector string -> string
@ -204,7 +194,7 @@
(apply bytes (internal-decode (string->list str))))) (apply bytes (internal-decode (string->list str)))))
(define (ascii-char? c) (define (ascii-char? c)
(<= (char->integer c) 127)) (< (char->integer c) ascii-size))
(define (hex-digit? c) (define (hex-digit? c)
(or (char<=? #\0 c #\9) (or (char<=? #\0 c #\9)
@ -312,9 +302,6 @@
(raise-type-error 'current-alist-separator-mode (raise-type-error 'current-alist-separator-mode
"'amp, 'semi, or 'amp-or-semi" "'amp, 'semi, or 'amp-or-semi"
s)) s))
s))) s))))))
))
)
;;; uri-codec-unit.ss ends here ;;; uri-codec-unit.ss ends here