;;; 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."
(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
-to create the file."
+ directory. Do not assume that this filename will be good by the time you
+ try to create the file."
(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."
+ Other OPEN-ARGS are passed to open."
(let* ((new (fresh-file-name file "new"))
(stream (apply #'open
new
(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)))
+ mangling."
+ (with-errno-handlers ()
+ (sys-rename old new)
+ (ENOENT nil)))
(defun safely-unwind (trail)
"Roll back the TRAIL of operations."
(defun safely-bail (safe)
"Abort the operations in SAFE, unwinding all the things that have been
-done. Streams are closed, new files are removed."
+ done. Streams are closed, new files are removed."
(dolist (stream (safely-streams safe))
(close stream :abort t))
(safely-unwind (safely-trail 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,
-if any. If a problem occurs during this stage, everything is rewound and no
-changes are made."
+ files created by safely-open-output-stream are renamed over the old
+ versions, if any. If a problem occurs during this stage, everything is
+ rewound and no changes are made."
(let ((trail (safely-trail safe))
(revert nil)
(cleanup nil))
(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)
(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."
+ SAFE is committed; otherwise it's bailed."
`(let ((,safe (make-safely)))
(unwind-protect
(progn
(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."
+ temporary file, and if BODY completes, it is renamed to FILE."
(with-gensyms safe
`(safely (,safe)
(let ((,stream (apply #'safely-open-output-stream