diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-20 23:04:07 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-05-20 23:05:20 -0700 |
| commit | 55ae0b8942f44becf2a8fda50c03c085e4da7cc3 (patch) | |
| tree | b53e10498ea479542511ead21984b06a8437cec1 | |
| parent | df8a09e78b92aa04bd2a95232c23670c573d5460 (diff) | |
| download | consfigurator-55ae0b8942f44becf2a8fda50c03c085e4da7cc3.tar.gz | |
add FILE:CONTAINING-DIRECTORY-EXISTS
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
| -rw-r--r-- | src/package.lisp | 3 | ||||
| -rw-r--r-- | src/property/file.lisp | 12 |
2 files changed, 15 insertions, 0 deletions
diff --git a/src/package.lisp b/src/package.lisp index b90654f..8ec1f9e 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -16,6 +16,7 @@ #:stripln #:unix-namestring #:pathname-directory-pathname + #:pathname-parent-directory-pathname #:with-temporary-file #:ensure-directory-pathname #:ensure-pathname @@ -44,6 +45,7 @@ #:stripln #:unix-namestring #:pathname-directory-pathname + #:pathname-parent-directory-pathname #:with-temporary-file #:ensure-directory-pathname #:ensure-pathname @@ -271,6 +273,7 @@ #:contains-ini-settings #:regex-replaced-lines #:directory-exists + #:containing-directory-exists #:symlinked #:is-copy-of #:update-unix-table)) diff --git a/src/property/file.lisp b/src/property/file.lisp index c49a703..7136db9 100644 --- a/src/property/file.lisp +++ b/src/property/file.lisp @@ -125,6 +125,18 @@ Uses CL-PPCRE:REGEX-REPLACE, which see for the syntax of REPLACE." ;; assume it was already there :no-change)) +(defprop containing-directory-exists :posix (file) + "Ensure that a file's directory and the latter's parents exist." + (:desc #?"Directory containing ${file} exists") + (:apply + (if (pathname-name file) + (let ((parent (unix-namestring (pathname-directory-pathname file)))) + (when (plusp (length parent)) + (mrun "mkdir" "-p" parent))) + (mrun "mkdir" "-p" (pathname-parent-directory-pathname file))) + ;; likewise assume it was already there + :no-change)) + ;; readlink(1) is not POSIX (defun remote-link-target (symlink) (loop with s = (stripln (run :env '(:LOCALE "POSIX") "ls" "-ld" symlink)) |