September 2008 - bknr-cvs@common-lisp.net

[bknr-cvs] hans changed branches/anon-transaction-fixes/
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3944 Author: hans URL: http://bknr.net/trac/changeset/3944 Remove obsolete branch D branches/anon-transaction-fixes/

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3943 Author: hans URL: http://bknr.net/trac/changeset/3943 Remove obsolete branch D branches/anon-transaction-fixes-2/

1 0

[bknr-cvs] hans changed trunk/
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3942 Author: hans URL: http://bknr.net/trac/changeset/3942 Merge from anon-transaction-fixes-2 branch. This changeset removes make-object and initialize-persistent-instance, makes the allocation of object IDs simpler and more safe and removes several relicts from previous refactoring iterations. Also, the store tests have been extended significantly to test pathological cases and create objects from multiple threads. U trunk/bknr/datastore/src/bknr.datastore.asd U trunk/bknr/datastore/src/data/blob.lisp U trunk/bknr/datastore/src/data/object-tests.lisp U trunk/bknr/datastore/src/data/object.lisp U trunk/bknr/datastore/src/data/package.lisp U trunk/bknr/datastore/src/data/tests.lisp U trunk/bknr/datastore/src/data/tutorial.lisp U trunk/bknr/datastore/src/data/txn.lisp U trunk/bknr/datastore/src/data/xml-object.lisp U trunk/bknr/datastore/src/indices/indexed-class.lisp U trunk/bknr/datastore/src/indices/indices.lisp U trunk/bknr/datastore/src/utils/class.lisp U trunk/bknr/modules/bknr.modules.asd U trunk/bknr/modules/bug/bug-handlers.lisp U trunk/bknr/modules/comics/comics.lisp U trunk/bknr/modules/feed/edit-feed-handler.lisp U trunk/bknr/modules/feed/feed.lisp U trunk/bknr/modules/imagemap/imagemap.lisp U trunk/bknr/modules/mail/import-yahoo-group.lisp U trunk/bknr/modules/mail/mail.lisp U trunk/bknr/modules/mail/mailinglist-handlers.lisp U trunk/bknr/modules/mail/mailinglist.lisp U trunk/bknr/modules/mail/register-handler.lisp U trunk/bknr/modules/mail/registration.lisp U trunk/bknr/modules/quizz/edit-quizz-handlers.lisp U trunk/bknr/modules/stats/stats.lisp U trunk/bknr/modules/text/article-handlers.lisp U trunk/bknr/modules/text/article.lisp U trunk/bknr/modules/text/billboard-handlers.lisp U trunk/bknr/modules/text/billboard.lisp U trunk/bknr/modules/text/blog-handlers.lisp U trunk/bknr/modules/text/paste-handlers.lisp U trunk/bknr/modules/text/wiki-handlers.lisp U trunk/bknr/modules/track/track.lisp U trunk/bknr/modules/url/cached-url-handlers.lisp U trunk/bknr/modules/url/edit-url-handlers.lisp U trunk/bknr/web/src/images/image.lisp U trunk/bknr/web/src/rss/rss.lisp U trunk/bknr/web/src/sysclasses/cron.lisp U trunk/bknr/web/src/sysclasses/event.lisp U trunk/bknr/web/src/sysclasses/sysparam.lisp U trunk/bknr/web/src/sysclasses/user.lisp U trunk/bknr/web/src/web/host.lisp U trunk/projects/bknr-website/src/init.lisp U trunk/projects/bos/m2/allocation.lisp U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/map.lisp U trunk/projects/bos/m2/news.lisp U trunk/projects/bos/m2/poi.lisp U trunk/projects/bos/web/daily.lisp U trunk/projects/bos/web/kml-handlers.lisp U trunk/projects/bos/web/languages-handler.lisp U trunk/projects/bos/web/poi-handlers.lisp U trunk/projects/bos/web/sat-tree.lisp U trunk/projects/hello-web/src/news.lisp U trunk/projects/lisp-ecoop/src/handlers.lisp U trunk/projects/lisp-ecoop/src/participant.lisp U trunk/projects/lisp-ecoop/src/tags.lisp U trunk/projects/quickhoney/src/daily.lisp U trunk/projects/quickhoney/website/static/javascript.js U trunk/projects/scrabble/src/game.lisp U trunk/projects/scrabble/src/rules.lisp U trunk/projects/scrabble/src/start-webserver.lisp U trunk/projects/unmaintained/eboy/src/dynasite-tags.lisp U trunk/projects/unmaintained/eboy/src/item-handlers.lisp U trunk/projects/unmaintained/gpn/gpn-user.lisp U trunk/projects/unmaintained/gpn/gpn-web.lisp U trunk/projects/unmaintained/gpn/zeitplan-handlers.lisp U trunk/projects/unmaintained/raw-data/mcp/bluetooth.lisp U trunk/projects/unmaintained/raw-data/mcp/isdn-operator.lisp U trunk/projects/unmaintained/raw-data/mcp/sensors.lisp U trunk/projects/unmaintained/saugnapf/src/saugnapf.lisp Change set too large, please see URL above

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3941 Author: hans URL: http://bknr.net/trac/changeset/3941 Merged revisions 3937 via svnmerge from svn+ssh://bknr.net/svn/trunk ........ r3937 | hans | 2008-09-22 17:51:49 +0200 (Mon, 22 Sep 2008) | 2 lines copy js2 to trunk ........ _U branches/anon-transaction-fixes-2/ Property changes on: branches/anon-transaction-fixes-2 ___________________________________________________________________ Name: svnmerge-integrated - /trunk:1-3928 + /trunk:1-3940

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/datastore/src/data/object
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3940 Author: hans URL: http://bknr.net/trac/changeset/3940 Store next object id to use in snapshot file. This removes the previous buggy behaviour that the store would re-use an object IDs of objects deleted right before the snapshot has been written. U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-22 18:31:17 UTC (rev 3939) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-22 18:33:13 UTC (rev 3940) @@ -54,15 +54,19 @@ (defvar *tests* (make-hash-table)) (defun do-run-test (thunk) - (let ((bknr.datastore::*store-verbose* nil) - initial-objects) + "Run the test in THUNK, then verify that the store contains the +`same' objects after a restore and after snapshot and a restore." + (let ((bknr.datastore::*store-verbose* nil) initial-objects) (funcall thunk) - (setf initial-objects (object-classes-and-ids)) - (restore) - (test-equal initial-objects (object-classes-and-ids)) - (snapshot) - (restore) - (test-equal initial-objects (object-classes-and-ids)))) + (let ((next-object-id (bknr.datastore::next-object-id (bknr.datastore::store-object-subsystem)))) + (setf initial-objects (object-classes-and-ids)) + (restore) + (test-equal initial-objects (object-classes-and-ids)) + (test-equal next-object-id (bknr.datastore::next-object-id (bknr.datastore::store-object-subsystem))) + (snapshot) + (restore) + (test-equal initial-objects (object-classes-and-ids)) + (test-equal next-object-id (bknr.datastore::next-object-id (bknr.datastore::store-object-subsystem)))))) (defmacro defdstest (name args &body body) (when args @@ -150,6 +154,13 @@ (time (map-store-objects #'delete-object)) (test-equal (all-store-objects) nil))) +(defdstest holes-test () + (dotimes (i +stress-size+) + (let ((delete (zerop (random 2)))) + (with-transaction (:foo) + (funcall (if delete #'delete-object #'identity) + (make-instance 'store-object)))))) + (defdstest make-instance-in-anon-txn () (with-transaction () (make-instance 'store-object)) @@ -228,14 +239,7 @@ (restore) (test-assert (< object-id (store-object-id (make-instance 'store-object)))))) -#+(or) (defdstest delete-object-and-check-object-id-of-next-3 () -;; This test currently fails: The store has no explicit knowledge of -;; the object ID that it created. Instead, the next free object ID is -;; determined during restore by looking at the IDs of the objects -;; being restored. If the last object that has been created is -;; deleted right before the snapshot is written, the next object after -;; a restore will receive the same ID. (let (object-id) (with-transaction (:make) (let ((object (make-instance 'store-object))) Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-22 18:31:17 UTC (rev 3939) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-22 18:33:13 UTC (rev 3940) @@ -498,7 +498,8 @@ (when class (let ((object (allocate-instance class))) (setf (slot-value object 'id) object-id - (next-object-id (store-object-subsystem)) (1+ object-id)) + (next-object-id (store-object-subsystem)) (max (1+ object-id) + (next-object-id (store-object-subsystem)))) (dolist (index (class-slot-indices class 'id)) (index-add index object))))))) @@ -590,6 +591,10 @@ id slot-name (type-of container) (if container (store-object-id container) "unknown object")))))) +(defun encode-current-object-id (stream) + (%write-tag #\I stream) + (%encode-integer (next-object-id (store-object-subsystem)) stream)) + (defmethod snapshot-subsystem ((store store) (subsystem store-object-subsystem)) (let ((snapshot (store-subsystem-snapshot-pathname store subsystem))) (with-open-file (s snapshot @@ -600,6 +605,7 @@ (let ((class-layouts (make-hash-table))) (with-transaction (:prepare-for-snapshot) (map-store-objects #'prepare-for-snapshot)) + (encode-current-object-id s) (map-store-objects (lambda (object) (when (subtypep (type-of object) 'store-object) (encode-create-object class-layouts object s)))) (map-store-objects (lambda (object) (when (subtypep (type-of object) 'store-object) @@ -644,10 +650,11 @@ (report-progress "~A of ~A objects initialized.~%" read-slots created-objects) (force-output)) (let ((char (%read-tag s nil nil))) - (unless (member char '(#\O #\L #\S nil)) + (unless (member char '(#\I #\L #\O #\S nil)) (error "unknown char ~A at offset ~A~%" char (file-position s))) (ecase char ((nil) (return)) + (#\I (setf (next-object-id (store-object-subsystem)) (%decode-integer s))) (#\L (snapshot-read-layout s class-layouts)) (#\O (snapshot-read-object s class-layouts) (incf created-objects)) (#\S (snapshot-read-slots s class-layouts) (incf read-slots))))))

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3939 Author: hans URL: http://bknr.net/trac/changeset/3939 Oops, we certainly did not want to have defined a primary method for inititialize-instance on user objects. U branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp Modified: branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp 2008-09-22 18:23:36 UTC (rev 3938) +++ branches/anon-transaction-fixes-2/bknr/web/src/sysclasses/user.lisp 2008-09-22 18:31:17 UTC (rev 3939) @@ -60,7 +60,7 @@ (user-login object) "unbound")))) -(defmethod initialize-instance ((user user) &key) +(defmethod initialize-instance :after ((user user) &key) (let* ((plaintext-password (slot-value user 'password)) (password (when plaintext-password (crypt-md5 plaintext-password (make-salt))))) (setf (slot-value user 'password) password)))

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/projects/bos/
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3938 Author: hans URL: http://bknr.net/trac/changeset/3938 Application fixes for BOS to make it work with the recent store updates. U branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp U branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp U branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp Modified: branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp =================================================================== --- branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp 2008-09-22 15:51:49 UTC (rev 3937) +++ branches/anon-transaction-fixes-2/projects/bos/m2/allocation.lisp 2008-09-22 18:23:36 UTC (rev 3938) @@ -127,7 +127,6 @@ :top top :width width :height height - :y top :active-p nil :vertices vertices))) result))) Modified: branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp =================================================================== --- branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp 2008-09-22 15:51:49 UTC (rev 3937) +++ branches/anon-transaction-fixes-2/projects/bos/m2/poi.lisp 2008-09-22 18:23:36 UTC (rev 3938) @@ -50,7 +50,7 @@ (assert (if (or title subtitle description) language t) nil "language needs to be specified, if any of title, subtitle or description is given") - (apply #'make-instance class-name rest)) + (apply #'make-instance class-name (remove-keys '(:initargs) rest))) (defmethod initialize-instance :after ((poi-medium poi-medium) &key poi) (when poi Modified: branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp =================================================================== --- branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp 2008-09-22 15:51:49 UTC (rev 3937) +++ branches/anon-transaction-fixes-2/projects/bos/web/daily.lisp 2008-09-22 18:23:36 UTC (rev 3938) @@ -3,7 +3,6 @@ (defun daily-cleanup () (format t "; performing daily cleanup run~%") (bos.m2::delete-expired-contracts) - (bknr.stats::make-yesterdays-stats :delete-events t) (format t "; snapshotting datastore~%") (snapshot) (format t "; running check (consistent-p)~%")

