@ -1,6 +1,7 @@
( in-package #:cl-user )
( defpackage #:storage
( :use #:cl )
( :use #:cl
#:copy-directory )
( :export #:init-storage
#:directory-exists-p
#:ensure-directory-exists
@ -21,7 +22,12 @@
#:store-text-with-raw-path
#:open-text-file-with-raw-path
#:store-test
#:remove-file-with-raw-path ) )
#:remove-file-with-raw-path
#:make-raw-path
#:ensure-raw-directory-exists
#:remove-raw-directory
#:copy-storage-directory
#:copy-raw-directory ) )
( in-package #:storage )
( defun init-storage ( )
@ -47,7 +53,19 @@ This is used as part of the /run-set defroute in web.lisp file."
( uiop:copy-file ( make-path "" "default-assets" "site-wide-snippet.html" )
( make-path "" "snippets" "site-wide-snippet.html" ) )
;; Nothing is added to /storage/media yet, this is just prep. work.
( ensure-directory-exists "" "media" ) )
( ensure-directory-exists "" "media" )
( ensure-raw-directory-exists "snapshots/" ) )
( defun copy-storage-directory ( target-path )
" Copies the contents of /storage directory to ` TARGET-PATH '.
Make sure ` TARGET-PATH ' ends with a slash ( E.G. snapshots/oct-2022/ ) . Without
it, the system will assume you 're trying to work with a file and throw an
error. "
( copy-directory:copy ( make-raw-path "storage/" ) ( make-raw-path target-path ) ) )
( defun copy-raw-directory ( source-path target-path )
"Copies a directory (`SOURCE-PATH') outside of /storage to `TARGET-PATH'."
( copy-directory:copy ( make-raw-path source-path ) ( make-raw-path target-path ) ) )
( defun directory-exists-p ( username directory )
" Checks to see if the specified diretory exists.
@ -55,6 +73,12 @@ The directories path is returned if it does exist and `NIL' is
returned if the directory cannot be found. "
( cl:probe-file ( make-path username directory "" ) ) )
( defun ensure-raw-directory-exists ( directory-path )
" Creates directory if it doesn 't exist ( use for working outside of /storage ) .
The directories path is returned if it does exist and ` NIL ' is returned if the
directory cannot be found. "
( ensure-directories-exist ( make-raw-path directory-path ) ) )
( defun ensure-directory-exists ( username directory )
" The project 's standardised way to call ` ENSURE-DIRECTORY-EXISTS '.
If the directory exists, the full ( absolute ) path is
@ -90,7 +114,12 @@ not (user-)`ID' is because I wanted to easily identify the directories in
/storage. "
( merge-pathnames ( format nil "storage/~A/~A/~A"
username subdirectory slug )
ritherdon-archive.config::*application-root* ) )
ritherdon-archive.config:*application-root* ) )
( defun make-raw-path ( path )
"Make a file/directory path outsite of the /storage directory."
( merge-pathnames ( format nil "~a" path )
ritherdon-archive.config:*application-root* ) )
( defun open-binary-file ( username subdirectory slug )
"Reads the file stored in the /storage directory."
@ -110,8 +139,12 @@ not (user-)`ID' is because I wanted to easily identify the directories in
( read-sequence data stream )
data ) ) )
( defun remove-raw-directory ( directory-path )
"Removes directory at `DIRECTORY-PATH' when outside /storage directory."
( cl-fad:delete-directory-and-files ( make-raw-path directory-path ) ) )
( defun remove-directory ( username subdirectory )
" Deletes an entire sketchbook directory in /storage ( not database ) .
" Deletes an directory in /storage.
Path template: ` *APPLICATION-ROOT* '/storage/ ` USERNAME '/ ` SUBDIRECTORY '/ '
- https://edicl.github.io/cl-fad/#delete-directory-and-files
- https://stackoverflow.com/questions/24350183/how-do-i-delete-a-directory-in-common-lisp