Reorganized codebase

1 files changed, 71 insertions, 0 deletions

diff --git a/src/flash.lisp b/src/flash.lisp
new file mode 100644
index 0000000..b655fa0
--- /dev/null
+++ b/src/flash.lisp
@@ -0,0 +1,71 @@
+;;;; flash.lisp -- communicating between page loads
+
+(in-package :dnd)
+
+(defvar *flashes*
+  (make-hash-table :test #'equal :synchronized t))
+(defvar *flash-lock*
+  (bt:make-lock "flash lock"))
+
+(defparameter +flash-cookie-name+ "DNDFLASHKEY")
+(defparameter +flash-value-lifetime+ 10
+  "Number of seconds a flashed value lives.")
+
+(defstruct flash-entry
+  "TABLE is a PLIST"
+  (timestamp (get-universal-time))
+  (table nil))
+
+(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."
+  (check-type label keyword)
+  (let* ((key
+           (or (lzb:request-cookie +flash-cookie-name+) (nuid)))
+         (now
+           (get-universal-time)))
+    ;; holding a lock here b/c I do stuff in between getting an entry
+    ;; and writing to it.
+    (bt:with-lock-held (*flash-lock*)
+      (let ((entry
+              (or (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))))
+
+
+(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."
+  (bt:with-lock-held (*flash-lock*) 
+    (a:when-let* ((key (lzb:request-cookie +flash-cookie-name+))
+                  (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)
+           ;; might as well delete the entry if its table is empty.
+           (when (null (flash-entry-table entry))
+             (remhash key *flashes*))
+           val))
+        (t
+         ;; drop expired entries and return nil
+         (remhash key *flashes*)
+         nil)))))
+