Revision: 3689 Author: hans URL: http://bknr.net/trac/changeset/3689

Remove INITIALIZE-PERSISTENT-INSTANCE, use INITIALIZE-INSTANCE instead. During restore, use ALLOCATE-INSTANCE to reinstantiate persistent objects.

U trunk/bknr/datastore/src/data/object.lisp U trunk/bknr/datastore/src/data/package.lisp U trunk/bknr/datastore/src/data/tutorial.lisp U trunk/bknr/modules/feed/feed.lisp U trunk/bknr/modules/text/article.lisp U trunk/bknr/web/src/rss/rss.lisp U trunk/bknr/web/src/sysclasses/user.lisp U trunk/projects/bos/m2/allocation.lisp U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/poi.lisp U trunk/projects/lisp-ecoop/src/participant.lisp U trunk/projects/unmaintained/raw-data/mcp/bluetooth.lisp U trunk/projects/unmaintained/raw-data/mcp/sensors.lisp

Modified: trunk/bknr/datastore/src/data/object.lisp =================================================================== --- trunk/bknr/datastore/src/data/object.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/datastore/src/data/object.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -190,36 +190,32 @@ #+allegro (aclmop::finalize-inheritance (find-class 'store-object))

-(defmethod initialize-instance :around - ((object store-object) &key &allow-other-keys) +(defmethod initialize-instance :around ((object store-object) &rest initargs &key) (if (in-anonymous-transaction-p) (prog1 (call-next-method) (encode (make-instance 'transaction :function-symbol 'make-instance :timestamp (get-universal-time) - :args (cons (class-name (class-of object)) - (loop for slotd in (class-slots (class-of object)) - for slot-name = (slot-definition-name slotd) - for slot-initarg = (first (slot-definition-initargs slotd)) - when (and slot-initarg - (slot-boundp object slot-name)) - appending (list slot-initarg (slot-value object slot-name))))) + :args (cons (class-name (class-of object)) initargs)) (anonymous-transaction-log-buffer *current-transaction*))) (call-next-method)))

-(defmethod initialize-instance :after ((object store-object) &key id &allow-other-keys) - (let ((subsystem (store-object-subsystem))) - (cond (id - ;; during restore, use the given ID - (when (>= id (next-object-id subsystem)) - (setf (next-object-id subsystem) (1+ id)))) - (t - ;; normal transaction: assign a new ID - (setf id (next-object-id subsystem)) - (incf (next-object-id subsystem)) - (setf (slot-value object 'id) id))))) +(defmethod allocate-instance :around ((class persistent-class) &key) + (let* ((object (call-next-method)) + (subsystem (store-object-subsystem)) + (id (next-object-id subsystem))) + (incf (next-object-id subsystem)) + (setf (slot-value object 'id) id) + object))

+(defmethod initialize-instance :after ((object store-object) &key) + ;; This is called only when initially creating the (persistent) + ;; instance, not during restore. During restore, the + ;; INITIALIZE-TRANSIENT-INSTANCE function is called after the + ;; snapshot has been read, but before running the transaction log. + (initialize-transient-instance object)) + (defmethod print-object ((object store-object) stream) (print-unreadable-object (object stream :type t) (format stream "ID: ~D" (store-object-id object)))) @@ -244,19 +240,13 @@ :timestamp (get-universal-time) :args (append (list object (if (symbolp class) class (class-name class))) args))))

-(defgeneric initialize-persistent-instance (store-object &key &allow-other-keys) - (:documentation - "Initializes the persistent aspects of a persistent object. This -method is called at the creation of a persistent object, but not when -the object is loaded from a snapshot.")) - (defgeneric initialize-transient-instance (store-object) (:documentation "Initializes the transient aspects of a persistent object. This -method is called whenever a persistent object is initialized, also -when the object is loaded from a snapshot.")) +method is called after a persistent object has been initialized, also +when the object is loaded from a snapshot, but before reading the +transaction log."))

-(defmethod initialize-persistent-instance ((object store-object) &key)) (defmethod initialize-transient-instance ((object store-object)))

(defmethod store-object-persistent-slots ((object store-object)) @@ -464,7 +454,10 @@ ;; 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 - (make-instance class :id object-id))))) + (let ((object (allocate-instance class))) + (dolist (index (class-slot-indices class 'id)) + (assert (= object-id (slot-value object 'id))) + (index-add index object)))))))

