[bknr-cvs] r1892 - branches/xml-class-rework/bknr/src/data
bknr at bknr.net
bknr at bknr.net
Tue Mar 7 05:58:43 UTC 2006
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))
More information about the Bknr-cvs
mailing list