1 (uiop:define-package
#:lw2.admin
2 (:use
#:cl
#:alexandria
#:lw2.lmdb
#:lw2.clean-html
#:lw2.backend
#:lw2.backlinks
)
3 (:export
#:reclean-html
))
5 (in-package #:lw2.admin
)
7 (defun map-posts-and-comments (fn &key skip-comments skip-posts
)
8 (let ((total-count (count-database-entries "post-body-json"))
11 (format *error-output
* "Press Enter to abort.~%")
12 (labels ((report-progress ()
13 (when (= 0 (mod done-count
1))
14 (format *error-output
* "Finished ~A of ~A posts.~A" done-count total-count
(string #\Return
))
15 (force-output *error-output
*))))
17 for
(post post-id
) = (with-cache-readonly-transaction
18 (call-with-cursor "post-body-json"
21 (multiple-value-bind (post post-id
)
24 (cursor-get cursor
:set-range
:key last-done
:return-type
'existence
)
25 (cursor-get cursor
:next
:value-type
:json
))
26 (cursor-get cursor
:first
:value-type
:json
))
27 (list (ignore-errors (postprocess-query-result post
)) post-id
)))))
29 do
(when (read-char-no-hang)
30 (format *error-output
* "Aborted.~%")
31 (return-from map-posts-and-comments
(values)))
35 (with-simple-restart (continue "Ignore this post and continue.")
36 (funcall fn post post-id
)))
39 (let ((comments (if (cdr (assoc :question post
))
40 (append (get-post-comments post-id
:revalidate nil
)
41 (get-post-answers post-id
:revalidate nil
))
42 (get-post-comments post-id
:revalidate nil
))))
43 (loop for comment in comments
44 for comment-id
= (cdr (assoc :--id comment
))
45 do
(with-simple-restart (continue "Ignore this comment and continue.")
46 (funcall fn comment post-id comment-id
))))))
48 (setf last-done post-id
)))
50 (format *error-output
* "~%Done.~%")
53 (defun reclean-html ()
54 (map-posts-and-comments
55 (lambda (item post-id
&optional comment-id
)
58 (let ((*before-clean-hook
* (lambda () (clear-backlinks post-id
)))
59 (*link-hook
* (lambda (link)
60 (add-backlink link post-id
))))
61 (clean-html (or (cdr (assoc :html-body item
)) "") :with-toc t
:post-id post-id
)))
63 (let ((*before-clean-hook
* (lambda () (clear-backlinks post-id comment-id
)))
64 (*link-hook
* (lambda (link)
65 (add-backlink link post-id comment-id
))))
66 (clean-html (or (cdr (assoc :html-body item
)) ""))))))))
68 (defun grep-posts-and-comments (regex &key skip-comments print-ids
)
69 (let* ((scanner (ppcre:create-scanner regex
))
70 (printer (if print-ids
71 (lambda (item post-id
&optional comment-id
)
72 (when (ppcre:scan scanner
(or (cdr (assoc :html-body item
)) ""))
73 (format t
"~A~@[/~A~]~%" post-id comment-id
)))
74 (lambda (item post-id
&optional comment-id
)
75 (declare (ignore post-id comment-id
))
76 (ppcre:do-matches-as-strings
(match scanner
(or (cdr (assoc :html-body item
)) ""))
77 (write-line match
))))))
78 (map-posts-and-comments
80 :skip-comments skip-comments
)))