Coverage report: /home/ati/workspace/perec/persistence/object.lisp
Both branches taken
One branch taken
Neither branch taken
;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;; Copyright (c) 2006 by the authors.
;;; See LICENCE for details.
;;; Persistent object base class
(defvar *make-persistent-instances* #t
"True means make-instance will make the new instance persistent by default.")
(defpclass* persistent-object ()
:documentation "Life time unique identifier of the object which can be remembered and may be used the load the object later.")
:documentation "True means the object is known to be persistent, false means the object is known to be transient, unbound means the state is not yet determined. Actually, in the latter case slot-value-using-class will automatically determine whether the object is in the database or not. Therefore reading the persistent slot will always return either true or false.")
:documentation "A weak reference to the transaction to this object is currently attached to.")
:documentation "True means the object was created in the current transaction.")
:documentation "True means the object was modified in the current transaction.")
:documentation "True means the object was deleted in the current transaction.")
:type (list persistent-effective-slot-definition)
:documentation "A list of slots for which the slot values are currently cached in the object in the lisp VM. This list must be updated when database update happens outside of slot access (batch update, trigger, etc."))
(:default-initargs :persistent *make-persistent-instances*)
(:documentation "Base class for all persistent classes. If this class is not inherited by a persistent class then it is automatically added to the direct superclasses. There is only one persistent object instance in a transaction with a give oid therefore eq will return true iff the oids are equal."))
(defmacro with-making-persistent-instances (&body forms)
`(let ((*make-persistent-instances* #t))
(defmacro with-making-transient-instances (&body forms)
`(let ((*make-persistent-instances* #f))
(defmethod initialize-instance :around ((object persistent-object) &rest args &key persistent &allow-other-keys)
(ensure-exported (class-of object)))
(prog1 (apply #'call-next-method object :persistent #f args)
(when (eq persistent #t)
(setf (created-p object) #t)
(setf (cached-slots-of object)
(collect-if #'cache-p (persistent-effective-slots-of (class-of object)))))))
(defmethod make-instance :before ((class persistent-class) &key &allow-other-keys)
(when (abstract-p class)
(error "Cannot make instances of abstract class ~A" class)))
(defvar +persistent-object-class+ (find-class 'persistent-object))
(defun persistent-object-p (object)
(typep object 'persistent-object))
(defun p-eq (object-1 object-2)
"Tests if two object references the same persistent object. Normally there at most one persistent object for each oid in a transaction so eq may be safely used. On the other hand huge transactions may require to throw away objects form the object cache which results in several instances for the same oid within the same transaction."
(or (eq object-1 object-2)
(defun print-persistent-instance (object)
(declare (type persistent-object object))
(princ ":persistent ")
(princ (cond ((not (slot-boundp object 'persistent))
(if (and (slot-boundp object 'oid)
(princ (id-of object))
(defprint-object (self persistent-object)
"Prints the oid of the object and whether the object is known to be persistent or transient."
(defun ensure-oid (object)
"Makes sure that the object has a valid oid."
(unless (oid-of object)
(setf (oid-of object) (make-new-oid (class-name-of object)))))
(defun id-of (object)
"Shortcut for the unique identifier number of the object."
(oid-id (oid-of object)))
(defun (setf class-name-of) (new-value object)
"Shortcut for the setter of the class name of the object."
(setf (oid-class-name (oid-of object)) new-value))
(defun id-value (object)
"Returns the RDBMS representation."
(defun class-name-value (object)
"Returns the RDBMS representation."
(canonical-symbol-name (class-name-of object)))
(defun oid-values (object)
"Returns a list representation of the object oid in the order of the corresponding RDBMS columns."
(list (id-value object) (class-name-value object)))