Author: lgiessmann Date: Sat Feb 20 09:49:30 2010 New Revision: 198 Log: new-datamodel: fixed some accessor/slot-names; restructured the file datamodel.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sat Feb 20 09:49:30 2010 @@ -78,9 +78,11 @@ :mark-as-deleted-p :in-topicmaps :delete-construct + :get-revision ;;globals - :*TM-REVISION*)) + :*TM-REVISION* + :*CURRENT-XTM*)) (in-package :datamodel) @@ -89,7 +91,7 @@ ;; after some data-operations are completed (should be passed as body) ;; and a merge should be done ;;TODO: use some exceptions --> more than one type, -;; identifier, not-mergable merges, ... +;; identifier, not-mergable merges, missing-init-args... ;;TODO: implement make-construct -> symbol ;; replace the latest make-construct-method ;;TODO: implement merge-construct -> ReifiableConstructC -> ... @@ -103,6 +105,447 @@ (defvar *TM-REVISION* 0) +(defparameter *CURRENT-XTM* nil "Represents the currently active TM.") + + +;;; classes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; versioning +(defpclass VersionInfoC() + ((start-revision :initarg :start-revision + :accessor start-revision + :type integer + :initform 0 + :documentation "The start-revision of the version's + interval of a versioned object.") + (end-revision :initarg :end-revision + :accessor end-revision + :type integer + :initform 0 + :documentation "The end-revision of the version's interval + of a versioned object.") + (versioned-construct :initarg :versioned-construct + :accessor versioned-construct + :associate VersionedConstructC + :documentation "The reference of the versioned + object that is described by this + VersionInfoC-object.")) + (:documentation "A VersionInfoC-object describes the revision information + of a versioned object in intervals starting by the value + start-revision and ending by the value end-revision - 1. + end-revision=0 means always the latest version.")) + + +(defpclass VersionedConstructC() + ((versions :initarg :versions + :accessor versions + :inherit t + :associate (VersionInfoC versioned-construct) + :documentation "Version infos for former versions of this base + class."))) + + +;;; 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.")) + + +(defpclass IdentifierC(PointerC) + () + (:documentation "An abstract base class for all TM-Identifiers.")) + + +(defpclass TopicIdentificationC(PointerC) + ((xtm-id :initarg :xtm-id + :accessor xtm-id + :type string + :initform (error "From TopicIdentificationC(): xtm-id must be seet for a topic-identifier") + :index t + :documentation "ID of the TM this identification came from.")) + (:index t) + (:documentation "Identify topic items through generalized topic-ids. + A topic may have many original topicids, the class + 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.")) + + +;;; reifiables ... +(defpclass AssociationC(ReifiableConstructC ScopableC TypableC) + ((roles :associate (RoleAssociationC association) + :documentation "Contains all association-objects of all roles this + association contains.") + (in-topicmaps :associate (TopicMapC associations) + :many-to-many t + :documentation "List of all topic maps this association is + part of")) + (:index t) + (:documentation "Association in a Topic Map")) + + +(defpclass RoleC(ReifiableConstructC TypableC) + ((parent :associate (RoleAssociationC role) + :documentation "Associates this object with a role-association.") + (player :associate (PlayerAssociationC parent-construct) + :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) + :documentation "List of topics that explicitly belong to this TM.") + (associations :accessor associations + :associate (AssociationC in-topicmaps) + :documentation "List of associations that belong to this TM.")) + (:documentation "Represnets a topic map.")) + + +(defpclass TopicC (ReifiableConstructC) + ((topic-identifiers :associate (TopicIdAssociationC parent-construct) + :documentation "Contains all association objects that + relate a topic with its actual + topic-identifiers.") + (psis :associate (PersistentIdAssociationC parent-construct) + :documentation "Contains all association objects that relate a topic + with its actual psis.") + (locators :associate (PersistentIdAssociationC parent-construct) + :documentation "Contains all association objects that relate a + topic with its actual subject-lcoators.") + (names :associate (NameAssociationC parent-construct) + :documentation "Contains all association objects that relate a topic + with its actual names.") + (occurrences :associate (OccurrenceAssociationC parent-construct) + :documentation "Contains all association objects that relate a + topic with its actual occurrences.") + (player-in-roles :associate (PlayerAssociationC player-topic) + :documentation "Contains all association objects that relate + a topic that is a player with its role.") + (used-as-type :associate (TypeAssociationC type-topic) + :documentation "Contains all association objects that relate a + topic that is a type with its typable obejct.") + (used-as-theme :associate (ScopeAssociationC theme-topic) + :documentation "Contains all association objects that relate a + topic that is a theme with its scoppable + object.") + (reified-construct :associate (ReifiedAssociationC reifier-topic) + :documentation "Contains all association objects that + relate a topic that is a reifier with + its reified object.") + (in-topicmaps :associate (TopicMapC topics) + :many-to-many t + :documentation "List of all topic maps this topic is part of.")) + (:index t) + (:documentation "Represents a TM topic.")) + + + +;;; characteristics ... +(defpclass OccurrenceC(CharacteristicC DatatypableC) + () + (:documentation "Represents a TM occurrence.")) + + +(defpclass NameC(CharacteristicC) + ((variants :associate (VariantAssociationC parent-construct) + :documentation "Associates this obejct with varian-associations.")) + (:documentation "Scoped name of a topic.")) + + +(defpclass VariantC(CharacteristicC DatatypableC) + () + (: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 TypeAssociationC(VersionedAssociationC) + ((type-topic :initarg :type-topic + :accessor type-topic + :initform (error "From TypeAssociationC(): type-topic must be set") + :associate TopicC + :documentation "Associates this object with a topic that is used + as type.") + (typable-construct :initarg :typable-construct + :accessor typable-construct + :initform (error "From TypeAssociationC(): typable-construct must be set") + :associate TypableC + :documentation "Associates this object with the typable + construct that is typed by the + type-topic.")) + (:documentation "This class associates topics that are used as type for + typable constructcs. Additionally there are stored some + version-infos.")) + + +(defpclass ScopeAssociationC(VersionedAssociationC) + ((theme-topic :initarg :theme-topic + :accessor theme-topic + :initform (error "From ScopeAssociationC(): theme-topic must be set") + :associate TopicC + :documentation "Associates this opbject with a topic that is a + scopable construct.") + (scopable-construct :initarg :scopable-construct + :accessor scopable-construct + :initform (error "From ScopeAssociationC(): scopable-construct must be set") + :associate ScopableC + :documentation "Associates this object with the socpable + construct that is scoped by the + scope-topic.")) + (:documentation "This class associates topics that are used as scope with + scopable construtcs. Additionally there are stored some + version-infos")) + + +(defpclass ReifierAssociationC(VersionedAssociationC) + ((reifiable-construct :initarg :reifiable-construct + :accessor reifiable-construct + :initform (error "From ReifierAssociation(): reifiable-construct must be set") + :associate ReifiableConstructC + :documentation "The actual construct which is reified + by a topic.") + (reifier-topic :initarg :reifier-topic + :accessor reifier-topic + :initform (error "From ReifierAssociationC(): reifier-topic must be set") + :associate TopicC + :documentation "The reifier-topic that reifies the + reifiable-construct.")) + (:documentation "A versioned-association that relates a reifiable-construct + with a topic.")) + + +(defpclass VersionedAssociationC(VersionedConstructC) + () + (:documentation "An abstract base class for all versioned associations.")) + + + +;;; pointer associations ... +(defpclass SubjectLocatorAssociationC(PointerAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From SubjectLocatorAssociationC(): parent-construct must be set") + :associate TopicC + :documentation "The actual topic which is associated + with the subject-locator.")) + (:documentation "A pointer that associates subject-locators, versions + and topics.")) + + +(defpclass PersistentIdAssociationC(PointerAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From PersistentIdAssociationC(): parent-construct must be set") + :associate TopicC + :documentation "The actual topic which is associated + with the subject-identifier/psi.")) + (:documentation "A pointer that associates subject-identifiers, versions + and topics.")) + + +(defpclass TopicIdAssociationC(PointerAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From TopicIdAssociationC(): parent-construct must be set") + :associate TopicC + :documentation "The actual topic which is associated + with the topic-identifier.")) + (:documentation "A pointer that associates topic-identifiers, versions + and topics.")) + + +(defpclass ItemIdAssociationC(PointerAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From ItemIdAssociationC(): parent-construct must be set") + :associate ReifiableConstructC + :documentation "The actual parent which is associated + with the item-identifier.")) + (:documentation "A pointer that associates item-identifiers, versions + 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 VariantAssociationC(CharateristicAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From VariantAssociationC(): parent-construct must be set") + :associate NameC + :documentation "Associates this object with a name.")) + (:documentation "Associates variant objects with name obejcts. + Additionally version-infos are stored.")) + + +(defpclass NameAssociationC(CharacteristicAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From NameAssociationC(): parent-construct must be set") + :associate TopicC + :documentation "Associates this object with a topic.")) + (:documentation "Associates name objects with their parent topics. + Additionally version-infos are stored.")) + + +(defpclass OccurrenceAssociationC(CharacteristicAssociationC) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :initform (error "From OccurrenceAssociationC(): parent-construct must be set") + :associate TopicC + :documentation "Associates this object with a topic.")) + (:documentation "Associates occurrence objects with their parent topics. + 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 + :accessor player-topic + :associate TopicC + :initform (error "From PlayerAssociationC(): player-topic must be set") + :documentation "Associates this object with a topic that is + a player.") + (parent-construct :initarg :parent-construct + :accessor parent-construct + :associate RoleC + :initform (error "From PlayerAssociationC(): parent-construct must be set") + :documentation "Associates this object with the parent-association.")) + (:documentation "This class associates roles and their player in given + revisions.")) + + +(defpclass RoleAssociationC(VersionedAssociationC) + ((role :initarg :role + :accessor role + :associate RoleC + :initform (error "From RoleAssociationC(): role must be set") + :documentation "Associates this objetc with a role-object.") + (parent-construct :initarg :parent-construct + :accessor parent-construct + :associate AssociationC + :initform (error "From RoleAssociationC(): parent-construct must be set") + :documentation "Assocates thius object with an + association-object.")) + (:documentation "Associates roles with assoications and adds some + 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." @@ -154,46 +597,18 @@ properties)))))) -;;; VersionInfoC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defpclass VersionInfoC() - ((start-revision :initarg :start-revision - :accessor start-revision - :type integer - :initform 0 - :documentation "The start-revision of the version's - interval of a versioned object.") - (end-revision :initarg :end-revision - :accessor end-revision - :type integer - :initform 0 - :documentation "The end-revision of the version's interval - of a versioned object.") - (versioned-construct :initarg :versioned-construct - :accessor versioned-construct - :associate VersionedConstructC - :documentation "The reference of the versioned - object that is described by this - VersionInfoC-object.")) - (:documentation "A VersionInfoC-object describes the revision information - of a versioned object in intervals starting by the value - start-revision and ending by the value end-revision - 1. - end-revision=0 means always the latest version.")) +(defun get-revision () + "TODO: replace by something that does not suffer from a 1 second resolution." + (get-universal-time)) +;;; generic functions/accessors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; VersionInfocC (defmethod delete-construct :before ((version-info VersionInfoC)) (delete-1-n-association version-info 'versioned-construct)) -;;; VersionedConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defpclass VersionedConstructC() - ((versions :initarg :versions - :accessor versions - :inherit t - :associate (VersionInfoC versioned-construct) - :documentation "Version infos for former versions of this base - class."))) - - +;;; VersionedConstructC (defmethod delete-construct :before ((construct VersionedConstructC)) (dolist (version-info (versions construct)) (delete-construct version-info))) @@ -303,80 +718,7 @@ (setf (end-revision last-version) revision)))) -;;; TopicMapC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(elephant:defpclass TopicMapC (ReifiableConstructC) - ((topics :accessor topics - :associate (TopicC in-topicmaps) - :documentation "List of topics that explicitly belong to this TM.") - (associations :accessor associations - :associate (AssociationC in-topicmaps) - :documentation "List of associations that belong to this TM.")) - (:documentation "Represnets a topic map.")) - - -;;; Pointers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; SubjectLocatorC -;;; PersistentIdC -;;; ItemIdentifierC -;;; IdentifierC -;;; TopicIdentificationC ;;; PointerC -(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.")) - - -(defpclass IdentifierC(PointerC) - () - (:documentation "An abstract base class for all TM-Identifiers.")) - - -(defpclass TopicIdentificationC(PointerC) - ((xtm-id :initarg :xtm-id - :accessor xtm-id - :type string - :initform (error "From TopicIdentificationC(): xtm-id must be seet for a topic-identifier") - :index t - :documentation "ID of the TM this identification came from.")) - (:index t) - (:documentation "Identify topic items through generalized topic-ids. - A topic may have many original topicids, the class - 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 :initarg :identified-construct - :associate (PointerAssociationC identifier) - :inherit t)) - (:documentation "An abstract base class for all pointers.")) - - (defgeneric identified-construct (construct &key revision) (:documentation "Returns the identified-construct -> ReifiableConstructC or TopicC that corresponds with the passed revision.") @@ -389,77 +731,7 @@ (first assocs))))) -;;; TopicC + Characterics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defpclass TopicC (ReifiableConstructC) - ((topic-identifiers :associate (TopicIdAssociationC parent-construct) - :documentation "Contains all association objects that - relate a topic with its actual - topic-identifiers.") - (psis :associate (PersistentIdAssociationC parent-construct) - :documentation "Contains all association objects that relate a topic - with its actual psis.") - (locators :associate (PersistentIdAssociationC parent-construct) - :documentation "Contains all association objects that relate a - topic with its actual subject-lcoators.") - (names :associate (NameAssociationC parent-construct) - :documentation "Contains all association objects that relate a topic - with its actual names.") - (occurrences :associate (OccurrenceAssociationC parent-construct) - :documentation "Contains all association objects that relate a - topic with its actual occurrences.") - (player-in-roles :associate (PlayerAssociationC player-topic) - :documentation "Contains all association objects that relate - a topic that is a player with its role.") - (used-as-type :associate (TypeAssociationC type-topic) - :documentation "Contains all association objects that relate a - topic that is a type with its typable obejct.") - (used-as-theme :associate (ScopeAssociationC theme-topic) - :documentation "Contains all association objects that relate a - topic that is a theme with its scoppable - object.") - (reified-construct :associate (ReifiedAssociationC reifier-topic) - :documentation "Contains all association objects that - relate a topic that is a reifier with - its reified object.") - (in-topicmaps :associate (TopicMapC topics) - :many-to-many t - :documentation "List of all topic maps this topic is part of.")) - (:index t) - (:documentation "Represents a TM topic.")) - - -(defpclass OccurrenceC(CharacteristicC DatatypableC) - () - (:documentation "Represents a TM occurrence.")) - - -(defpclass NameC(CharacteristicC) - ((variants :associate (VariantAssociationC parent-construct) - :documentation "Associates this obejct with varian-associations.")) - (:documentation "Scoped name of a topic.")) - - -(defpclass VariantC(CharacteristicC DatatypableC) - () - (: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).")) - - +;;; TopicC (defmethod delete-construct :before ((construct TopicC)) "Deletes all association objects of the passed construct." (dolist (assoc (append (slot-p construct 'topic-identifiers) @@ -509,10 +781,10 @@ :revision revision) construct)) (t - (make-construct 'TopicIdAssociationC - :start-revision revision - :parent-construct construct - :identifier topic-identifier) + (make-instance 'TopicIdAssociationC + :start-revision revision + :parent-construct construct + :identifier topic-identifier) construct))))) @@ -560,10 +832,10 @@ :revision revision) construct)) (t - (make-construct 'PersistentIdAssociationC - :start-revision revision - :parent-construct construct - :identifier psi) + (make-instance 'PersistentIdAssociationC + :start-revision revision + :parent-construct construct + :identifier psi) construct))))) @@ -611,10 +883,10 @@ :revision revision) construct)) (t - (make-construct 'SubjectLocatorAssociationC - :start-revision revision - :parent-construct construct - :identifier locator) + (make-instance 'SubjectLocatorAssociationC + :start-revision revision + :parent-construct construct + :identifier locator) construct))))) @@ -660,10 +932,10 @@ when (eql (parent-construct name-assoc) name) return name-assoc))) (add-to-version-history name-assoc :start-revision revision)) - (make-construct 'NameAssociationC - :start-revision revision - :parent-construct construct - :characteristic name)) + (make-instance 'NameAssociationC + :start-revision revision + :parent-construct construct + :characteristic name)) construct))) @@ -709,10 +981,10 @@ when (eql (parent-construct occ-assoc) occurrence) return occ-assoc))) (add-to-version-history occ-assoc :start-revision revision)) - (make-construct 'OccurrenceAssociationC - :start-revision revision - :parent-construct construct - :characteristic occurrence)) + (make-instance 'OccurrenceAssociationC + :start-revision revision + :parent-construct construct + :characteristic occurrence)) construct))) @@ -773,6 +1045,8 @@ (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision)) + +;;; NameC (defgeneric variants (construct &key revision) (:documentation "Returns all variants that correspond with the given revision and that are associated with the passed construct.") @@ -786,7 +1060,7 @@ (defgeneric add-variant (construct variant &key revision) (:documentation "Adds the given theme-topic to the passed scopable-construct.") - (:method ((construct ScopableC) (variant VariantC) + (:method ((construct NameC) (variant VariantC) &key (revision *TM-REVISION*)) (when (not (eql (parent variant) construct)) (error "From add-variant(): ~a can't be owned by ~a since it is already owned by the name ~a" @@ -822,6 +1096,7 @@ construct))) +;;; CharacteristicC (defmethod delete-construct :before ((construct CharacteristicC)) "Deletes all association-obejcts." (dolist (parent-assoc (slot-p construct 'parent)) @@ -923,66 +1198,20 @@ (let ((assoc-to-delete (loop for parent-assoc in (slot-p construct 'parent) when (eql (characteristic parent-assoc) parent-construct) - return parent-assoc))) - (when assoc-to-delete - (mark-as-deleted assoc-to-delete :revision revision)) - construct)) - - -;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; PlayerAssociationC -;;; RoleAssociationC -;;; VariantAssociationC -;;; NameAssociationC -;;; OccurrenceAssociationC -;;; CharacteristicAssociationC -;;; TypeAssociationC -;;; ScopeAssociationC -;;; ReifierAssociationC -;;; SubjectLocatorAssociationC -;;; PersistentIdAssociationC -;;; TopicIdAssociationC -;;; ItemIdAssociationC -;;; PointerAssociationC -;;; VersionedAssociationC -(defpclass PlayerAssociationC(VersionedAssociationC) - ((player-topic :initarg :player-topic - :accessor player-topic - :associate TopicC - :initform (error "From PlayerAssociationC(): player-topic must be set") - :documentation "Associates this object with a topic that is - a player.") - (parent-construct :initarg :parent-construct - :accessor parent-construct - :associate RoleC - :initform (error "From PlayerAssociationC(): parent-construct must be set") - :documentation "Associates this object with the parent-association.")) - (:documentation "This class associates roles and their player in given - revisions.")) + return parent-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct)) +;;; PlayerAssociationC (defmethod delete-construct :before ((construct PlayerAssociationC)) "Deletes all elephant-associations." (delete-1-n-association construct 'player-topic) (delete-1-n-association construct 'parent-construct)) -(defpclass RoleAssociationC(VersionedAssociationC) - ((role :initarg :role - :accessor role - :associate RoleC - :initform (error "From RoleAssociationC(): role must be set") - :documentation "Associates this objetc with a role-object.") - (parent-construct :initarg :parent-construct - :accessor parent-construct - :associate AssociationC - :initform (error "From RoleAssociationC(): parent-construct must be set") - :documentation "Assocates thius object with an - association-object.")) - (:documentation "Associates roles with assoications and adds some - version-infos between these realtions.")) - - +;;; RoleAssociationC (defmethod delete-construct :before ((construct RoleAssociationC)) "Deletes all elephant-associations and the entire role if it is not associated with another AssociationC object." @@ -993,60 +1222,22 @@ (delete-1-n-association construct 'parent-construct))) -(defpclass VariantAssociationC(CharateristicAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From VariantAssociationC(): parent-construct must be set") - :associate NameC - :documentation "Associates this object with a name.")) - (:documentation "Associates variant objects with name obejcts. - Additionally version-infos are stored.")) - - +;;; VariantAssociationC (defmethod delete-construct :before ((construct VariantAssociationC)) (delete-1-n-association construct 'parent-construct)) -(defpclass NameAssociationC(CharacteristicAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From NameAssociationC(): parent-construct must be set") - :associate TopicC - :documentation "Associates this object with a topic.")) - (:documentation "Associates name objects with their parent topics. - Additionally version-infos are stored.")) - - +;;; NameAssociationC (defmethod delete-construct :before ((construct NameAssociationC)) (delete-1-n-association construct 'parent-construct)) -(defpclass OccurrenceAssociationC(CharacteristicAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From OccurrenceAssociationC(): parent-construct must be set") - :associate TopicC - :documentation "Associates this object with a topic.")) - (:documentation "Associates occurrence objects with their parent topics. - Additionally version-infos are stored.")) - - +;;; OccurrenceAssociationC (defmethod delete-construct :before ((construct OccurrenceAssociationC)) (delete-1-n-association construct 'parent-construct)) -(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.")) - - +;;; CharacteristicAssociationC (defmethod delete-construct :before ((construct CharacteristicAssociationC)) "Deletes all elephant-associations." (let ((characteristic (characteristic construct))) @@ -1056,73 +1247,21 @@ (delete-construct characteristic)))) -(defpclass TypeAssociationC(VersionedAssociationC) - ((type-topic :initarg :type-topic - :accessor type-topic - :initform (error "From TypeAssociationC(): type-topic must be set") - :associate TopicC - :documentation "Associates this object with a topic that is used - as type.") - (typable-construct :initarg :typable-construct - :accessor typable-construct - :initform (error "From TypeAssociationC(): typable-construct must be set") - :associate TypableC - :documentation "Associates this object with the typable - construct that is typed by the - type-topic.")) - (:documentation "This class associates topics that are used as type for - typable constructcs. Additionally there are stored some - version-infos.")) - - +;;; TypeAssociationC (defmethod delete-construct :before ((construct TypeAssociationC)) "Deletes all elephant-associations of the given construct." (delete-1-n-association construct 'type-topic) (delete-1-n-association construct 'typable-construct)) -(defpclass ScopeAssociationC(VersionedAssociationC) - ((theme-topic :initarg :theme-topic - :accessor theme-topic - :initform (error "From ScopeAssociationC(): theme-topic must be set") - :associate TopicC - :documentation "Associates this opbject with a topic that is a - scopable construct.") - (scopable-construct :initarg :scopable-construct - :accessor scopable-construct - :initform (error "From ScopeAssociationC(): scopable-construct must be set") - :associate ScopableC - :documentation "Associates this object with the socpable - construct that is scoped by the - scope-topic.")) - (:documentation "This class associates topics that are used as scope with - scopable construtcs. Additionally there are stored some - version-infos")) - - +;;; ScopeAssociationC (defmethod delete-construct :before ((construct ScopeAssociationC)) "Deletes all elephant-associations of this construct." (delete-1-n-association construct 'theme-topic) (delete-1-n-association construct 'scopable-topic)) -(defpclass ReifierAssociationC(VersionedAssociationC) - ((reifiable-construct :initarg :reifiable-construct - :accessor reifiable-construct - :initform (error "From ReifierAssociation(): reifiable-construct must be set") - :associate ReifiableConstructC - :documentation "The actual construct which is reified - by a topic.") - (reifier-topic :initarg :reifier-topic - :accessor reifier-topic - :initform (error "From ReifierAssociationC(): reifier-topic must be set") - :associate TopicC - :documentation "The reifier-topic that reifies the - reifiable-construct.")) - (:documentation "A versioned-association that relates a reifiable-construct - with a topic.")) - - +;;; ReifierAssociationC (defmethod delete-construct :before ((construct ReifierAssociationC)) "Deletes the association-construct and the reifier-topic when it is not used as a reifier of another construct." @@ -1133,78 +1272,27 @@ (delete-construct reifier-top)))) -(defpclass SubjectLocatorAssociationC(PointerAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From SubjectLocatorAssociationC(): parent-construct must be set") - :associate TopicC - :documentation "The actual topic which is associated - with the subject-locator.")) - (:documentation "A pointer that associates subject-locators, versions - and topics.")) - - +;;; SubjectLocatorAssociationC (defmethod delete-construct :before ((construct SubjectLocatorAssociationC)) (delete-1-n-association construct 'parent-construct)) -(defpclass PersistentIdAssociationC(PointerAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From PersistentIdAssociationC(): parent-construct must be set") - :associate TopicC - :documentation "The actual topic which is associated - with the subject-identifier/psi.")) - (:documentation "A pointer that associates subject-identifiers, versions - and topics.")) - - +;;; PersistentIdAssociationC (defmethod delete-construct :before ((construct PersistentIdAssociationC)) (delete-1-n-association construct 'parent-construct)) -(defpclass TopicIdAssociationC(PointerAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From TopicIdAssociationC(): parent-construct must be set") - :associate TopicC - :documentation "The actual topic which is associated - with the topic-identifier.")) - (:documentation "A pointer that associates topic-identifiers, versions - and topics.")) - - +;;; TopicIdAssociationC (defmethod delete-construct :before ((construct TopicIdAssociationC)) (delete-1-n-association construct 'parent-construct)) -(defpclass ItemIdAssociationC(PointerAssociationC) - ((parent-construct :initarg :parent-construct - :accessor parent-construct - :initform (error "From ItemIDAssociationC(): parent-construct must be set") - :associate ReifiableConstructC - :documentation "The actual parent which is associated - with the item-identifier.")) - (:documentation "A pointer that associates item-identifiers, versions - and reifiable-constructs.")) - - +;;; ItemIdAssociationC (defmethod delete-construct :before ((construct ItemIdAssociationC)) (delete-1-n-association construct 'parent-construct)) -(defpclass PointerAssociationC (VersionedAssociationC) - ((identifier :initarg :identifier - :accessor identifier - :inherit t - :initform (error "From VersionedAssociationC(): 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.")) - - +;;; PointerAssociationC (defmethod delete-construct :before ((construct PointerAssociationC)) "Deletes the association-construct and the pointer if it is not used as an idengtiffier of any other object." @@ -1214,31 +1302,7 @@ (delete-construct id)))) -(defpclass VersionedAssociationC() - () - (:documentation "An abstract base class for all versioned associations.")) - - -;;; RoleC + AssociationC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defpclass AssociationC(ReifiableConstructC ScopableC TypableC) - ((roles :associate (RoleAssociationC association) - :documentation "Contains all association-objects of all roles this - association contains.") - (in-topicmaps :associate (TopicMapC associations) - :many-to-many t - :documentation "List of all topic maps this association is - part of")) - (:index t) - (:documentation "Association in a Topic Map")) - - -(defpclass RoleC(ReifiableConstructC TypableC) - ((parent :associate (RoleAssociationC role) - :documentation "Associates this object with a role-association.") - (player :associate (PlayerAssociationC parent-construct) - :documentation "Associates this object with a player-association."))) - - +;;; AssociationC (defmethod delete-construct :before ((construct AssociationC)) "Removes all elephant-associations and deleted all roles that are not associated by another associations." @@ -1295,6 +1359,7 @@ (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision)) +;;; RoleC (defmethod delete-construct :before ((construct RoleC)) "Deletes all association-objects." (dolist (assoc (slot-p construct 'parent)) @@ -1341,7 +1406,7 @@ &key (revision (error "From delete-parent(): revision must be set"))) (let ((assoc-to-delete (loop for parent-assoc in (slot-p construct 'parent) - when (eql (association parent-assoc) parent-construct) + when (eql (parent-construct parent-assoc) parent-construct) return parent-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision revision)) @@ -1399,18 +1464,7 @@ construct))) -;;; ReifiableConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defpclass ReifiableConstructC(TopicMapConstructC) - ((item-identifiers :associate (ItemIdAssociationC identified-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.")) - - +;;; ReifiableConstructC (defgeneric item-identifiers (construct &key revision) (:documentation "Returns the ItemIdentifierC-objects that correspond with the passed construct and the passed version.") @@ -1463,11 +1517,11 @@ :revision revision) construct)) (t - (make-construct 'ItemIdAssociationC - :start-revision revision - :parent-construct construct - :identifier item-identifier) - construct))))) + (make-instance 'ItemIdAssociationC + :start-revision revision + :parent-construct construct + :identifier item-identifier))) + construct))) (defgeneric delete-item-identifier (construct item-identifier &key revision) @@ -1509,10 +1563,10 @@ (all-constructs (merge-constructs (first all-constructs) construct)) (t - (make-construct 'ReifierAssociationC - :start-revision revision - :reifiable-construct construct - :reifier-topic merged-reifier-topic) + (make-instance 'ReifierAssociationC + :start-revision revision + :reifiable-construct construct + :reifier-topic merged-reifier-topic) construct)))))) @@ -1529,22 +1583,7 @@ construct))) -;;; TopicMapConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defpclass TopicMapConstructC() - () - (:documentation "An abstract base class for all classes that describes - Topic Maps data.")) - - -;;; ScopableC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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.")) - - +;;; ScopableC (defmethod delete-construct :before ((construct ScopableC)) "Deletes all ScopeAssociationCs that are associated with the given object." (dolist (theme (slot-p construct 'themes)) @@ -1595,15 +1634,7 @@ construct))) -;;; TypableC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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.")) - - +;;; TypableC (defmethod delete-construct :before ((construct TypableC)) "Deletes all TypeAssociationCs that are associated with this object." (dolist (type (slot-p construct 'instance-of)) @@ -1663,18 +1694,6 @@ construct))) -;;; DatatypableC -(defpclass DatatypableC() - ((datatype :accessor datatype - :initarg :datatype - :initform constants:*xml-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.")) - - Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Sat Feb 20 09:49:30 2010 @@ -16,7 +16,8 @@ :unittests-constants) (:export :run-datamodel-tests :test-VersionInfoC - :test-VersionedConstructC)) + :test-VersionedConstructC + :test-ItemIdentifierC)) (declaim (optimize (debug 3))) @@ -91,11 +92,28 @@ (is (= (length (elephant:get-instances-by-class 'd::VersionInfoC)) 0)) (is (= (length (elephant:get-instances-by-class 'd::VersionedConstructC)) 0))))) - - +(test test-ItemIdentifierC () + "Tests various functions of the VersionedCoinstructC class." + (with-fixture with-empty-db (*db-dir*) + (setf d:*TM-REVISION* 100) + (let ((ii-1 (make-instance 'd:ItemIdentifierC + :uri "ii-1")) + (ii-2 (make-instance 'd:ItemIdentifierC + :uri "ii-2")) + (topic (make-instance 'd:TopicC))) + (is-false (d:identified-construct ii-1)) + (signals error (make-instance 'd:ItemIdentifierC)) + (is-false (item-identifiers topic)) + (d:add-item-identifier topic ii-1) + (format t ">>> ~a~%" (d::parent-construct ii-1)) + (is (= (length (d:item-identifiers topic)) 1)) + ))) + + (defun run-datamodel-tests() (it.bese.fiveam:run! 'test-VersionInfoC) (it.bese.fiveam:run! 'test-VersionedConstructC) + (it.bese.fiveam:run! 'test-ItemIdentifierC) ) \ No newline at end of file