src/admin.lisp

   1 (uiop:define-package #:lw2.admin
   2   (:use #:cl #:alexandria #:lw2.lmdb #:lw2.clean-html #:lw2.backend #:lw2.backlinks)
   3   (:export #:reclean-html))
   4
   5 (in-package #:lw2.admin)
   6
   7 (defun reclean-html ()
   8   (let ((total-count (count-database-entries "post-body-json"))
   9         (done-count 0)
  10         (last-done nil))
  11     (truncate-database "clean-html-memo")
  12     (format t "Press Enter to abort.~%")
  13     (labels ((report-progress ()
  14                (when (= 0 (mod done-count 1))
  15                  (format t "Finished ~A of ~A posts.~A" done-count total-count (string #\Return))
  16                  (force-output))))
  17       (loop
  18          for (post-json post-id) = (mapcar (lambda (x) (and x (flexi-streams:octets-to-string x :external-format :utf-8)))
  19                                            (call-with-cursor "post-body-json"
  20                                                              (lambda (db cursor)
  21                                                                (declare (ignore db))
  22                                                                (multiple-value-list
  23                                                                 (if last-done
  24                                                                     (progn
  25                                                                       (lmdb:cursor-get cursor :set-range last-done)
  26                                                                       (lmdb:cursor-get cursor :next))
  27                                                                     (lmdb:cursor-get cursor :first))))))
  28          while post-json
  29          do (when (read-char-no-hang)
  30               (format t "Aborted.~%")
  31               (return-from reclean-html (values)))
  32          do (report-progress)
  33          do (let ((post (json:decode-json-from-string post-json)))
  34               (ignore-errors
  35                 (let ((*before-clean-hook* (lambda () (clear-backlinks post-id)))
  36                       (*link-hook* (lambda (link)
  37                                      (add-backlink link post-id))))
  38                   (clean-html (or (cdr (assoc :html-body post)) "") :with-toc t :post-id post-id)))
  39               (ignore-errors
  40                 (let ((comments (if (cdr (assoc :question post))
  41                                     (append (get-post-comments post-id :revalidate nil)
  42                                             (get-post-answers post-id :revalidate nil))
  43                                     (get-post-comments post-id :revalidate nil))))
  44                   (loop for comment in comments
  45                      for comment-id = (cdr (assoc :--id comment))
  46                      do (ignore-errors
  47                           (let ((*before-clean-hook* (lambda () (clear-backlinks post-id comment-id)))
  48                                 (*link-hook* (lambda (link)
  49                                                (add-backlink link post-id comment-id))))
  50                             (clean-html (or (cdr (assoc :html-body comment)) ""))))))))
  51            (incf done-count)
  52            (setf last-done post-id))
  53       (report-progress)
  54       (format t "~%Done.~%")
  55       (values))))