Allow flushed servlet instances to be specified.

Author: kimmyg

web-server-lib/web-server/dispatchers/dispatch-servlets.rkt

@@ -23,16 +23,21 @@
  [make-cached-url->servlet
   (-> url->path/c
       path->servlet/c
-      (values (-> void)
+      (values (() ((or/c false/c (listof url?))) . ->* . void?)
               url->servlet/c))])
 
 (define (make-cached-url->servlet         
          url->path 
          path->servlet)
   (define config:scripts (make-cache-table))
-  (values (lambda ()
+  (values (lambda ([uris #f])
             ;; This is broken - only out of date or specifically mentioned scripts should be flushed.  This destroys persistent state!
-            (cache-table-clear! config:scripts))
+            (cache-table-clear!
+             config:scripts
+             (and uris
+                  (for/list ([uri (in-list uris)])
+                    (let-values ([(servlet-path _) (url->path uri)])
+                      (string->symbol (path->string servlet-path)))))))
           (lambda (uri)
             (define-values (servlet-path _)
               (with-handlers

web-server-lib/web-server/private/cache-table.rkt

@@ -8,11 +8,15 @@
   (make-cache-table (make-hasheq)
                     (make-semaphore 1)))
 
-(define (cache-table-clear! ct)
+(define (cache-table-clear! ct [entry-ids #f])
   (call-with-semaphore
    (cache-table-semaphore ct)
    (lambda ()
-     (set-cache-table-hash! ct (make-hasheq)))))
+     (if entry-ids
+       (let ([cache-hash (cache-table-hash ct)])
+         (for ([entry-id (in-list entry-ids)])
+           (hash-remove! cache-hash entry-id))) 
+       (set-cache-table-hash! ct (make-hasheq))))))
 
 (define (cache-table-lookup! ct entry-id entry-thunk)
   (define ht (cache-table-hash ct))
@@ -31,5 +35,5 @@
  [rename new-cache-table make-cache-table
          (-> cache-table?)]
  [cache-table-lookup! (cache-table? symbol? (-> any/c) . -> . any/c)]
- [cache-table-clear! (cache-table? . -> . void?)]
+ [cache-table-clear! ((cache-table?) ((or/c false/c (listof symbol?))) . ->* . void?)]
  [cache-table? (any/c . -> . boolean?)])