1 0

[bknr-cvs] hans changed trunk/thirdparty/emacs/js2.el
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3937 Author: hans URL: http://bknr.net/trac/changeset/3937 copy js2 to trunk A trunk/thirdparty/emacs/js2.el Change set too large, please see URL above

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/datastore/src/data/object
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3936 Author: hans URL: http://bknr.net/trac/changeset/3936 Stop using allocate-instance method for ID allocation again. SBCL allocates an instance of every class as an optimization for object creation, and this prototype object was then made part of the class extent. Instead, the ID is now allocated in initialize-instance. Lock ID allocation against concurrent access. U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp U branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-22 08:06:08 UTC (rev 3935) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object-tests.lisp 2008-09-22 10:40:42 UTC (rev 3936) @@ -144,8 +144,8 @@ (defdstest stress-test-2 () (bknr.datastore::without-sync () (format t "Creating ~A objects~%" +stress-size+) - (dotimes (i +stress-size+) - (make-instance 'store-object)) + (time (dotimes (i +stress-size+) + (make-instance 'store-object))) (format t "Deleting ~A objects~%" (length (all-store-objects))) (time (map-store-objects #'delete-object)) (test-equal (all-store-objects) nil))) @@ -169,10 +169,11 @@ (defun object-classes-and-ids () "Return a list of conses with the car being a class name and the cdr being the object id for all persistent objects in the store" - (mapcar (lambda (object) - (cons (class-name (class-of object)) - (store-object-id object))) - (all-store-objects))) + (sort (mapcar (lambda (object) + (cons (class-name (class-of object)) + (store-object-id object))) + (all-store-objects)) + #'< :key #'cdr)) (defdstest make-referenced-object-in-anon-tx () (with-transaction (:make) Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-22 08:06:08 UTC (rev 3935) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/object.lisp 2008-09-22 10:40:42 UTC (rev 3936) @@ -163,7 +163,9 @@ (remove-if #'transient-slot-p (class-slots class))) (defclass store-object () - ((id :initarg :id :reader store-object-id + ((id :initarg :id + :reader store-object-id + :type integer :index-type unique-index :index-initargs (:test #'eql) :index-reader store-object-with-id :index-values all-store-objects @@ -220,6 +222,7 @@ (aclmop::finalize-inheritance (find-class 'store-object)) (defmethod initialize-instance :around ((object store-object) &rest initargs &key) + (setf (slot-value object 'id) (allocate-next-object-id)) (cond ((not (in-transaction-p)) (with-store-guard () @@ -242,14 +245,14 @@ (t (call-next-method)))) -(defmethod allocate-instance :around ((class persistent-class) &key) - (let* ((object (call-next-method)) - (subsystem (store-object-subsystem)) - (id (next-object-id subsystem))) - (setf (slot-value object 'id) id) - (incf (next-object-id subsystem)) - object)) +(defvar *allocate-object-id-lock* (bt:make-lock "Persistent Object ID Creation")) +(defun allocate-next-object-id () + (mp-with-lock-held (*allocate-object-id-lock*) + (let ((id (next-object-id (store-object-subsystem)))) + (incf (next-object-id (store-object-subsystem))) + id))) + (defun initialize-transient-slots (object) (dolist (slotd (class-slots (class-of object))) (when (and (typep slotd 'persistent-effective-slot-definition) @@ -493,15 +496,9 @@ ;; If the class is NIL, it was not found in the currently ;; running Lisp image and objects of this class will be ignored. (when class - ;; We set the next object ID to allocate in the store to the - ;; object ID read from the snapshot file. ALLOCATE-INSTANCE - ;; will assign this object ID to the object and increment the - ;; counter. This way, we correctly deserialze store snapshots - ;; which have holes in their ID space (because objects have - ;; been deleted). - (setf (next-object-id (store-object-subsystem)) object-id) (let ((object (allocate-instance class))) - (assert (= object-id (slot-value object 'id))) + (setf (slot-value object 'id) object-id + (next-object-id (store-object-subsystem)) (1+ object-id)) (dolist (index (class-slot-indices class 'id)) (index-add index object)))))))

