|
|
|
@ -1,39 +1,40 @@
|
|
|
|
|
(in-package #:cl-user) |
|
|
|
|
(defpackage #:nera-db |
|
|
|
|
(:nicknames #:nera) |
|
|
|
|
(:use #:cl |
|
|
|
|
#:app-constants |
|
|
|
|
#:hermetic |
|
|
|
|
#:ritherdon-archive.db |
|
|
|
|
#:utils |
|
|
|
|
#:user |
|
|
|
|
#:pages |
|
|
|
|
#:files |
|
|
|
|
#:site-settings) |
|
|
|
|
(:export #:init-db |
|
|
|
|
#:update-user |
|
|
|
|
#:get-user |
|
|
|
|
#:get-user-id |
|
|
|
|
#:delete-user |
|
|
|
|
#:create-user |
|
|
|
|
#:get-site-settings |
|
|
|
|
#:migrate-all |
|
|
|
|
#:get-all-users |
|
|
|
|
#:update-enable-sign-on-settings |
|
|
|
|
#: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 |
|
|
|
|
#:system-data |
|
|
|
|
#:add-storage-file |
|
|
|
|
#:get-storage-file |
|
|
|
|
#:get-all-storage-files)) |
|
|
|
|
(:nicknames #:nera) |
|
|
|
|
(:use #:cl |
|
|
|
|
#:app-constants |
|
|
|
|
#:hermetic |
|
|
|
|
#:ritherdon-archive.db |
|
|
|
|
#:utils |
|
|
|
|
#:user |
|
|
|
|
#:pages |
|
|
|
|
#:files |
|
|
|
|
#:site-settings) |
|
|
|
|
(:export #:init-db |
|
|
|
|
#:update-user |
|
|
|
|
#:get-user |
|
|
|
|
#:get-user-id |
|
|
|
|
#:delete-user |
|
|
|
|
#:create-user |
|
|
|
|
#:get-site-settings |
|
|
|
|
#:migrate-all |
|
|
|
|
#:get-all-users |
|
|
|
|
#:update-enable-sign-on-settings |
|
|
|
|
#: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 |
|
|
|
|
#:system-data |
|
|
|
|
#:add-storage-file |
|
|
|
|
#:get-storage-file |
|
|
|
|
#:get-all-storage-files |
|
|
|
|
#:rename-storage-file)) |
|
|
|
|
(in-package #:nera-db) |
|
|
|
|
|
|
|
|
|
(defparameter *tables* '(user site-settings page storage-file) |
|
|
|
@ -93,7 +94,7 @@
|
|
|
|
|
(defun ensure-tables-exist () |
|
|
|
|
"Creates missing tables from the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mapcar #'mito:ensure-table-exists *tables*))) |
|
|
|
|
(mapcar #'mito:ensure-table-exists *tables*))) |
|
|
|
|
|
|
|
|
|
(defun migrate-all () |
|
|
|
|
"Migrate the tables after we changed the class definition." |
|
|
|
@ -241,13 +242,25 @@
|
|
|
|
|
:slug slug |
|
|
|
|
:file-type file-type))) |
|
|
|
|
|
|
|
|
|
(defun get-storage-file (filename) |
|
|
|
|
(defun get-storage-file (&key filename slug) |
|
|
|
|
"Returns a `STORAGE-FILE' row from the database. `NIL' if nothing found." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:find-dao 'storage-file :name filename))) |
|
|
|
|
(if (null slug) |
|
|
|
|
(mito:find-dao 'files:storage-file :name filename) |
|
|
|
|
(mito:find-dao 'files:storage-file :slug slug)))) |
|
|
|
|
|
|
|
|
|
(defun get-all-storage-files () |
|
|
|
|
"Returns a list of all `STORAGE-FILES' entries in the database." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:select-dao 'storage-file |
|
|
|
|
(sxql:order-by (:asc :name))))) |
|
|
|
|
|
|
|
|
|
(defun rename-storage-file (old-file-name new-file-name) |
|
|
|
|
"Renames `STORAGE-FILE' in the database. |
|
|
|
|
The `NAME' is renamed from `OLD-FILE-NAME' to `NEW-FILE-NAME' and the |
|
|
|
|
slug is updated based on `NEW-FILE-NAME'." |
|
|
|
|
(with-connection (db) |
|
|
|
|
(let ((file-to-rename (mito:find-dao 'storage-file :name old-file-name))) |
|
|
|
|
(setf (files::name-of file-to-rename) new-file-name |
|
|
|
|
(files::slug-of file-to-rename) (utils:slugify new-file-name)) |
|
|
|
|
(mito:save-dao file-to-rename)))) |
|
|
|
|