Changeset 3672

Show
Ignore:
Timestamp:
07/29/08 10:42:50 (4 months ago)
Author:
hans
Message:

Schema evolution aid: In order to make it possible to restore
snapshots from older schema when slots of a class have been deleted,
provide for a CONVERT-SLOT-VALUE-WHILE-RESTORING generic function that
can be defined to convert old slot values into the new object layout.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/datastore/src/data/object.lisp

    r3585 r3672  
    378378            (mapcar #'slot-definition-name (class-slots class)) :key #'symbol-name :test #'equal))) 
    379379 
     380(defgeneric convert-slot-value-while-restoring (object slot-name value) 
     381  (:documentation "Generic function to be called to convert a slot's 
     382  value from a previous snapshot layout.  OBJECT is the object that is 
     383  being restored, SLOT-NAME is the name of the slot in the old schema, 
     384  VALUE is the value of the slot in the old schema.")) 
     385 
    380386(defun find-slot-name-with-automatic-rename (class slot-name) 
    381387  (if (find slot-name (class-slots class) :key #'slot-definition-name) 
    …… 
    391397               (error "can't find a slot in class ~A which matches the name ~A used in the store snapshot" 
    392398                      (class-name class) slot-name)))) 
     399        (convert-values () 
     400          :report "Convert slot values using CONVERT-SLOT-VALUE-WHILE-RESTORING" 
     401          (cons 'convert-slot-values slot-name)) 
    393402        (ignore-slot () 
    394403          :report "Ignore slot, discarding values found in the snapshot file" 
    …… 
    420429  (declare (optimize (speed 3))) 
    421430  (dolist (slot-name slots) 
    422     (if slot-name ; NIL for slots which are not restored because of schema changes 
    423         (restart-case 
    424             (let ((*current-object-slot* (list object slot-name)) 
    425                   (*current-slot-relaxed-p* (or (null object) 
    426                                                 (store-object-relaxed-object-reference-p object slot-name)))) 
    427               (let ((value (decode stream))) 
    428                 (when object 
    429                   (let ((bknr.indices::*indices-remove-p* nil)) 
    430                     (if (eq value 'unbound) 
    431                         (slot-makunbound object slot-name) 
    432                         (setf (slot-value object slot-name) value)))))) 
    433           (set-slot-nil () 
    434             :report "Set slot to NIL." 
    435             (setf (slot-value object slot-name) nil)) 
    436           (make-slot-unbound () 
    437             :report "Make slot unbound." 
    438             (slot-makunbound object slot-name))) 
    439         (decode stream))))              ; read and ignore value 
     431    (let ((value (decode stream))) 
     432      (cond 
     433        ((consp slot-name) 
     434         (assert (eq 'convert-slot-values (car slot-name))) 
     435         (convert-slot-value-while-restoring object (cdr slot-name) value)) 
     436        ((null slot-name) 
     437         ;; ignore value 
     438         ) 
     439        (t 
     440         (restart-case 
     441             (let ((*current-object-slot* (list object slot-name)) 
     442                   (*current-slot-relaxed-p* (or (null object) 
     443                                                 (store-object-relaxed-object-reference-p object slot-name)))) 
     444               (when object 
     445                 (let ((bknr.indices::*indices-remove-p* nil)) 
     446                   (if (eq value 'unbound) 
     447                       (slot-makunbound object slot-name) 
     448                       (if (slot-boundp object slot-name) 
     449                           (convert-slot-value-while-restoring object slot-name value) 
     450                           (setf (slot-value object slot-name) value)))))) 
     451           (set-slot-nil () 
     452             :report "Set slot to NIL." 
     453             (setf (slot-value object slot-name) nil)) 
     454           (make-slot-unbound () 
     455             :report "Make slot unbound." 
     456             (slot-makunbound object slot-name)))))))) 
    440457 
    441458(defun snapshot-read-object (stream layouts) 
    …… 
    497514 
    498515(defun %decode-store-object (stream) 
    499   ;; This is actually called in two contexts, when a slot-value is to be filled with a reference to a store object 
    500   ;; and when a list of store objects is read from the transaction log (%decode-list).  In the former case, references 
    501   ;; two deleted objects are accepted when the slot pointing to the object is marked as being a "relaxed-object-reference", 
    502   ;; in the latter case, no such information is available.  To ensure maximum restorability of transaction logs, object 
    503   ;; references stored in lists are always considered to be relaxed references, which means that references to deleted 
    504   ;; objects are restored as NIL.  Applications must be prepared to cope with NIL entries in such object lists (usually 
     516  ;; This is actually called in two contexts, when a slot-value is to 
     517  ;; be filled with a reference to a store object and when a list of 
     518  ;; store objects is read from the transaction log (%decode-list). 
     519  ;; In the former case, references two deleted objects are accepted 
     520  ;; when the slot pointing to the object is marked as being a 
     521  ;; "relaxed-object-reference", in the latter case, no such 
     522  ;; information is available.  To ensure maximum restorability of 
     523  ;; transaction logs, object references stored in lists are always 
     524  ;; considered to be relaxed references, which means that references 
     525  ;; to deleted objects are restored as NIL.  Applications must be 
     526  ;; prepared to cope with NIL entries in such object lists (usually 
    505527  ;; lists in slots). 
    506528  (let* ((id (%decode-integer stream)) 
    507529         (object (or (store-object-with-id id) 
    508                      (warn "internal inconsistency during restore: can't find store object ~A in loaded store" id))) 
     530                     (warn "internal inconsistency during restore: can't find store object ~A in loaded store" 
     531                           id))) 
    509532         (container (first *current-object-slot*)) 
    510533         (slot-name (second *current-object-slot*))) 
    …… 
    513536          ((or *current-slot-relaxed-p* (not container)) 
    514537           (if container 
    515                (warn "Reference to inexistent object with id ~A in relaxed slot ~A of object with class ~A with ID ~A." 
     538               (warn "Reference to inexistent object with id ~A in relaxed slot ~A of object ~ 
     539                      with class ~A with ID ~A." 
    516540                     id slot-name (type-of container) (store-object-id container)) 
    517541               (warn "Reference to inexistent object with id ~A from unnamed container, returning NIL." id)) 
    …… 
    522546           nil) 
    523547           
    524           (t (error "Reference to inexistent object with id ~A from slot ~A of object ~A with ID ~A." id slot-name (type-of container) 
     548          (t (error "Reference to inexistent object with id ~A from slot ~A of object ~A with ID ~A." 
     549                    id slot-name (type-of container) 
    525550                    (if container (store-object-id container) "unknown object")))))) 
    526551