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

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