Adding post request hook mechanism.

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*))