summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThomas Hintz <t@thintz.com>2015-06-18 12:21:24 -0700
committerThomas Hintz <t@thintz.com>2015-06-18 12:21:24 -0700
commit19fb2577692abb1d96b61032d3a7380cc941da06 (patch)
treef01f8b41b147ff9f4986573b4da87b01a454496e
parentf9a7563ed67a89f84cc338b62c6d1eaea3f2d3a7 (diff)
downloadsimple-19fb2577692abb1d96b61032d3a7380cc941da06.tar.gz
Adding post request hook mechanism.
-rw-r--r--simple.scm34
1 files changed, 25 insertions, 9 deletions
diff --git a/simple.scm b/simple.scm
index 14860ee..6166fde 100644
--- a/simple.scm
+++ b/simple.scm
@@ -3,7 +3,8 @@
add-request-handler-hook! remove-request-handler-hook!
define-page redirect-to enable-session-cookie session-cookie-setter
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)
(use posix srfi-13 tcp ports)
@@ -46,6 +47,7 @@
(define %error (make-parameter #f))
(define %page-title (make-parameter #f))
(define *request-handler-hooks* '())
+(define *post-request-handler-hooks* '())
(define *static-resources* (make-hash-table equal?))
(define *proc-resources* '())
@@ -71,7 +73,11 @@
(define (remove-request-handler-hook! name)
(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
(http-request-variables #f)
@@ -126,13 +132,23 @@
(lambda (path proc)
(proc))))
(call/cc (lambda (continue)
- (for-each (lambda (hook)
- ((cdr hook) path
- (lambda ()
- (handler path proc)
- (continue #f))))
- *request-handler-hooks*)
- (handler path proc)))))
+ (dynamic-wind
+ (lambda ()
+ (for-each (lambda (hook)
+ ((cdr hook) path
+ (lambda ()
+ (handler path proc)
+ (continue #f))))
+ *request-handler-hooks*))
+ (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)
(let loop ((resources *proc-resources*))