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:
parent
1f056dbc47
commit
ed9d988cd8
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user