Working on url-encoding library
This commit is contained in:
parent
a55cefcbd1
commit
627bb0e9f0
|
|
@ -4,6 +4,7 @@
|
|||
*.tgz
|
||||
*.log
|
||||
.*
|
||||
*.json
|
||||
retropikzel/*/README.html
|
||||
foreign
|
||||
venv
|
||||
|
|
|
|||
|
|
@ -1,41 +1,53 @@
|
|||
;; Works same as Javascript encodeURI
|
||||
;; https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURI
|
||||
|
||||
(define encode-replacements
|
||||
(list (list " " "%20")
|
||||
(list " " "+")
|
||||
(list "!" "%21")
|
||||
(list "#" "%23")
|
||||
(list "$" "%24")
|
||||
(list "%" "%25")
|
||||
(list "&" "%26")
|
||||
(list "'" "%27")
|
||||
(list "(" "%28")
|
||||
(list ")" "%29")
|
||||
(list "*" "%2A")
|
||||
(list "+" "%2B")
|
||||
(list "," "%2C")
|
||||
(list "/" "%2F")
|
||||
(list ":" "%3A")
|
||||
(list ";" "%3B")
|
||||
(list "=" "%3D")
|
||||
(list "?" "%3F")
|
||||
(list "@" "%40")
|
||||
(list "[" "%5B")
|
||||
(list "]" "%5D")
|
||||
(list "<" "%3C")
|
||||
(list ">" "%3E")
|
||||
(list "\\" "%5C")
|
||||
(list "\"" "%22")
|
||||
(list "\n" "%0A")
|
||||
(list "\r" "%0D")))
|
||||
|
||||
'((#\space "%20")
|
||||
(#\% "%25")
|
||||
(#\[ "%5B")
|
||||
(#\] "%5D")
|
||||
(#\> "%3E")
|
||||
(#\< "%3C")
|
||||
(#\\" "%5C")
|
||||
(#\\" "%22")
|
||||
(#\\" "%0A")
|
||||
(#\\" "%0D")
|
||||
(#\^ "%5E")
|
||||
(#\{ "%7B")
|
||||
(#\} "%7D")
|
||||
(#\| "%7C")
|
||||
(#\€ "%E2%82%AC")
|
||||
(#\ƒ "%C6%92")
|
||||
(#\„ "%E2%80%9E")
|
||||
(#\… "%E2%80%A6")
|
||||
(#\† "%E2%80%A0")
|
||||
(#\‡ "%E2%80%A1")
|
||||
(#\ˆ "%CB%86")
|
||||
(#\‰ "%E2%80%B0")
|
||||
(#\Š "%C5%A0")
|
||||
(#\‹ "%E2%80%B9")
|
||||
(#\Œ "%C5%92")
|
||||
(#\Ž "%C5%BD")
|
||||
(#\‘ "%E2%80%98")
|
||||
(#\' "%E2%80%99")
|
||||
(#\“ "%E2%80%9C")
|
||||
(#\” "%E2%80%9D")))
|
||||
(define decode-replacements (map reverse encode-replacements))
|
||||
;(define char-lookup-table (make-vector 10000 #f))
|
||||
|
||||
(define (get-replacement key mode)
|
||||
#;(for-each
|
||||
(lambda (pair)
|
||||
(vector-set! char-lookup-table (char->integer (car pair)) (cadr pair)))
|
||||
encode-replacements)
|
||||
|
||||
|
||||
#;(define (get-replacement key mode)
|
||||
(let ((r (if (string=? mode "encode")
|
||||
(assoc key encode-replacements)
|
||||
(assoc key decode-replacements))))
|
||||
(if r (car (cdr r)) key)))
|
||||
|
||||
(define (endecode mode s)
|
||||
#;(define (endecode mode s)
|
||||
(if (not s)
|
||||
""
|
||||
(letrec ((s-length (string-length s))
|
||||
|
|
@ -55,5 +67,30 @@
|
|||
result))))
|
||||
(looper 0 ""))))
|
||||
|
||||
(define (url-encode str) (cond ((string? str) (endecode "encode" str)) (else str)))
|
||||
(define (url-decode str) (cond ((string? str) (endecode "decode" str)) (else str)))
|
||||
(define (encode-url str)
|
||||
(when (not (string? str)) (error "encode-url: Can only encode strings" str))
|
||||
(letrec* ((str-vector (list->vector (string->list str)))
|
||||
(str-length (vector-length str-vector))
|
||||
(looper (lambda (index result)
|
||||
(if (= index str-length)
|
||||
(list->string (reverse result))
|
||||
(looper (+ index 1)
|
||||
(cond
|
||||
((char=? (vector-ref str-vector index) #\space)
|
||||
(cons #\0 (cons #\2 (cons #\% result))))
|
||||
((char=? (vector-ref str-vector index) #\%)
|
||||
(cons #\5 (cons #\2 (cons #\% result))))
|
||||
((char=? (vector-ref str-vector index) #\[)
|
||||
(cons #\B (cons #\5 (cons #\% result))))
|
||||
(else (cons (vector-ref str-vector index) result))))))))
|
||||
(looper 0 '()))
|
||||
#;(let ((result '()))
|
||||
(for-each
|
||||
(lambda (c)
|
||||
;(set! result (cons (or (vector-ref char-lookup-table (char->integer c)) (string c)) result))
|
||||
(set! result (cons c result))
|
||||
)
|
||||
(string->list str))
|
||||
(list->string (reverse result))))
|
||||
|
||||
;(define (decode-url str) (cond ((string? str) (endecode "decode" str)) (else str)))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,9 @@
|
|||
(define-library
|
||||
(retropikzel url-encoding)
|
||||
(import (scheme base))
|
||||
(export url-encode
|
||||
url-decode)
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme char))
|
||||
(export encode-url
|
||||
;decode-url
|
||||
)
|
||||
(include "url-encoding.scm"))
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,17 @@
|
|||
(test-begin "url-encoding")
|
||||
|
||||
(test-assert "url-encode-1"
|
||||
(string=? (encode-url "https://retropikzel.neocities.org/blog/2025-12-24 - Making a Scheme script on windows.html")
|
||||
"https://retropikzel.neocities.org/blog/2025-12-24%20-%20Making%20a%20Scheme%20script%20on%20windows.html"))
|
||||
|
||||
(write (encode-url "https://retropikzel.neocities.org/blog/2025-12-24 - Making a Scheme script on windows.html"))
|
||||
(newline)
|
||||
|
||||
(define long-text (slurp "retropikzel/url-encoding/long-test-string.txt"))
|
||||
|
||||
(test-assert "url-encode long-text" (string? (encode-url long-text)))
|
||||
|
||||
(define long-text1 (slurp "retropikzel/url-encoding/long-test-string1.txt"))
|
||||
(test-assert "url-encode long-text1" (string? (encode-url long-text1)))
|
||||
|
||||
(test-end "url-encoding")
|
||||
Loading…
Reference in New Issue