;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:safely
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:safely
- #+sbcl '(sb-int:unix-namestring)))
+ #+sbcl '(sb-ext:native-namestring)))
+#+cmu
+(progn
+ (declaim (inline unix-namestring))
+ (defun native-namestring (pathname &key as-file)
+ (declare (ignore as-file))
+ (unix-namestring pathname nil)))
(defun safely-close (safe stream)
"Make sure that STREAM is closed when SAFE is finished."
(push stream (safely-streams safe)))
(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) (safely-trail safe)))
(defun safely-delete-file (safe file)
"Delete FILE when SAFE is committed."
(push `(:delete ,file) (safely-trail safe)))
(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."
(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."
- #-clisp (rename-file old new)
- #+clisp (posix:copy-file old new :method :rename))
+ #-clisp
+ (let ((target (make-pathname :directory '(:relative)
+ :defaults new)))
+ (rename-file old target))
+
+ #+clisp
+ (let ((rc (%rename (namestring old) (namestring new))))
+ (when (= rc -1)
+ (error "Failed to rename ~S to ~S: ~A" old new (posix:strerror)))))
(defun delete-file-without-moaning (file)
"Delete the FILE, ignoring errors."
(defun delete-file-without-moaning (file)
"Delete the FILE, ignoring errors."
(defun safely-bail (safe)
"Abort the operations in SAFE, unwinding all the things that have been
done. Streams are closed, new files are removed."
(defun safely-bail (safe)
"Abort the operations in SAFE, unwinding all the things that have been
done. Streams are closed, new files are removed."
;; Otherwise just copy the file contents and hope for the best.
(with-open-file (input file :element-type :default)
(multiple-value-bind
;; Otherwise just copy the file contents and hope for the best.
(with-open-file (input file :element-type :default)
(multiple-value-bind
(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
(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
- (let ((job (pop trail)))
- (ecase (car job)
- (:shunt (destructuring-bind (tag new file) job
- (declare (ignore tag))
- (push `(:rmtmp ,new) revert)
- (if (probe-file file)
- (let ((old (safe-copy file "old")))
- (push `(:rmtmp ,old) cleanup)
- (push `(:revert ,old ,file) revert))
- (push `(:rmtmp ,file) revert))
- (rename new file)))
- (:delete (destructuring-bind (tag file) job
- (declare (ignore tag))
- (let ((old (safe-copy file "delete")))
- (push `(:revert ,old ,file) revert)
- (push `(:rmtmp ,old) cleanup)
- (delete-file file)))))))
+ (let ((job (pop trail)))
+ (ecase (car job)
+ (:shunt (destructuring-bind (tag new file) job
+ (declare (ignore tag))
+ (push `(:rmtmp ,new) revert)
+ (if (probe-file file)
+ (let ((old (safe-copy file "old")))
+ (push `(:rmtmp ,old) cleanup)
+ (push `(:revert ,old ,file) revert))
+ (push `(:rmtmp ,file) revert))
+ (rename new file)))
+ (:delete (destructuring-bind (tag file) job
+ (declare (ignore tag))
+ (let ((old (safe-copy file "delete")))
+ (push `(:revert ,old ,file) revert)
+ (push `(:rmtmp ,old) cleanup)
+ (delete-file file)))))))
(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."
(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."
(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."
(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."