|
|
|
@ -113,21 +113,12 @@
|
|
|
|
|
(handle-not-found
|
|
|
|
|
(let ((old-handler (handle-not-found)))
|
|
|
|
|
(lambda (_)
|
|
|
|
|
(let* ((path-list (uri-path (request-uri (current-request))))
|
|
|
|
|
(method (request-method (current-request)))
|
|
|
|
|
(dir? (equal? (last path-list) ""))
|
|
|
|
|
(path (if (null? (cdr path-list))
|
|
|
|
|
(car path-list)
|
|
|
|
|
(string-append "/" (concat (cdr path-list) "/"))))
|
|
|
|
|
(proc (resource-ref path method)))
|
|
|
|
|
(let* ((method (request-method (current-request)))
|
|
|
|
|
(uri (request-uri (current-request)))
|
|
|
|
|
(proc (resource-ref uri method)))
|
|
|
|
|
(if proc
|
|
|
|
|
(run-resource proc path)
|
|
|
|
|
(if dir? ;; try to find a procedure with the trailing slash removed
|
|
|
|
|
(let ((proc (resource-ref (string-chomp path "/") method)))
|
|
|
|
|
(if proc
|
|
|
|
|
(run-resource proc path)
|
|
|
|
|
(old-handler _)))
|
|
|
|
|
(old-handler _))))))))
|
|
|
|
|
(run-resource proc uri)
|
|
|
|
|
(old-handler _)))))))
|
|
|
|
|
|
|
|
|
|
(define (run-resource proc path)
|
|
|
|
|
(reset-per-request-parameters)
|
|
|
|
@ -158,11 +149,11 @@
|
|
|
|
|
(loop (cdr resources))))
|
|
|
|
|
(loop (cdr resources)))))))
|
|
|
|
|
|
|
|
|
|
(define (resource-ref path method)
|
|
|
|
|
(if (hash-table-exists? *static-resources* (list path method))
|
|
|
|
|
(let ((proc (hash-table-ref *static-resources* (list path method))))
|
|
|
|
|
(lambda () (proc path)))
|
|
|
|
|
(resource-match/procedure path method)))
|
|
|
|
|
(define (resource-ref uri method)
|
|
|
|
|
(if (hash-table-exists? *static-resources* (list (uri-path uri) method))
|
|
|
|
|
(let ((proc (hash-table-ref *static-resources* (list (uri-path uri) method))))
|
|
|
|
|
(lambda () (proc uri)))
|
|
|
|
|
(resource-match/procedure uri method)))
|
|
|
|
|
|
|
|
|
|
(define (add-resource! path proc method)
|
|
|
|
|
(let ((methods (if (list? method) method (list method))))
|
|
|
|
@ -174,8 +165,8 @@
|
|
|
|
|
(set! *proc-resources* (cons (list path upcase-method proc) *proc-resources*))
|
|
|
|
|
(hash-table-set! *static-resources*
|
|
|
|
|
(list
|
|
|
|
|
(cond ((string? path) path)
|
|
|
|
|
((uri-reference? path) (uri->string path))
|
|
|
|
|
(cond ((string? path) (uri-path (uri-reference path)))
|
|
|
|
|
((uri-reference? path) (uri-path path))
|
|
|
|
|
(else (abort "unknown path type")))
|
|
|
|
|
upcase-method) proc))))
|
|
|
|
|
methods)))
|
|
|
|
@ -188,7 +179,8 @@
|
|
|
|
|
(handle-directory
|
|
|
|
|
(let ((old-handler (handle-directory)))
|
|
|
|
|
(lambda (path)
|
|
|
|
|
(cond ((resource-ref path (request-method (current-request)))
|
|
|
|
|
(cond ((resource-ref (request-uri (current-request))
|
|
|
|
|
(request-method (current-request)))
|
|
|
|
|
=> (cut run-resource <> path))
|
|
|
|
|
(else (old-handler path)))))))
|
|
|
|
|
|
|
|
|
|