Commit 0ce78b52 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Have temporary files work better with logical pathnames and/or missing directories.

parent 8a93a49a
......@@ -576,16 +576,17 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e
(check-type direction (member :output :io))
(assert (or want-stream-p want-pathname-p))
(loop
:with prefix = (native-namestring
(ensure-absolute-pathname
(or prefix "tmp")
(or (ensure-pathname directory :namestring :native :ensure-directory t)
#'temporary-directory)))
:with results = ()
:with prefix-pn = (ensure-absolute-pathname
(or prefix "tmp")
(or (ensure-pathname directory :namestring :native :ensure-directory t)
#'temporary-directory))
:with prefix-nns = (native-namestring prefix-pn)
:with results = (progn (ensure-directories-exist prefix-pn)
())
:for counter :from (random (expt 36 #-gcl 8 #+gcl 5))
:for pathname = (parse-native-namestring
(format nil "~A~36R~@[~A~]~@[.~A~]"
prefix counter suffix (unless (eq type :unspecific) type)))
prefix-nns counter suffix (unless (eq type :unspecific) type)))
:for okp = nil :do
;; TODO: on Unix, do something about umask
;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
......@@ -594,6 +595,7 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e
;; Can we at least design some hook?
(unwind-protect
(progn
(ensure-directories-exist pathname)
(with-open-file (stream pathname
:direction direction
:element-type element-type
......@@ -677,9 +679,9 @@ Further KEYS can be passed to MAKE-PATHNAME."
A new empty file with said temporary pathname is created, to ensure there is no
clash with any concurrent process attempting the same thing."
(let* ((px (ensure-pathname x))
(prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")))
(get-temporary-file
:directory (pathname-directory-pathname px) :prefix prefix :type (pathname-type px))))
(prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))
(directory (translate-logical-pathname (pathname-directory-pathname px))))
(get-temporary-file :directory directory :prefix prefix :type (pathname-type px))))
(defun call-with-staging-pathname (pathname fun)
"Calls FUN with a staging pathname, and atomically
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment