Adding post request hook mechanism.

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* '())
@@ -73,6 +75,10 @@
   (set! *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)
   (server-response-headers #f)
@@ -126,13 +132,23 @@
          (lambda (path proc)
            (proc))))
     (call/cc (lambda (continue)
+               (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))))
-                         *request-handler-hooks*)
+                             *post-request-handler-hooks*)))))))
-               (handler path proc)))))
 
 (define (resource-match/procedure path method)
   (let loop ((resources *proc-resources*))