;;; along with this program; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-(defpackage #:mdw.safely
+(defpackage #:safely
(:use #:common-lisp #:mdw.base #:mdw.unix)
(:export #:safely #:safely-close #:safely-delete-file
#:safely-open-output-stream #:safely-bail #:safely-commit
#:safely-writing))
-(in-package #:mdw.safely)
+(in-package #:safely)
(defstruct (safely (:predicate safelyp))
"Stores information about how to commit or undo safe writes."
(streams nil)
(trail nil))
+
(defun safely-close (safe stream)
"Make sure that STREAM is closed when SAFE is finished."
(push stream (safely-streams safe)))
+
(defun safely-delete-file (safe file)
"Delete FILE when SAFE is committed."
(push `(:delete ,file ,(fresh-file-name file "del")) (safely-trail safe)))
+
(defun fresh-file-name (base tag)
"Return a fresh file name constructed from BASE and TAG in the current
directory. Do not assume that this filename will be good by the time you try
(let ((name (format nil "~A.~A-~X"
base tag (random most-positive-fixnum))))
(if (probe-file name) (fresh-file-name base tag) name)))
+
(defun safely-open-output-stream (safe file &rest open-args)
"Create an output stream which will be named FILE when SAFE is committed.
Other OPEN-ARGS are passed to open."
(push `(:shunt ,new ,file ,(fresh-file-name file "old"))
(safely-trail safe))
stream))
+
(defun delete-file-without-moaning (file)
"Delete the FILE, ignoring errors."
- (when (probe-file file)
- (unix-try unlink file)))
+ (with-errno-handlers ()
+ (sys-unlink file)
+ (ENOENT nil)))
+
(defun rename-file-without-moaning (old new)
"Rename OLD to NEW, ignoring errors, and without doing any stupid name
mangling."
- (when (probe-file old)
- (unix-try rename old new)))
+ (with-errno-handlers ()
+ (sys-rename old new)
+ (ENOENT nil)))
+
(defun safely-unwind (trail)
"Roll back the TRAIL of operations."
(dolist (job trail)
(:revert (destructuring-bind (tag old new) job
(declare (ignore tag))
(rename-file-without-moaning old new))))))
+
(defun safely-reset (safe)
"Reset SAFE to its initial state."
(setf (safely-streams safe) nil)
(setf (safely-trail safe) nil))
+
(defun safely-bail (safe)
"Abort the operations in SAFE, unwinding all the things that have been
done. Streams are closed, new files are removed."
(close stream :abort t))
(safely-unwind (safely-trail safe))
(safely-reset safe))
+
(defun safely-commit (safe)
"Commit SAFE. The files deleted by safely-delete-file are deleted; the
files created by safely-open-output-stream are renamed over the old versions,
(copy-file file old)
(push `(:revert ,old ,file) revert))
(push `(:rmtmp ,file) revert))
- (unix-try rename new file)))
+ (sys-rename new file)))
(:delete (destructuring-bind (tag file old) job
(declare (ignore tag))
(push `(:revert ,old ,file) revert)
- (unix-try rename file old)
+ (sys-rename file old)
(push `(:rmtmp old) cleanup))))))
(setf revert nil))
(safely-unwind trail)
(safely-unwind revert)
(safely-unwind cleanup)
(safely-reset safe))))
+
(defmacro safely ((safe &key) &body body)
"Do stuff within the BODY safely. If BODY completes without errors, the
SAFE is committed; otherwise it's bailed."
(setf ,safe nil))
(when ,safe
(safely-bail ,safe)))))
+
(defmacro safely-writing ((stream file &rest open-args) &body body)
"Simple macro for writing a single file safely. STREAM is opened onto a
temporary file, and if BODY completes, it is renamed to FILE."