Modify: flash feature to be more robust; add labels

1 files changed, 37 insertions, 18 deletions

diff --git a/flash.lisp b/flash.lisp
index 27a6c31..09818b0 100644
--- a/flash.lisp
+++ b/flash.lisp
@@ -9,33 +9,52 @@
 (defparameter +flash-value-lifetime+ 10
   "Number of seconds a flashed value lives.")
 
+(defstruct flash-entry
+  (timestamp (get-universal-time))
+  (table nil))
 
-(defun flash (value)
+(defun flash-entry-alive-p (entry)
+  "Returns T if ENTRY has not expired."
+  (<= (get-universal-time)
+      (+ (flash-entry-timestamp entry) +flash-value-lifetime+)))
+
+(defun flash (label value)
   "A flash is a one-time inter-request value. Once stored, it can only
 be retrieved once. And if not retrieved in a short period of time, it
 expires."
-  (let ((key (nuid))
-        (now (get-universal-time)))
-    (setf (gethash key *flashes*) (cons value now))
+  (check-type label keyword)
+  (let* ((key
+           (or (lzb:request-cookie +flash-cookie-name+) (nuid)))
+         (now
+           (get-universal-time))
+         (entry
+           (gethash key *flashes* (make-flash-entry))))
+    ;; update the entry
+    (setf (flash-entry-timestamp entry) now
+          (getf (flash-entry-table entry) label) value
+          (gethash key *flashes*) entry)
+    ;; set the cookie, updating its expiration if necessary 
     (lzb:set-response-cookie
      +flash-cookie-name+ key
      ;; TODO: generalize domain
      :path "/" :domain "localhost" 
-     :expires (+ +flash-value-lifetime+ now))  
-    key))
-
-(defun flashed-value-alive-p (val)
-  (<= (+ (cdr val) +flash-value-lifetime+)
-      (get-universal-time)))
+     :expires (+ +flash-value-lifetime+ now))))
 
-(defun flashed-value ()
-  "Retrieves the value flashed in this request, if it exists, and
-returns it.  
 
-Removes the flashed value from the hash table if it was found."
+(defun flashed-value (label)
+  "Retrieves and deletes the flashed value with label LABEL associated
+with this request. If the value exists, return it. Otherwise return
+NIL."
   (a:when-let* ((key (lzb:request-cookie +flash-cookie-name+))
-                (val (gethash key *flashes*)))
-    (remhash key *flashes*)
-    (when (flashed-value-alive-p val)
-      (car val))))
+                (entry (gethash key *flashes*)))
+    (cond
+      ((flash-entry-alive-p entry)
+       (let ((val (getf (flash-entry-table entry) label)))
+         ;; can only retrieve once
+         (remf (flash-entry-table entry) label)
+         val))
+      (t
+       ;; drop expired entries and return nil
+       (remhash key *flashes*)
+       nil))))