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
Loading
Loading
Loading
Loading
+12 −10
Original line number Diff line number Diff line
@@ -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