Author: lgiessmann Date: Wed Feb 17 14:55:29 2010 New Revision: 194 Log: new-datamodel: updated the uml-schema; implemented AssociationC 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 14:55:29 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 14:55:29 2010 @@ -11,6 +11,7 @@ (:use :cl :elephant :constants) (:nicknames :d) (:export ;;classes + :AssociationC :RoleC :OccurrenceC :NameC @@ -43,13 +44,17 @@ :variants :add-variant :delete-variant - :parent - :add-parent - :delete-parent + :association + :add-tm-association + :delete-tm-association :player :add-player :delete-player + :roles + :add-role + :delete-role :mark-as-deleted + :in-topicmaps ;;globals :*TM-REVISION*)) @@ -57,7 +62,7 @@ (in-package :datamodel) ;;TODO: use some exceptions --> more than one type, -;; identifier, not-mergeable merges, ... +;; identifier, not-mergable merges, ... ;;TODO: implement make-construct -> symbol ;; replace the latest make-construct-method ;;TODO: implement merge-construct -> ReifiableConstructC -> ... @@ -73,10 +78,6 @@ () (:documentation "A temporary emtpy class to avoid compiler-errors.")) -(defpclass AssociationC (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) @@ -310,11 +311,35 @@ (defpclass NameC(CharacteristicC) - ((variants :associate (VaraitnAssociationC name) + ((variants :associate (VariantAssociationC name) :documentation "Associates this obejct with varian-associations.")) (:documentation "Scoped name of a topic.")) +(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 + :documentation "Assocates the characterist obejct with the + parent-association.") + (charavalue :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).")) + + (defgeneric variants (construct &key revision) (:documentation "Returns all variants that correspond with the given revision and that are associated with the passed construct.") @@ -351,7 +376,7 @@ (: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"))) + &key (revision (error "From delete-variant(): revision must be set"))) (let ((assoc-to-delete (loop for variant-assoc in (slot-p construct 'variants) when (eql (characteristic variant-assoc) variant) @@ -361,30 +386,6 @@ 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 - :documentation "Assocates the characterist obejct with the - parent-association.") - (charavalue :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).")) - - (defmethod delete-construct :before ((construct CharacteristicC)) "Deletes all association-obejcts." (dolist (parent-assoc (slot-p construct 'parent)) @@ -532,11 +533,12 @@ :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.")) + (parent-construct :initarg :parent-construct + :accessor parent-construct + :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.")) @@ -548,7 +550,7 @@ (delete-1-n-association construct 'role) (when (not (slot-p role 'parent)) (delete-construct role)) - (delete-1-n-association construct 'association))) + (delete-1-n-association construct 'parent-construct))) (defpclass VariantAssociationC(CharateristicAssociationC) @@ -687,7 +689,7 @@ (delete-1-n-association construct 'reifiable-construct) (let ((reifier-top (slot-p construct 'reifier-topic))) (delete-1-n-association construct 'reifier-topic) - (when (= (length (all-reified-constructs reifier-top)) 0) + (when (= (length (slot-p reifier-top 'reified-construct)) 0) (delete-construct reifier-top)))) @@ -777,43 +779,111 @@ (:documentation "An abstract base class for all versioned associations.")) -;;; RoleC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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.") + ((assocation :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 AssociationC)) + "Removes all elephant-associations and deleted all roles that are not + associated by another associations." + (dolist (assoc (slot-p construct 'roles)) + (delete-construct assoc)) + (dolist (tm (in-topicmaps construct)) + (remove-association construct 'in-topicmaps tm))) + + +(defgeneric roles (construct &key revision) + (:documentation "Returns all topics that correspond with the given revision + as a scope for the given topic.") + (:method ((construct AssociationC) &key (revision *TM-REVISION*)) + (let ((valid-associations + (filter-slot-value-by-revision construct 'roles + :start-revision revision))) + (map 'list #'role valid-associations)))) + + +(defgeneric add-role (construct role &key revision) + (:documentation "Adds the given role to the passed association-construct.") + (:method ((construct AssociationC) (role RoleC) + &key (revision *TM-REVISION*)) + (let ((all-roles + (map 'list #'role + (remove-if #'marked-as-deleted-p (slot-p construct 'roles))))) + (if (find role all-roles) + (let ((role-assoc + (loop for role-assoc in (slot-p construct 'roles) + when (eql (role role-assoc) role) + return role-assoc))) + (add-to-version-history role-assoc :start-revision revision)) + (make-instance 'RoleAssociationC + :start-revision revision + :role role + :association construct))) + construct)) + + +(defgeneric delete-role (construct role &key revision) + (:documentation "Deletes the passed role by marking it's association as + deleted in the passed revision.") + (:method ((construct AssociationC) (role RoleC) + &key (revision (error "From delete-role(): revision must be set"))) + (let ((assoc-to-delete (loop for role-assoc in (slot-p construct 'roles) + when (eql (role role-assoc) role) + return role-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defmethod in-topicmaps ((association AssociationC) &key (revision *TM-REVISION*)) + (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision)) + + (defmethod delete-construct :before ((construct RoleC)) "Deletes all association-objects." - (dolist (assoc (slot-p construct 'parent)) + (dolist (assoc (slot-p construct 'association)) (delete-construct assoc)) (dolist (assoc (slot-p construct 'player)) (delete-construct assoc))) -(defgeneric parent (construct &key revision) +(defgeneric association (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 + (filter-slot-value-by-revision construct 'association :start-revision revision))) (when valid-associations - (association (first valid-associations)))))) + (parent-construct (first valid-associations)))))) -(defmethod add-parent ((construct RoleC) (parent-construct AssociationC) - &key (revision *TM-REVISION*)) +(defmethod add-tm-association ((construct RoleC) (parent-construct AssociationC) + &key (revision *TM-REVISION*)) (let ((already-set-parent (map 'list #'association - (filter-slot-value-by-revision construct 'parent + (filter-slot-value-by-revision construct 'association :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) + (loop for parent-assoc in (slot-p construct 'association) when (eql parent-construct (association parent-assoc)) return parent-assoc))) (add-to-version-history parent-assoc :start-revision revision))) @@ -821,17 +891,17 @@ (make-instance 'RoleAssociationC :start-revision revision :role construct - :association parent-construct)) + :parent-construct 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) +(defmethod delete-tm-association ((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) + (loop for parent-assoc in (slot-p construct 'assocaition) when (eql (association parent-assoc) parent-construct) return parent-assoc))) (when assoc-to-delete @@ -1063,7 +1133,8 @@ (when (reifier construct) (merge-constructs (reifier construct) reifier-topic)))) (let ((all-constructs - (all-reified-constructs merged-reifier-topic :with-deleted nil))) + (remove-if #'marked-as-deleted-p + (slot-p reifier-topic 'reified-construct)))) (cond ((find construct all-constructs) (let ((reifier-assoc (loop for reifier-assoc in