Author: lgiessmann Date: Mon Feb 22 14:05:06 2010 New Revision: 200 Log: new-datamode: fixed a problem with elephant-associaitons in the PointerAssociationC-classes Modified: branches/new-datamodel/src/model/datamodel.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Mon Feb 22 14:05:06 2010 @@ -144,29 +144,56 @@ class."))) -;;; pointers ... -(defpclass SubjectLocatorC(IdentifierC) +;;; base classes ... +(defpclass TopicMapConstructC() () - (:index t) - (:documentation "A subject-locator that contains an uri-value and an - association to SubjectLocatorAssociationC's which are in - turn associated with TopicC's.")) + (:documentation "An abstract base class for all classes that describes + Topic Maps data.")) -(defpclass PersistentIdC(IdentifierC) - () - (:index t) - (:documentation "A subject-identifier that contains an uri-value and an - association to PersistentIdAssociationC's which are in - turn associated with TopicC's.")) +(defpclass ScopableC() + ((themes :associate (ScopeAssociationC scopable-construct) + :inherit t + :documentation "Contains all association-objects that contain the + actual scope-topics.")) + (:documentation "An abstract base class for all constructs that are scoped.")) -(defpclass ItemIdentifierC(IdentifierC) - () +(defpclass TypableC() + ((instance-of :associate (TypeAssociationC type-topic) + :inherit t + :documentation "Contains all association-objects that contain + the actual type-topic.")) + (:documentation "An abstract base class for all typed constructcs.")) + + +(defpclass DatatypableC() + ((datatype :accessor datatype + :initarg :datatype + :initform constants:*xml-string* + :type string + :documentation "The XML Schema datatype of the occurrencevalue + (optional, always IRI for resourceRef).")) (:index t) - (:documentation "An item-identifier that contains an uri-value and an - association to ItemIdAssociationC's which are in turn - associated with RiefiableConstructC's.")) + (:documentation "An abstract base class for characteristics that own + an xml-datatype.")) + + +;;; pointers ... +(defpclass PointerC(TopicMapConstructC) + ((uri :initarg :uri + :accessor uri + :inherit t + :type string + :initform (error "From PointerC(): uri must be set for a pointer") + :index t + :documentation "The actual value of a pointer, i.e. uri or ID.") + (identified-construct :associate (PointerAssociationC identifier) + :inherit t + :documentation "Associates a association-object that + additionally stores some + version-infos.")) + (:documentation "An abstract base class for all pointers.")) (defpclass IdentifierC(PointerC) @@ -187,23 +214,42 @@ representing one of them.")) -(defpclass PointerC(TopicMapConstructC) - ((uri :initarg :uri - :accessor uri - ;:inherit t - :type string - :initform (error "From PointerC(): uri must be set for a pointer") - :index t - :documentation "The actual value of a pointer, i.e. uri or ID.") - (identified-construct :associate (PointerAssociationC identifier) - :inherit t - :documentation "Associates a association-object that - additionally stores some - version-infos.")) - (:documentation "An abstract base class for all pointers.")) +(defpclass SubjectLocatorC(IdentifierC) + () + (:index t) + (:documentation "A subject-locator that contains an uri-value and an + association to SubjectLocatorAssociationC's which are in + turn associated with TopicC's.")) + + +(defpclass PersistentIdC(IdentifierC) + () + (:index t) + (:documentation "A subject-identifier that contains an uri-value and an + association to PersistentIdAssociationC's which are in + turn associated with TopicC's.")) + + +(defpclass ItemIdentifierC(IdentifierC) + () + (:index t) + (:documentation "An item-identifier that contains an uri-value and an + association to ItemIdAssociationC's which are in turn + associated with RiefiableConstructC's.")) ;;; reifiables ... +(defpclass ReifiableConstructC(TopicMapConstructC) + ((item-identifiers :associate (ItemIdAssociationC parent-construct) + :inherit t + :documentation "A relation to all item-identifiers of + this construct.") + (reifier :associate (ReifierAssociationC reified-construct) + :inherit t + :documentation "A relation to a reifier-topic.")) + (:documentation "Reifiable constructs as per TMDM.")) + + (defpclass AssociationC(ReifiableConstructC ScopableC TypableC) ((roles :associate (RoleAssociationC association) :documentation "Contains all association-objects of all roles this @@ -223,17 +269,6 @@ :documentation "Associates this object with a player-association."))) -(defpclass ReifiableConstructC(TopicMapConstructC) - ((item-identifiers :associate (ItemIdAssociationC parent-construct) - :inherit t - :documentation "A relation to all item-identifiers of - this construct.") - (reifier :associate (ReifierAssociationC reified-construct) - :inherit t - :documentation "A relation to a reifier-topic.")) - (:documentation "Reifiable constructs as per TMDM.")) - - (elephant:defpclass TopicMapC (ReifiableConstructC) ((topics :accessor topics :associate (TopicC in-topicmaps) @@ -284,6 +319,22 @@ ;;; characteristics ... +(defpclass CharacteristicC(ReifiableConstructC ScopableC TypableC) + ((parent :associate (CharacteriticAssociationC characteristic) + :inherit t + :documentation "Assocates the characterist obejct with the + parent-association.") + (charvalue :initarg :charvalue + :accessor charvalue + :type string + :inherit t + :initform "" + :index t + :documentation "Contains the actual data of this object.")) + (:documentation "Scoped characteristic of a topic (meant to be used + as an abstract class).")) + + (defpclass OccurrenceC(CharacteristicC DatatypableC) () (:documentation "Represents a TM occurrence.")) @@ -300,23 +351,12 @@ (:documentation "Represents a TM variant.")) -(defpclass CharacteristicC(ReifiableConstructC ScopableC TypableC) - ((parent :associate (CharacteriticAssociationC characteristic) - :inherit t - :documentation "Assocates the characterist obejct with the - parent-association.") - (charvalue :initarg :charvalue - :accessor charvalue - :type string - ;:inherit t - :initform "" - :index t - :documentation "Contains the actual data of this object.")) - (:documentation "Scoped characteristic of a topic (meant to be used - as an abstract class).")) +;;; versioned associations ... +(defpclass VersionedAssociationC(VersionedConstructC) + () + (:documentation "An abstract base class for all versioned associations.")) -;;; versioned associations ... (defpclass TypeAssociationC(VersionedAssociationC) ((type-topic :initarg :type-topic :accessor type-topic @@ -372,13 +412,19 @@ with a topic.")) -(defpclass VersionedAssociationC(VersionedConstructC) - () - (:documentation "An abstract base class for all versioned associations.")) - +;;; pointer associations ... +(defpclass PointerAssociationC (VersionedAssociationC) + ((identifier :initarg :identifier + :accessor identifier + :inherit t + :initform (error "From PointerAssociationC(): identifier must be set") + :associate PointerC + :documentation "The actual data that is associated with + the pointer-association's parent.")) + (:documentation "An abstract base class for all versioned + pointer-associations.")) -;;; pointer associations ... (defpclass SubjectLocatorAssociationC(PointerAssociationC) ((parent-construct :initarg :parent-construct :accessor parent-construct @@ -423,19 +469,19 @@ and reifiable-constructs.")) -(defpclass PointerAssociationC (VersionedAssociationC) - ((identifier :initarg :identifier - :accessor identifier - ;:inherit t - :initform (error "From PointerAssociationC(): identifier must be set") - :associate PointerC - :documentation "The actual data that is associated with - the pointer-association's parent.")) - (:documentation "An abstract base class for all versioned - pointer-associations.")) +;;; characteristic associations ... +(defpclass CharacteristicAssociationC(VersionedAssociationC) + ((characteristic :initarg :characteristic + :accessor characteristic + :inherit t + :initform (error "From CharacteristicCAssociation(): characteristic must be set") + :associate CharactersiticC + :documentation "Associates this object with the actual + characteristic object.")) + (:documentation "An abstract base class for all association-objects that + associates characteristics with topics.")) -;;; characteristic associations ... (defpclass VariantAssociationC(CharateristicAssociationC) ((parent-construct :initarg :parent-construct :accessor parent-construct @@ -466,18 +512,6 @@ Additionally version-infos are stored.")) -(defpclass CharacteristicAssociationC(VersionedAssociationC) - ((characteristic :initarg :characteristic - :accessor characteristic - ;:inherit t - :initform (error "From CharacteristicCAssociation(): characteristic must be set") - :associate CharactersiticC - :documentation "Associates this object with the actual - characteristic object.")) - (:documentation "An abstract base class for all association-objects that - associates characteristics with topics.")) - - ;;; roles/association associations ... (defpclass PlayerAssociationC(VersionedAssociationC) ((player-topic :initarg :player-topic @@ -511,48 +545,19 @@ version-infos between these realtions.")) -;;; base classes ... -(defpclass TopicMapConstructC() - () - (:documentation "An abstract base class for all classes that describes - Topic Maps data.")) - - -(defpclass ScopableC() - ((themes :associate (ScopeAssociationC scopable-construct) - :inherit t - :documentation "Contains all association-objects that contain the - actual scope-topics.")) - (:documentation "An abstract base class for all constructs that are scoped.")) - - -(defpclass TypableC() - ((instance-of :associate (TypeAssociationC type-topic) - :inherit t - :documentation "Contains all association-objects that contain - the actual type-topic.")) - (:documentation "An abstract base class for all typed constructcs.")) - - -(defpclass DatatypableC() - ((datatype :accessor datatype - :initarg :datatype - :initform constants:*xml-string* - :type string - :documentation "The XML Schema datatype of the occurrencevalue - (optional, always IRI for resourceRef).")) - (:index t) - (:documentation "An abstract base class for characteristics that own - an xml-datatype.")) - - ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun slot-p (instance slot-symbol) "Returns t if the slot depending on slot-symbol is bound and not nil." - (when (slot-boundp instance slot-symbol) - (let ((value (slot-value instance slot-symbol))) - (when value - value)))) + (if (slot-boundp instance slot-symbol) + (let ((value (slot-value instance slot-symbol))) + (when value + value)) + ;elephant-relations are handled separately, since slot-boundp does not + ;here + (handler-case (let ((value (slot-value instance slot-symbol))) + (when value + value)) + (error () nil)))) (defun delete-1-n-association(instance slot-symbol) @@ -1517,10 +1522,11 @@ :revision revision) construct)) (t - (make-instance 'ItemIdAssociationC - :start-revision revision - :parent-construct construct - :identifier item-identifier))) + (let ((assoc + (make-instance 'ItemIdAssociationC + :parent-construct construct + :identifier item-identifier))) + (add-to-version-history assoc :start-revision revision)))) construct)))