Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge pull request #4 from segv/segvs-utils

Added various utility functions for manipulating pathnames
  • Loading branch information...
commit ce5cdc093373dc34965ddcabd78f37cf8cf27b8f 2 parents 0bfdfd8 + 547da8d
@hanshuebner hanshuebner authored
View
26 LICENSE
@@ -0,0 +1,26 @@
+;;; Copyright (c) 2004, Peter Seibel. All rights reserved.
+;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
14 cl-fad.asd
@@ -35,5 +35,15 @@
:components ((:file "packages")
#+:cormanlisp (:file "corman")
#+:openmcl (:file "openmcl")
- (:file "fad"))
- :depends-on (#+sbcl :sb-posix))
+ (:file "fad")
+ (: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 "packages.test")
+ (:file "fad.test" :depends-on ("packages.test"))
+ (:file "temporary-files.test" :depends-on ("packages.test")))
+ :depends-on (:cl-fad :unit-test :cl-ppcre))
View
524 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; }
@@ -43,8 +43,7 @@
license</a> so you can basically do with it whatever you want.
<p>
-<font color=red>Download shortcut:</font> <a href="http://weitz.de/files/cl-fad.tar.gz">http://weitz.de/files/cl-fad.tar.gz</a>.
-
+<font color=red>Download shortcut:</font> <a href="https://github.com/edicl/cl-fad/archive/master.zip">https://github.com/edicl/cl-fad/archive/master.zip</a>.
</blockquote>
<br>&nbsp;<br><h3><a class=none name="contents">Contents</a></h3>
@@ -53,16 +52,50 @@
<li><a href="#implementations">Supported Lisp implementations</a>
<li><a href="#dictionary">The CL-FAD dictionary</a>
<ol>
- <li><a href="#directory-pathname-p"><code>directory-pathname-p</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="#file-exists-p"><code>file-exists-p</code></a>
- <li><a href="#directory-exists-p"><code>directory-exists-p</code></a>
- <li><a href="#list-directory"><code>list-directory</code></a>
- <li><a href="#walk-directory"><code>walk-directory</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></a>
- <li><a href="#copy-stream"><code>copy-stream</code></a>
+ <li><a href="#querying">Querying files, directories and pathnames</a>
+ <ol>
+ <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> [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> [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> [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"><code>path</code> [package]</a>
</ol>
<li><a href="#ack">Acknowledgements</a>
</ol>
@@ -91,11 +124,8 @@
If for some reason you can't or don't want to use MK:DEFSYSTEM or asdf you
can just <code>LOAD</code> the file <code>load.lisp</code>.
<p>
-Lu&iacute;s Oliveira maintains a <a href="http://darcs.net/">darcs</a>
-repository of CL-FAD
-at <a
-href="http://common-lisp.net/~loliveira/ediware/">http://common-lisp.net/~loliveira/ediware/</a>.
-<p>
+The latest version of the source code lives in the github repository <a href="https://github.com/edicl/cl-fad">edicl/cl-fad</a>
+
If you want to send patches, please <a href="http://weitz.de/patches.html">read this first</a>.
<br>&nbsp;<br><h3><a class=none name="implementations">Supported Lisp implementations</a></h3>
@@ -121,6 +151,18 @@
<br>&nbsp;<br><h3><a class=none name="dictionary">The CL-FAD dictionary</a></h3>
+<h4><a class=none name="querying">Querying files, directories and pathnames</a></h4>
+
+<p><br>[Function]
+<br><a class=none name="directory-exists-p"><b>directory-exists-p</b> <i> pathspec </i> =&gt; <i> generalized-boolean</i></a>
+
+<blockquote><br>
+Checks whether the file named by the <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>pathspec</i></code>
+exists and if it is a directory. Returns its <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_t.htm#truename">truename</a> if this is the
+case, <code>NIL</code> otherwise. The truename is returned in <em>directory form</em> as if
+by <a href="#pathname-as-directory"><code>PATHNAME-AS-DIRECTORY</code></a>.
+</blockquote>
+
<p><br>[Function]
<br><a class=none name="directory-pathname-p"><b>directory-pathname-p</b> <i> pathspec </i> =&gt; <i> generalized-boolean</i></a>
@@ -131,6 +173,140 @@
</blockquote>
<p><br>[Function]
+<br><a class=none name="file-exists-p"><b>file-exists-p</b> <i> pathspec </i> =&gt; <i> generalized-boolean</i></a>
+
+<blockquote><br>
+Checks whether the file named by the <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>pathspec</i></code>
+exists and returns its <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_t.htm#truename">truename</a> if this is the case, <code>NIL</code> otherwise.
+The truename is returned in "canonical" form, i.e. the truename of a
+directory is returned in <em>directory form</em> as if by <a href="#pathname-as-directory"><code>PATHNAME-AS-DIRECTORY</code></a>.
+</blockquote>
+
+<p><br>[Function]<br><a class=none name='pathname-absolute-p'><b>pathname-absolute-p</b> <i>a</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Returns true if <code><i>a</i></code> is an absolute pathname. This simply
+tests if <code><i>a</i></code>&#039;s directory list starts with <code>:ABSOLUTE</code></p>
+</blockquote>
+
+<p><br>[Function]<br><a class=none name='pathname-equal'><b>pathname-equal</b> <i>a b</i> =&gt; <i>result</i></a>
+<blockquote>
+
+<p>Returns <em>true</em> if <code><i>a</i></code> and <code><i>b</i></code>
+represent the same pathname. This function does not access the
+filesystem, it only looks at the components of the two pathnames to
+test if they are the same (though by passing both <code><i>a</i></code>
+and <code><i>b</i></code> to probe-file one can make this function test for
+file &#039;sameness&#039;.</p>
+
+<p>Equality is defined as:</p>
+
+<ul>
+ <li>strings that are <code>string=</code>
+ <li>symbols (including <code>nil</code> and keywords) which are <code>eql</code>
+ <li>lists of the same length with equal (as per these rules) elements.
+</ul>
+
+<p>If any of these tree conditions is false for any of the components in
+<code><i>a</i></code> and <code><i>b</i></code> then <code><i>a</i></code>
+and <code><i>b</i></code> are different, otherwise they are the same.</p>
+
+<p><em>NB:</em> This function does not convert name strings to pathnames. So
+&quot;foo.txt&quot; and #P&quot;foo.txt&quot; are different pathnames.</p>
+
+</blockquote>
+
+<p><br>[Function]<br><a class=none name='pathname-relative-p'><b>pathname-relative-p</b> <i>a</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Returns true if <code><i>a</i></code> is a relative pathname. This simply
+tests if <code><i>a</i></code>&#039;s directory starts
+with <code>:RELATIVE</code>.</p>
+</blockquote>
+
+<p><br>[Function]<br><a class=none name='pathname-root-p'><b>pathname-root-p</b> <i>a</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Returns <em>true</em> if <code><i>pathname</i></code> is the root
+directory (in other words, a directory which is its own parent).</p>
+</blockquote>
+
+<h4><a class=none name="manipulating">Manipulating pathnames</a></h4>
+
+<p><br>[Function]<br><a class=none name='canonical-pathname'><b>canonical-pathname</b> <i>pathname</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Remove reduntant information from PATHNAME.</p>
+
+<p>This simply walks down <code>PATHNAME</code>&#039;s
+pathname-directory and drops &quot;.&quot; directories, removes :back
+and its preceding element.</p>
+
+<p>NB: This function does not access the filesystem, it only looks at the
+values in the pathname and works on their known (or assumed)
+meanings.</p>
+
+<p>NB: Since this function does not access the filesystem it will only
+remove <code>:BACK</code> elements from the path (not <code>:UP</code>
+elements). Since some lisps, ccl/sbcl/clisp convert &quot;..&quot; in
+pathnames to <code>:UP</code>, and not <code>:BACK</code>, the actual
+utility of the function is limited.</p>
+</blockquote>
+
+<p><br>[Function]<br><a class=none name='merge-pathnames-as-directory'><b>merge-pathnames-as-directory</b> <i><tt>&amp;rest</tt> pathnames</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Given a list of, probably relative, pathnames returns a single
+directory pathname containing the logical concatenation of them all.</p>
+
+<p>The returned value is the current directory if one were to cd into
+each of <code><i>pathnames</i></code> in order. For this reason an
+absolute pathname will, effectively, cancel the affect of any previous
+relative pathnames.</p>
+
+<p>The returned value&#039;s defaults are taken from the first element of
+<code><i>pathnames</i></code> (host, version and device).</p>
+
+<p><em>NB:</em> Since this function only looks at directory names the name and
+type of the elements of <code><i>pathnames</i></code> are ignored. Make sure to properly
+use either trailing #\/s, or <a href="#pathname-as-directory">pathname-as-directory</a>, to get the
+expected results.</p>
+
+<p>Examples:</p>
+
+<pre>
+ (merge-pathnames-as-directory #P&quot;foo/&quot; #P&quot;bar/&quot;) == #P&quot;foo/bar/&quot;
+
+ (merge-pathnames-as-directory #P&quot;foo/&quot; #P&quot;./bar/&quot;) == #P&quot;foo/./bar/&quot;
+
+ (merge-pathnames-as-directory #P&quot;foo/&quot; #P&quot;/bar/&quot;) == #P&quot;/bar/&quot;
+
+ (merge-pathnames-as-directory #P&quot;foo/&quot; #P&quot;/bar/&quot; #P&#039;quux/file.txt) == #P&quot;/bar/quux/&quot;
+</pre>
+
+</blockquote>
+
+<p><br>[Function]<br><a class=none name='merge-pathnames-as-file'><b>merge-pathnames-as-file</b> <i><tt>&amp;rest</tt> pathnames</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Given a list of, probably relative, pathnames returns a single
+filename pathname containing the logical concatenation of them all.</p>
+
+<p>The returned value&#039;s defaults are taken from the first element of
+<code><i>pathnames</i></code> (host, version and device). The returned
+values&#039;s name, type and version are taken from the last element
+of <code><i>pathnames</i></code>. The intervening elements are used only for
+their pathname-directory values.</p>
+
+Examples:
+
+<pre>
+ (merge-pathnames-as-file #P&quot;foo/&quot; #P&quot;bar.txt&quot;) == #P&quot;foo/bar.txt&quot;
+
+ (merge-pathnames-as-file #P&quot;foo/&quot; #P&quot;./bar.txt&quot;) == #P&quot;foo/./bar.txt&quot;
+
+ (merge-pathnames-as-file #P&quot;foo/&quot; #P&quot;/bar/README&quot;) == #P&quot;/bar/README&quot;
+
+ (merge-pathnames-as-file #P&quot;/foo/&quot; #P&quot;/bar/&quot; #P&#039;quux/file.txt) == #P&quot;/bar/quux/file.txt&quot;
+</pre>
+
+</blockquote>
+
+<p><br>[Function]
<br><a class=none name="pathname-as-directory"><b>pathname-as-directory</b> <i> pathspec </i> =&gt; <i> pathname</i></a>
<blockquote><br>
Converts the <em>non-wild</em> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>pathspec</i></code> to <em>directory form</em>, i.e. it returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname">pathname</a> which would return a <em>true</em> value if fed to <a href="#directory-pathname-p"><code>DIRECTORY-PATHNAME-P</code></a>.
@@ -143,26 +319,33 @@
Converts the <em>non-wild</em> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>pathspec</i></code> to <em>file form</em>, i.e. it returns a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname">pathname</a> which would return a <code>NIL</code> value if fed to <a href="#directory-pathname-p"><code>DIRECTORY-PATHNAME-P</code></a>.
</blockquote>
-<p><br>[Function]
-<br><a class=none name="file-exists-p"><b>file-exists-p</b> <i> pathspec </i> =&gt; <i> generalized-boolean</i></a>
-
-<blockquote><br>
-Checks whether the file named by the <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>pathspec</i></code>
-exists and returns its <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_t.htm#truename">truename</a> if this is the case, <code>NIL</code> otherwise.
-The truename is returned in "canonical" form, i.e. the truename of a
-directory is returned in <em>directory form</em> as if by <a href="#pathname-as-directory"><code>PATHNAME-AS-DIRECTORY</code></a>.
+<p><br>[Function]<br><a class=none name='pathname-directory-pathname'><b>pathname-directory-pathname</b> <i>pathname</i> =&gt; <i>result</i></a>
+<blockquote>
+<p>Returns a complete pathname representing the directory of
+<code><i>pathname</i></code>. If <code><i>pathname</i></code> is
+already a directory pathname
+(<code>name</code> <code>nil</code>, <code>type</code>
+<code>nil</code>) returns a pathname equal (as
+per <a href="#pathname-equal">pathname-equal</a>) to it.</p>
</blockquote>
-<p><br>[Function]
-<br><a class=none name="directory-exists-p"><b>directory-exists-p</b> <i> pathspec </i> =&gt; <i> generalized-boolean</i></a>
+<p><br>[Function]<br><a class=none name='pathname-parent-directory'><b>pathname-parent-directory</b> <i>pathname</i> =&gt; <i>result</i></a>
+<blockquote>
+
+<p>Returns a pathname which would, by name at least,
+contain <code><i>pathname</i></code> as one of its direct
+children. Symlinks can make the parent/child relationship a like
+opaque, but generally speaking the value returned by this function is
+a directory name which contains <code><i>pathname</i></code>.</p>
+
+<p>The root directory, #P&quot;/&quot;, is its own parent. The parent
+directory of a filename is the parent of the filename&#039;s
+dirname.</p>
-<blockquote><br>
-Checks whether the file named by the <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>pathspec</i></code>
-exists and if it is a directory. Returns its <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_t.htm#truename">truename</a> if this is the
-case, <code>NIL</code> otherwise. The truename is returned in <em>directory form</em> as if
-by <a href="#pathname-as-directory"><code>PATHNAME-AS-DIRECTORY</code></a>.
</blockquote>
+<h4><a class=none name="traversing">Traversing directories</a></h4>
+
<p><br>[Function]
<br><a class=none name="list-directory"><b>list-directory</b> <i> dirname <tt>&amp;key</tt> follow-symlinks</i> =&gt; <i> list</i></a>
@@ -214,23 +397,222 @@
</p>
</blockquote>
-<p><br>[Function]
-<br><a class=none name="delete-directory-and-files"><b>delete-directory-and-files</b> <i> dirname<tt>&amp;key</tt> if-does-not-exist</i> =&gt; |</a>
-
-<blockquote><br>
-<p>
-Recursively deletes all files and directories within the directory
-designated by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>dirname</i></code> including
-<code><i>dirname</i></code> itself. <code><i>if-does-not-exist</i></code> must be one of <code>:ERROR</code> or <code>:IGNORE</code>
-where <code>:ERROR</code> (the default) means that an error will be signaled if the directory
-<code><i>dirname</i></code> does not exist.
-</p>
-<p>
- <b>Warning:</b> this function <em>might</em> remove files from outside the
- directory, if the directory that you are deleting contains links to
- external files. This is currently fixed for SBCL and CCL.
-</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]
<br><a class=none name="copy-file"><b>copy-file</b> <i> from to <tt>&amp;key</tt> overwrite</i> =&gt; |</a>
@@ -253,6 +635,48 @@
true (which is the default), the function will signal an error if the
element types aren't the same.
</blockquote>
+<p><br>[Function]
+<br><a class=none name="delete-directory-and-files"><b>delete-directory-and-files</b> <i> dirname<tt>&amp;key</tt> if-does-not-exist</i> =&gt; |</a>
+
+<blockquote><br>
+<p>
+Recursively deletes all files and directories within the directory
+designated by the non-wild <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#pathname_designator">pathname designator</a> <code><i>dirname</i></code> including
+<code><i>dirname</i></code> itself. <code><i>if-does-not-exist</i></code> must be one of <code>:ERROR</code> or <code>:IGNORE</code>
+where <code>:ERROR</code> (the default) means that an error will be signaled if the directory
+<code><i>dirname</i></code> does not exist.
+</p>
+<p>
+ <b>Warning:</b> this function <em>might</em> remove files from outside the
+ directory, if the directory that you are deleting contains links to
+ external files. This is currently fixed for SBCL and CCL.
+</p>
+</blockquote>
+
+<h4>The <code>PATH</code> package</h4>
+
+<p><br>[Package]
+<br><a class=none name="package-path">(defpackage <b>path</b>)</a>
+
+<blockquote>
+Provides a set of short names for commonly used pathname manipulation
+functions (these are all functions from the <code>cl-fad</code>
+package which are being exported under different names):
+<dl>
+ <dt><code>dirname</code></dt> <dd><a href="#pathname-as-directory">pathname-as-directory</a></dd>
+ <dt><code>basename</code></dt> <dd><code>cl:file-namestring</code></dd>
+ <dt><code>-e</code></dt> <dd><a href="#file-exists-p">file-exists-p</a></dd>
+ <dt><code>-d</code></dt> <dd><a href="#directory-exists-p">directory-exists-p</a></dd>
+ <dt><code>catfile</code></dt> <dd><a href="#merge-pathnames-as-file">merge-pathnames-as-file</a></dd>
+ <dt><code>catdir</code></dt> <dd><a href="#merge-pathnames-as-directory">merge-pathnames-as-directory</a></dd>
+ <dt><code>rm-r</code></dt> <dd><a href="#delete-directory-and-files">delete-directory-and-files</a></dd>
+ <dt><code>=</code></dt> <dd><a href="#pathname-equal">pathname-equal</a></dd>
+ <dt><code>absolute-p</code></dt> <dd><a href="#pathname-absolute-p">pathname-absolute-p</a></dd>
+ <dt><code>relative-p</code></dt> <dd><a href="#pathname-relative-p">pathname-relative-p</a></dd>
+ <dt><code>root-p</code></dt> <dd><a href="#pathname-root-p">pathname-root-p</a></dd>
+</dl>
+</blockquote>
+
<br>&nbsp;<br><h3><a class=none name="ack">Acknowledgements</a></h3>
View
256 fad.lisp
@@ -32,7 +32,7 @@
(defun component-present-p (value)
"Helper function for DIRECTORY-PATHNAME-P which checks whether VALUE
-is neither NIL nor the keyword :UNSPECIFIC."
+ is neither NIL nor the keyword :UNSPECIFIC."
(and value (not (eql value :unspecific))))
(defun directory-pathname-p (pathspec)
@@ -82,16 +82,16 @@ sub-directories are returned by DIRECTORY."
(defun list-directory (dirname &key (follow-symlinks t))
"Returns a fresh list of pathnames corresponding to all files within
-the directory named by the non-wild pathname designator DIRNAME. The
-pathnames of sub-directories are returned in directory form - see
-PATHNAME-AS-DIRECTORY.
+ the directory named by the non-wild pathname designator DIRNAME.
+ The pathnames of sub-directories are returned in directory form -
+ see PATHNAME-AS-DIRECTORY.
-If FOLLOW-SYMLINKS is true, then the returned list contains
+ If FOLLOW-SYMLINKS is true, then the returned list contains
truenames (symlinks will be resolved) which essentially means that it
might also return files from *outside* the directory. This works on
all platforms.
-When FOLLOW-SYMLINKS is NIL, it should return the actual directory
+ When FOLLOW-SYMLINKS is NIL, it should return the actual directory
contents, which might include symlinks. Currently this works on SBCL
and CCL."
(declare (ignorable follow-symlinks))
@@ -317,6 +317,250 @@ might be removed instead! This is currently fixed for SBCL and CCL."
:if-does-not-exist if-does-not-exist)
(values))
+(defun pathname-directory-pathname (pathname)
+ "Returns a complete pathname representing the directory of
+PATHNAME. If PATHNAME is already a directory pathname (name NIL, type
+NIL) returns a pathname equal (as per pathname=) to it."
+ (make-pathname :defaults pathname
+ :name nil :type nil))
+
+(defun pathname-parent-directory (pathname)
+ "Returns a pathname which would, by name at least, contain PATHNAME
+as one of its direct children. Symlinks can make the parent/child
+relationship a like opaque, but generally speaking the value returned
+by this function is a directory name which contains PATHNAME.
+
+The root directory, #P\"/\", is its own parent. The parent directory
+of a filename is the parent of the filename's dirname."
+ (canonical-pathname
+ (make-pathname :defaults pathname
+ :directory (if (pathname-root-p pathname)
+ (list :absolute)
+ (append (or (pathname-directory pathname)
+ (list :relative))
+ (list :back))))))
+
+(defun canonical-pathname (pathname)
+ "Remove reduntant information from PATHNAME.
+
+This simply walks down PATHNAME's pathname-directory and drops \".\"
+directories, removes :back and its preceding element.
+
+NB: This function does not access the filesystem, it only looks at the
+values in the pathname and works on their known (or assumed)
+meanings.
+
+NB: Since this function does not access the filesystem it will only
+remove :BACK elements from the path (not :UP elements). Since some
+lisps, ccl/sbcl/clisp convert \"..\" in pathnames to :UP, and
+not :BACK, the actual utility of the function is limited."
+ (let ((pathname (pathname pathname))) ;; just make sure to get a pathname object
+ (loop
+ with full-dir = (or (pathname-directory pathname)
+ (list :relative))
+ with canon-dir = (if (member (first full-dir) '(:relative :absolute))
+ (list (pop full-dir))
+ (list :relative))
+ while full-dir
+ do (cond
+ ((string= "." (first full-dir))
+ (pop full-dir))
+ ((eql :back (second full-dir))
+ (pop full-dir)
+ (pop full-dir))
+ (t (push (pop full-dir) canon-dir)))
+ finally (return (make-pathname :defaults pathname :directory (nreverse canon-dir))))))
+
+(defun merge-pathnames-as-directory (&rest pathnames)
+ "Given a list of, probably relative, pathnames returns a single
+directory pathname containing the logical concatenation of them all.
+
+The returned value is the current directory if one were to cd into
+each of PATHNAMES in order. For this reason an absolute pathname will,
+effectively, cancel the affect of any previous relative pathnames.
+
+The returned value's defaults are taken from the first element of
+PATHNAMES (host, version and device).
+
+NB: Since this function only looks at directory names the name and
+type of the elements of PATHNAMES are ignored. Make sure to properly
+use either trailing #\\/s, or pathname-as-directory, to get the
+expected results.
+
+Examples:
+
+ (merge-pathnames-as-directory #P\"foo/\" #P\"bar/\") == #P\"foo/bar/\"
+ (merge-pathnames-as-directory #P\"foo/\" #P\"./bar/\") == #P\"foo/./bar/\"
+ (merge-pathnames-as-directory #P\"foo/\" #P\"/bar/\") == #P\"/bar/\"
+ (merge-pathnames-as-directory #P\"foo/\" #P\"/bar/\" #P'quux/file.txt) == #P\"/bar/quux/\"
+"
+ (when (null pathnames)
+ (return-from merge-pathnames-as-directory
+ (make-pathname :defaults *default-pathname-defaults* :directory nil :name nil :type nil)))
+ (let* ((pathnames (mapcar #'pathname pathnames)))
+ (loop
+ with defaults = (first pathnames)
+ with dir = (pathname-directory defaults)
+ for pathname in (rest pathnames)
+ for type = (first (pathname-directory pathname))
+ do (ecase type
+ ((nil) ;; this is equivalent to (:relative) == ".", so, for this function, just do nothing.
+ )
+ (:absolute
+ (setf dir (pathname-directory pathname)))
+ (:relative
+ (setf dir (append dir (rest (pathname-directory pathname))))))
+ finally (return (make-pathname :defaults defaults :directory dir :name nil :type nil)))))
+
+(defun merge-pathnames-as-file (&rest pathnames)
+ "Given a list of, probably relative, pathnames returns a single
+filename pathname containing the logical concatenation of them all.
+
+The returned value's defaults are taken from the first element of
+PATHNAMES (host, version and device). The returned values's name, type
+and version are taken from the last element of PATHNAMES. The
+intervening elements are used only for their pathname-directory
+values.
+
+Examples:
+
+ (merge-pathnames-as-file #P\"foo/\" #P\"bar.txt\") == #P\"foo/bar.txt\"
+ (merge-pathnames-as-file #P\"foo/\" #P\"./bar.txt\") == #P\"foo/./bar.txt\"
+ (merge-pathnames-as-file #P\"foo/\" #P\"/bar/README\") == #P\"/bar/README\"
+ (merge-pathnames-as-file #P\"/foo/\" #P\"/bar/\" #P'quux/file.txt) == #P\"/bar/quux/file.txt\"
+"
+ (case (length pathnames)
+ (0
+ (when (null pathnames)
+ (make-pathname :defaults *default-pathname-defaults*
+ :directory nil
+ :name nil
+ :type nil)))
+ (1
+ (pathname-as-file (first pathnames)))
+ (t
+ (let* ((defaults (pop pathnames))
+ (file-name-part (first (last pathnames)))
+ (file-name-directory (make-pathname :defaults file-name-part
+ :name nil :type nil))
+ (pathnames (butlast pathnames)))
+ (make-pathname :defaults (apply #'merge-pathnames-as-directory (append (list defaults) pathnames (list file-name-directory)))
+ :name (pathname-name file-name-part)
+ :type (pathname-type file-name-part)
+ :version (pathname-version file-name-part))))))
+
+(defmacro with-component-testers ((a b key) &body body)
+ (let ((k (gensym)))
+ `(let* ((,k ,key)
+ (,a (funcall ,k ,a))
+ (,b (funcall ,k ,b)))
+ (labels ((components-are (test)
+ (and (funcall test ,a) (funcall test ,b)))
+
+ (components-are-member (values)
+ (and (member ,a values :test #'eql)
+ (member ,b values :test #'eql)
+ (eql ,a ,b)))
+
+ (components-are-string= ()
+ (and (stringp ,a) (stringp ,b) (string= ,a ,b)))
+
+ (components-are-every (test)
+ (and (consp ,a)
+ (consp ,b)
+ (every test ,a ,b))))
+
+
+ (if (or ,@body)
+ (values t ,a ,b)
+ nil)))))
+
+(defun pathname-host-equal (a b)
+ (with-component-testers (a b #'pathname-host)
+ (eq a b)
+ (components-are-member '(nil :unspecific))
+ (components-are-string=)
+ (and (consp a)
+ (consp b)
+ (components-are-every #'string=))))
+
+(defun pathname-device-equal (a b)
+ (with-component-testers (a b #'pathname-device)
+ (components-are-member '(nil :unspecific))
+ (components-are-string=)))
+
+(defun pathname-directory-equal (a b)
+ (with-component-testers (a b #'pathname-directory)
+ (and (null a) (null b))
+ (and (= (length a) (length b))
+ (every (lambda (a b)
+ (or (and (stringp a) (stringp b) (string= a b))
+ (and (null a) (null b))
+ (and (keywordp a) (keywordp b) (eql a b))))
+ a b))))
+
+(defun pathname-name-equal (a b)
+ (with-component-testers (a b #'pathname-name)
+ (components-are-member '(nil :wild :unspecific))
+ (components-are-string=)))
+
+(defun pathname-type-equal (a b)
+ (with-component-testers (a b #'pathname-type)
+ (components-are-member '(nil :wild :unspecific))
+ (components-are-string=)))
+
+(defun pathname-version-equal (a b)
+ (with-component-testers (a b #'pathname-version)
+ (and (null a) (null b))
+ (components-are-member '(:wild :newest :unspecific))
+ (and (integerp a) (integerp b) (= a b))))
+
+(defun pathname-equal (a b)
+ "Returns T if A and B represent the same pathname. This function
+does not access the filesystem, it only looks at the components of the
+two pathnames to test if they are the same (though by
+passing both A and B to probe-file one can make this function test for file 'sameness'.
+
+Equality is defined as:
+
+ - strings that are string equal
+ - symbol (including nil) or keywords which are eql
+ - lists of the same length with equal (as per these rules) elements.
+
+if any of these tree conditions is false for any of the components in
+A and B then A and B are different, otherwise they are the same.
+
+NB: This function does not convert name strings to pathnames. So
+\"foo.txt\" and #P\"foo.txt\" are different pathnames."
+ (if (and a b)
+ (if (and (pathname-host-equal a b)
+ (pathname-device-equal a b)
+ (pathname-directory-equal a b)
+ (pathname-name-equal a b)
+ (pathname-type-equal a b)
+ (pathname-version-equal a b))
+ (values t a b)
+ (values nil))
+ (values nil)))
+
+(defun pathname-absolute-p (a)
+ "Returns true if A is an absolute pathname.
+
+This simply tests if A's directory list starts with :ABSOLUTE"
+ (eql :absolute (first (pathname-directory (pathname a)))))
+
+(defun pathname-relative-p (a)
+ "Returns true if A is a relative pathname.
+
+This simply tests if A's directory starts with :RELATIVE."
+ (let ((dir (pathname-directory (pathname a))))
+ (or (null dir) (eql :relative (first dir)))))
+
+(defun pathname-root-p (a)
+ (let ((dir (pathname-directory (pathname a))))
+ (and (eql :absolute (first dir))
+ (= 1 (length dir)))))
+
(pushnew :cl-fad *features*)
;; stuff for Nikodemus Siivola's HYPERDOC
View
11 test.lisp → fad.test.lisp
@@ -43,6 +43,17 @@
(defun test ()
(setq *test-counter* 0)
+
+ (assert* (path:= (path:catdir) #P""))
+ (assert* (path:= (path:catdir #P"/") #P"/"))
+ (assert* (path:= (path:catdir #P"a/" #P"b/") #P"a/b/"))
+ (assert* (path:= (path:catdir #P"/a/" #P"/b/" #P"c/" #P"./d/" #P"e" #P"f/") #P"/b/c/./d/f/"))
+
+ (assert* (path:= (path:catfile) #P""))
+ (assert* (path:= (path:catfile #P"R.txt") #P"R.txt"))
+ (assert* (path:= (path:catfile #P"a/" #P"/b/" #P"R.txt") #P"/b/R.txt"))
+
+
(let ((fad-dir (merge-pathnames (pathname-as-directory "fad-test")
*tmp-dir*)))
(delete-directory-and-files fad-dir :if-does-not-exist :ignore)
View
42 packages.lisp
@@ -46,8 +46,42 @@
:list-directory
:pathname-as-directory
:pathname-as-file
- :walk-directory))
+ :pathname-directory-pathname
+ :pathname-equal
+ :pathname-parent-directory
+ :pathname-absolute-p
+ :pathname-relative-p
+ :pathname-root-p
+
+ :canonical-pathname
+ :merge-pathnames-as-directory
+ :merge-pathnames-as-file
+
+ :walk-directory
-(defpackage :cl-fad-test
- (:use :cl :cl-fad)
- (:export :test))
+ :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)
+ (:documentation "Rexporting certain functions from the cl-fad package with shorter names.
+
+This package provides no functionality, it serves only to make file
+system intensive code easier to read (for unix people at least).")
+ (:export #:dirname
+ #:basename
+ #:-e
+ #:-d
+ #:catfile
+ #:catdir
+ #:rm-r
+ #:=
+
+ #:absolute-p
+ #:relative-p
+ #:root-p))
View
5 packages.test.lisp
@@ -0,0 +1,5 @@
+(in-package :common-lisp-user)
+
+(defpackage :cl-fad-test
+ (:use :cl :cl-fad :unit-test)
+ (:export :test))
View
32 path.lisp
@@ -0,0 +1,32 @@
+(in-package :cl-fad)
+
+(defmacro defalias (name args realname)
+ `(progn
+ (defun ,name ,args
+ ,(if (eql '&rest (first args))
+ `(apply #',realname ,(second args))
+ `(,realname ,@args)))
+ (define-compiler-macro ,name (&rest args)
+ (list* ',realname args))))
+
+(defalias path:dirname (pathname) cl-fad:pathname-directory-pathname)
+
+(defun path:basename (pathname) (pathname (file-namestring pathname)))
+
+(defalias path:-e (pathname) cl-fad:file-exists-p)
+
+(defalias path:-d (directory) cl-fad:directory-exists-p)
+
+(defalias path:catfile (&rest pathnames) cl-fad:merge-pathnames-as-file)
+
+(defalias path:catdir (&rest pathnames) cl-fad:merge-pathnames-as-directory)
+
+(defalias path:= (a b) cl-fad:pathname-equal)
+
+(defalias path:absolute-p (pathname) cl-fad:pathname-absolute-p)
+
+(defalias path:relative-p (pathname) cl-fad:pathname-relative-p)
+
+(defalias path:root-p (pathname) cl-fad:pathname-root-p)
+
+(defalias path:rm-r (pathname) cl-fad:delete-directory-and-files)
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)))))
+
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.