Wed Jun 15 09:21:48 UTC 2011  pix@kepibu.org
  * Cache known-good copies; simplify working with rucksack
diff -rN -u old-claki/claki.lisp new-claki/claki.lisp
--- old-claki/claki.lisp	2016-02-04 00:21:09.000000000 +0000
+++ new-claki/claki.lisp	2016-02-04 00:21:10.000000000 +0000
@@ -152,15 +152,22 @@
        page)
       (t nil))))
 
-;; TODO?: persist this, so we don't have to care whether cliki remembers it
 (defun get-cliki-source (url version)
   "Fetches the source text of a given version of a cliki page.  That is, it
 returns the text you should POST to revert a cliki page to the given version."
-  (multiple-value-bind (page status headers)
-      (drakma:http-request (format nil "http://cliki.net/~a?source&v=~a" url version))
-    (cond
-      ((= 200 status) page)
-      (t (error "crap!")))))
+  (or (find-in-cache url version)
+      (multiple-value-bind (page status headers)
+          (drakma:http-request (format nil "http://cliki.net/~a?source&v=~a" url version))
+        (declare (ignore headers))
+        (cond
+          ((= 200 status)
+           ;; We have to coerce to a simple-string because rucksack mistakenly
+           ;; assumes non-simple strings have a fill pointer
+           (cache-known-good url version (coerce page 'simple-string))
+           page)
+          (t (error "crap!"))))))
+
+#+(or) (get-cliki-source "araneida" "281")
 
 (defun attended-revert-new-spam ()
   (mapcar #'parse-page (get-recent-changes))
@@ -195,24 +202,53 @@
 
 (defvar *state-file* (or #.*load-pathname* #p"/home/pixel/repos/claki/state/"))
 
+(defmacro with-rucksack-and-transaction ((rucksack) (&rest root-vars) &body body)
+  (with-unique-names (rest)
+    `(rucksack:with-rucksack (,rucksack *state-file*)
+       (rucksack:with-transaction ()
+         (destructuring-bind (&optional ,@root-vars &rest ,rest) (ordered-roots rs:*rucksack*)
+           (declare (ignore ,rest) ,@(when (member '_ root-vars) `((ignore _))))
+           ,@body)))))
+
+(defun ordered-roots (sack)
+  (sort (rs:rucksack-roots sack) #'< :key #'rs:object-id))
+
+(defun initialize-rucksack ()
+  (with-rucksack-and-transaction (rs) ()
+    (let ((roots (rs:rucksack-roots rs:*rucksack*)))
+      (dotimes (i (- 2 (length roots)))
+        (rs:add-rucksack-root (make-instance 'rs:btree :key< 'string<) rs:*rucksack*)))))
+
+#+(or) (initialize-rucksack)
+
 (defun save-state ()
-  (rucksack:with-rucksack (rs *state-file*)
-    (rucksack:with-transaction ()
-      (unless (rs:rucksack-roots rs:*rucksack*)
-        (rs:add-rucksack-root (make-instance 'rs:btree :key< 'string<) rs:*rucksack*))
-      (let ((btree (first (rs:rucksack-roots rs:*rucksack*))))
-        (rs:btree-insert btree 'spam-urls *spam-urls*)
-        (rs:btree-insert btree 'ham-urls *okay-urls*)
-        (rs:btree-insert btree 'known-good *last-known-good*)))))
+  (with-rucksack-and-transaction (rs) (btree)
+    (rs:btree-insert btree 'spam-urls *spam-urls*)
+    (rs:btree-insert btree 'ham-urls *okay-urls*)
+    (rs:btree-insert btree 'known-good *last-known-good*)))
 
 #+(or) (save-state)
 
 (defun restore-state ()
-  (rs:with-rucksack (rs *state-file*)
-    (rs:with-transaction ()
-      (let ((btree (first (rs:rucksack-roots rs:*rucksack*))))
-        (setf *spam-urls* (rs:btree-search btree 'spam-urls)
-              *okay-urls* (rs:btree-search btree 'ham-urls)
-              *last-known-good* (rs:btree-search btree 'known-good))))))
+  (with-rucksack-and-transaction (rs) (btree)
+    (setf *spam-urls* (rs:btree-search btree 'spam-urls)
+          *okay-urls* (rs:btree-search btree 'ham-urls)
+          *last-known-good* (rs:btree-search btree 'known-good))))
 
 #+(or) (restore-state)
+#+(or) (with-rucksack-and-transaction (rs) ()
+         (ordered-roots rs:*rucksack*))
+
+(defun cache-known-good (cliki-page version content)
+  (with-rucksack-and-transaction (rs) (_ btree)
+    (rs:btree-insert btree cliki-page (list version content))))
+
+(defun find-in-cache (cliki-page version)
+  (with-rucksack-and-transaction (rs) (_ btree)
+    (destructuring-bind (&optional cached-version cached-content)
+        (rs:btree-search btree cliki-page :default-value nil :errorp nil)
+      (and cached-version
+           (string= cached-version version)
+           cached-content))))
+
+#+(or) (find-in-cache "araneida" "281")