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 2013-07-04 21:23:12.000000000 +0000
+++ new-claki/claki.lisp 2013-07-04 21:23:12.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")