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

strange build-path bug

Browse Source 
svn: r1933
This commit is contained in:
Jay McCarthy 2006-01-23 15:30:00 +00:00
parent 30b48f9b68
commit 46b83f1872
1 changed files with 23 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -111,25 +111,35 @@
[(path? base) base]))) [(path? base) base])))
; 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.
(define (url-path->path base p) (define (url-path->path base p)
(let ((path-elems (chop-string #\/ p))) (let ([path-elems (chop-string #\/ 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) "")
(string=? (cadr path-elems) "servlets"))) (string=? (cadr path-elems) "servlets")))
;; Servlets can have extra stuff after them ;; Servlets can have extra stuff after them
(let loop ((p-e (if (string=? (car path-elems) "") (let ([build-path
(lambda (b p)
(if (string=? p "")
b
(build-path b p)))])
(let loop ([p-e (if (string=? (car path-elems) "")
(cddr path-elems) (cddr path-elems)
(cdr path-elems))) (cdr path-elems))]
(f (build-path base [f (build-path base
(if (string=? (car path-elems) "") (if (string=? (car path-elems) "")
(cadr path-elems) (cadr path-elems)
(car path-elems))))) (car path-elems)))])
(cond (cond
((null? p-e) f) [(null? p-e)
((directory-exists? f) (loop (cdr p-e) (build-path f (car p-e)))) f]
((file-exists? f) f) [(directory-exists? f)
(else f))) ;; Don't worry about e.g. links for now (loop (cdr p-e) (build-path f (car p-e)))]
[(file-exists? f)
f]
[else
f]))) ;; Don't worry about e.g. links for now
; spidey can't check build-path's use of only certain symbols ; spidey can't check build-path's use of only certain symbols
(apply build-path base (apply build-path base
(foldr (lambda (x acc) (foldr (lambda (x acc)