Author: lgiessmann Date: Tue Feb 16 06:54:16 2010 New Revision: 189 Log: new-datamodel: added the implementation of TypableC Modified: branches/new-datamodel/src/model/datamodel.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Tue Feb 16 06:54:16 2010 @@ -168,6 +168,7 @@ (defpclass VersionedConstructC() ((versions :initarg :versions :accessor versions + :inherit t :associate (VersionInfoC versioned-construct) :documentation "Version infos for former versions of this base class."))) @@ -439,6 +440,7 @@ (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 @@ -513,12 +515,14 @@ (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))) + :associate (PointerAssociationC identifier) + :inherit t)) (:documentation "An abstract base class for all pointers.")) @@ -550,10 +554,12 @@ (defpclass ReifiableConstructC(TopicMapConstructC) ((item-identifiers :initarg :item-identifiers :associate (ItemIdAssociationC identified-construct) + :inherit t :documentation "A relation to all item-identifiers of this construct.") (reifier :initarg :reifier :associate (ReifierAssociationC reified-construct) + :inherit t :documentation "A relation to a reifier-topic.")) (:documentation "Reifiable constructs as per TMDM.")) @@ -656,26 +662,26 @@ ;;; ScopableC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass ScopableC() - ((themes :initarg :themes - :associate (ScopeAssociationC scopable-construct) + ((themes :associate (ScopeAssociationC scopable-construct) :inherit t - :documentation "Contains all Association-objects that contain the + :documentation "Contains all association-objects that contain the actual scope-topics.")) (:documentation "An abstract base class for all constructs that are scoped.")) (defmethod delete-construct :before ((construct ScopableC)) "Deletes all ScopeAssociationCs that are associated with the given object." - (dolist (theme (themes construct)) + (dolist (theme (slot-p construct 'themes)) (delete-construct theme))) -(defgeneric themes (construct) +(defgeneric themes (construct &key revision) (:documentation "Returns all topics that are not marked as deleted and are as a scope for the given topic.") - (:method ((construct ScopableC)) + (:method ((construct ScopableC) &key (revision *TM-REVISION*)) (let ((valid-associations - (remove-if-not #'marked-as-deleted-p (slot-p construct 'themes)))) + (filter-slot-value-by-revision construct 'themes + :start-revision revision))) (map 'list #'theme-topic valid-associations)))) @@ -712,5 +718,68 @@ ;;; TypableC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;TODO: implement a TypeAssociationC-class -> extend the uml schema -;; --> error if there are more than one types on one revision \ No newline at end of file +(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.")) + + +(defmethod delete-construct :before ((construct TypableC)) + "Deletes all TypeAssociationCs that are associated with this object." + (dolist (type (slot-p construct 'instance-of)) + (delete-construct type))) + + +(defgeneric instance-of (construct &key revision) + (:documentation "Returns the type topic that is set on the passed + revision.") + (:method ((construct TypableC) &key (revision *TM-REVISION*)) + (let ((valid-associations + (filter-slot-value-by-revision construct 'instance-of + :start-revision revision))) + (when valid-associations + (type-topic (first valid-associations)))))) + + +(defgeneric add-type (construct type-topic &key revision) + (:documentation "Add the passed type-topic as type to the given + typed construct if there is no other type-topic + set at the same revision.") + (:method ((construct TypableC) (type-topic TopicC) + &key (revision *TM-REVISION*)) + (let ((already-set-type + (map 'list #'type-topic + (filter-slot-value-by-revision construct 'instance-of + :start-revision revision)))) + (cond ((and already-set-type + (eql (first already-set-type) type-topic)) + (let ((type-assoc + (loop for type-assoc in (slot-p construct 'instance-of) + when (eql type-topic (type-topic type-assoc)) + return type-assoc))) + (add-to-version-history type-assoc :start-revision revision))) + ((not already-set-type) + (make-instance 'TypeAssociationC + :start-revision revision + :type-topic type-topic + :typable-construct construct)) + (t + (error "From add-type(): ~a can't by typed by ~a since it is already typed by the topic ~a" + construct type-topic already-set-type))) + construct))) + + +(defgeneric delete-type (construct type-topic &key revision) + (:documentation "Deletes the passed type by marking it's association as + deleted in the passed revision.") + (:method ((construct TypableC) (type-topic TopicC) + &key (revision (error "From delete-type(): revision must be set"))) + (let ((assoc-to-delete + (loop for type-assoc in (slot-p construct 'instance-of) + when (eql (type-topic type-assoc) type-topic) + return type-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) \ No newline at end of file