Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Hugo Ishimaru
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
...
@@ -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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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