Author: lgiessmann Date: Fri Feb 19 13:34:28 2010 New Revision: 197 Log: new-datamodel: added the class DatatypableC as abstract base class for variants and occurrences; fixed some problems; updates 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 Fri Feb 19 13:34:28 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 Fri Feb 19 13:34:28 2010 @@ -26,11 +26,11 @@ ;;methods and functions :xtm-id :uri - :identifieid-construct + :identified-construct :item-identifiers - :reifier :add-item-identifier :delete-item-identifier + :reifier :add-reifier :delete-reifier :find-item-by-revision @@ -40,14 +40,12 @@ :instance-of :add-type :delete-type + :parent :add-parent :delete-parent :variants :add-variant :delete-variant - :association - :add-tm-association - :delete-tm-association :player :add-player :delete-player @@ -73,16 +71,23 @@ :delete-occurrence :player-in-roles :used-as-type - :ased-as-theme + :used-as-theme + :datatype :reified-construct :mark-as-deleted + :mark-as-deleted-p :in-topicmaps + :delete-construct ;;globals :*TM-REVISION*)) (in-package :datamodel) + +;;TODO: implement a macro "with-merge-construct" that merges constructs +;; 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, ... ;;TODO: implement make-construct -> symbol @@ -423,12 +428,9 @@ (:documentation "Represents a TM topic.")) -(defpclass OccurrenceC(CharacteristicC) - ((datatype :accessor datatype - :initarg :datatype - :initform nil - :documentation "The XML Schema datatype of the occurrencevalue - (optional, always IRI for resourceRef)."))) +(defpclass OccurrenceC(CharacteristicC DatatypableC) + () + (:documentation "Represents a TM occurrence.")) (defpclass NameC(CharacteristicC) @@ -437,12 +439,9 @@ (: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 VariantC(CharacteristicC DatatypableC) + () + (:documentation "Represents a TM variant.")) (defpclass CharacteristicC(ReifiableConstructC ScopableC TypableC) @@ -1234,8 +1233,8 @@ (defpclass RoleC(ReifiableConstructC TypableC) - ((assocation :associate (RoleAssociationC role) - :documentation "Associates this object with a role-association.") + ((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."))) @@ -1298,34 +1297,33 @@ (defmethod delete-construct :before ((construct RoleC)) "Deletes all association-objects." - (dolist (assoc (slot-p construct 'association)) + (dolist (assoc (slot-p construct 'parent)) (delete-construct assoc)) (dolist (assoc (slot-p construct 'player)) (delete-construct assoc))) -(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 'association - :start-revision revision))) - (when valid-associations - (parent-construct (first valid-associations)))))) - +(defmethod parent ((construct RoleC) &key (revision *TM-REVISION*)) + "Returns the construct's parent corresponding to the given revision." + (let ((valid-associations + (filter-slot-value-by-revision construct 'parent + :start-revision revision))) + (when valid-associations + (parent-construct (first valid-associations))))) + -(defmethod add-tm-association ((construct RoleC) (parent-construct AssociationC) +(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 'association + (map 'list #'parent + (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 'association) - when (eql parent-construct (association parent-assoc)) + (loop for parent-assoc in (slot-p construct 'parent) + when (eql parent-construct + (parent-construct parent-assoc)) return parent-assoc))) (add-to-version-history parent-assoc :start-revision revision))) ((not already-set-parent) @@ -1339,10 +1337,10 @@ construct)) -(defmethod delete-tm-association ((construct RoleC) (parent-construct AssociationC) +(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 'assocaition) + (loop for parent-assoc in (slot-p construct 'parent) when (eql (association parent-assoc) parent-construct) return parent-assoc))) (when assoc-to-delete @@ -1665,7 +1663,16 @@ 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."))