Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Made article transactions atomic and consistent

  • Loading branch information...
commit 35ec483e354ccc71ebfd377e0c2ae3a40af1aadb 1 parent 41b80e0
@vsedach authored
View
2  TODO
@@ -1,2 +1,4 @@
+* fix up name/logout in chrome
+* fix up undo padding in parentheses
* make sure code coloring is specified properly and works
* make sure email works
View
34 cliki-convert/cliki-convert.lisp
@@ -22,28 +22,28 @@
do (setf content (fixup-tag regex content action)))
content))
-(defun maybe-delete-article (article args)
- (apply #'cliki2::delete-article article args))
+(defun delete-article (article authorship)
+ (cliki2::latest-revision
+ (cliki2::toggle-delete (bknr.datastore:store-object-id article) authorship)))
-(defun import-revision (article content args)
- (apply #'cliki2::add-revision article "import from CLiki" content args))
+(defun import-revision (article content authorship)
+ (cliki2::add-revision article "import from CLiki" content authorship))
(defun import-revisions (account article revision-paths)
(let ((timestamp-skew 0))
(dolist (path revision-paths)
- (let* ((date (+ (incf timestamp-skew) (file-write-date path)))
- (unix-date (local-time:timestamp-to-unix
- (local-time:universal-to-timestamp date)))
- (content (convert-article-revision (read-file path)))
- (args (list :author account
- :author-ip "0.0.0.0"
- :date date))
- (revision
- (or (when (and (eq path (car (last revision-paths)))
- (search "*(delete this page)"
- content :test #'char-equal))
- (maybe-delete-article article args))
- (import-revision article content args))))
+ (let* ((date (+ (incf timestamp-skew) (file-write-date path)))
+ (unix-date (local-time:timestamp-to-unix
+ (local-time:universal-to-timestamp date)))
+ (content (convert-article-revision (read-file path)))
+ (authorship (list :author account
+ :author-ip "0.0.0.0"
+ :date date))
+ (revision (or (when (and (eq path (car (last revision-paths)))
+ (search "*(delete this page)"
+ content :test #'char-equal))
+ (delete-article article authorship))
+ (import-revision article content authorship))))
(sb-posix:utimes (cliki2::revision-path revision)
unix-date unix-date)))))
View
101 src/article.lisp
@@ -11,24 +11,43 @@
(string-downcase (cut-whitespace title)))
(defun category-keyword (category-title)
- (intern (canonicalize category-title) '#:cliki2.categories))
+ (intern category-title '#:cliki2.categories))
(defun content-categories (content)
(let (categories)
(ppcre:do-register-groups (category) (#?/\*\(([^\)]*)\)/ content)
- (pushnew category categories :test #'string-equal))
+ (pushnew (canonicalize category) categories :test #'string=))
categories))
;;; article
-(defclass article (store-object)
+(defclass proto-article (store-object)
((title :initarg :title
:reader title)
- (canonical-title :reader canonical-title
- :index-type string-unique-index
+ (canonical-title :reader canonical-title)
+ (revisions :initarg :revisions
+ :accessor revisions))
+ (:metaclass persistent-class)
+ (:default-initargs :revisions ()))
+
+(defmethod shared-initialize :after ((article proto-article) slot-names
+ &key &allow-other-keys)
+ (with-slots (title canonical-title) article
+ (setf title (cut-whitespace title)
+ canonical-title (string-downcase title))))
+
+(defmethod link-to ((article proto-article))
+ (link-to (title article)))
+
+(defmethod link-to ((article-titled string))
+ #?[/${(uri-encode (cut-whitespace article-titled))}])
+
+(defun latest-revision (article)
+ (car (revisions article)))
+
+(defclass article (proto-article)
+ ((canonical-title :index-type string-unique-index
:index-reader article-with-canonical-title)
- (revisions :initform ()
- :accessor revisions)
(category-list :initform ()
:accessor category-list
:index-type hash-list-index
@@ -37,27 +56,13 @@
:accessor cached-content))
(:metaclass persistent-class))
-(defmethod shared-initialize :after ((article article) slot-names &key &allow-other-keys)
- (with-slots (title canonical-title) article
- (setf title (cut-whitespace title)
- canonical-title (string-downcase title))))
-
(defun find-article (title)
(article-with-canonical-title (canonicalize title)))
-(defun latest-revision (article)
- (car (revisions article)))
-
(defun article-description (article)
(let ((c (cached-content article)))
(subseq c 0 (ppcre:scan "\\.(?:\\s|$)|\\n|$" c))))
-(defmethod link-to ((article store-object))
- (link-to (canonical-title article)))
-
-(defmethod link-to ((article-titled string))
- #?[/${(uri-encode (cut-whitespace article-titled))}])
-
(defun %print-article-link (title class)
#H[<a href="${(link-to title)}" class="${class}">${title}</a>])
@@ -84,39 +89,44 @@
:reader summary))
(:metaclass persistent-class))
+(defun %revision-path (article revision-date)
+ #?"${*datadir*}articles/${(uri-encode (title article))}/${revision-date}")
+
(defun revision-path (revision)
- #?"${*datadir*}articles/${(uri-encode (canonical-title (article revision)))}/${(date revision)}")
+ (%revision-path (article revision) (date revision)))
(defun revision-content (revision)
(alexandria:read-file-into-string (revision-path revision)))
-(defun add-revision (article summary content &key
- (author (or *account*
- (get-anonymous-account (real-remote-addr))))
- (author-ip (real-remote-addr))
- (date (get-universal-time))
+(defun connection-authorship-info ()
+ (list :author (or *account* (get-anonymous-account (real-remote-addr)))
+ :author-ip (real-remote-addr)
+ :date (get-universal-time)))
+
+(deftransaction %add-revision (article revision-type authorship summary
+ categories content)
+ (let ((revision (apply #'make-instance revision-type
+ :article article
+ :summary summary
+ authorship)))
+ (push revision (revisions article))
+ (push revision *recent-revisions*)
+ (setf (category-list article) (mapcar #'category-keyword categories)
+ (cached-content article) content)
+ (index-article article)
+ revision))
+
+(defun add-revision (article summary content &optional
+ (authorship (connection-authorship-info))
(revision-type 'revision))
- (let ((new-revision (make-instance revision-type
- :article article
- :author author
- :author-ip author-ip
- :date date
- :summary summary))
- (content (remove #\Return content)))
+ (let ((content (remove #\Return content)))
(alexandria:write-string-into-file
content
- (ensure-directories-exist (revision-path new-revision))
+ (ensure-directories-exist (%revision-path article (getf authorship :date)))
:if-exists :supersede
:if-does-not-exist :create)
- (%add-revision article new-revision (content-categories content) content)
- (index-article article)
- new-revision))
-
-(deftransaction %add-revision (article revision categories content)
- (push revision (revisions article))
- (push revision *recent-revisions*)
- (setf (category-list article) (mapcar #'category-keyword categories)
- (cached-content article) content))
+ (%add-revision article revision-type authorship summary
+ (content-categories content) content)))
(defun link-to-edit (revision text)
#?[<a href="$(#/site/edit-article?title={(title (article revision))}&from-revision={(store-object-id revision)})">${text}</a>])
@@ -141,7 +151,8 @@
(unless (youre-banned?)
#H[<li>${(link-to-edit revision "Edit")}</li>]
#H[<li><a href="$(#/site/edit-article?create=t)">Create</a></li>]
- (when *account*
+ (when (and *account*
+ (not (string= "index" (title (article revision)))))
#H[<li><form method="post" action="$(#/site/delete?title={title})">
<input class="del" type="submit" value="Delete" /></form></li>]))))))
View
76 src/deleted-articles.lisp
@@ -1,15 +1,9 @@
(in-package #:cliki2)
(in-readtable cliki2)
-(defclass deleted-article (store-object)
- ((title :initarg :title
- :reader title)
- (canonical-title :initarg :canonical-title
- :reader canonical-title
- :index-type string-unique-index
- :index-reader deleted-article-with-title)
- (revisions :initarg :revisions
- :reader revisions))
+(defclass deleted-article (proto-article)
+ ((canonical-title :index-type string-unique-index
+ :index-reader deleted-article-with-title))
(:metaclass persistent-class))
(defun find-deleted-article (title)
@@ -21,55 +15,49 @@
(defmethod pprint-article-summary-li ((article deleted-article) separator)
#H[<li>] (pprint-article-link (title article)) #H[ ${separator} </li>])
-(defun %move-revisions (old-article new-article)
- (dolist (r (revisions old-article))
- (setf (slot-value r 'article) new-article)))
-
(defclass revision-undelete (revision) ()
(:metaclass persistent-class))
-(deftransaction tx-delete-article (article)
- (let ((deleted (make-instance 'deleted-article
- :title (title article)
- :canonical-title (canonical-title article)
- :revisions (revisions article))))
- (%move-revisions article deleted)))
-
-(defun delete-article (article &rest args)
- (prog1 (apply #'add-revision article "Deleted article" "" args)
- (tx-delete-article article)
- (delete-object article)))
-
-(deftransaction tx-undelete-article (deleted)
- (let ((article (make-instance 'article :title (title deleted))))
- (setf (slot-value article 'revisions) (revisions deleted))
- (%move-revisions deleted article)
- article))
+(defun %move-revisions (old-article new-article)
+ (dolist (r (revisions old-article))
+ (setf (slot-value r 'article) new-article)))
-(defun undelete-article (deleted)
- (let ((article (tx-undelete-article deleted)))
- (add-revision article "Undeleted article"
- (revision-content (second (revisions article)))
- :revision-type 'revision-undelete)
- (delete-object deleted)
- article))
+(deftransaction toggle-delete (old-article-id authorship)
+ (let* ((old-article (store-object-with-id old-article-id))
+ (new-article (make-instance (if (typep old-article 'article)
+ 'deleted-article
+ 'article)
+ :title (title old-article)
+ :revisions (revisions old-article))))
+ ;; use add-revision with empty content to de-index deleted article
+ (if (typep old-article 'article)
+ (push (add-revision old-article "Deleted article" "" authorship)
+ (revisions new-article))
+ (add-revision new-article "Undeleted article"
+ (revision-content (second (revisions old-article)))
+ authorship 'revision-undelete))
+ (dolist (r (revisions old-article))
+ (setf (slot-value r 'article) new-article))
+ (delete-object old-article)
+ new-article))
(defhandler /site/delete (title)
(awhen (and (not (youre-banned?))
(not (find-deleted-article title))
(find-article title))
- (delete-article it))
+ (toggle-delete (store-object-id it) (connection-authorship-info)))
(link-to title))
-(deftransaction tx-permadelete (deleted-article)
- (dolist (r (revisions deleted-article))
- (setf *recent-revisions* (remove r *recent-revisions*))
- (delete-object r)))
+(deftransaction permadelete (deleted-article-id)
+ (let ((deleted-article (store-object-with-id deleted-article-id)))
+ (dolist (r (revisions deleted-article))
+ (setf *recent-revisions* (remove r *recent-revisions*))
+ (delete-object r))
+ (delete-object deleted-article)))
(defhandler /site/permadelete (title)
(awhen (and (not (youre-banned?))
(account-is? *account* :moderator :administrator)
(find-deleted-article title))
- (tx-permadelete it)
- (delete-object it))
+ (permadelete (store-object-id it)))
#/)
View
4 src/diff.lisp
@@ -107,7 +107,9 @@
<th colspan="2">] (revision-version-info-links diffr)
(when (and maybe-undo-button?
(eq diffr (latest-revision (article diffr))))
- (output-undo-link diffr))
+ #H[<form method="post" action="$(#/site/history-special)">]
+ (output-undo-link diffr)
+ #H[</form>])
#H[</th>
</tr>
${(diff:format-diff-string 'wiki-diff
View
42 src/history.lisp
@@ -3,9 +3,8 @@
(defun output-undo-link (revision)
(unless (youre-banned?)
- #H[<form method="post" action="$(#/site/history-special)">
- <input type="hidden" name="r" value="${(store-object-id revision)}" />
- (<input type="submit" name="undo" value="undo" class="undo" />)</form>]))
+ #H[<input type="hidden" name="r" value="${(store-object-id revision)}" />
+ (<input type="submit" name="undo" value="undo" class="undo" />)]))
(defun output-compare-link (old new text)
#H[(<a class="internal" href="$(#/site/compare-revisions?old={(store-object-id old)}&diff={(store-object-id new)})">${text}</a>)])
@@ -51,25 +50,24 @@
#H[Can't undo this revision because it is not the latest.
<a href="$(#/site/history?title={title})">Go back to history page</a>.])
-(defun undo (r)
- (let* ((revision (find-revision r))
- (article (article revision))
- (latest-revision (latest-revision article)))
- (cond ((check-banned))
- ((typep article 'deleted-article)
- (link-to (undelete-article article)))
- ((eq revision latest-revision)
- (prog1 (link-to article)
- (if (or (typep latest-revision 'revision-undelete)
- (not (cdr (revisions article))))
- (delete-article article)
- (add-revision
- article
- #?"undid last revision by ${(name (author revision))}"
- (revision-content (second (revisions article)))))))
- (t #/site/not-latest?title={(title article)}))))
-
(defhandler /site/history-special (old diff undo r)
(if undo
- (undo r)
+ (let* ((revision (find-revision r))
+ (article (article revision))
+ (latest-revision (latest-revision article)))
+ (cond ((check-banned))
+ ((typep article 'deleted-article)
+ (link-to (toggle-delete (store-object-id article)
+ (connection-authorship-info))))
+ ((eq revision latest-revision)
+ (prog1 (link-to article)
+ (if (or (typep latest-revision 'revision-undelete)
+ (not (cdr (revisions article))))
+ (toggle-delete (store-object-id article)
+ (connection-authorship-info))
+ (add-revision
+ article
+ #?"undid last revision by ${(name (author revision))}"
+ (revision-content (second (revisions article)))))))
+ (t #/site/not-latest?title={(title article)})))
#/site/compare-revisions?old={old}&diff={diff}))
View
2  src/markup.lisp
@@ -65,7 +65,7 @@
(defun format-category-list (category) ;; /(
#H[<ul>] (dolist (article (sort (copy-list
(articles-with-category
- (category-keyword category)))
+ (category-keyword (canonicalize category))))
#'string< :key 'canonical-title))
(pprint-article-summary-li article "-"))
#H[</ul>])
View
8 src/recent-changes.lisp
@@ -4,11 +4,9 @@
(defvar *recent-revisions* ())
(defun init-recent-revisions ()
- (subseq (setf *recent-revisions*
- (sort (copy-list (store-objects-with-class 'revision))
- #'>
- :key #'date))
- 0 100))
+ (let ((sorted (sort (copy-list (store-objects-with-class 'revision))
+ #'> :key #'date)))
+ (setf *recent-revisions* (subseq sorted 0 (min 100 (length sorted))))))
(defun do-recent-revisions (f)
(loop for i from 0 below 100
View
10 src/search.lisp
@@ -16,12 +16,6 @@
:index-reader concordance-entries-for))
(:metaclass persistent-class))
-(deftransaction add-to-entry (entry article)
- (pushnew article (articles entry)))
-
-(deftransaction remove-from-entry (entry article)
- (setf (articles entry) (remove article (articles entry))))
-
(defun get-concordance-entry (word)
(or (find-concordance-entry word)
(make-instance 'concordance-entry :word word)))
@@ -38,9 +32,9 @@
(words (cached-content article))))
(old-entries (concordance-entries-for article)))
(dolist (entry (set-difference old-entries new-entries))
- (remove-from-entry entry article))
+ (setf (articles entry) (remove article (articles entry))))
(dolist (entry (set-difference new-entries old-entries))
- (add-to-entry entry article))))
+ (pushnew article (articles entry)))))
(defun search-articles (phrase)
(let ((words (words phrase)))
Please sign in to comment.
Something went wrong with that request. Please try again.