Author: hhubner Date: 2006-03-07 00:58:42 -0500 (Tue, 07 Mar 2006) New Revision: 1892
Modified: branches/xml-class-rework/bknr/src/data/txn.lisp Log: When restoring a store with :until, truncate the log file at the :until position. :until can now be used to implement a roll-forward based undo facility.
Modified: branches/xml-class-rework/bknr/src/data/txn.lisp =================================================================== --- branches/xml-class-rework/bknr/src/data/txn.lisp 2006-03-06 21:55:14 UTC (rev 1891) +++ branches/xml-class-rework/bknr/src/data/txn.lisp 2006-03-07 05:58:42 UTC (rev 1892) @@ -462,39 +462,46 @@
(defvar *show-transactions* nil)
+(defun truncate-log (pathname position) + (let ((backup (make-pathname :type "backup" :defaults pathname))) + (format t "~&; creating log file backup: ~A~%" backup) + (with-open-file (s pathname + :element-type '(unsigned-byte 8) + :direction :input) + (with-open-file (r backup + :element-type '(unsigned-byte 8) + :direction :output) + (copy-stream s r)))) + (format t "~&; truncating transaction log at position ~D.~%" position) + #+cmu + (unix:unix-truncate (ext:unix-namestring pathname) position) + #+sbcl + (sb-posix:truncate (namestring pathname) position)) + (defun load-transaction-log (pathname &key until) - (let (length p) + (let (length position) (restart-case (with-open-file (s pathname :element-type '(unsigned-byte 8) :direction :input) (setf length (file-length s)) (loop - (setf p (file-position s)) - (unless (< p length) + (setf position (file-position s)) + (unless (< position length) (return)) (let ((txn (decode s))) - (when (or (not until) - (<= (transaction-timestamp txn) until)) - (when *show-transactions* - (format t "~&;;; txn @~D: ~A~%" p txn)) - (execute-unlogged txn))))) + (cond + ((and until + (> (transaction-timestamp txn) until)) + (truncate-log pathname position) + (return-from load-transaction-log)) + (t + (when *show-transactions* + (format t "~&;;; ~A txn @~D: ~A~%" (transaction-timestamp txn) position txn)) + (execute-unlogged txn)))))) (discard () :report "Discard rest of transaction log." - (let ((backup (make-pathname :type "backup" :defaults pathname))) - (format t "~&; creating log file backup: ~A~%" backup) - (with-open-file (s pathname - :element-type '(unsigned-byte 8) - :direction :input) - (with-open-file (r backup - :element-type '(unsigned-byte 8) - :direction :output) - (copy-stream s r)))) - (format t "~&; truncating transaction log at position ~D.~%" p) - #+cmu - (unix:unix-truncate (ext:unix-namestring pathname) p) - #+sbcl - (sb-posix:truncate (namestring pathname) p))))) + (truncate-log pathname position)))))
(defgeneric restore-subsystem (store subsystem &key until))