Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
0ce78b52
Commit
0ce78b52
authored
Aug 16, 2015
by
Francois-Rene Rideau
Browse files
Have temporary files work better with logical pathnames and/or missing directories.
parent
8a93a49a
Changes
1
Hide whitespace changes
Inline
Side-by-side
uiop/stream.lisp
View file @
0ce78b52
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment