data.lisp (8142B)
1 (in-package :miniblog.data) 2 3 (defvar *post-link-format* "~a/~a/~a.html") 4 5 (defun format-dates (content) 6 (let ((created-at (getf content :created-at)) 7 (last-updated-at (getf content :last-updated-at))) 8 (setf (getf content :created-at-rfc-822) (miniblog.format:rfc-822-format created-at)) 9 (setf (getf content :created-at-short) (miniblog.format:short-date-format created-at)) 10 (setf (getf content :created-at-long) (miniblog.format:long-date-format created-at)) 11 (setf (getf content :last-updated-at-rfc-822) (miniblog.format:rfc-822-format last-updated-at)) 12 (setf (getf content :last-updated-at-short) (miniblog.format:short-date-format last-updated-at)) 13 (setf (getf content :last-updated-at-long) (miniblog.format:long-date-format last-updated-at)) 14 content)) 15 16 (defun format-post-link (entry) 17 (let ((created-at (mito.dao.mixin:object-created-at entry))) 18 (format nil *post-link-format* (miniblog.format:year created-at) (miniblog.format:month created-at) (mito.dao.mixin:object-id entry)))) 19 20 (defgeneric xform (entry) 21 (:documentation "Transform an entry of some type into an idiomatic p-list")) 22 23 (defmethod xform ((entry blog-entries)) 24 "Transform a blog-entries object into an idiomatic property list" 25 (format-dates 26 (list :id (mito.dao.mixin:object-id entry) 27 :created-at (mito.dao.mixin:object-created-at entry) 28 :last-updated-at (mito.dao.mixin:object-updated-at entry) 29 :parent (entry-parent entry) 30 :title (entry-title entry) 31 :content (entry-content entry) 32 :rendered-content (entry-rendered-content entry) 33 :created-by (entry-username entry) 34 :draftp (entry-draftp entry) 35 :last-updated-by (entry-last-updated-by entry) 36 :link (format-post-link entry)))) 37 38 (defmethod xform ((entry blog-pages)) 39 "Transform a blog-pages object into an idiomatic p-list" 40 (format-dates 41 (list :id (mito.dao.mixin:object-id entry) 42 :created-at (mito.dao.mixin:object-created-at entry) 43 :last-updated-at (mito.dao.mixin:object-updated-at entry) 44 :name (page-name entry) 45 :parent (page-parent entry) 46 :title (page-title entry) 47 :content (page-content entry) 48 :rendered-content (page-rendered-content entry) 49 :draftp (page-draftp entry) 50 :created-by (page-username entry) 51 :last-updated-by (page-last-updated-by entry)))) 52 53 (defun add-entry (title content &key parent rendered-content (username "nobody") draftp) 54 (miniblog.db:add-entry title content :parent parent :rendered-content rendered-content :draftp draftp :username username :transform #'xform)) 55 56 (defun make-entry-tree (id subtree) 57 (let ((dict (make-hash-table))) 58 (flet ((attach-node (node) 59 (let* ((node-id (getf node :id)) 60 (parent-id (or (getf node :parent) 0)) 61 (curr-node (gethash node-id dict)) 62 (parent-node (gethash parent-id dict)) 63 (siblings (getf parent-node :children))) 64 (if (and curr-node (getf curr-node :children) (getf node :children)) 65 (progn 66 (format t "womp womp ~A~%" (getf node :children)) 67 (rplaca (getf node :children) (getf curr-node :children))) 68 (setf (getf node :children) (list))) 69 (setf (getf parent-node :children) (cons node siblings)) 70 (setf (gethash parent-id dict) parent-node) 71 (setf (gethash node-id dict) node)))) 72 (loop for node in subtree 73 do (attach-node node)) 74 (let ((root (gethash id dict))) 75 (if (getf root :id) 76 ; Real node, return as root 77 root 78 ; Nonexistent node (probably 0), return the list of first-level children instead 79 (getf root :children)))))) 80 81 (defun get-entry (id) 82 "Get entry by id, or nil if the requested id isn't found" 83 (let ((subtree (miniblog.db:get-subtree-for-entry id :transform #'xform))) 84 (make-entry-tree id subtree))) 85 86 (defmacro with-entry-id (entry id &rest body) 87 "Takes a varname to hold the entry list and a post id 88 and executes the forms in body with the entry bound 89 to the specified entry variable" 90 `(let ((,entry (miniblog.data:get-entry ,id))) 91 (if ,entry 92 (progn ,@body) 93 (format t "Post ID ~d not found~%" ,id)))) 94 95 (defun get-drafts () 96 "Get all drafts. Returns (VALUES [list of draft posts] [list of draft pages])." 97 (values 98 (miniblog.db:get-entries :drafts :drafts-only :transform #'xform) 99 (miniblog.db:get-pages :drafts :drafts-only :transform #'xform))) 100 101 (defun get-entries (&key year month max-entries include-drafts-p) 102 "Get entries from the database, optionally limited to a date 103 range or count" 104 (make-entry-tree 0 (miniblog.db:get-entries :year year :month month :drafts include-drafts-p :max-entries max-entries :transform #'xform))) 105 106 (defun update-entry (id title content &key rendered-content parent (username "nobody") created-by draftp reset-timestamp-p) 107 "Update entry by id. Returns the updated entry or nil if the id doesn't exist." 108 (miniblog.db:update-entry id title content 109 :rendered-content rendered-content :draftp draftp :reset-timestamp-p reset-timestamp-p 110 :parent parent :created-by created-by :username username :transform #'xform)) 111 112 (defun update-entry-rendered-content (id rendered-content &key (username "nobody")) 113 "Updated entry RENDERED-CONTENT by ID. Returns the updated page or NIL if ID doesn't exist." 114 (miniblog.db:update-entry-rendered-content id rendered-content :username username)) 115 116 (defun delete-entry (id) 117 "Delete the specified entry from the database. No-op if the id is invalid." 118 (miniblog.db:delete-entry id)) 119 120 (defun add-page (name title content &key (parent 0) rendered-content (username "nobody") draftp) 121 "Add a new page to the database" 122 (miniblog.db:add-page name title content :parent parent :rendered-content rendered-content :draftp draftp :username username :transform #'xform)) 123 124 (defun get-page (id) 125 "Get page by id, or NIL if the requested id isn't found" 126 (miniblog.db:get-page id :transform #'xform)) 127 128 (defmacro with-page-id (page id &rest body) 129 "Takes a varname to hold the entry list and a page id 130 and executes the forms in body with the entry bound 131 to the specified entry variable" 132 `(let ((,page (miniblog.data:get-page ,id))) 133 (if ,page 134 (progn ,@body) 135 (format t "Page ID ~d not found~%" ,id)))) 136 137 (defun get-pages (&key (root-id 0) include-drafts-p) 138 "Get all pages in a tree, or optionally a subtree starting from a given id. Returns the subtree as the first return value and the (unconditionally) full hashtable as the second." 139 (miniblog.db:get-pages :root-id root-id :drafts include-drafts-p :transform #'xform)) 140 141 (defun update-page (id name title content &key rendered-content (username "nobody") draftp reset-timestamp-p) 142 "Update page by id. Returns the updated page or nil if the id doesn't exist." 143 (miniblog.db:update-page id name title content 144 :rendered-content rendered-content :draftp draftp :reset-timestamp-p reset-timestamp-p 145 :username username :transform #'xform )) 146 147 (defun update-page-rendered-content (id rendered-content &key (username "nobody")) 148 "Updated page RENDERED-CONTENT by ID. Returns the updated page or NIL if ID doesn't exist." 149 (miniblog.db:update-page-rendered-content id rendered-content :username username)) 150 151 (defun move-page (id parent) 152 "Move a page under a new parent page (or to the root if parent is 0 or NIL)" 153 (miniblog.db:move-page id parent :transform #'xform)) 154 155 (defun delete-page (id &key (children :move-to-parent)) 156 "Delete a page. The parameter CHILDREN can be any of :MOVE-TO-PARENT (the default) in which all immediate children will be attached to the deleted page's parent, :MOVE-TO-ROOT in which all immediate children will be made top-level pages, or :DELETE in which case the entire subtree will be pruned." 157 (miniblog.db:delete-page id :children children))