Adding support for URI objects.
This commit is contained in:
15
simple.scm
15
simple.scm
@@ -192,7 +192,11 @@
|
|||||||
(if (procedure? path)
|
(if (procedure? path)
|
||||||
(set! *proc-resources* (cons (list path upcase-method proc) *proc-resources*))
|
(set! *proc-resources* (cons (list path upcase-method proc) *proc-resources*))
|
||||||
(hash-table-set! *static-resources*
|
(hash-table-set! *static-resources*
|
||||||
(list path upcase-method) proc))))
|
(list
|
||||||
|
(cond ((string? path) path)
|
||||||
|
((uri-reference? path) (uri->string path))
|
||||||
|
(else (abort "unknown path type")))
|
||||||
|
upcase-method) proc))))
|
||||||
methods)))
|
methods)))
|
||||||
|
|
||||||
(define (reset-resources!)
|
(define (reset-resources!)
|
||||||
@@ -316,10 +320,11 @@
|
|||||||
($ 'sid))))
|
($ 'sid))))
|
||||||
|
|
||||||
(define (redirect-to new-uri)
|
(define (redirect-to new-uri)
|
||||||
;; Just set the `%redirect' internal parameter, so `run-resource' is
|
(display (string-append "<html><head><meta http-equiv=\"refresh\" content=\"0; URL="
|
||||||
;; able to know where to redirect.
|
(cond ((string? new-uri) new-uri)
|
||||||
(%redirect new-uri)
|
((uri-reference? new-uri) (uri->string new-uri))
|
||||||
"")
|
(else (abort "invalid URI construct")))
|
||||||
|
"\"></head></html")))
|
||||||
|
|
||||||
(define ($ var #!optional default/converter)
|
(define ($ var #!optional default/converter)
|
||||||
(unless (http-request-variables)
|
(unless (http-request-variables)
|
||||||
|
|||||||
Reference in New Issue
Block a user