1 0

[bknr-cvs] hans changed branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp
by BKNR Commits 22 Sep '08

22 Sep '08

Revision: 3935 Author: hans URL: http://bknr.net/trac/changeset/3935 Fix indentation U branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp Modified: branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp =================================================================== --- branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp 2008-09-21 21:26:39 UTC (rev 3934) +++ branches/anon-transaction-fixes-2/bknr/datastore/src/data/tutorial.lisp 2008-09-22 08:06:08 UTC (rev 3935) @@ -131,17 +131,17 @@ (close-store) (make-instance 'tutorial-store :directory "/tmp/tutorial-store/" :subsystems nil) - ; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (tutorial-store-counter *store*) - ; => 0 +; => 0 (incf-counter) - ; => 1 +; => 1 (incf-counter) - ; => 2 +; => 2 (decf-counter) - ; => 1 +; => 1 ;;; The three transactions have been logged to the transaction log in ;;; "/tmp/tutorial-store/", as we can see: @@ -149,13 +149,13 @@ (with-open-file (s "/tmp/tutorial-store/current/transaction-log" :direction :input) (file-length s)) - ; => 126 +; => 126 (incf-counter) - ; => 2 +; => 2 (with-open-file (s "/tmp/tutorial-store/current/transaction-log" :direction :input) (file-length s)) - ; => 168 +; => 168 ;;; The transaction log is kept in a directory called "current", which ;;; is where the currently active version of the snapshots and log @@ -166,29 +166,29 @@ ;;; the persistent data (the counter value). (snapshot) - ; => Error in function (METHOD SNAPSHOT-STORE NIL (STORE)): - ; => Cannot snapshot store without subsystems... - ; => [Condition of type SIMPLE-ERROR] +; => Error in function (METHOD SNAPSHOT-STORE NIL (STORE)): +; => Cannot snapshot store without subsystems... +; => [Condition of type SIMPLE-ERROR] ;;; We can close the store by using the function `CLOSE-STORE'. *store* - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (close-store) - ; => NIL +; => NIL (boundp '*store*) - ; => NIL +; => NIL ;;; The store can then be recreated, and the transaction log will be ;;; read and executed upon restore. (make-instance 'tutorial-store :directory "/tmp/tutorial-store/" :subsystems nil) - ; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Warning: loading transaction log - ; /tmp/tutorial-store/current/transaction-log - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: loading transaction log +; /tmp/tutorial-store/current/transaction-log +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (tutorial-store-counter *store*) - ; => 2 +; => 2 ;;; The store can also be restored in a later LISP session. Make sure ;;; that all the code necessary to the execution of the transaction @@ -205,26 +205,26 @@ ;;; `UNTIL' argument of `RESTORE-STORE'. (setf *store-debug* t) - ; => T +; => T (restore-store *store*) - ; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; loading transaction log /tmp/tutorial-store/current/transaction-log - ; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 - ; executing transaction #<TRANSACTION 21.04.2008 07:08:25 TX-INCF-COUNTER > at timestamp 3417743305 - ; executing transaction #<TRANSACTION 21.04.2008 07:08:26 TX-DECF-COUNTER > at timestamp 3417743306 - ; executing transaction #<TRANSACTION 21.04.2008 07:08:34 TX-INCF-COUNTER > at timestamp 3417743314 - ; => NIL +; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; loading transaction log /tmp/tutorial-store/current/transaction-log +; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 +; executing transaction #<TRANSACTION 21.04.2008 07:08:25 TX-INCF-COUNTER > at timestamp 3417743305 +; executing transaction #<TRANSACTION 21.04.2008 07:08:26 TX-DECF-COUNTER > at timestamp 3417743306 +; executing transaction #<TRANSACTION 21.04.2008 07:08:34 TX-INCF-COUNTER > at timestamp 3417743314 +; => NIL (tutorial-store-counter *store*) - ; => 2 - ; !! Update the timestamp below to correspond to the fist transaction executed above !! +; => 2 +; !! Update the timestamp below to correspond to the fist transaction executed above !! (restore-store *store* :until 3417743302) ... - ; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; loading transaction log /tmp/tutorial-store/current/transaction-log - ; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 - ; creating log file backup: /tmp/tutorial-store/current/transaction-log.backup - ; truncating transaction log at position 42. +; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; loading transaction log /tmp/tutorial-store/current/transaction-log +; executing transaction #<TRANSACTION 21.04.2008 07:08:22 TX-INCF-COUNTER > at timestamp 3417743302 +; creating log file backup: /tmp/tutorial-store/current/transaction-log.backup +; truncating transaction log at position 42. (tutorial-store-counter *store*) - ; => 1 +; => 1 ;;;## Adding a subsystem @@ -287,22 +287,22 @@ ;;; `COUNTER-SUBSYSTEM'. (close-store) - ; => NIL +; => NIL (make-instance 'tutorial-store :directory "/tmp/tutorial-store/" :subsystems (list (make-instance 'counter-subsystem))) - ; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Warning: Could not find store counter value, setting to 0. - ; Warning: loading transaction log - ; /tmp/tutorial-store/current/transaction-log - ; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Warning: Could not find store counter value, setting to 0. +; Warning: loading transaction log +; /tmp/tutorial-store/current/transaction-log +; => #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> (snapshot) - ; Snapshotting subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Successfully snapshotted #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; => NIL +; Snapshotting subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Successfully snapshotted #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => NIL (restore) - ; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; Restoring the subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> - ; => NUL +; restoring #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; Restoring the subsystem #<COUNTER-SUBSYSTEM #xE65F866> of #<TUTORIAL-STORE DIR: "/tmp/tutorial-store/"> +; => NUL ;;;# An object store example @@ -340,11 +340,11 @@ :subsystems (list (make-instance 'store-object-subsystem))) - ; Warning: restoring #<MP-STORE DIR: "/tmp/object-store/"> - ; restoring #<MP-STORE DIR: "/tmp/object-store/"> - ; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE63F866> of #<MP-STORE DIR: "/tmp/object-store/"> +; Warning: restoring #<MP-STORE DIR: "/tmp/object-store/"> +; restoring #<MP-STORE DIR: "/tmp/object-store/"> +; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE63F866> of #<MP-STORE DIR: "/tmp/object-store/"> (all-store-objects) - ; => NIL +; => NIL ;;; We can now create a few store objects (which is not very ;;; interesting in itself). Store objects have to be created inside a @@ -354,28 +354,28 @@ ;;; separate transaction. (make-instance 'store-object) - ; => #<STORE-OBJECT ID: 0> +; => #<STORE-OBJECT ID: 0> (make-instance 'store-object) - ; => #<STORE-OBJECT ID: 1> +; => #<STORE-OBJECT ID: 1> (all-store-objects) - ; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1>) +; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1>) (all-store-classes) - ; => (STORE-OBJECT) +; => (STORE-OBJECT) ;;; Object deletion also has to be done through the transaction ;;; `DELETE-OBJECT', which will log the deletion of the object in the ;;; transaction log, and remove the object from all its indices. (make-instance 'store-object) - ; executing transaction #<TRANSACTION 21.04.2008 08:02:10 MAKE-INSTANCE STORE-OBJECT ID 2> at timestamp 3417746530 - ; => #<STORE-OBJECT ID: 12> +; executing transaction #<TRANSACTION 21.04.2008 08:02:10 MAKE-INSTANCE STORE-OBJECT ID 2> at timestamp 3417746530 +; => #<STORE-OBJECT ID: 12> (store-object-with-id 2) - ; => #<STORE-OBJECT ID: 2> +; => #<STORE-OBJECT ID: 2> (delete-object (store-object-with-id 2)) - ; executing transaction #<TRANSACTION 21.04.2008 08:52:14 TX-DELETE-OBJECT 2> at timestamp 3417749534 - ; => T +; executing transaction #<TRANSACTION 21.04.2008 08:52:14 TX-DELETE-OBJECT 2> at timestamp 3417749534 +; => T (store-object-with-id 2) - ; => NIL +; => NIL ;;;## Defining persistent classes @@ -412,25 +412,25 @@ ;;; We can now create a few instance of `TUTORIAL-OBJECT': (make-instance 'tutorial-object :a 2) - ; => #<TUTORIAL-OBJECT ID: 3> +; => #<TUTORIAL-OBJECT ID: 3> (make-instance 'tutorial-object :a 2) - ; => #<TUTORIAL-OBJECT ID: 4> +; => #<TUTORIAL-OBJECT ID: 4> (make-instance 'tutorial-object :a 2) - ; => #<TUTORIAL-OBJECT ID: 5> +; => #<TUTORIAL-OBJECT ID: 5> (store-object-with-id 5) - ; => #<TUTORIAL-OBJECT ID: 5> +; => #<TUTORIAL-OBJECT ID: 5> (all-store-classes) - ; => (STORE-OBJECT TUTORIAL-OBJECT) +; => (STORE-OBJECT TUTORIAL-OBJECT) (store-objects-with-class 'tutorial-object) - ; => (#<TUTORIAL-OBJECT ID: 3> #<TUTORIAL-OBJECT ID: 4> - ; #<TUTORIAL-OBJECT ID: 5>) +; => (#<TUTORIAL-OBJECT ID: 3> #<TUTORIAL-OBJECT ID: 4> +; #<TUTORIAL-OBJECT ID: 5>) (store-objects-with-class 'store-object) - ; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1> - ; #<FOO ID: 2> #<TUTORIAL-OBJECT ID: 3> - ; #<TUTORIAL-OBJECT ID: 4> #<TUTORIAL-OBJECT ID: 5>) +; => (#<STORE-OBJECT ID: 0> #<STORE-OBJECT ID: 1> +; #<FOO ID: 2> #<TUTORIAL-OBJECT ID: 3> +; #<TUTORIAL-OBJECT ID: 4> #<TUTORIAL-OBJECT ID: 5>) ;;; In order to change the slot values of persistent object, the ;;; application needs to be in a transaction context. This can be @@ -442,16 +442,16 @@ ((b :update))) (make-instance 'tutorial-object2 :b 3) - ; executing transaction #<TRANSACTION 21.04.2008 08:03:27 MAKE-INSTANCE TUTORIAL-OBJECT2 ID 6 B 3> at timestamp 3417746607 - ; => #<TUTORIAL-OBJECT2 ID: 6> +; executing transaction #<TRANSACTION 21.04.2008 08:03:27 MAKE-INSTANCE TUTORIAL-OBJECT2 ID 6 B 3> at timestamp 3417746607 +; => #<TUTORIAL-OBJECT2 ID: 6> (setf (slot-value (store-object-with-id 6) 'b) 4) - ; => Error - ; Attempt to set persistent slot B of #<TUTORIAL-OBJECT2 ID: 6> outside of a transaction +; => Error +; Attempt to set persistent slot B of #<TUTORIAL-OBJECT2 ID: 6> outside of a transaction (with-transaction () (setf (slot-value (store-object-with-id 6) 'b) 4)) - ; => 4 +; => 4 (tutorial-object2-b (store-object-with-id 6)) - ; => 4 +; => 4 ;;;## Object creation and deletion protocol @@ -479,17 +479,17 @@ ;;; We can modify the slot `A' outside a transaction: (make-instance 'protocol-object :a 1 :b 2) - ; executing transaction #<TRANSACTION 21.04.2008 08:10:49 MAKE-INSTANCE PROTOCOL-OBJECT ID 7 A 1 B 2> at timestamp 3417747049 - ; => #<PROTOCOL-OBJECT ID: 7> +; executing transaction #<TRANSACTION 21.04.2008 08:10:49 MAKE-INSTANCE PROTOCOL-OBJECT ID 7 A 1 B 2> at timestamp 3417747049 +; => #<PROTOCOL-OBJECT ID: 7> (setf (protocol-object-a (store-object-with-id 7)) 2) - ; => 2 +; => 2 ;;; However, we cannot modify the slot `B', as it is persistent and ;;; has to be changed inside a transaction. (setf (protocol-object-b (store-object-with-id 7)) 4) - ; => Error - ; Attempt to set persistent slot B of #<PROTOCOL-OBJECT ID: 7> outside of a transaction +; => Error +; Attempt to set persistent slot B of #<PROTOCOL-OBJECT ID: 7> outside of a transaction ;;; An object can be removed from the datastore using the transaction ;;; `DELETE-OBJECT', which calls the method `DESTROY-OBJECT' on the @@ -502,19 +502,19 @@ ;;; We can snapshot the persistent state of all created objects by ;;; using `SNAPSHOT'. (snapshot) - ; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> +; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> +; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE54991E> of #<MP-STORE DIR: "/tmp/object-store/"> ;;; This will create a backup directory containing the old transaction ;;; log, and the creation of a snapshot file in the "current" ;;; directory. (directory "/tmp/object-store/**/*.*") - ; => (#P"/tmp/object-store/20080421T061210/random-state" - ; #P"/tmp/object-store/20080421T061210/transaction-log" - ; #P"/tmp/object-store/current/random-state" - ; #P"/tmp/object-store/current/store-object-subsystem-snapshot" - ; #P"/tmp/object-store/current/transaction-log") +; => (#P"/tmp/object-store/20080421T061210/random-state" +; #P"/tmp/object-store/20080421T061210/transaction-log" +; #P"/tmp/object-store/current/random-state" +; #P"/tmp/object-store/current/store-object-subsystem-snapshot" +; #P"/tmp/object-store/current/transaction-log") ;;; The snapshot file contains all persistent objects present at ;;; snapshotting time, and the value of their persistent @@ -538,15 +538,15 @@ :index-keys all-gorilla-moods))) (make-instance 'gorilla :name "lucy" :mood :aggressive) - ; => #<GORILLA ID: 8> +; => #<GORILLA ID: 8> (make-instance 'gorilla :name "john" :mood :playful) - ; => #<GORILLA ID: 9> +; => #<GORILLA ID: 9> (make-instance 'gorilla :name "peter" :mood :playful) - ; => #<GORILLA ID: 10> +; => #<GORILLA ID: 10> (gorilla-with-name "lucy") - ; => #<GORILLA ID: 8> +; => #<GORILLA ID: 8> (gorillas-with-mood :playful) - ; => (#<GORILLA ID: 10> #<GORILLA ID: 9>) +; => (#<GORILLA ID: 10> #<GORILLA ID: 9>) ;;;## Adding blobs @@ -606,7 +606,7 @@ (make-blob-from-file "/tmp/bla.jpg" 'photo :name "foobar" :type :jpg) - ; => #<PHOTO ID: 11, TYPE: jpg> +; => #<PHOTO ID: 11, TYPE: jpg> ;;; We can work with the photo object in the same way as when we work ;;; with a normal object. However, we can access the binary data using @@ -615,7 +615,7 @@ ;;; object. (blob-pathname (store-object-with-id 11)) - ; => #P"/tmp/object-store/blob-root/11" +; => #P"/tmp/object-store/blob-root/11" ;;; The method `BLOB-TO-FILE' and `BLOB-TO-STREAM' write the binary ;;; data of the object to the specified file or stream (the stream has @@ -642,37 +642,37 @@ ((a :update :relaxed-object-reference t))) (make-instance 'relaxed-object) - ; => #<RELAXED-OBJECT ID: 12> +; => #<RELAXED-OBJECT ID: 12> (make-instance 'relaxed-object) - ; => #<RELAXED-OBJECT ID: 13> +; => #<RELAXED-OBJECT ID: 13> (with-transaction () (setf (slot-value (store-object-with-id 12) 'a) (store-object-with-id 13))) - ; => #<RELAXED-OBJECT ID: 13> +; => #<RELAXED-OBJECT ID: 13> (delete-object (store-object-with-id 13)) - ; => T +; => T (snapshot) - ; Warning: Backup of the datastore in /tmp/object-store/20080421T064811/. - ; While executing: (:INTERNAL (SNAPSHOT-STORE (STORE))), in process worker(1750). - ; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Warning: Encoding reference to destroyed object with ID 13 from slot A of object RELAXED-OBJECT with ID 12. - ; While executing: #<STANDARD-METHOD ENCODE-OBJECT (STORE-OBJECT T)>, in process worker(1750). - ; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Snapshotting subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; Successfully snapshotted #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; => NIL +; Warning: Backup of the datastore in /tmp/object-store/20080421T064811/. +; While executing: (:INTERNAL (SNAPSHOT-STORE (STORE))), in process worker(1750). +; Snapshotting subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> +; Warning: Encoding reference to destroyed object with ID 13 from slot A of object RELAXED-OBJECT with ID 12. +; While executing: #<STANDARD-METHOD ENCODE-OBJECT (STORE-OBJECT T)>, in process worker(1750). +; Successfully snapshotted #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> +; Snapshotting subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> +; Successfully snapshotted #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> +; => NIL (restore) - ; restoring #<MP-STORE DIR: "/tmp/object-store/"> - ; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; loading snapshot file /tmp/object-store/current/store-object-subsystem-snapshot - ; Warning: internal inconsistency during restore: can't find store object 13 in loaded store - ; While executing: %DECODE-STORE-OBJECT, in process worker(1754). - ; Warning: Reference to inexistent object with id 13 from unnamed container, returning NIL. - ; While executing: %DECODE-STORE-OBJECT, in process worker(1754). - ; Restoring the subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> - ; loading transaction log /tmp/object-store/current/transaction-log - ; executing transaction #<ANONYMOUS-TRANSACTION 21.04.2008 08:48:48 PREPARE-FOR-SNAPSHOT NIL> at timestamp 3417749328 +; restoring #<MP-STORE DIR: "/tmp/object-store/"> +; Restoring the subsystem #<STORE-OBJECT-SUBSYSTEM #xE6069EE> of #<MP-STORE DIR: "/tmp/object-store/"> +; loading snapshot file /tmp/object-store/current/store-object-subsystem-snapshot +; Warning: internal inconsistency during restore: can't find store object 13 in loaded store +; While executing: %DECODE-STORE-OBJECT, in process worker(1754). +; Warning: Reference to inexistent object with id 13 from unnamed container, returning NIL. +; While executing: %DECODE-STORE-OBJECT, in process worker(1754). +; Restoring the subsystem #<BLOB-SUBSYSTEM #xE6069CE> of #<MP-STORE DIR: "/tmp/object-store/"> +; loading transaction log /tmp/object-store/current/transaction-log +; executing transaction #<ANONYMOUS-TRANSACTION 21.04.2008 08:48:48 PREPARE-FOR-SNAPSHOT NIL> at timestamp 3417749328 (relaxed-object-a (store-object-with-id 12)) - ; => NIL +; => NIL ;;;# Store internals

1 0