aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/main.lisp40
-rw-r--r--src/util.lisp2
2 files changed, 29 insertions, 13 deletions
diff --git a/src/main.lisp b/src/main.lisp
index 3d081b4..1917763 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -211,6 +211,13 @@
(json:write-key-value :isFlagged (if (not (null flagged-by)) t :false))
(json:write-key-value :isLocked (if lockedp t :false)))))
+;;; CACHES
+
+
+(defvar *newest-cache-size* 20)
+(defvar *newest-cache* nil
+ "A cache of the newest oneliners")
+
;;; SERVICE CONTROL
(defvar *server* nil)
@@ -390,14 +397,6 @@ startup process attempts to start as swank server on the provided port.
(mapc #'db:delete-object expired-invites)))))
-;;; EXTERNAL CACHES
-
-(defparameter +newest-queue-size+ 10)
-(defvar *newest-queue-lock*
- (bt:make-lock "newest-queue-lock"))
-(defvar *newest-queue*
- (make-qb +newest-queue-size+))
-
;;; API DEFINITION AND PROVISIONING
(defparameter +oneliners-description+
@@ -501,8 +500,10 @@ startup process attempts to start as swank server on the provided port.
:brief brief
:name name
:runstyle (if runstyle (a:make-keyword runstyle) :auto)))))
- (bt:with-lock-held (*newest-queue-lock*)
- (enqueue-qb *newest-queue* ol))
+ (setf *newest-cache*
+ (if (< (length *newest-cache*) *newest-cache-size*)
+ (cons ol *newest-cache*)
+ (cons ol (drop-last *newest-cache*))))
ol))
(defun unflag-oneliner (oneliner)
@@ -542,12 +543,25 @@ startup process attempts to start as swank server on the provided port.
(when runstyle
(setf (oneliner-runstyle ol) (a:make-keyword runstyle)))))
-
;;; NONTRANSACTIONAL DATABASE QUERIES
(defun newest-oneliners (&optional limit)
- (bt:with-lock-held (*newest-queue-lock*)
- (qb-look *newest-queue* :limit limit :reversep t)))
+ (cond
+ ((and *newest-cache* (<= limit (length *newest-cache*)))
+ (a:subseq* *newest-cache* 0 limit))
+ (t
+ (let (newest)
+ (loop
+ for ol in (db:store-objects-with-class 'oneliner)
+ when (< (length newest) limit)
+ do (setf newest (sort (cons ol newest) #'> :key #'created-at))
+ when (> (created-at ol) (created-at (first newest)))
+ do (setf newest
+ (cons ol (drop-last newest))))
+ (setf *newest-cache*
+ (a:subseq* newest 0 *newest-cache-size*))
+ newest))))
+
(defun flagged-oneliners (&optional limit)
(loop
diff --git a/src/util.lisp b/src/util.lisp
index 426acb0..2f3da03 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -81,3 +81,5 @@ when T, Puts the newest items first."
(a:subseq* seq 0 limit)
seq))))
+(defun drop-last (xs &optional (howmany 1))
+ (reverse (nthcdr 1 (reverse xs))))