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
Eric Timmons
asdf
Commits
9beaabb5
Commit
9beaabb5
authored
Nov 15, 2013
by
Francois-Rene Rideau
Browse files
Enhance WITH-TEMPORARY-FILE. Robustify TRUENAMIZE for GCL.
parent
33b25631
Changes
2
Hide whitespace changes
Inline
Side-by-side
uiop/filesystem.lisp
View file @
9beaabb5
...
...
@@ -266,13 +266,19 @@ and recurse each of its subdirectories on which the RECURSEP returns true when C
(
down-components
()))
(
assert
(
eq
:absolute
(
first
directory
)))
(
loop
:while
up-components
:do
(
if-let
(
parent
(
probe-file*
(
make-pathname*
:directory
`
(
:absolute
,@
(
reverse
up-components
))
:name
nil
:type
nil
:version
nil
:defaults
p
)))
(
return
(
merge-pathnames*
(
make-pathname*
:directory
`
(
:relative
,@
down-components
)
:defaults
p
)
(
ensure-directory-pathname
parent
)))
(
push
(
pop
up-components
)
down-components
))
:finally
(
return
p
))))))
(
if-let
(
parent
(
ignore-errors
(
probe-file*
(
make-pathname*
:directory
`
(
:absolute
,@
(
reverse
up-components
))
:name
nil
:type
nil
:version
nil
:defaults
p
))))
(
if-let
(
simplified
(
ignore-errors
(
merge-pathnames*
(
make-pathname*
:directory
`
(
:relative
,@
down-components
)
:defaults
p
)
(
ensure-directory-pathname
parent
))))
(
return
simplified
)))
(
push
(
pop
up-components
)
down-components
)
:finally
(
return
p
))))))
(
defun
resolve-symlinks
(
path
)
"Do a best effort at resolving symlinks in PATH, returning a partially or totally resolved PATH."
...
...
uiop/stream.lisp
View file @
9beaabb5
...
...
@@ -530,25 +530,41 @@ If a string, repeatedly read and evaluate from it, returning the last values."
(
defun
call-with-temporary-file
(
thunk
&key
(
want-stream-p
t
)
(
want-pathname-p
t
)
prefix
keep
(
direction
:io
)
(
want-stream-p
t
)
(
want-pathname-p
t
)
(
direction
:io
)
keep
after
directory
prefix
suffix
type
(
element-type
*default-stream-element-type*
)
(
external-format
*utf-8-external-format*
))
"Call a THUNK with STREAM and PATHNAME arguments identifying a temporary file.
The pathname will be based on appending a random suffix to PREFIX.
This utility will KEEP the file past its extent if and only if explicitly requested.
The file will be open with specified DIRECTION, ELEMENT-TYPE and EXTERNAL-FORMAT."
"Call a THUNK with stream and/or pathname arguments identifying a temporary file.
The temporary file's pathname will be based on concatenating
PREFIX (defaults to \"tmp\"), a random alphanumeric string, and optional SUFFIX and TYPE,
within DIRECTORY (defaulting to the TEMPORARY-DIRECTORY) if the PREFIX isn't absolute.
The file will be open with specified DIRECTION (defaults to :IO),
ELEMENT-TYPE (defaults to *DEFAULT-STREAM-ELEMENT-TYPE*) and
EXTERNAL-FORMAT (defaults to *UTF-8-EXTERNAL-FORMAT*).
If WANT-STREAM-P is true (the defaults to T), then THUNK will then be CALL-FUNCTION'ed
with the stream and the pathname (if WANT-PATHNAME-P is true, defaults to T),
and stream with be closed after the THUNK exits (either normally or abnormally).
If WANT-STREAM-P is false, then WANT-PATHAME-P must be true, and then
THUNK is only CALL-FUNCTION'ed after the stream is closed, with the pathname as argument.
Upon exit of THUNK, the AFTER thunk if defined is CALL-FUNCTION'ed with the pathname as argument.
If AFTER is defined, its results are returned, otherwise, the results of THUNK are returned.
Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'ed returns true."
(
check-type
direction
(
member
:output
:io
))
(
assert
(
or
want-stream-p
want-pathname-p
))
(
loop
:with
prefix
=
(
namestring
(
ensure-absolute-pathname
(
or
prefix
"tmp"
)
#'
temporary-directory
))
:with
prefix
=
(
namestring
(
ensure-absolute-pathname
(
or
prefix
"tmp"
)
(
or
directory
#'
temporary-directory
)))
:with
results
=
()
:for
counter
:from
(
random
(
ash
1
32
))
:for
pathname
=
(
pathname
(
format
nil
"~A~36R"
prefix
counter
))
:for
counter
:from
(
random
(
expt
36
8
))
:for
pathname
=
(
pathname
(
format
nil
"~A~36R
~@[~A~]~@[.~A~]
"
prefix
counter
suffix
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
;; TODO: on Unix, use CFFI and mkstemp -- but UIOP is precisely meant to not depend on CFFI or on anything! Grrrr.
;; TODO: on Unix, use CFFI and mkstemp --
;; except UIOP is precisely meant to not depend on CFFI or on anything! Grrrr.
;; Can we at least design some hook?
(
unwind-protect
(
progn
(
with-open-file
(
stream
pathname
...
...
@@ -565,50 +581,71 @@ The file will be open with specified DIRECTION, ELEMENT-TYPE and EXTERNAL-FORMAT
(
funcall
thunk
stream
pathname
)
(
funcall
thunk
stream
)))))))
(
when
okp
(
if
want-stream-p
(
return
(
apply
'values
results
))
(
return
(
funcall
thunk
pathname
)))))
(
when
(
and
okp
(
not
keep
))
(
unless
want-stream-p
(
setf
results
(
multiple-value-list
(
call-function
thunk
pathname
))))
(
when
after
(
setf
results
(
multiple-value-list
(
call-function
after
pathname
))))
(
return
(
apply
'values
results
))))
(
when
(
and
okp
(
not
(
call-function
keep
)))
(
ignore-errors
(
delete-file-if-exists
okp
))))))
(
defmacro
with-temporary-file
((
&key
(
stream
(
gensym
"STREAM"
)
streamp
)
(
pathname
(
gensym
"PATHNAME"
)
pathnamep
)
prefix
keep
direction
element-type
external-format
)
directory
prefix
suffix
type
keep
direction
element-type
external-format
)
&body
body
)
"Evaluate BODY where the symbols specified by keyword arguments
STREAM and PATHNAME (if respectively specified) are bound corresponding
to a newly created temporary file ready for I/O, as per CALL-WITH-TEMPORARY-FILE.
The STREAM will be closed if no binding is specified.
Unless KEEP is specified, delete the file afterwards."
At least one of STREAM or PATHNAME must be specified.
If the STREAM is not specified, it will be closed before the BODY is evaluated.
If STREAM is specified, then the :CLOSE-STREAM label if it appears in the BODY,
separates forms run before and after the stream is closed.
The values of the last form of the BODY (not counting the separating :CLOSE-STREAM) are returned.
Upon success, the KEEP form is evaluated and the file is is deleted unless it evaluates to TRUE."
(
check-type
stream
symbol
)
(
check-type
pathname
symbol
)
(
assert
(
or
streamp
pathnamep
))
`
(
flet
((
think
(
,@
(
when
streamp
`
(
,
stream
))
,@
(
when
pathnamep
`
(
,
pathname
)))
,@
body
))
#-
gcl
(
declare
(
dynamic-extent
#'
think
))
(
call-with-temporary-file
#'
think
:want-stream-p
,
streamp
:want-pathname-p
,
pathnamep
,@
(
when
direction
`
(
:direction
,
direction
))
,@
(
when
prefix
`
(
:prefix
,
prefix
))
,@
(
when
keep
`
(
:keep
,
keep
))
,@
(
when
element-type
`
(
:element-type
,
element-type
))
,@
(
when
external-format
`
(
:external-format
,
external-format
)))))
(
defun
get-temporary-file
(
&key
prefix
)
(
with-temporary-file
(
:pathname
pn
:keep
t
:prefix
prefix
)
(
let*
((
afterp
(
position
:close-stream
body
))
(
before
(
if
afterp
(
subseq
body
0
(
1-
afterp
))
body
))
(
after
(
when
afterp
(
subseq
body
(
1+
afterp
))))
(
beforef
(
gensym
"BEFORE"
))
(
afterf
(
gensym
"AFTER"
)))
`
(
flet
(
,@
(
when
before
`
((
,
beforef
(
,@
(
when
streamp
`
(
,
stream
))
,@
(
when
pathnamep
`
(
,
pathname
)))
,@
before
)))
,@
(
when
after
(
assert
pathnamep
)
`
((
,
afterf
(
,
pathname
)
,@
after
))))
#-
gcl
(
declare
(
dynamic-extent
,@
(
when
before
`
(
#'
,
beforef
))
,@
(
when
after
`
(
#'
,
afterf
))))
(
call-with-temporary-file
,
(
when
before
`
#'
,
beforef
)
:want-stream-p
,
streamp
:want-pathname-p
,
pathnamep
,@
(
when
direction
`
(
:direction
,
direction
))
,@
(
when
directory
`
(
:directory
,
directory
))
,@
(
when
prefix
`
(
:prefix
,
prefix
))
,@
(
when
suffix
`
(
:suffix
,
suffix
))
,@
(
when
type
`
(
:suffix
,
type
))
,@
(
when
keep
`
(
:keep
,
keep
))
,@
(
when
after
`
(
:after
`
#'
,
afterf
))
,@
(
when
element-type
`
(
:element-type
,
element-type
))
,@
(
when
external-format
`
(
:external-format
,
external-format
))))))
(
defun
get-temporary-file
(
&key
directory
prefix
suffix
type
)
(
with-temporary-file
(
:pathname
pn
:keep
t
:directory
directory
:prefix
prefix
:suffix
suffix
:type
type
)
pn
))
;; Temporary pathnames in simple cases where no contention is assumed
(
defun
add-pathname-suffix
(
pathname
suffix
)
"Add a SUFFIX to the name of a PATHNAME, return a new pathname"
(
make-pathname
:name
(
strcat
(
pathname-name
pathname
)
suffix
)
:defaults
pathname
))
(
defun
add-pathname-suffix
(
pathname
suffix
&rest
keys
)
"Add a SUFFIX to the name of a PATHNAME, return a new pathname.
Further KEYS can be passed to MAKE-PATHNAME."
(
apply
'make-pathname
:name
(
strcat
(
pathname-name
pathname
)
suffix
)
:defaults
pathname
keys
))
(
defun
tmpize-pathname
(
x
)
"Return a new pathname modified from X by adding a trivial deterministic suffix"
(
add-pathname-suffix
x
"-
ASDF-
TMP"
))
(
add-pathname-suffix
x
"-TMP"
))
(
defun
call-with-staging-pathname
(
pathname
fun
)
"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