Author: lgiessmann Date: Wed Feb 17 13:59:30 2010 New Revision: 193 Log: new-datamodel: fixed some problems; removed some unnecessary functions; implemented RoleC, PlayerAssociationC, RoleAssociationC; updated the UML-schema Modified: branches/new-datamodel/docs/isidorus_data_model.pdf branches/new-datamodel/docs/isidorus_data_model.vsd branches/new-datamodel/src/model/datamodel.lisp Modified: branches/new-datamodel/docs/isidorus_data_model.pdf ============================================================================== Binary files branches/new-datamodel/docs/isidorus_data_model.pdf (original) and branches/new-datamodel/docs/isidorus_data_model.pdf Wed Feb 17 13:59:30 2010 differ Modified: branches/new-datamodel/docs/isidorus_data_model.vsd ============================================================================== Binary files. No diff available. Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Wed Feb 17 13:59:30 2010 @@ -11,6 +11,10 @@ (:use :cl :elephant :constants) (:nicknames :d) (:export ;;classes + :RoleC + :OccurrenceC + :NameC + :VariantC :PersistentIdC :ItemIdentifierC :SubjectLocatorC @@ -21,7 +25,6 @@ :xtm-id :uri :identifieid-construct - :all-identified-constructs :item-identifiers :reifier :add-item-identifier @@ -37,6 +40,15 @@ :delete-type :add-parent :delete-parent + :variants + :add-variant + :delete-variant + :parent + :add-parent + :delete-parent + :player + :add-player + :delete-player :mark-as-deleted ;;globals @@ -44,11 +56,8 @@ (in-package :datamodel) - -;;TODO: implement delete-item-identifier -;;TODO: implement delete-reifier -;;TODO: implement all-reified-constructs (:with-deleted t) -> TopicC -;; the method should return all reifed-constructs of the given topic +;;TODO: use some exceptions --> more than one type, +;; identifier, not-mergeable merges, ... ;;TODO: implement make-construct -> symbol ;; replace the latest make-construct-method ;;TODO: implement merge-construct -> ReifiableConstructC -> ... @@ -60,30 +69,21 @@ ;;; start hacks -> just some temporary hacks to avoid compiler-errors ;;;;;;;;;; -(defpclass NameC (TopicMapConstructC) +(defpclass TopicC (TopicMapConstructC) () (:documentation "A temporary emtpy class to avoid compiler-errors.")) -(defpclass OccurrenceC (TopicMapConstructC) +(defpclass AssociationC (TopicMapConstructC) () (:documentation "A temporary emtpy class to avoid compiler-errors.")) -(defpclass TopicC (TopicMapConstructC) - () - (:documentation "A temporary emtpy class to avoid compiler-errors.")) - (defgeneric merge-constructs(construc-1 construct-2 &key revision) (:method ((construct-1 TopicMapConstructC) (construct-2 TopicMapconstructC) &key (revision *TM-REVISION*)) (or construct-1 construct-2 revision))) -(defgeneric all-reified-constructs(topic &key with-deleted) - (:method ((topic TopicC) &key (with-deleted t)) - (or topic with-deleted))) - - (defgeneric make-construct (class-symbol &key start-revision &allow-other-keys) (:method ((class-symbol symbol) &key (start-revision *TM-REVISION*)) (or class-symbol start-revision))) @@ -301,6 +301,74 @@ ;;; Characterics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defpclass OccurrenceC(CharacteristicC) + ((datatype :accessor datatype + :initarg :datatype + :initform nil + :documentation "The XML Schema datatype of the occurrencevalue + (optional, always IRI for resourceRef)."))) + + +(defpclass NameC(CharacteristicC) + ((variants :associate (VaraitnAssociationC name) + :documentation "Associates this obejct with varian-associations.")) + (:documentation "Scoped name of a topic.")) + + +(defgeneric variants (construct &key revision) + (:documentation "Returns all variants that correspond with the given revision + and that are associated with the passed construct.") + (:method ((construct NameC) &key (revision *TM-REVISION*)) + (let ((valid-associations + (filter-slot-value-by-revision construct 'variants + :start-revision revision))) + (map 'list #'characteristic valid-associations)))) + + +(defgeneric add-variant (construct variant &key revision) + (:documentation "Adds the given theme-topic to the passed + scopable-construct.") + (:method ((construct ScopableC) (variant VariantC) + &key (revision *TM-REVISION*)) + (let ((all-variants + (map 'list #'characteristic + (remove-if #'marked-as-deleted-p + (slot-p construct 'variants))))) + (if (find variant all-variants) + (let ((variant-assoc + (loop for variant-assoc in (slot-p construct 'variants) + when (eql (characteristic variant-assoc) variant) + return variant-assoc))) + (add-to-version-history variant-assoc :start-revision revision)) + (make-instance 'VariantAssociationC + :start-revision revision + :characteristic variant + :name construct))) + construct)) + + +(defgeneric delete-variant (construct variant &key revision) + (:documentation "Deletes the passed variant by marking it's association as + deleted in the passed revision.") + (:method ((construct NameC) (variant VariantC) + &key (revision (error "From delete-theme(): revision must be set"))) + (let ((assoc-to-delete (loop for variant-assoc in (slot-p construct + 'variants) + when (eql (characteristic variant-assoc) variant) + return variant-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defpclass VariantC(CharacteristicC) + ((datatype :accessor datatype + :initarg :datatype + :initform nil + :documentation "The XML Schema datatype of the occurrencevalue + (optional, always IRI for resourceRef)."))) + + (defpclass CharacteristicC(ReifiableConstructC ScopableC TypableC) ((parent :associate (CharacteriticAssociationC characteristic) :inherit t @@ -421,6 +489,8 @@ ;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; PlayerAssociationC +;;; RoleAssociationC ;;; VariantAssociationC ;;; NameAssociationC ;;; OccurrenceAssociationC @@ -434,13 +504,59 @@ ;;; 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.") + (role :initarg :role + :accessor role + :associate RoleC + :initform (error "From PlayerAssociationC(): role must be set") + :documentation "Associates this object with the parent-association.")) + (:documentation "This class associates roles and their player in given + revisions.")) + + +(defmethod delete-construct :before ((construct PlayerAssociationC)) + "Deletes all elephant-associations." + (delete-1-n-association construct 'player-topic) + (delete-1-n-association construct 'role)) + + +(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.") + (association :initarg :association + :accessor association + :associate AssociationC + :initform (error "From RoleAssociationC(): association must be set") + :documentation "Assocates thius object with an association-object.")) + (:documentation "Associates roles with assoications and adds some + version-infos between these realtions.")) + + +(defmethod delete-construct :before ((construct RoleAssociationC)) + "Deletes all elephant-associations and the entire role if it is not + associated with another AssociationC object." + (let ((role (role construct))) + (delete-1-n-association construct 'role) + (when (not (slot-p role 'parent)) + (delete-construct role)) + (delete-1-n-association construct 'association))) + + (defpclass VariantAssociationC(CharateristicAssociationC) ((name :initarg :name :accessor name :initform (error "From VariantAssociationC(): name must be set") :associate NameC :documentation "Associates this object with a name.")) - (:index t) (:documentation "Associates variant objects with name obejcts. Additionally version-infos are stored.")) @@ -455,7 +571,6 @@ :initform (error "From NameAssociationC(): topic must be set") :associate TopicC :documentation "Associates this object with a topic.")) - (:index t) (:documentation "Associates name objects with their parent topics. Additionally version-infos are stored.")) @@ -470,7 +585,6 @@ :initform (error "From OccurrenceAssociationC(): topic must be set") :associate TopicC :documentation "Associates this object with a topic.")) - (:index t) (:documentation "Associates occurrence objects with their parent topics. Additionally version-infos are stored.")) @@ -514,7 +628,6 @@ :documentation "Associates this object with the typable construct that is typed by the type-topic.")) - (:index t) (:documentation "This class associates topics that are used as type for typable constructcs. Additionally there are stored some version-infos.")) @@ -540,7 +653,6 @@ :documentation "Associates this object with the socpable construct that is scoped by the scope-topic.")) - (:index t) (:documentation "This class associates topics that are used as scope with scopable construtcs. Additionally there are stored some version-infos")) @@ -565,7 +677,6 @@ :associate TopicC :documentation "The reifier-topic that reifies the reifiable-construct.")) - (:index t) (:documentation "A versioned-association that relates a reifiable-construct with a topic.")) @@ -587,7 +698,6 @@ :associate TopicC :documentation "The actual topic which is associated with the subject-locator.")) - (:index t) (:documentation "A pointer that associates subject-locators, versions and topics.")) @@ -603,7 +713,6 @@ :associate TopicC :documentation "The actual topic which is associated with the subject-identifier/psi.")) - (:index t) (:documentation "A pointer that associates subject-identifiers, versions and topics.")) @@ -619,7 +728,6 @@ :associate TopicC :documentation "The actual topic which is associated with the topic-identifier.")) - (:index t) (:documentation "A pointer that associates topic-identifiers, versions and topics.")) @@ -635,7 +743,6 @@ :associate ReifiableConstructC :documentation "The actual parent which is associated with the item-identifier.")) - (:index t) (:documentation "A pointer that associates item-identifiers, versions and reifiable-constructs.")) @@ -661,7 +768,7 @@ as an idengtiffier of any other object." (let ((id (slot-p construct 'identifier))) (delete-1-n-association construct 'identifier) - (when (= (length (all-identified-constructs id)) 0) + (when (= (length (slot-p id 'identified-construct)) 0) (delete-construct id)))) @@ -670,6 +777,119 @@ (:documentation "An abstract base class for all versioned associations.")) +;;; RoleC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defpclass RoleC(ReifiableConstructC TypableC) + ((parent :associate (RoleAssociationC role) + :documentation "Associates this object with a role-association.") + (player :associate (PlayerAssociationC parent-role) + :documentation "Associates this object with a player-association."))) + + +(defmethod delete-construct :before ((construct RoleC)) + "Deletes all association-objects." + (dolist (assoc (slot-p construct 'parent)) + (delete-construct assoc)) + (dolist (assoc (slot-p construct 'player)) + (delete-construct assoc))) + + +(defgeneric parent (construct &key revision) + (:documentation "Returns the construct's parent corresponding to + the given revision.") + (:method ((construct RoleC) &key (revision *TM-REVISION*)) + (let ((valid-associations + (filter-slot-value-by-revision construct 'parent + :start-revision revision))) + (when valid-associations + (association (first valid-associations)))))) + + +(defmethod add-parent ((construct RoleC) (parent-construct AssociationC) + &key (revision *TM-REVISION*)) + (let ((already-set-parent + (map 'list #'association + (filter-slot-value-by-revision construct 'parent + :start-revision revision)))) + (cond ((and already-set-parent + (eql (first already-set-parent) parent-construct)) + (let ((parent-assoc + (loop for parent-assoc in (slot-p construct 'parent) + when (eql parent-construct (association parent-assoc)) + return parent-assoc))) + (add-to-version-history parent-assoc :start-revision revision))) + ((not already-set-parent) + (make-instance 'RoleAssociationC + :start-revision revision + :role construct + :association parent-construct)) + (t + (error "From add-parent(): ~a can't be a parent of ~a since it is already owned by the association ~a" + parent-construct construct already-set-parent))) + construct)) + + +(defmethod delete-parent ((construct RoleC) (parent-construct AssociationC) + &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) + return parent-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct)) + + +(defgeneric player (construct &key revision) + (:documentation "Returns the construct's player corresponding to + the given revision.") + (:method ((construct RoleC) &key (revision *TM-REVISION*)) + (let ((valid-associations + (filter-slot-value-by-revision construct 'player + :start-revision revision))) + (when valid-associations + (player-topic (first valid-associations)))))) + + +(defgeneric add-player (construct player-topic &key revision) + (:documentation "Adds a topic as a player to a role in the given revision.") + (:method ((construct RoleC) (player-topic TopicC) + &key (revision *TM-REVISION*)) + (let ((already-set-player + (map 'list #'player-topic + (filter-slot-value-by-revision construct 'player + :start-revision revision)))) + (cond ((and already-set-player + (eql (first already-set-player) player-topic)) + (let ((player-assoc + (loop for player-assoc in (slot-p construct 'player) + when (eql player-topic (player-topic player-assoc)) + return player-assoc))) + (add-to-version-history player-assoc :start-revision revision))) + ((not already-set-player) + (make-instance 'PlayerAssociationC + :start-revision revision + :role construct + :player-topic player-topic)) + (t + (error "From add-player(): ~a can't be a player of ~a since it has already the player ~a" + player-topic construct already-set-player))) + construct))) + + +(defgeneric delete-player (construct player-topic &key revision) + (:documentation "Deletes the passed topic as a player of the passed role + object by marking its association-object as deleted.") + (:method ((construct RoleC) (player-topic TopicC) + &key (revision (error "From delete-parent(): revision must be set"))) + (let ((assoc-to-delete + (loop for player-assoc in (slot-p construct 'player) + when (eql (player-topic player-assoc) player-topic) + return player-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + ;;; Pointers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; SubjectLocatorC ;;; PersistentIdC @@ -745,18 +965,6 @@ (first assocs))))) -(defgeneric all-identified-constructs (construct &key with-deleted) - (:documentation "Returns all constructs which are associated with this - pointer.") - (:method ((construct PointerC) &key (with-deleted t)) - (let ((all-values (slot-p construct 'identified-construct))) - (let ((filtered-values - (if with-deleted - all-values - (remove-if #'marked-as-deleted-p all-values)))) - (map 'list #'parent-construct filtered-values))))) - - ;;; ReifiableConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass ReifiableConstructC(TopicMapConstructC) ((item-identifiers :initarg :item-identifiers @@ -808,18 +1016,20 @@ the identified-constructs are merged.") (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC) &key (revision *TM-REVISION*)) - (let ((all-constructs - (all-identified-constructs item-identifier - :with-deleted nil))) - (cond ((find construct all-constructs) - (let ((ii-assoc - (loop for ii-assoc in (slot-p construct 'item-identifiers) - when (eql (identifier ii-assoc) item-identifier) - return ii-assoc))) - (add-to-version-history ii-assoc :start-revision revision) - construct)) - (all-constructs - (merge-constructs (first all-constructs) construct)) + (let ((all-ids + (map 'list #'identifier + (remove-if #'marked-as-deleted-p + (slot-p construct 'item-identifiers))))) + (cond ((find item-identifier all-ids) + (let ((ii-assoc (loop for ii-assoc in (slot-p construct + 'item-identifiers) + when (eql (identifier ii-assoc) item-identifier) + return ii-assoc))) + (add-to-version-history ii-assoc :start-revision revision))) + (all-ids + (merge-constructs (identified-construct (first all-ids) + :revision revision) + construct)) (t (make-construct 'ItemIdAssociationC :start-revision revision @@ -909,7 +1119,7 @@ (defgeneric themes (construct &key revision) - (:documentation "Returns all topics that are not marked as deleted and are + (:documentation "Returns all topics that correspond with the given revision as a scope for the given topic.") (:method ((construct ScopableC) &key (revision *TM-REVISION*)) (let ((valid-associations @@ -923,7 +1133,9 @@ scopable-construct.") (:method ((construct ScopableC) (theme-topic TopicC) &key (revision *TM-REVISION*)) - (let ((all-themes (themes construct))) + (let ((all-themes + (map 'list #'theme-topic + (remove-if #'marked-as-deleted-p (slot-p construct 'themes))))) (if (find theme-topic all-themes) (let ((theme-assoc (loop for theme-assoc in (slot-p construct 'themes)