tjhintz/simple
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Adding post request hook mechanism.

Browse Source
This commit is contained in:
Thomas Hintz
2015-06-18 12:21:24 -07:00
parent f9a7563ed6
commit 19fb257769
1 changed files with 25 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
simple.scm
View File

@@ -3,7 +3,8 @@
add-request-handler-hook! remove-request-handler-hook! add-request-handler-hook! remove-request-handler-hook!
define-page redirect-to enable-session-cookie session-cookie-setter define-page redirect-to enable-session-cookie session-cookie-setter
session-cookie-name $session $session-set! $ page-access-denied-message session-cookie-name $session $session-set! $ page-access-denied-message
debug-file page-access-control server-start $session-destroy!) debug-file page-access-control server-start $session-destroy!
add-post-request-handler-hook!)
(import scheme chicken data-structures utils extras ports srfi-69 files srfi-1) (import scheme chicken data-structures utils extras ports srfi-69 files srfi-1)
(use posix srfi-13 tcp ports) (use posix srfi-13 tcp ports)
@@ -46,6 +47,7 @@
(define %error (make-parameter #f)) (define %error (make-parameter #f))
(define %page-title (make-parameter #f)) (define %page-title (make-parameter #f))
(define *request-handler-hooks* '()) (define *request-handler-hooks* '())
(define *post-request-handler-hooks* '())
(define *static-resources* (make-hash-table equal?)) (define *static-resources* (make-hash-table equal?))
(define *proc-resources* '()) (define *proc-resources* '())
@@ -73,6 +75,10 @@
(set! *request-handler-hooks* (set! *request-handler-hooks*
(alist-delete! name *request-handler-hooks*))) (alist-delete! name *request-handler-hooks*)))
(define (add-post-request-handler-hook! name proc)
(set! *post-request-handler-hooks*
(alist-update! name proc *post-request-handler-hooks*)))
(define (reset-per-request-parameters) ;; to cope with spiffy's thread reuse (define (reset-per-request-parameters) ;; to cope with spiffy's thread reuse
(http-request-variables #f) (http-request-variables #f)
(server-response-headers #f) (server-response-headers #f)
@@ -126,13 +132,23 @@
(lambda (path proc) (lambda (path proc)
(proc)))) (proc))))
(call/cc (lambda (continue) (call/cc (lambda (continue)
(dynamic-wind
(lambda ()
(for-each (lambda (hook) (for-each (lambda (hook)
((cdr hook) path ((cdr hook) path
(lambda () (lambda ()
(handler path proc) (handler path proc)
(continue #f)))) (continue #f))))
*request-handler-hooks*) *request-handler-hooks*))
(handler path proc))))) (lambda ()
(handler path proc))
(lambda ()
(for-each (lambda (hook)
((cdr hook) path
(lambda ()
(handler path proc)
(continue #f))))
*post-request-handler-hooks*)))))))
(define (resource-match/procedure path method) (define (resource-match/procedure path method)
(let loop ((resources *proc-resources*)) (let loop ((resources *proc-resources*))