[bknr-cvs] r1892 - branches/xml-class-rework/bknr/src/data

[bknr at bknr.net]

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))