[PATCH consfigurator v2 1/6] create package consfigurator.data.util
David Bremner
david at tethera.net
Thu Mar 10 00:28:55 GMT 2022
This package is intended to provide a home for utility functions used by
multiple data sources. Initially move a local function from
consfigurator.data.files-tree, and slightly generalize it to support an
extension or "type" argument.
Note that the goal of literal-data-pathname is to map (IDEN1 IDEN2) to
existing paths in a user maintained file hierarchy. This is quite different
from data-pathname, which escapes various characters to map to a safe internal
filename.
---
consfigurator.asd | 2 ++
src/data/files-tree.lisp | 14 +++-----------
src/data/util.lisp | 31 +++++++++++++++++++++++++++++++
src/package.lisp | 6 +++++-
tests/data/util.lisp | 33 +++++++++++++++++++++++++++++++++
tests/package.lisp | 3 ++-
6 files changed, 76 insertions(+), 13 deletions(-)
create mode 100644 src/data/util.lisp
create mode 100644 tests/data/util.lisp
diff --git a/consfigurator.asd b/consfigurator.asd
index 3531ada..d01e089 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -88,6 +88,7 @@
(:file "src/connection/setuid")
(:file "src/connection/as")
(:file "src/connection/linux-namespace")
+ (:file "src/data/util")
(:file "src/data/asdf")
(:file "src/data/pgp")
(:file "src/data/git-snapshot")
@@ -108,6 +109,7 @@
(:feature :sbcl (:require #:sb-rt))
(:feature (:not :sbcl) #:rt))
:components ((:file "tests/package")
+ (:file "tests/data/util")
(:file "tests/util")
(:file "tests/property/file"))
:perform (test-op (o c) (symbol-call :consfigurator/tests '#:do-tests)))
diff --git a/src/data/files-tree.lisp b/src/data/files-tree.lisp
index 993d9aa..8418a80 100644
--- a/src/data/files-tree.lisp
+++ b/src/data/files-tree.lisp
@@ -37,20 +37,12 @@ IDEN2 an an absolute or relative path are all supported."
(unless (directory-exists-p base-path)
(missing-data-source
"~A does not exist, or is not a directory." base-path))
- (labels ((%make-path (iden1 iden2)
- (merge-pathnames
- (uiop:relativize-pathname-directory
- iden2)
- (merge-pathnames
- (uiop:relativize-pathname-directory
- (ensure-directory-pathname iden1))
- base-path)))
- (check (iden1 iden2)
- (let ((file-path (%make-path iden1 iden2)))
+ (labels ((check (iden1 iden2)
+ (let ((file-path (literal-data-pathname base-path iden1 iden2)))
(and (file-exists-p file-path)
(file-write-date file-path))))
(extract (iden1 iden2)
- (let ((file-path (%make-path iden1 iden2)))
+ (let ((file-path (literal-data-pathname base-path iden1 iden2)))
(and (file-exists-p file-path)
(make-instance 'file-data
:file file-path
diff --git a/src/data/util.lisp b/src/data/util.lisp
new file mode 100644
index 0000000..15e0ab5
--- /dev/null
+++ b/src/data/util.lisp
@@ -0,0 +1,31 @@
+;;; Consfigurator -- Lisp declarative configuration management system
+
+;;; Copyright (C) 2022 David Bremner <david at tethera.net>
+
+;;; This file is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3, or (at your option)
+;;; any later version.
+
+;;; This file is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :consfigurator.data.util)
+(named-readtables:in-readtable :consfigurator)
+
+(defun literal-data-pathname (base-path iden1 iden2 &key type)
+ "Generate a path from BASE-PATH, IDEN1 and IDEN2 by concatentation,
+optionally adding extension TYPE. No escaping of special characters is done."
+ (merge-pathnames
+ (uiop:relativize-pathname-directory
+ (uiop:parse-unix-namestring iden2 :type type))
+ (merge-pathnames
+ (uiop:relativize-pathname-directory
+ (ensure-directory-pathname iden1))
+ (ensure-directory-pathname base-path))
+ nil))
diff --git a/src/package.lisp b/src/package.lisp
index 202477f..ef499a5 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1004,6 +1004,9 @@
(:local-nicknames (#:user #:consfigurator.property.user)
(#:lxc #:consfigurator.property.lxc)))
+ (package :consfigurator.data.util
+ (:export #:literal-data-pathname))
+
(package :consfigurator.data.asdf)
(package :consfigurator.data.pgp
@@ -1018,4 +1021,5 @@
(package :consfigurator.data.local-file)
- (package :consfigurator.data.files-tree))
+ (package :consfigurator.data.files-tree
+ (:use #:consfigurator.data.util)))
diff --git a/tests/data/util.lisp b/tests/data/util.lisp
new file mode 100644
index 0000000..4bb99b5
--- /dev/null
+++ b/tests/data/util.lisp
@@ -0,0 +1,33 @@
+(in-package :consfigurator/tests)
+(named-readtables:in-readtable :consfigurator)
+(in-consfig "consfigurator/tests")
+
+;; relative parts
+(deftest literal-data-pathname.1
+ (data-util:literal-data-pathname "/home/user/data/" "foo" "bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+
+;; missing trailing / on part 1
+(deftest literal-data-pathname.2
+ (data-util:literal-data-pathname "/home/user/data" "foo" "bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+
+;; absolute part 2
+(deftest literal-data-pathname.3
+ (data-util:literal-data-pathname "/home/user/data/" "/foo" "bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+
+;; relative part 2, "_"
+(deftest literal-data-pathname.4
+ (data-util:literal-data-pathname "/home/user/data/" "_foo" "bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/_foo/bar"))
+
+;; absolute part 3
+(deftest literal-data-pathname.5
+ (data-util:literal-data-pathname "/home/user/" "/data" "/foo/bar")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar"))
+
+;; with type
+(deftest literal-data-pathname.6
+ (data-util:literal-data-pathname "/home/user/" "/data" "/foo/bar" :type "txt")
+ #.(uiop:parse-unix-namestring "/home/user/data/foo/bar.txt"))
diff --git a/tests/package.lisp b/tests/package.lisp
index 286243c..161bad7 100644
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -2,4 +2,5 @@
(defpackage :consfigurator/tests
(:use #:cl #:consfigurator #+sbcl :sb-rt #-sbcl :rtest)
- (:local-nicknames (#:file #:consfigurator.property.file)))
+ (:local-nicknames (#:file #:consfigurator.property.file)
+ (#:data-util #:consfigurator.data.util)))
--
2.34.1
More information about the sgo-software-discuss
mailing list