Skip to content
Browse files

Merge in code (and tests and docs) from temporary-files

  • Loading branch information...
1 parent b39491b commit 1f2fd07ffc273ad720f9ef6e48b3536b21355c6b @segv segv committed
Showing with 492 additions and 25 deletions.
  1. +10 −2 cl-fad.asd
  2. +248 −21 doc/index.html
  3. 0 test.lisp → fad.test.lisp
  4. +10 −2 packages.lisp
  5. +175 −0 temporary-files.lisp
  6. +49 −0 temporary-files.test.lisp
View
12 cl-fad.asd
@@ -36,5 +36,13 @@
#+:cormanlisp (:file "corman")
#+:openmcl (:file "openmcl")
(:file "fad")
- (:file "path"))
- :depends-on (#+sbcl :sb-posix))
+ (:file "path" :depends-on ("fad"))
+ (:file "temporary-files" :depends-on ("fad")))
+ :depends-on (#+sbcl :sb-posix :bordeaux-threads :alexandria))
+
+(asdf:defsystem #:cl-fad-test
+ :version "0.6.4"
+ :serial t
+ :components ((:file "fad.test")
+ (:file "temporary-files.test"))
+ :depends-on (:cl-fad :unit-test :cl-ppcre))
View
269 doc/index.html
@@ -6,7 +6,7 @@
<title>CL-FAD - A portable pathname library for Common Lisp</title>
<style type="text/css">
pre { padding:5px; background-color:#e0e0e0 }
- h3, h4 { text-decoration: underline; }
+ h3, h4, h5 { text-decoration: underline; }
a { text-decoration: none; padding: 1px 2px 1px 2px; }
a:visited { text-decoration: none; padding: 1px 2px 1px 2px; }
a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; }
@@ -54,36 +54,48 @@
<ol>
<li><a href="#querying">Querying files, directories and pathnames</a>
<ol>
- <li><a href="#directory-exists-p"><code>directory-exists-p</code></a>
- <li><a href="#directory-pathname-p"><code>directory-pathname-p</code></a>
- <li><a href="#file-exists-p"><code>file-exists-p</code></a>
- <li><a href="#pathname-absolute-p"><code>pathname-absolute-p</code></a>
- <li><a href="#pathname-equal"><code>pathname-equal</code></a>
- <li><a href="#pathname-relative-p"><code>pathname-relative-p</code></a>
- <li><a href="#pathname-root-p"><code>pathname-root-p</code></a>
+ <li><a href="#directory-exists-p"><code>directory-exists-p</code> [function]</a>
+ <li><a href="#directory-pathname-p"><code>directory-pathname-p</code> [function]</a>
+ <li><a href="#file-exists-p"><code>file-exists-p</code> [function]</a>
+ <li><a href="#pathname-absolute-p"><code>pathname-absolute-p</code> [function]</a>
+ <li><a href="#pathname-equal"><code>pathname-equal</code> [function]</a>
+ <li><a href="#pathname-relative-p"><code>pathname-relative-p</code> [function]</a>
+ <li><a href="#pathname-root-p"><code>pathname-root-p</code> [function]</a>
</ol> </li>
<li><a href="#manipulating">Manipulating pathnames</a>
<ol>
- <li><a href="#canonical-pathname"><code>canonical-pathname</code></a>
- <li><a href="#merge-pathnames-as-directory"><code>merge-pathnames-as-directory</code></a>
- <li><a href="#merge-pathnames-as-file"><code>merge-pathnames-as-file</code></a>
- <li><a href="#pathname-as-directory"><code>pathname-as-directory</code></a>
- <li><a href="#pathname-as-file"><code>pathname-as-file</code></a>
- <li><a href="#pathname-directory-pathname"><code>pathname-directory-pathname</code></a>
- <li><a href="#pathname-parent-directory"><code>pathname-parent-directory</code></a>
+ <li><a href="#canonical-pathname"><code>canonical-pathname</code> [function]</a>
+ <li><a href="#merge-pathnames-as-directory"><code>merge-pathnames-as-directory</code> [function]</a>
+ <li><a href="#merge-pathnames-as-file"><code>merge-pathnames-as-file</code> [function]</a>
+ <li><a href="#pathname-as-directory"><code>pathname-as-directory</code> [function]</a>
+ <li><a href="#pathname-as-file"><code>pathname-as-file</code> [function]</a>
+ <li><a href="#pathname-directory-pathname"><code>pathname-directory-pathname</code> [function]</a>
+ <li><a href="#pathname-parent-directory"><code>pathname-parent-directory</code> [function]</a>
</ol> </li>
<li><a href="#traversing">Traversing directories</a>
<ol>
- <li><a href="#list-directory"><code>list-directory</code></a>
- <li><a href="#walk-directory"><code>walk-directory</code></a>
+ <li><a href="#list-directory"><code>list-directory</code> [function]</a>
+ <li><a href="#walk-directory"><code>walk-directory</code> [function]</a>
</ol> </li>
+ <li><a href="#temporary-files">Temporary Files</a>
+ <ol>
+ <li><a href="#open-temporary"><code>open-temporary</code> [function]</a>
+ <li><a href="#with-output-to-temporary-file"><code>with-output-to-temporary-file</code> [macro]</a>
+ <li><a href="#with-open-temporary-file"><code>with-open-temporary-file</code> [macro]</a>
+ <li><a href="#star-default-template-star"><code>*default-template*</code> [variable]</a>
+ <li><a href="#cannot-create-temporary-file"><code>cannot-create-temporary-file</code> [condition]</a>
+ <li><a href="#invalid-temporary-pathname-template"><code>invalid-temporary-pathname-template</code> [condition]</a>
+ <li><a href="#missing-temp-environment-variable"><code>missing-temp-environment-variable</code> [condition]</a>
+ <li><a href="#lp-host-temporary-files"><code>temporary-files</code> [logical pathname host]</a>
+ </ol>
+ </li>
<li><a href="#modifying">Modifying the file system</a>
<ol>
- <li><a href="#copy-file"><code>copy-file</code></a>
- <li><a href="#copy-stream"><code>copy-stream</code></a>
- <li><a href="#delete-directory-and-files"><code>delete-directory-and-files</code></a>
+ <li><a href="#copy-file"><code>copy-file</code> [function]</a>
+ <li><a href="#copy-stream"><code>copy-stream</code> [function]</a>
+ <li><a href="#delete-directory-and-files"><code>delete-directory-and-files</code> [function]</a>
</ol> </li>
- <li><a href="#package-path">The <code>path</code> package</a>
+ <li><a href="#package-path"><code>path</code> [package]</a>
</ol>
<li><a href="#ack">Acknowledgements</a>
</ol>
@@ -385,6 +397,221 @@
</p>
</blockquote>
+<h4><a class=none name="temporary-files">Temporary Files</a></h4>
+
+<h5>Synopsis</h5>
+
+ <p>
+ Create a temporary file and return its name:
+<pre>CL-USER&gt; (temporary-file:<code xmlns=""><a href="#with-output-to-temporary-file">with-output-to-temporary-file</a></code> (foo)
+ (print "hello" foo))
+#P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/temp-yjck024x"</pre>
+ </p>
+ <p>
+ Create a temporary file, read and write it, have it be deleted
+ automatically:
+<pre>CL-USER&gt; (temporary-file:<code xmlns=""><a href="#with-open-temporary-file">with-open-temporary-file</a></code> (foo :direction :io)
+ (print "hello" foo)
+ (file-position foo 0)
+ (read foo))
+"hello"</pre>
+ </p>
+
+ <h5><a class="none" name="default-temporary-directory">Default temporary file directory</a></h5>
+ By default, temporary files are created in a system specific
+ directory that defaults based on operating system conventions. On
+ Unix and Unix-like systems, the directory <tt>/tmp/</tt> is used
+ by default. It can be overridden by setting the <tt>TMPDIR</tt>
+ environment variable. On Windows, the value of the environment
+ variable <tt>TEMP</tt> is used. If it is not set, temporary file
+ creation will fail.
+
+ <h5><a class="none" name="defining-temporary-directory">Defining the temporary file directory</a></h5>
+ <p>
+ The Lisp application can set the default directory in which
+ temporary files are created by the way of the
+ <code xmlns=""><a href="#temporary-files">temporary-files</a></code> logical pathname host:
+
+<pre>(setf (<a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_logica.htm">logical-pathname-translations</a> "<code xmlns=""><a href="#temporary-files">temporary-files</a></code>") '(("*.*.*" "/var/tmp/")))</pre>
+
+ This would set the directory for temporary files to
+ <tt>/var/tmp/</tt>. For more information about logical
+ pathnames, please refer to <a href="http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/html/cltl/clm/node208.html#SECTION002715000000000000000">Common
+ Lisp the Language, 2nd Edition</a> and the <a href="http://clhs.lisp.se/Body/19_.htm">Common Lisp
+ HyperSpec</a>.
+ </p>
+ <p>
+ Physical path names have restrictions regarding the permitted
+ character in file names. If these restrictions conflict with
+ your desired naming scheme, you can pass a physical pathname as
+ TEMPLATE parameter to the temporary file generation function.
+ </p>
+ <p>
+ Here are a few examples:
+<pre>CL-USER&gt; (<a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_logica.htm">logical-pathname-translations</a> "temporary-files")
+(("*.*.*" #P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/"))
+CL-USER&gt; (temporary-file:<code xmlns=""><a href="#with-open-temporary-file">with-open-temporary-file</a></code> (foo)
+ (<a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_pn.htm">pathname</a> foo))
+#P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/temp-6rdqdkd1"</pre>
+
+ This used the temporary directory established in the TMPDIR
+ environment variable, by the way of the definition of the
+ temporary-files logical host definition.
+
+<pre>CL-USER&gt; (temporary-file:<code xmlns=""><a href="#with-open-temporary-file">with-open-temporary-file</a></code> (foo :template "/tmp/file.with.dots.in.name.%.txt")
+ (<a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_pn.htm">pathname</a> foo))
+#P"/tmp/file.with.dots.in.name.2EF04KUJ.txt"</pre>
+
+ Here, a physical pathname was used for the
+ <code xmlns=""><i>:template</i></code> keyword argument so that a
+ filename containing multiple dots could be generated.
+
+<pre>CL-USER&gt; (temporary-file:<code xmlns=""><a href="#with-open-temporary-file">with-open-temporary-file</a></code> (foo :template "temporary-files:blah-%.txt")
+ (<a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_pn.htm">pathname</a> foo))
+#P"/var/folders/Yu/YuNMNBNPGoqs9G-1Wmj1dk+++TI/-Tmp-/blah-72mj450d.txt"</pre>
+
+ This used the temporary-files logical pathname host, but changed
+ the filename slightly.
+
+<pre>CL-USER&gt; *default-pathname-defaults*
+#P"/Users/hans/"
+CL-USER&gt; (temporary-file:<code xmlns=""><a href="#with-open-temporary-file">with-open-temporary-file</a></code> (foo :template "blah-%.txt")
+ (<a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_pn.htm">pathname</a> foo))
+#P"/Users/hans/blah-5OEJELG2.txt"</pre>
+
+ Here, a relative pathname was used in the template, which
+ caused the file to be generated in the directory established
+ by <a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/v_defaul.htm">*default-pathname-defaults*</a>.
+ </p>
+ <p>
+ Alternatively, the <code xmlns=""><a href="#*default-template*">*default-template*</a></code>
+ special variable can be set to define a custom default template
+ for generating names.
+ </p>
+
+ <h5 xmlns=""><a class="none" name="security">Security</a></h5>
+ The TEMPORARY-FILE library does not directly address security
+ issues. The application that uses it needs to take additional
+ measures if it is important that files created by one process
+ cannot be accessed by other, unrelated processes. This can be
+ done by using the system dependent security mechanisms like
+ default file permissions or access control lists.
+
+ <h5>Dictionary</h5>
+
+
+ <p xmlns="">[Function]<br><a class="none" name="open-temporary"><b>open-temporary</b> <i><clix:lambda-list xmlns:clix="http://bknr.net/clixdoc">&amp;rest open-arguments &amp;key template generate-random-string max-tries &amp;allow-other-keys</clix:lambda-list></i>
+ =&gt;
+ <i>stream</i></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ <p xmlns="http://www.w3.org/1999/xhtml">
+ Create a file with a randomly generated name and return the
+ opened stream. The resulting pathname is generated from
+ <code xmlns=""><i>template</i></code>, which is a string
+ representing a pathname template. A percent sign (%) in
+ that string is replaced by a randomly generated string to
+ make the filename unique. The default for
+ <code xmlns=""><i>template</i></code> places temporary files in the
+ <code xmlns=""><a href="#temporary-files">temporary-files</a></code> logical pathname host,
+ which is automatically set up in a system specific manner.
+ The file name generated from <code xmlns=""><i>template</i></code>
+ is merged with <a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/v_defaul.htm">*default-pathname-defaults*</a>,
+ so random pathnames relative to that directory can be
+ generated by not specifying a directory in
+ <code xmlns=""><i>template</i></code>.
+ </p>
+ <p xmlns="http://www.w3.org/1999/xhtml">
+ <code xmlns=""><i>generate-random-string</i></code> can be passed to
+ override the default function that generates the random name
+ component. It should return a random string consisting of
+ characters that are permitted in a pathname (logical or
+ physical, depending on <code xmlns=""><i>template</i></code>).
+ </p>
+ <p xmlns="http://www.w3.org/1999/xhtml">
+ The name of the temporary file can be accessed calling the
+ <a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_pn.htm">pathname</a>
+ function on <code xmlns=""><i>stream</i></code>. For convenience,
+ the temporary file is opened on the physical pathname,
+ i.e. if the <code xmlns=""><i>template</i></code> designate a
+ logical pathname the translation to a physical pathname is
+ performed before opening the stream.
+ </p>
+ <p xmlns="http://www.w3.org/1999/xhtml">
+ In order to create a unique file name,
+ <code xmlns=""><a href="#open-temporary">open-temporary</a></code> may loop internally up
+ to <code xmlns=""><i>max-tries</i></code> times before giving up and
+ signalling a
+ <code xmlns=""><a href="#cannot-create-temporary-file">cannot-create-temporary-file</a></code> condition.
+ </p>
+ <p xmlns="http://www.w3.org/1999/xhtml">
+ Any unrecognized keyword arguments are passed to the call to
+ <a xmlns="" href="http://www.lispworks.com/documentation/HyperSpec/Body/f_open.htm">open</a>.
+ </p>
+ </clix:description></blockquote></p>
+ <p xmlns="">[Macro]<br><a class="none" name="with-output-to-temporary-file"><b>with-output-to-temporary-file</b> <i><clix:lambda-list xmlns:clix="http://bknr.net/clixdoc">(stream &amp;rest args) &amp;body body</clix:lambda-list></i>
+ =&gt;
+ <i>pathname</i></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ Create a temporary file using
+ <code xmlns=""><a href="#open-temporary">open-temporary</a></code> with
+ <code xmlns=""><i>args</i></code> and run <code xmlns=""><i>body</i></code>
+ with <code xmlns=""><i>stream</i></code> bound to the temporary file
+ stream. Returns the pathname of the file that has been
+ created. See <code xmlns=""><a href="#open-temporary">open-temporary</a></code> for
+ permitted options.
+ </clix:description></blockquote></p>
+ <p xmlns="">[Macro]<br><a class="none" name="with-open-temporary-file"><b>with-open-temporary-file</b> <i><clix:lambda-list xmlns:clix="http://bknr.net/clixdoc">(stream &amp;rest args &amp;key keep &amp;allow-other-keys) &amp;body body</clix:lambda-list></i>
+ =&gt;
+ <i>values</i></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ Create a temporary file using
+ <code xmlns=""><a href="#open-temporary">open-temporary</a></code> with
+ <code xmlns=""><i>args</i></code> and run <code xmlns=""><i>body</i></code>
+ with <code xmlns=""><i>stream</i></code> bound to the temporary file
+ stream. Returns the values returned by
+ <code xmlns=""><i>body</i></code>. By default, the file is deleted
+ when <code xmlns=""><i>body</i></code> is exited. If a true value is
+ passed in <code xmlns=""><i>keep</i></code>, the file is not deleted
+ when the body is exited. See
+ <code xmlns=""><a href="#open-temporary">open-temporary</a></code> for more permitted
+ options.
+ </clix:description></blockquote></p>
+ <p xmlns="">
+ [Special variable]<br><a class="none" name="*default-template*"><b>*default-template*</b></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ This variable can be set to a string representing the desired
+ default template for temporary file name generation. See
+ <code xmlns=""><a href="#open-temporary">open-temporary</a></code> for a description of the
+ template string format.
+ </clix:description></blockquote></p>
+ <p xmlns="">
+ [Condition type]<br><a class="none" name="cannot-create-temporary-file"><b>cannot-create-temporary-file</b></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ Signalled when an attempt to create unique temporary file name
+ failed after the established number of retries.
+ </clix:description></blockquote></p>
+ <p xmlns="">
+ [Condition type]<br><a class="none" name="invalid-temporary-pathname-template"><b>invalid-temporary-pathname-template</b></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ Signalled when the <code xmlns=""><i>template</i></code> argument to
+ <code xmlns=""><a href="#open-temporary">open-temporary</a></code> does not contain a valid
+ template string. The template string must contain a percent
+ sign, which is replaced by the generated random string to
+ yield the filename.
+ </clix:description></blockquote></p>
+ <p xmlns="">
+ [Condition type]<br><a class="none" name="missing-temp-environment-variable"><b>missing-temp-environment-variable</b></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ (Windows only) Signalled when the TEMP environment variable is
+ not set.
+ </clix:description></blockquote></p>
+ <p xmlns="">
+ [Logical Pathname Host]<br><a class="none" name="lp-host-temporary-files"><b>temporary-files</b></a><blockquote><clix:description xmlns:clix="http://bknr.net/clixdoc">
+ This logical pathname host defines where temporary files are
+ stored by default. It is initialized in a suitable system
+ specific fashion: On Unix and Unix-like systems, the directory
+ specified in the TMPDIR environment variable is used. If that
+ variable is not set, /tmp is used as the default. On Windows,
+ the directory specified in the TEMP environment variable is
+ used. If it is not set, a
+ <code xmlns=""><a href="#missing-temp-environment-variable">missing-temp-environment-variable</a></code> error
+ is signalled.
+ </clix:description></blockquote></p>
+
+
<h4><a class=none name="modifying">Modifying the file system</a></h4>
<p><br>[Function]
View
0 test.lisp → fad.test.lisp
File renamed without changes.
View
12 packages.lisp
@@ -57,7 +57,15 @@
:merge-pathnames-as-directory
:merge-pathnames-as-file
- :walk-directory))
+ :walk-directory
+
+ :open-temporary
+ :with-output-to-temporary-file
+ :with-open-temporary-file
+ :*default-template*
+ :invalid-temporary-pathname-template
+ :cannot-create-temporary-file
+ #+win32 #:missing-temp-environment-variable))
(defpackage :path
(:use)
@@ -79,5 +87,5 @@ system intensive code easier to read (for unix people at least).")
#:root-p))
(defpackage :cl-fad-test
- (:use :cl :cl-fad)
+ (:use :cl :cl-fad :unit-test)
(:export :test))
View
175 temporary-files.lisp
@@ -0,0 +1,175 @@
+(in-package :cl-fad)
+
+(defparameter *default-template* "TEMPORARY-FILES:TEMP-%")
+
+(defparameter *max-tries* 10000)
+
+(defvar *name-random-state* (make-random-state t))
+
+;; from XCVB
+(eval-when (:load-toplevel :execute)
+ (defun getenv (x)
+ "Query the libc runtime environment. See getenv(3)."
+ (declare (ignorable x))
+ #+(or abcl clisp xcl) (ext:getenv x)
+ #+allegro (sys:getenv x)
+ #+clozure (ccl:getenv x)
+ #+(or cmu scl) (cdr (assoc x ext:*environment-list* :test #'string=))
+ #+cormanlisp
+ (let* ((buffer (ct:malloc 1))
+ (cname (ct:lisp-string-to-c-string x))
+ (needed-size (win:getenvironmentvariable cname buffer 0))
+ (buffer1 (ct:malloc (1+ needed-size))))
+ (prog1 (if (zerop (win:getenvironmentvariable cname buffer1 needed-size))
+ nil
+ (ct:c-string-to-lisp-string buffer1))
+ (ct:free buffer)
+ (ct:free buffer1)))
+ #+ecl (si:getenv x)
+ #+gcl (system:getenv x)
+ #+lispworks (lispworks:environment-variable x)
+ #+mcl (ccl:with-cstrs ((name x))
+ (let ((value (_getenv name)))
+ (unless (ccl:%null-ptr-p value)
+ (ccl:%get-cstring value))))
+ #+sbcl (sb-ext:posix-getenv x)
+ #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl)
+ (error "~S is not supported on your implementation" 'getenv))
+
+ (defun directory-from-environment (environment-variable-name)
+ (let ((string (getenv environment-variable-name)))
+ (when (plusp (length string))
+ (pathname-as-directory string))))
+
+ #+win32
+ (define-condition missing-temp-environment-variable (error)
+ ()
+ (:report (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream "the TEMP environment variable has not been found, cannot continue"))))
+
+ #+win32
+ (defun get-default-temporary-directory ()
+ (or (directory-from-environment "TEMP")
+ (error 'missing-temp-environment-variable)))
+
+ #-win32
+ (defun get-default-temporary-directory ()
+ (or (directory-from-environment "TMPDIR")
+ #-clisp
+ (probe-file #P"/tmp/")
+ #+clisp
+ (and (ext:probe-directory #P"/tmp/")
+ #P"/tmp/")))
+
+ (handler-case
+ (logical-pathname-translations "TEMPORARY-FILES")
+ (#-clisp type-error
+ #+clisp simple-error ()
+ (alexandria:if-let (default-temporary-directory (get-default-temporary-directory))
+ (setf (logical-pathname-translations "TEMPORARY-FILES") `(("*.*.*" ,default-temporary-directory)))
+ (warn "could not automatically determine a default mapping for TEMPORARY-FILES")))))
+
+;; locking for multi-threaded operation with unsafe random function
+
+(defvar *create-file-name-lock* (bordeaux-threads:make-lock "Temporary File Name Creation Lock"))
+
+(defmacro with-file-name-lock-held (() &body body)
+ `(bordeaux-threads:with-lock-held (*create-file-name-lock*)
+ ,@body))
+
+(defun generate-random-string ()
+ (with-file-name-lock-held ()
+ (format nil "~:@(~36,8,'0R~)" (random (expt 36 8) *name-random-state*))))
+
+(define-condition invalid-temporary-pathname-template (error)
+ ((string :initarg :string))
+ (:report (lambda (condition stream)
+ (with-slots (string) condition
+ (format stream "invalid temporary file name template ~S, must contain a percent sign that is to be replaced by a random string" string)))))
+
+(defun generate-random-pathname (template random-string-generator)
+ (let ((percent-position (or (position #\% template)
+ (error 'invalid-temporary-pathname-template :string template))))
+ (merge-pathnames (concatenate 'string
+ (subseq template 0 percent-position)
+ (funcall random-string-generator)
+ (subseq template (1+ percent-position))))))
+
+(define-condition cannot-create-temporary-file (error)
+ ((template :initarg :template)
+ (max-tries :initarg :max-tries))
+ (:report (lambda (condition stream)
+ (with-slots (template max-tries) condition
+ (format stream "cannot create temporary file with template ~A, giving up after ~D attempt~:P"
+ template max-tries)))))
+
+(defun open-temporary (&rest open-arguments
+ &key
+ (template *default-template*)
+ (generate-random-string 'generate-random-string)
+ (max-tries *max-tries*)
+ (direction :output)
+ &allow-other-keys)
+ "Create a file with a randomly generated name and return the opened
+ stream. The resulting pathname is generated from TEMPLATE, which
+ is a string representing a pathname template. A percent sign (%)
+ in that string is replaced by a randomly generated string to make
+ the filename unique. The default for TEMPLATE places temporary
+ files in the TEMPORARY-FILES logical pathname host, which is
+ automatically set up in a system specific manner. The file name
+ generated from TEMPLATE is merged with *DEFAULT-PATHNAME-DEFAULTS*,
+ so random pathnames relative to that directory can be generated by
+ not specifying a directory in TEMPLATE.
+
+ GENERATE-RANDOM-STRING can be passed to override the default
+ function that generates the random name component. It should
+ return a random string consisting of characters that are permitted
+ in a pathname (logical or physical, depending on TEMPLATE).
+
+ The name of the temporary file can be accessed calling the PATHNAME
+ function on STREAM. For convenience, the temporary file is opened
+ on the physical pathname, i.e. if the TEMPLATE designate a logical
+ pathname the translation to a physical pathname is performed before
+ opening the stream.
+
+ In order to create a unique file name, OPEN-TEMPORARY may loop
+ internally up to MAX-TRIES times before giving up and signalling a
+ CANNOT-CREATE-TEMPORARY-FILE condition."
+ (loop thereis (apply #'open
+ (translate-logical-pathname (generate-random-pathname template generate-random-string))
+ :direction direction
+ :if-exists nil
+ (alexandria:remove-from-plist open-arguments :template :generate-random-string :max-tries))
+ repeat max-tries
+ finally (error 'cannot-create-temporary-file
+ :template template
+ :max-tries max-tries)))
+
+(defmacro with-output-to-temporary-file ((stream &rest args) &body body)
+ "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY
+ with STREAM bound to the temporary file stream. Returns the
+ pathname of the file that has been created. See OPEN-TEMPORARY for
+ permitted options."
+ `(with-open-stream (,stream (open-temporary ,@args))
+ ,@body
+ (pathname ,stream)))
+
+(defmacro with-open-temporary-file ((stream &rest args &key keep &allow-other-keys) &body body)
+ "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY
+ with STREAM bound to the temporary file stream. Returns the values
+ returned by BODY. By default, the file is deleted when BODY is
+ exited. If a true value is passed in KEEP, the file is not deleted
+ when the body is exited. See OPEN-TEMPORARY for more permitted
+ options."
+ `(with-open-stream (,stream (open-temporary ,@(alexandria:remove-from-plist args :keep)))
+ #+sbcl
+ (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+ ,(if (and (constantp keep)
+ keep)
+ `(progn ,@body)
+ `(unwind-protect
+ (progn ,@body)
+ (unless ,keep
+ (close ,stream)
+ (delete-file (pathname ,stream)))))))
View
49 temporary-files.test.lisp
@@ -0,0 +1,49 @@
+(in-package :cl-fad-test)
+
+(deftest 'temporary-file 'with-output-to-temporary-file ()
+ (let ((pathname (with-output-to-temporary-file (f)
+ (write-string "hello" f))))
+ (test-assert (probe-file pathname))
+ (test-equal (alexandria:read-file-into-string pathname) "hello")
+ (delete-file pathname)))
+
+(deftest 'temporary-file 'with-open-temporary-file-keep ()
+
+ (let ((pathname (with-open-temporary-file (f :keep nil)
+ (pathname f))))
+ (test-assert (null (probe-file pathname))))
+ (let ((pathname (with-open-temporary-file (f :keep t)
+ (pathname f))))
+ (test-assert (probe-file pathname))
+ (delete-file pathname))
+
+ (let* ((keep nil)
+ (pathname (with-open-temporary-file (f :keep keep)
+ (pathname f))))
+ (test-assert (null (probe-file pathname))))
+ (let* ((keep t)
+ (pathname (with-open-temporary-file (f :keep keep)
+ (pathname f))))
+ (test-assert (probe-file pathname))
+ (delete-file pathname)))
+
+(deftest 'temporary-file 'template-tests ()
+ ;; error is signalled when template does not contain a percent sign.
+ (let ((*default-template* "foo"))
+ (test-condition (with-open-temporary-file (f :keep nil))
+ 'invalid-temporary-pathname-template))
+ ;; file name template occurs in generated file name (for logical path name)
+ (let* ((*default-template* "temporary-files:bla%.txt")
+ (pathname (with-open-temporary-file (f :keep nil)
+ (pathname f))))
+ (test-assert (cl-ppcre:scan "(?i)bla.*\\.txt$" (namestring pathname))))
+ ;; file name template occurs in generated file name (for pysical path name)
+ (let* ((*default-template* (concatenate 'string
+ (namestring (translate-logical-pathname "temporary-files:"))
+ "bla%.txt"))
+ (pathname (with-open-temporary-file (f :keep nil)
+ (pathname f))))
+ (test-assert (cl-ppcre:scan "(?i)bla.*\\.txt$" (namestring pathname)))))
+
+
+

0 comments on commit 1f2fd07

Please sign in to comment.
Something went wrong with that request. Please try again.