suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

removed chop-string, fix url-path->path

Browse Source 
svn: r3131
This commit is contained in:
Eli Barzilay 2006-05-30 19:21:00 +00:00
parent f8c0eb7c87
commit f662133a9a
1 changed files with 11 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/web-server/util.ss
View File

@ -114,7 +114,7 @@
; more here - ".." should probably raise an error instead of disappearing. ; more here - ".." should probably raise an error instead of disappearing.
; XXX: This is terrible. should re-write. ; XXX: This is terrible. should re-write.
(define (url-path->path base p) (define (url-path->path base p)
(let ([path-elems (chop-string #\/ p)]) (let ([path-elems (regexp-split #rx"/" p)])
;;; Hardcoded, bad, and wrong ;;; Hardcoded, bad, and wrong
(if (or (string=? (car path-elems) "servlets") (if (or (string=? (car path-elems) "servlets")
(and (string=? (car path-elems) "") (and (string=? (car path-elems) "")
@ -141,16 +141,16 @@
f] f]
[else [else
f]))) ;; Don't worry about e.g. links for now f]))) ;; Don't worry about e.g. links for now
; spidey can't check build-path's use of only certain symbols
(apply build-path base (apply build-path base
(foldr (lambda (x acc) (reverse!
(foldl (lambda (x acc)
(cond (cond
[(string=? x "") acc] [(string=? x "") acc]
[(string=? x ".") acc] [(string=? x ".") acc]
[(string=? x "..") acc] ; ignore ".." (cons 'up acc)] [(string=? x "..") (if (pair? acc) (cdr acc) acc)]
[else (cons x acc)])) [else (cons x acc)]))
null null
(chop-string #\/ p)))))) (regexp-split #rx"/" p)))))))
; update-params : Url (U #f String) -> String ; update-params : Url (U #f String) -> String
; to create a new url just like the old one, but with a different parameter part ; to create a new url just like the old one, but with a different parameter part
@ -177,23 +177,6 @@
[else ; conflate 'relative and #f [else ; conflate 'relative and #f
new-acc]))))) new-acc])))))
; chop-string : Char String -> (listof String)
(define (chop-string separator s)
(let ([p (open-input-string s)])
(let extract-parts ()
(cons (list->string
(let part ()
(let ([char (peek-char p)])
(cond
[(eof-object? char) null]
[else (cond
[(eq? separator char) null]
[else (read-char p) (cons char (part))])]))))
(cond
[(eof-object? (read-char p)) null]
[else (extract-parts)])))))
; this should go somewhere that other collections can use it too ; this should go somewhere that other collections can use it too
(define-syntax provide-define-struct (define-syntax provide-define-struct
(lambda (stx) (lambda (stx)