diff options
| author | Thomas Hintz <t@thintz.com> | 2015-04-29 10:49:41 -0700 |
|---|---|---|
| committer | Thomas Hintz <t@thintz.com> | 2015-04-29 10:49:41 -0700 |
| commit | 6bf71718d1163f51e6224bfcf3de804a2eb79587 (patch) | |
| tree | dd7c385f06afb61d244b042226611d6e62df9804 | |
| parent | 8a50bb984c612769976b83cd186fa0edfddcd9da (diff) | |
| download | simple-6bf71718d1163f51e6224bfcf3de804a2eb79587.tar.gz | |
Adding support for URI objects.
| -rw-r--r-- | simple.scm | 15 |
1 files changed, 10 insertions, 5 deletions
@@ -192,7 +192,11 @@ (if (procedure? path) (set! *proc-resources* (cons (list path upcase-method proc) *proc-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))) (define (reset-resources!) @@ -316,10 +320,11 @@ ($ 'sid)))) (define (redirect-to new-uri) - ;; Just set the `%redirect' internal parameter, so `run-resource' is - ;; able to know where to redirect. - (%redirect new-uri) - "") + (display (string-append "<html><head><meta http-equiv=\"refresh\" content=\"0; URL=" + (cond ((string? new-uri) new-uri) + ((uri-reference? new-uri) (uri->string new-uri)) + (else (abort "invalid URI construct"))) + "\"></head></html"))) (define ($ var #!optional default/converter) (unless (http-request-variables) |