data.lisp (6743B)
1 (in-package :miniblog.data) 2 3 (defparameter +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 :title (entry-title entry) 30 :content (entry-content entry) 31 :rendered-content (entry-rendered-content entry) 32 :created-by (entry-username entry) 33 :draftp (entry-draftp entry) 34 :last-updated-by (entry-last-updated-by entry) 35 :link (format-post-link entry)))) 36 37 (defmethod xform ((entry blog-pages)) 38 "Transform a blog-pages object into an idiomatic p-list" 39 (format-dates 40 (list :id (mito.dao.mixin:object-id entry) 41 :created-at (mito.dao.mixin:object-created-at entry) 42 :last-updated-at (mito.dao.mixin:object-updated-at entry) 43 :name (page-name entry) 44 :parent (page-parent entry) 45 :title (page-title entry) 46 :content (page-content entry) 47 :rendered-content (page-rendered-content entry) 48 :draftp (page-draftp entry) 49 :created-by (page-username entry) 50 :last-updated-by (page-last-updated-by entry)))) 51 52 (defun add-entry (title content &key rendered-content (username "nobody") draftp) 53 (miniblog.db:add-entry title content :rendered-content rendered-content :draftp draftp :username username :transform #'xform)) 54 55 (defun get-entry (id) 56 "Get entry by id, or nil if the requested id isn't found" 57 (miniblog.db:get-entry id :transform #'xform)) 58 59 (defmacro with-entry-id (entry id &rest body) 60 "Takes a varname to hold the entry list and a post id 61 and executes the forms in body with the entry bound 62 to the specified entry variable" 63 `(let ((,entry (miniblog.data:get-entry ,id))) 64 (if ,entry 65 (progn ,@body) 66 (format t "Post ID ~d not found~%" ,id)))) 67 68 (defun get-drafts () 69 "Get all drafts. Returns (VALUES [list of draft posts] [list of draft pages])." 70 (values 71 (miniblog.db:get-entries :drafts :drafts-only :transform #'xform) 72 (miniblog.db:get-pages :drafts :drafts-only :transform #'xform))) 73 74 (defun get-entries (&key year month max-entries include-drafts-p) 75 "Get entries from the database, optionally limited to a date 76 range or count" 77 (miniblog.db:get-entries :year year :month month :drafts include-drafts-p :max-entries max-entries :transform #'xform)) 78 79 (defun update-entry (id title content &key rendered-content (username "nobody") draftp reset-timestamp-p) 80 "Update entry by id. Returns the updated entry or nil if the id doesn't exist." 81 (miniblog.db:update-entry id title content 82 :rendered-content rendered-content :draftp draftp :reset-timestamp-p reset-timestamp-p 83 :username username :transform #'xform)) 84 85 (defun update-entry-rendered-content (id rendered-content &key (username "nobody")) 86 "Updated entry RENDERED-CONTENT by ID. Returns the updated page or NIL if ID doesn't exist." 87 (miniblog.db:update-entry-rendered-content id rendered-content :username username)) 88 89 (defun delete-entry (id) 90 "Delete the specified entry from the database. No-op if the id is invalid." 91 (miniblog.db:delete-entry id)) 92 93 (defun add-page (name title content &key (parent 0) rendered-content (username "nobody") draftp) 94 "Add a new page to the database" 95 (miniblog.db:add-page name title content :parent parent :rendered-content rendered-content :draftp draftp :username username :transform #'xform)) 96 97 (defun get-page (id) 98 "Get page by id, or NIL if the requested id isn't found" 99 (miniblog.db:get-page id :transform #'xform)) 100 101 (defmacro with-page-id (page id &rest body) 102 "Takes a varname to hold the entry list and a page id 103 and executes the forms in body with the entry bound 104 to the specified entry variable" 105 `(let ((,page (miniblog.data:get-page ,id))) 106 (if ,page 107 (progn ,@body) 108 (format t "Page ID ~d not found~%" ,id)))) 109 110 (defun get-pages (&key (root-id 0) include-drafts-p) 111 "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." 112 (miniblog.db:get-pages :root-id root-id :drafts include-drafts-p :transform #'xform)) 113 114 (defun update-page (id name title content &key rendered-content (username "nobody") draftp reset-timestamp-p) 115 "Update page by id. Returns the updated page or nil if the id doesn't exist." 116 (miniblog.db:update-page id name title content 117 :rendered-content rendered-content :draftp draftp :reset-timestamp-p reset-timestamp-p 118 :username username :transform #'xform )) 119 120 (defun update-page-rendered-content (id rendered-content &key (username "nobody")) 121 "Updated page RENDERED-CONTENT by ID. Returns the updated page or NIL if ID doesn't exist." 122 (miniblog.db:update-page-rendered-content id rendered-content :username username)) 123 124 (defun move-page (id parent) 125 "Move a page under a new parent page (or to the root if parent is 0 or NIL)" 126 (miniblog.db:move-page id parent :transform #'xform)) 127 128 (defun delete-page (id &key (children :move-to-parent)) 129 "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." 130 (miniblog.db:delete-page id :children children))