[isidorus-cvs] r198 - in branches/new-datamodel/src: model unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Sat Feb 20 14:49:31 UTC 2010
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
More information about the Isidorus-cvs
mailing list