(defun snapshot-read-slots (stream layouts) (let* ((layout-id (%decode-integer stream)) @@ -641,15 +634,13 @@ (if restoring (remove-transient-slot-initargs (find-class class-name) initargs) initargs))) - (apply #'initialize-persistent-instance obj initargs) - (initialize-transient-instance obj) (setf error nil) obj) (when (and error obj) (destroy-object obj)))))

(defun make-object (class-name &rest initargs) - "Make a persistent object of class named CLASS-NAME. Calls MAKE-INSTANCE with INITARGS." + "Make a persistent object of class named CLASS-NAME. Calls MAKE-INSTANCE with INITARGS." (with-store-guard () (execute (make-instance 'transaction :function-symbol 'tx-make-object

Modified: trunk/bknr/datastore/src/data/package.lisp =================================================================== --- trunk/bknr/datastore/src/data/package.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/datastore/src/data/package.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -51,7 +51,6 @@ #:cascade-delete-p #:cascading-delete-object

- #:initialize-persistent-instance #:initialize-transient-instance

#:store-object-with-id

Modified: trunk/bknr/datastore/src/data/tutorial.lisp =================================================================== --- trunk/bknr/datastore/src/data/tutorial.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/datastore/src/data/tutorial.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -458,14 +458,13 @@ ;;; Persistent objects have the metaclass `PERSISTENT-CLASS', and have ;;; to be created using the function `MAKE-OBJECT'. This creates an ;;; instance of the object inside a transaction, sets its ID slot -;;; appropriately, and then calls `INITIALIZE-PERSISTENT-INSTANCE' and -;;; `INITIALIZE-TRANSIENT-INSTANCE'. The first method is called when -;;; the object is created inside a transaction, but not if the object -;;; is being restored from the snapshot file. This method has to be -;;; overridden in order to initialize persistent -;;; slots. `INITIALIZE-TRANSIENT-INSTANCE' is called at object -;;; creation inside a transaction and at object creation during -;;; restore. It is used to initialize the transient slots (not logged +;;; appropriately, and then calls `INITIALIZE-TRANSIENT-INSTANCE'. The +;;; standard CLOS function `INITIALIZE-INSTANCE' is called when the +;;; object is created inside a transaction, but not if the object is +;;; being restored from the snapshot file. +;;; `INITIALIZE-TRANSIENT-INSTANCE' is called at object creation +;;; inside a transaction and at object creation during restore. It +;;; must be specialized to initialize the transient slots (not logged ;;; to the snapshot file) of a persistent object. ;;; ;;; We can define the following class with a transient and a @@ -816,9 +815,7 @@ ;;; resolved (check the section about relaxed references). Finally, ;;; after each slot value has been set, the method ;;; `INITIALIZE-TRANSIENT-INSTANCE' is called for each created -;;; object. The method `INITIALIZE-PERSISTENT-INSTANCE' is not called, -;;; as it has to be executed only once at the time the persistent -;;; object is created. +;;; object.

;;;## Garbage collecting blobs

Modified: trunk/bknr/modules/feed/feed.lisp =================================================================== --- trunk/bknr/modules/feed/feed.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/modules/feed/feed.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -24,9 +24,6 @@ (type :update :documentation "(or :rss091 :rss10 :rss20 :atom)") (encoding :update :initform :iso-8859-1 :documentation "(or :utf8 :iso-8859-1)")))

-;(defmethod initialize-transient-instance ((feed feed)) -; (ignore-errors (update-feed feed))) - (defmethod print-object ((object feed) stream) (format stream "#<~a ID: ~A "~a">" (class-name (class-of object))

Modified: trunk/bknr/modules/text/article.lisp =================================================================== --- trunk/bknr/modules/text/article.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/modules/text/article.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -36,7 +36,7 @@ (article-subject article) " " (article-text article))))

-(defmethod initialize-persistent-instance :after ((article article) &key) +(defmethod initialize-instance :after ((article article) &key) (setf (article-search-vector article) (article-to-search-vector article)))

Modified: trunk/bknr/web/src/rss/rss.lisp =================================================================== --- trunk/bknr/web/src/rss/rss.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/web/src/rss/rss.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -176,7 +176,7 @@ (:method ((channel (eql nil)) item) (warn "no RSS channel defined for item ~A" item)))

-(defmethod initialize-persistent-instance :after ((rss-item rss-item) &key) +(defmethod initialize-instance :after ((rss-item rss-item) &key) (add-item (rss-item-channel rss-item) rss-item))

(defmethod destroy-object :before ((rss-item rss-item))

Modified: trunk/bknr/web/src/sysclasses/user.lisp =================================================================== --- trunk/bknr/web/src/sysclasses/user.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/bknr/web/src/sysclasses/user.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -60,7 +60,7 @@ (user-login object) "unbound"))))

-(defmethod initialize-persistent-instance ((user user) &key) +(defmethod initialize-instance ((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))) @@ -72,7 +72,7 @@ (define-persistent-class smb-user (user) ())

-(defmethod initialize-persistent-instance ((user smb-user) &key) +(defmethod initialize-instance ((user smb-user) &key) (let* ((plaintext-password (slot-value user 'password))) (when plaintext-password (set-smb-password (user-login user) plaintext-password))

Modified: trunk/projects/bos/m2/allocation.lisp =================================================================== --- trunk/projects/bos/m2/allocation.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/projects/bos/m2/allocation.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -34,7 +34,7 @@ :unbound) (store-object-id allocation-area))))

-(defmethod initialize-persistent-instance :after ((allocation-area allocation-area) &key) +(defmethod initialize-instance :after ((allocation-area allocation-area) &key) (with-slots (total-m2s free-m2s) allocation-area (setf total-m2s (calculate-total-m2-count allocation-area)) (setf free-m2s (- total-m2s (calculate-allocated-m2-count allocation-area))))

Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/projects/bos/m2/m2.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -278,7 +278,7 @@ (defun contract-p (object) (equal (class-of object) (find-class 'contract)))

-(defmethod initialize-persistent-instance :after ((contract contract) &key) +(defmethod initialize-instance :after ((contract contract) &key) (pushnew contract (sponsor-contracts (contract-sponsor contract))) (dolist (m2 (contract-m2s contract)) (setf (m2-contract m2) contract))

Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/projects/bos/m2/poi.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -35,7 +35,7 @@ or description is given") (apply #'make-object class-name rest))

-(defmethod initialize-persistent-instance :after ((poi-medium poi-medium) &key language title subtitle description poi) +(defmethod initialize-instance :after ((poi-medium poi-medium) &key language title subtitle description poi) (when poi (push poi-medium (poi-media poi))) (update-textual-attributes poi-medium language @@ -84,7 +84,7 @@ (setf (slot-string poi 'description language) description) poi))

-(defmethod initialize-persistent-instance :after ((poi poi) &key language title subtitle description) +(defmethod initialize-instance :after ((poi poi) &key language title subtitle description) (update-textual-attributes poi language :title title :subtitle subtitle

Modified: trunk/projects/lisp-ecoop/src/participant.lisp =================================================================== --- trunk/projects/lisp-ecoop/src/participant.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/projects/lisp-ecoop/src/participant.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -7,7 +7,7 @@ (submission :read :documentation "Submission that this document belongs to")) (:default-initargs :type "application/pdf" :submission (error ":submission argument missing while creating document")))

-(defmethod initialize-persistent-instance :after ((document document) &key) +(defmethod initialize-instance :after ((document document) &key) (with-slots (submission) document (push document (submission-documents submission))))

@@ -92,7 +92,7 @@ #'(lambda (&rest more) (apply fun (append args more))))

-(defmethod initialize-persistent-instance :after ((participant participant) &key) +(defmethod initialize-instance :after ((participant participant) &key) (make-email-list))

(defun make-email-list ()

Modified: trunk/projects/unmaintained/raw-data/mcp/bluetooth.lisp =================================================================== --- trunk/projects/unmaintained/raw-data/mcp/bluetooth.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/projects/unmaintained/raw-data/mcp/bluetooth.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -88,7 +88,7 @@ ((device :initarg :device :reader bluetooth-event-device)) (:metaclass persistent-class))

-(defmethod initialize-persistent-instance :after ((event bluetooth-event) &key) +(defmethod initialize-instance :after ((event bluetooth-event) &key) (with-slots (device) event (push event (bluetooth-device-events device)) (setf (sample-event-value event) (or (bluetooth-device-name device) (bluetooth-device-mac-address device)))))

Modified: trunk/projects/unmaintained/raw-data/mcp/sensors.lisp =================================================================== --- trunk/projects/unmaintained/raw-data/mcp/sensors.lisp 2008-07-30 08:42:31 UTC (rev 3688) +++ trunk/projects/unmaintained/raw-data/mcp/sensors.lisp 2008-07-30 09:36:20 UTC (rev 3689) @@ -60,7 +60,7 @@ (defmethod sample-event-table-name ((sensor sensor)) (format nil "sample_event_~(~A~)" (sensor-type sensor)))

-(defmethod initialize-persistent-instance :after ((sensor sensor) &key) +(defmethod initialize-instance :after ((sensor sensor) &key) (let ((id (store-object-id sensor))) (with-slots (name unit type) sensor (postgres-execute