X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/5e04ac396871d9b15a4cbcdb7de9084b650176f0..46cd5c4bce3089c64e40a23db9136b2ddcce3885:/safely.lisp diff --git a/safely.lisp b/safely.lisp index 5eddef3..60dd683 100644 --- a/safely.lisp +++ b/safely.lisp @@ -23,12 +23,12 @@ ;;; 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." @@ -45,15 +45,15 @@ (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 @@ -67,14 +67,16 @@ Other OPEN-ARGS are passed to open." (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." @@ -99,7 +101,7 @@ mangling." (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)) @@ -107,9 +109,9 @@ done. Streams are closed, new files are removed." (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)) @@ -131,11 +133,11 @@ changes are made." (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) @@ -145,7 +147,7 @@ changes are made." (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 @@ -157,7 +159,7 @@ SAFE is committed; otherwise it's bailed." (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