|
|
|
@ -7,6 +7,7 @@
|
|
|
|
|
#:ritherdon-archive.db |
|
|
|
|
#:utils |
|
|
|
|
#:user |
|
|
|
|
#:pages |
|
|
|
|
#:site-settings) |
|
|
|
|
(:export #:init-db |
|
|
|
|
#:update-user |
|
|
|
@ -18,10 +19,19 @@
|
|
|
|
|
#:migrate-all |
|
|
|
|
#:get-all-users |
|
|
|
|
#:update-enable-sign-on-settings |
|
|
|
|
#:set-home-page)) |
|
|
|
|
#:set-home-page |
|
|
|
|
#:update-enable-site-logo-setting |
|
|
|
|
#:update-site-name |
|
|
|
|
#:create-page |
|
|
|
|
#:update-page |
|
|
|
|
#:get-page |
|
|
|
|
#:delete-page |
|
|
|
|
#:get-all-pages |
|
|
|
|
#:nav-menu-slugs |
|
|
|
|
#:update-nav-menu)) |
|
|
|
|
(in-package #:nera-db) |
|
|
|
|
|
|
|
|
|
(defparameter *tables* '(user site-settings) |
|
|
|
|
(defparameter *tables* '(user site-settings page) |
|
|
|
|
"List of the DB tables that need to be checked for migrations and DB setup.") |
|
|
|
|
|
|
|
|
|
(defun init-db (request) |
|
|
|
@ -38,7 +48,32 @@
|
|
|
|
|
:password (hermetic::hash password) |
|
|
|
|
:administrator +true+) |
|
|
|
|
(mito:create-dao 'site-settings |
|
|
|
|
:enable-sign-up (utils:checkbox-to-bool allow-sign-up))))) |
|
|
|
|
:enable-sign-up (utils:checkbox-to-bool allow-sign-up)) |
|
|
|
|
(mito:create-dao 'page |
|
|
|
|
:title "Home" |
|
|
|
|
:slug "home" |
|
|
|
|
:enable-nav-menu +true+ |
|
|
|
|
:can-delete +true+) |
|
|
|
|
(mito:create-dao 'page |
|
|
|
|
:title "About" |
|
|
|
|
:slug "about" |
|
|
|
|
:enable-nav-menu +true+ |
|
|
|
|
:can-delete +true+) |
|
|
|
|
(mito:create-dao 'page |
|
|
|
|
:title "Contact" |
|
|
|
|
:slug "contact" |
|
|
|
|
:enable-nav-menu +true+ |
|
|
|
|
:can-delete +true+) |
|
|
|
|
(mito:create-dao 'page |
|
|
|
|
:title "Pages" |
|
|
|
|
:slug "pages" |
|
|
|
|
:enable-nav-menu +true+ |
|
|
|
|
:can-delete +false+) |
|
|
|
|
(mito:create-dao 'page |
|
|
|
|
:title "Archive" |
|
|
|
|
:slug "archive" |
|
|
|
|
:enable-nav-menu +true+ |
|
|
|
|
:can-delete +false+)))) |
|
|
|
|
|
|
|
|
|
(defun ensure-tables-exist () |
|
|
|
|
"Creates missing tables from the database." |
|
|
|
@ -93,6 +128,45 @@
|
|
|
|
|
(mito:select-dao 'user |
|
|
|
|
(sxql:order-by (:asc :display-name))))) |
|
|
|
|
|
|
|
|
|
(defun get-page (slug) |
|
|
|
|
"Returns a `PAGE' from the database." |
|
|
|
|
(with-connection (db) (mito:find-dao 'page :slug slug))) |
|
|
|
|
|
|
|
|
|
(defun get-all-pages () |
|
|
|
|
"Returns a list of all `PAGE' entries in the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:select-dao 'page |
|
|
|
|
(sxql:order-by (:asc :slug))))) |
|
|
|
|
|
|
|
|
|
(defun create-page (title slug nav-menu can-delete) |
|
|
|
|
"Add a new `PAGE' to the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:create-dao 'page :title title :slug slug |
|
|
|
|
:enable-nav-menu nav-menu :can-delete can-delete))) |
|
|
|
|
|
|
|
|
|
(defun update-page (id title slug &optional nav-menu can-delete) |
|
|
|
|
"Add a new `PAGE' to the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(let ((page-to-update (mito:find-dao 'page :id id))) |
|
|
|
|
(if (not (utils:string-is-nil-or-empty? title)) |
|
|
|
|
(setf (pages::title-of page-to-update) title)) |
|
|
|
|
(if (not (utils:string-is-nil-or-empty? slug)) |
|
|
|
|
(setf (pages::slug-of page-to-update) slug)) |
|
|
|
|
(if (not (null nav-menu)) |
|
|
|
|
(setf (pages::enable-nav-menu-p page-to-update) nav-menu)) |
|
|
|
|
(if (not (null can-delete)) |
|
|
|
|
(setf (pages::can-delete-p page-to-update) can-delete)) |
|
|
|
|
(mito:save-dao page-to-update)))) |
|
|
|
|
|
|
|
|
|
(defun delete-page (&key id slug) |
|
|
|
|
"Delete `PAGE' from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(cond ((not slug) |
|
|
|
|
(mito:delete-dao (mito:find-dao 'page :id id))) |
|
|
|
|
((not id) |
|
|
|
|
(mito:delete-dao (mito:find-dao 'page :slug slug))) |
|
|
|
|
(t nil)))) |
|
|
|
|
|
|
|
|
|
(defun get-site-settings () |
|
|
|
|
"Gets the settings for the website from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
@ -106,9 +180,36 @@
|
|
|
|
|
(utils:checkbox-to-bool value)) |
|
|
|
|
(mito:save-dao settings-to-update)))) |
|
|
|
|
|
|
|
|
|
(defun update-enable-site-logo-setting (value) |
|
|
|
|
"Updates the 'Enable Site Logo' setting in the database with `VALUE'." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(let ((settings-to-update (mito:find-dao 'site-settings))) |
|
|
|
|
(setf (site-settings::enable-site-logo-p settings-to-update) |
|
|
|
|
(utils:checkbox-to-bool value)) |
|
|
|
|
(mito:save-dao settings-to-update)))) |
|
|
|
|
|
|
|
|
|
(defun set-home-page (value) |
|
|
|
|
"Sets the page (in /storage/pages) to be displayed on the sites home page." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(let ((settings-to-update (mito:find-dao 'site-settings))) |
|
|
|
|
(setf (site-settings::home-page-of settings-to-update) value) |
|
|
|
|
(mito:save-dao settings-to-update)))) |
|
|
|
|
|
|
|
|
|
(defun update-site-name (name) |
|
|
|
|
"Updates the website's `SITE-NAME' the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(let ((settings-to-update (mito:find-dao 'site-settings))) |
|
|
|
|
(setf (site-settings::site-name-of settings-to-update) name) |
|
|
|
|
(mito:save-dao settings-to-update)))) |
|
|
|
|
|
|
|
|
|
(defun update-nav-menu (page-slug value) |
|
|
|
|
"Updates the `ENABLE-NAV-MENU' property in `PAGES' database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(let ((page-to-update (mito:find-dao 'page :slug page-slug))) |
|
|
|
|
(setf (pages::enable-nav-menu-p page-to-update) value) |
|
|
|
|
(mito:save-dao page-to-update)))) |
|
|
|
|
|
|
|
|
|
(defun nav-menu-slugs () |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:select-dao 'page |
|
|
|
|
(sxql:where (:= :enable-nav-menu +true+))))) |
|
|
|
|