February 2010 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r197 - in branches/new-datamodel: docs src/model
by Lukas Giessmann 19 Feb '10

19 Feb '10

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."))

1 0

[isidorus-cvs] r196 - branches/new-datamodel/src/model
by Lukas Giessmann 18 Feb '10

18 Feb '10

Author: lgiessmann Date: Thu Feb 18 15:36:34 2010 New Revision: 196 Log: new-datamodel: added some accessors and helpers to TopicC 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 Thu Feb 18 15:36:34 2010 @@ -56,6 +56,25 @@ :delete-role :associations :topics + :psis + :add-psi + :delete-psi + :topic-identifiers + :add-topic-identifier + :delete-topic-identifier + :locators + :add-locator + :delete-locator + :names + :add-name + :delete-name + :occurrences + :add-occurrence + :delete-occurrence + :player-in-roles + :used-as-type + :ased-as-theme + :reified-construct :mark-as-deleted :in-topicmaps @@ -290,6 +309,81 @@ (: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.") + (:method ((construct PointerC) &key (revision *TM-REVISION*)) + (let ((assocs + (map 'list #'parent-construct + (filter-slot-value-by-revision construct 'identified-construct + :start-revision revision)))) + (when assocs ;result must be nil or a list with one item + (first assocs))))) + + ;;; TopicC + Characterics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass TopicC (ReifiableConstructC) ((topic-identifiers :associate (TopicIdAssociationC parent-construct) @@ -329,12 +423,6 @@ (:documentation "Represents a TM topic.")) -;;TODO: delete-construct, topic-identifiers, add-topic-identifier, -;; delete-topic-identifier, psis, add-psi, delete-psi, locators, -;; add-locator, delete-locator, names, add-name, delete-name, -;; occurrences, add-occurrence, delete-occurrence, player-in-roles -;; used-as-type, used-as-theme, reified-construct, in-topicmaps - (defpclass OccurrenceC(CharacteristicC) ((datatype :accessor datatype :initarg :datatype @@ -373,6 +461,319 @@ as an abstract class).")) +(defmethod delete-construct :before ((construct TopicC)) + "Deletes all association objects of the passed construct." + (dolist (assoc (append (slot-p construct 'topic-identifiers) + (slot-p construct 'psis) + (slot-p construct 'locators) + (slot-p construct 'names) + (slot-p construct 'occurrences) + (slot-p construct 'player-in-roles) + (slot-p construct 'used-as-type) + (slot-p construct 'used-as-theme) + (slot-p construct 'reified-construct))) + (delete-construct assoc)) + (dolist (assoc (slot-p construct 'in-topicmaps)) + (remove-association construct 'in-topicmaps assoc))) + + +(defgeneric topic-identifiers (construct &key revision) + (:documentation "Returns the TopicIdentificationC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'topic-identifiers :start-revision revision))) + (map 'list #'identifier assocs)))) + + +(defgeneric add-topic-identifier (construct topic-identifier &key revision) + (:documentation "Adds the passed topic-identifier to the passed topic. + If the topic-identifier is already related with the passed + topic a new revision is added. + If the passed identifer already identifies another object + the identified-constructs are merged.") + (:method ((construct TopicC) (topic-identifier TopicIdentificationC) + &key (revision *TM-REVISION*)) + (let ((all-ids + (map 'list #'identifier + (remove-if #'marked-as-deleted-p + (slot-p construct 'topic-identifiers))))) + (cond ((find topic-identifier all-ids) + (let ((ti-assoc (loop for ti-assoc in (slot-p construct + 'topic-identifiers) + when (eql (identifier ti-assoc) + topic-identifier) + return ti-assoc))) + (add-to-version-history ti-assoc :start-revision revision))) + (all-ids + (merge-constructs (identified-construct (first all-ids) + :revision revision) + construct)) + (t + (make-construct 'TopicIdAssociationC + :start-revision revision + :parent-construct construct + :identifier topic-identifier) + construct))))) + + +(defgeneric delete-topic-identifier (construct topic-identifier &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct TopicC) (topic-identifier TopicIdentificationC) + &key (revision (error "From delete-topic-identifier(): revision must be set"))) + (let ((assoc-to-delete (loop for ti-assoc in (slot-p construct 'topic-identifiers) + when (eql (identifier ti-assoc) topic-identifier) + return ti-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defgeneric psis (construct &key revision) + (:documentation "Returns the PersistentIdC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'psis :start-revision revision))) + (map 'list #'identifier assocs)))) + + +(defgeneric add-psi (construct psi &key revision) + (:documentation "Adds the passed psi to the passed topic. + If the psi is already related with the passed + topic a new revision is added. + If the passed identifer already identifies another object + the identified-constructs are merged.") + (:method ((construct TopicC) (psi PersistentIdC) + &key (revision *TM-REVISION*)) + (let ((all-ids + (map 'list #'identifier + (remove-if #'marked-as-deleted-p + (slot-p construct 'psis))))) + (cond ((find psi all-ids) + (let ((psi-assoc (loop for psi-assoc in (slot-p construct 'psis) + when (eql (identifier psi-assoc) psi) + return psi-assoc))) + (add-to-version-history psi-assoc :start-revision revision))) + (all-ids + (merge-constructs (identified-construct (first all-ids) + :revision revision) + construct)) + (t + (make-construct 'PersistentIdAssociationC + :start-revision revision + :parent-construct construct + :identifier psi) + construct))))) + + +(defgeneric delete-psi (construct psi &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct TopicC) (psi PersistentIdC) + &key (revision (error "From delete-psi(): revision must be set"))) + (let ((assoc-to-delete (loop for psi-assoc in (slot-p construct 'psis) + when (eql (identifier psi-assoc) psi) + return psi-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defgeneric locators (construct &key revision) + (:documentation "Returns the SubjectLocatorC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'locators :start-revision revision))) + (map 'list #'identifier assocs)))) + + +(defgeneric add-locator (construct locator &key revision) + (:documentation "Adds the passed locator to the passed topic. + If the locator is already related with the passed + topic a new revision is added. + If the passed identifer already identifies another object + the identified-constructs are merged.") + (:method ((construct TopicC) (locator SubjectLocatorC) + &key (revision *TM-REVISION*)) + (let ((all-ids + (map 'list #'identifier + (remove-if #'marked-as-deleted-p + (slot-p construct 'locators))))) + (cond ((find locator all-ids) + (let ((loc-assoc (loop for loc-assoc in (slot-p construct 'locators) + when (eql (identifier loc-assoc) locator) + return loc-assoc))) + (add-to-version-history loc-assoc :start-revision revision))) + (all-ids + (merge-constructs (identified-construct (first all-ids) + :revision revision) + construct)) + (t + (make-construct 'SubjectLocatorAssociationC + :start-revision revision + :parent-construct construct + :identifier locator) + construct))))) + + +(defgeneric delete-locator (construct locator &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct TopicC) (locator SubjectLocatorC) + &key (revision (error "From delete-locator(): revision must be set"))) + (let ((assoc-to-delete (loop for loc-assoc in (slot-p construct 'locators) + when (eql (identifier loc-assoc) locator) + return loc-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defgeneric names (construct &key revision) + (:documentation "Returns the NameC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'names :start-revision revision))) + (map 'list #'characteristic assocs)))) + + +(defgeneric add-name (construct name &key revision) + (:documentation "Adds the passed name to the passed topic. + If the name is already related with the passed + topic a new revision is added. + If the passed name already owns another object + an error is thrown.") + (:method ((construct TopicC) (name NameC) + &key (revision *TM-REVISION*)) + (when (not (eql (parent name) construct)) + (error "From add-name(): ~a can't be owned by ~a since it is already owned by the topic ~a" + name construct (parent name))) + (let ((all-names + (map 'list #'characteristic + (remove-if #'marked-as-deleted-p + (slot-p construct 'names))))) + (if (find name all-names) + (let ((name-assoc (loop for name-assoc in (slot-p construct 'names) + 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)) + construct))) + + +(defgeneric delete-name (construct name &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct TopicC) (name NameC) + &key (revision (error "From delete-name(): revision must be set"))) + (let ((assoc-to-delete (loop for name-assoc in (slot-p construct 'names) + when (eql (parent-construct name-assoc) name) + return name-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defgeneric occurrences (construct &key revision) + (:documentation "Returns the OccurrenceC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'occurences :start-revision revision))) + (map 'list #'characteristic assocs)))) + + +(defgeneric add-occurrence (construct occurrence &key revision) + (:documentation "Adds the passed occurrence to the passed topic. + If the occurrence is already related with the passed + topic a new revision is added. + If the passed occurrence already owns another object + an error is thrown.") + (:method ((construct TopicC) (occurrence OccurrenceC) + &key (revision *TM-REVISION*)) + (when (not (eql (parent occurrence) construct)) + (error "From add-occurrence(): ~a can't be owned by ~a since it is already owned by the topic ~a" + occurrence construct (parent occurrence))) + (let ((all-occurrences + (map 'list #'characteristic + (remove-if #'marked-as-deleted-p + (slot-p construct 'occurrences))))) + (if (find occurrence all-occurrences) + (let ((occ-assoc (loop for occ-assoc in (slot-p construct 'occurrences) + 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)) + construct))) + + +(defgeneric delete-occurrence (construct occurrence &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct TopicC) (occurrence OccurrenceC) + &key (revision (error "From delete-occurrence(): revision must be set"))) + (let ((assoc-to-delete (loop for occ-assoc in (slot-p construct 'occurrences) + when (eql (parent-construct occ-assoc) occurrence) + return occ-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + +(defgeneric player-in-roles (construct &key revision) + (:documentation "Returns the RoleC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'player-in-roles :start-revision revision))) + (map 'list #'parent-construct assocs)))) + + +(defgeneric used-as-type (construct &key revision) + (:documentation "Returns the TypableC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'used-as-type :start-revision revision))) + (map 'list #'typable-construct assocs)))) + + +(defgeneric used-as-theme (construct &key revision) + (:documentation "Returns the ScopableC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'used-as-theme :start-revision revision))) + (map 'list #'scopable-construct assocs)))) + + +(defgeneric reified-construct (construct &key revision) + (:documentation "Returns the ReifiableConstructC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'reified-construct :start-revision revision))) + (map 'list #'reifiable-construct assocs)))) + + +(defgeneric in-topicmaps (construct &key revision) + (:documentation "Returns all TopicMapS-obejcts where the constrict is + contained in.")) + +(defmethod in-topicmaps ((topic TopicC) &key (revision *TM-REVISION*)) + (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision)) + + (defgeneric variants (construct &key revision) (:documentation "Returns all variants that correspond with the given revision and that are associated with the passed construct.") @@ -388,6 +789,9 @@ scopable-construct.") (:method ((construct ScopableC) (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" + variant construct (parent variant))) (let ((all-variants (map 'list #'characteristic (remove-if #'marked-as-deleted-p @@ -425,6 +829,12 @@ (delete-construct parent-assoc))) +(defmethod delete-construct :before ((construct NameC)) + "Deletes all association-obejcts." + (dolist (variant-assoc (slot-p construct 'variants)) + (delete-construct variant-assoc))) + + (defgeneric parent (construct &key revision) (:documentation "Returns the parent construct of the passed object that corresponds with the given revision. The returned construct @@ -434,10 +844,7 @@ (filter-slot-value-by-revision construct 'parent :start-revision revision))) (when valid-associations - (let ((valid-assoc (first valid-associations))) - (if (typep valid-assoc 'VariantAssociationC) - (name valid-assoc) - (topic valid-assoc))))))) + (parent-construct (first valid-associations)))))) (defgeneric add-parent (construct parent-construct &key revision) @@ -448,14 +855,15 @@ (defmethod add-parent ((construct CharacteristicC) (parent-construct TopicC) &key (revision *TM-REVISION*)) (let ((already-set-topic - (map 'list #'topic + (map 'list #'parent-construct (filter-slot-value-by-revision construct 'parent :start-revision revision)))) (cond ((and already-set-topic (eql (first already-set-topic) parent-construct)) (let ((parent-assoc (loop for parent-assoc in (slot-p construct 'parent) - when (eql parent-construct (topic parent-assoc)) + when (eql parent-construct (parent-construct + parent-assoc)) return parent-assoc))) (add-to-version-history parent-assoc :start-revision revision))) ((not already-set-topic) @@ -474,14 +882,14 @@ (defmethod add-parent ((construct CharacteristicC) (parent-construct NameC) &key (revision *TM-REVISION*)) (let ((already-set-name - (map 'list #'name + (map 'list #'characteristic (filter-slot-value-by-revision construct 'parent :start-revision revision)))) (cond ((and already-set-name (eql (first already-set-name) parent-construct)) (let ((parent-assoc (loop for parent-assoc in (slot-p construct 'parent) - when (eql parent-construct (name parent-assoc)) + when (eql parent-construct (characteristic parent-assoc)) return parent-assoc))) (add-to-version-history parent-assoc :start-revision revision))) ((not already-set-name) @@ -504,7 +912,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 (topic 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)) @@ -515,7 +923,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 (name parent-assoc) parent-construct) + when (eql (characteristic parent-assoc) parent-construct) return parent-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision revision)) @@ -993,81 +1401,6 @@ construct))) -;;; 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.") - (:method ((construct PointerC) &key (revision *TM-REVISION*)) - (let ((assocs - (map 'list #'parent-construct - (filter-slot-value-by-revision construct 'identified-construct - :start-revision revision)))) - (when assocs ;result must be nil or a list with one item - (first assocs))))) - - ;;; ReifiableConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass ReifiableConstructC(TopicMapConstructC) ((item-identifiers :associate (ItemIdAssociationC identified-construct)

1 0

[isidorus-cvs] r195 - in branches/new-datamodel: docs src/model
by Lukas Giessmann 17 Feb '10

17 Feb '10

Author: lgiessmann Date: Wed Feb 17 16:39:10 2010 New Revision: 195 Log: new-datamodel: updated the uml-schema; started to implement TopiC; implemented TopicMapC 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 16:39:10 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 16:39:10 2010 @@ -11,6 +11,7 @@ (:use :cl :elephant :constants) (:nicknames :d) (:export ;;classes + :TopicMapC :AssociationC :RoleC :OccurrenceC @@ -53,6 +54,8 @@ :roles :add-role :delete-role + :associations + :topics :mark-as-deleted :in-topicmaps @@ -72,31 +75,6 @@ ;; one revision-infos - -;;; start hacks -> just some temporary hacks 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 make-construct (class-symbol &key start-revision &allow-other-keys) - (:method ((class-symbol symbol) &key (start-revision *TM-REVISION*)) - (or class-symbol start-revision))) -;;; end hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - - - - - - ;;; globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar *TM-REVISION* 0) @@ -301,7 +279,62 @@ (setf (end-revision last-version) revision)))) -;;; Characterics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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.")) + + +;;; 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.")) + + +;;TODO: delete-construct, topic-identifiers, add-topic-identifier, +;; delete-topic-identifier, psis, add-psi, delete-psi, locators, +;; add-locator, delete-locator, names, add-name, delete-name, +;; occurrences, add-occurrence, delete-occurrence, player-in-roles +;; used-as-type, used-as-theme, reified-construct, in-topicmaps + (defpclass OccurrenceC(CharacteristicC) ((datatype :accessor datatype :initarg :datatype @@ -311,7 +344,7 @@ (defpclass NameC(CharacteristicC) - ((variants :associate (VariantAssociationC name) + ((variants :associate (VariantAssociationC parent-construct) :documentation "Associates this obejct with varian-associations.")) (:documentation "Scoped name of a topic.")) @@ -329,13 +362,13 @@ :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.")) + (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).")) @@ -368,7 +401,7 @@ (make-instance 'VariantAssociationC :start-revision revision :characteristic variant - :name construct))) + :parent-construct construct))) construct)) @@ -430,7 +463,7 @@ 'OccurrenceAssociationC 'NameAssociationC) :start-revision revision - :topic parent-construct + :parent-construct parent-construct :characteristic construct)) (t (error "From add-parent(): ~a can't be owned by ~a since it is already owned by the topic ~a" @@ -454,7 +487,7 @@ ((not already-set-name) (make-instance 'VariantAssociationC :start-revision revision - :name parent-construct + :parent-construct parent-construct :characteristic construct)) (t (error "From add-parent(): ~a can't be owned by ~a since it is already owned by the topic ~a" @@ -512,11 +545,11 @@ :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.")) + (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.")) @@ -524,7 +557,7 @@ (defmethod delete-construct :before ((construct PlayerAssociationC)) "Deletes all elephant-associations." (delete-1-n-association construct 'player-topic) - (delete-1-n-association construct 'role)) + (delete-1-n-association construct 'parent-construct)) (defpclass RoleAssociationC(VersionedAssociationC) @@ -536,7 +569,7 @@ (parent-construct :initarg :parent-construct :accessor parent-construct :associate AssociationC - :initform (error "From RoleAssociationC(): association must be set") + :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 @@ -554,45 +587,45 @@ (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.")) + ((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.")) (defmethod delete-construct :before ((construct VariantAssociationC)) - (delete-1-n-association construct 'name)) + (delete-1-n-association construct 'parent-construct)) (defpclass NameAssociationC(CharacteristicAssociationC) - ((topic :initarg :topic - :accessor topic - :initform (error "From NameAssociationC(): topic must be set") - :associate TopicC - :documentation "Associates this object with a topic.")) + ((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.")) (defmethod delete-construct :before ((construct NameAssociationC)) - (delete-1-n-association construct 'topic)) + (delete-1-n-association construct 'parent-construct)) (defpclass OccurrenceAssociationC(CharacteristicAssociationC) - ((topic :initarg :topic - :accessor topic - :initform (error "From OccurrenceAssociationC(): topic must be set") - :associate TopicC - :documentation "Associates this object with a topic.")) + ((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.")) (defmethod delete-construct :before ((construct OccurrenceAssociationC)) - (delete-1-n-association construct 'topic)) + (delete-1-n-association construct 'parent-construct)) (defpclass CharacteristicAssociationC(VersionedAssociationC) @@ -795,7 +828,7 @@ (defpclass RoleC(ReifiableConstructC TypableC) ((assocation :associate (RoleAssociationC role) :documentation "Associates this object with a role-association.") - (player :associate (PlayerAssociationC parent-role) + (player :associate (PlayerAssociationC parent-construct) :documentation "Associates this object with a player-association."))) @@ -938,7 +971,7 @@ ((not already-set-player) (make-instance 'PlayerAssociationC :start-revision revision - :role construct + :parent-construct 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" @@ -1037,13 +1070,11 @@ ;;; ReifiableConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass ReifiableConstructC(TopicMapConstructC) - ((item-identifiers :initarg :item-identifiers - :associate (ItemIdAssociationC identified-construct) + ((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) + (reifier :associate (ReifierAssociationC reified-construct) :inherit t :documentation "A relation to a reifier-topic.")) (:documentation "Reifiable constructs as per TMDM.")) @@ -1298,4 +1329,31 @@ return type-assoc))) (when assoc-to-delete (mark-as-deleted assoc-to-delete :revision revision)) - construct))) \ No newline at end of file + construct))) + + + + + + + + + + + + + + + + +;;; start hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(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 make-construct (class-symbol &key start-revision &allow-other-keys) + (:method ((class-symbol symbol) &key (start-revision *TM-REVISION*)) + (or class-symbol start-revision))) +;;; end hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; \ No newline at end of file

1 0

[isidorus-cvs] r194 - in branches/new-datamodel: docs src/model
by Lukas Giessmann 17 Feb '10

17 Feb '10

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

1 0

[isidorus-cvs] r193 - in branches/new-datamodel: docs src/model
by Lukas Giessmann 17 Feb '10

17 Feb '10

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)

1 0

[isidorus-cvs] r192 - branches/new-datamodel/src/model
by Lukas Giessmann 17 Feb '10

17 Feb '10

Author: lgiessmann Date: Wed Feb 17 07:04:15 2010 New Revision: 192 Log: new-datamodel: added the implementation of CharacteristiC 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 Wed Feb 17 07:04:15 2010 @@ -25,12 +25,18 @@ :item-identifiers :reifier :add-item-identifier + :delete-item-identifier :add-reifier + :delete-reifier :find-item-by-revision :themes :add-theme + :delete-theme :instance-of :add-type + :delete-type + :add-parent + :delete-parent :mark-as-deleted ;;globals @@ -39,6 +45,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: implement make-construct -> symbol @@ -52,6 +60,15 @@ ;;; start hacks -> just some temporary hacks to avoid compiler-errors ;;;;;;;;;; +(defpclass NameC (TopicMapConstructC) + () + (:documentation "A temporary emtpy class to avoid compiler-errors.")) + +(defpclass OccurrenceC (TopicMapConstructC) + () + (:documentation "A temporary emtpy class to avoid compiler-errors.")) + + (defpclass TopicC (TopicMapConstructC) () (:documentation "A temporary emtpy class to avoid compiler-errors.")) @@ -283,6 +300,126 @@ (setf (end-revision last-version) revision)))) +;;; Characterics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(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)) + (delete-construct parent-assoc))) + + +(defgeneric parent (construct &key revision) + (:documentation "Returns the parent construct of the passed object that + corresponds with the given revision. The returned construct + can be a TopicC or a NameC.") + (:method ((construct CharacteristicC) &key (revision *TM-REVISION*)) + (let ((valid-associations + (filter-slot-value-by-revision construct 'parent + :start-revision revision))) + (when valid-associations + (let ((valid-assoc (first valid-associations))) + (if (typep valid-assoc 'VariantAssociationC) + (name valid-assoc) + (topic valid-assoc))))))) + + +(defgeneric add-parent (construct parent-construct &key revision) + (:documentation "Adds the parent-construct (TopicC or NameC) in form of + a corresponding association to the given object.")) + + +(defmethod add-parent ((construct CharacteristicC) (parent-construct TopicC) + &key (revision *TM-REVISION*)) + (let ((already-set-topic + (map 'list #'topic + (filter-slot-value-by-revision construct 'parent + :start-revision revision)))) + (cond ((and already-set-topic + (eql (first already-set-topic) parent-construct)) + (let ((parent-assoc + (loop for parent-assoc in (slot-p construct 'parent) + when (eql parent-construct (topic parent-assoc)) + return parent-assoc))) + (add-to-version-history parent-assoc :start-revision revision))) + ((not already-set-topic) + (make-instance (if (typep construct 'OccurrenceC) + 'OccurrenceAssociationC + 'NameAssociationC) + :start-revision revision + :topic parent-construct + :characteristic construct)) + (t + (error "From add-parent(): ~a can't be owned by ~a since it is already owned by the topic ~a" + construct parent-construct already-set-topic))) + construct)) + + +(defmethod add-parent ((construct CharacteristicC) (parent-construct NameC) + &key (revision *TM-REVISION*)) + (let ((already-set-name + (map 'list #'name + (filter-slot-value-by-revision construct 'parent + :start-revision revision)))) + (cond ((and already-set-name + (eql (first already-set-name) parent-construct)) + (let ((parent-assoc + (loop for parent-assoc in (slot-p construct 'parent) + when (eql parent-construct (name parent-assoc)) + return parent-assoc))) + (add-to-version-history parent-assoc :start-revision revision))) + ((not already-set-name) + (make-instance 'VariantAssociationC + :start-revision revision + :name parent-construct + :characteristic construct)) + (t + (error "From add-parent(): ~a can't be owned by ~a since it is already owned by the topic ~a" + construct parent-construct already-set-name))) + construct)) + + +(defgeneric delete-parent (construct parent-construct &key revision) + (:documentation "Sets the assoication-object between the passed + constructs as marded-as-deleted.")) + + +(defmethod delete-parent ((construct CharacteristicC) (parent-construct TopicC) + &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 (topic parent-assoc) parent-construct) + return parent-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct)) + + +(defmethod delete-parent ((construct CharacteristicC) (parent-construct NameC) + &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 (name parent-assoc) parent-construct) + return parent-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct)) + + ;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; VariantAssociationC ;;; NameAssociationC @@ -691,6 +828,19 @@ construct))))) +(defgeneric delete-item-identifier (construct item-identifier &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC) + &key (revision (error "From delete-item-identifier(): revision must be set"))) + (let ((assoc-to-delete (loop for ii-assoc in (slot-p construct 'item-identifiers) + when (eql (identifier ii-assoc) item-identifier) + return ii-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + (defgeneric add-reifier (construct reifier-topic &key revision) (:documentation "Adds the passed reifier-topic as reifier of the construct. If the construct is already reified by the given topic @@ -723,6 +873,19 @@ construct)))))) +(defgeneric delete-reifier (construct reifier &key revision) + (:documentation "Sets the association object between the passed constructs + as mark-as-deleted.") + (:method ((construct ReifiableConstructC) (reifier TopicC) + &key (revision (error "From delete-reifier(): revision must be set"))) + (let ((assoc-to-delete (loop for reifier-assoc in (slot-p construct 'reifier) + when (eql (reifier-topic reifier-assoc) reifier) + return reifier-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + + ;;; TopicMapConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass TopicMapConstructC() () @@ -836,7 +999,7 @@ :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" + (error "From add-type(): ~a can't be typed by ~a since it is already typed by the topic ~a" construct type-topic already-set-type))) construct)))

1 0

[isidorus-cvs] r191 - in branches/new-datamodel: docs src/model
by Lukas Giessmann 16 Feb '10

16 Feb '10

Author: lgiessmann Date: Tue Feb 16 15:55:05 2010 New Revision: 191 Log: new-datamodel: fixed some name-problems with the UML-schema + implemented all CharacteristicCAssociationC-classes -> NameAssociationC, OccurrenceAssociationC, VariantAssociationC 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 Tue Feb 16 15:55:05 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 Tue Feb 16 15:55:05 2010 @@ -29,6 +29,8 @@ :find-item-by-revision :themes :add-theme + :instance-of + :add-type :mark-as-deleted ;;globals @@ -282,6 +284,10 @@ ;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; VariantAssociationC +;;; NameAssociationC +;;; OccurrenceAssociationC +;;; CharacteristicAssociationC ;;; TypeAssociationC ;;; ScopeAssociationC ;;; ReifierAssociationC @@ -291,6 +297,72 @@ ;;; ItemIdAssociationC ;;; PointerAssociationC ;;; VersionedAssociationC +(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.")) + + +(defmethod delete-construct :before ((construct VariantAssociationC)) + (delete-1-n-association construct 'name)) + + +(defpclass NameAssociationC(CharacteristicAssociationC) + ((topic :initarg :topic + :accessor topic + :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.")) + + +(defmethod delete-construct :before ((construct NameAssociationC)) + (delete-1-n-association construct 'topic)) + + +(defpclass OccurrenceAssociationC(CharacteristicAssociationC) + ((topic :initarg :topic + :accessor topic + :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.")) + + +(defmethod delete-construct :before ((construct OccurrenceAssociationC)) + (delete-1-n-association construct 'topic)) + + +(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.")) + + +(defmethod delete-construct :before ((construct CharacteristicAssociationC)) + "Deletes all elephant-associations." + (let ((characteristic (characteristic construct))) + (delete-1-n-association construct 'characteristic) + (when (and characteristic + (not (slot-p characteristic 'parent))) + (delete-construct characteristic)))) + + (defpclass TypeAssociationC(VersionedAssociationC) ((type-topic :initarg :type-topic :accessor type-topic

1 0

[isidorus-cvs] r190 - in branches/new-datamodel: docs src/model
by Lukas Giessmann 16 Feb '10

16 Feb '10

Author: lgiessmann Date: Tue Feb 16 09:16:32 2010 New Revision: 190 Log: new-datamodel: updated the UML-Schema -> TypeAssoicationC, ScopeAssociationC, PlayerAssociationC 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 Tue Feb 16 09:16:32 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 Tue Feb 16 09:16:32 2010 @@ -37,8 +37,6 @@ (in-package :datamodel) -;;TODO: extend the UML-schema -> ScopeAssociationC + TypeAssociationC -;; + PlayerAssociationC ;;TODO: implement all-reified-constructs (:with-deleted t) -> TopicC ;; the method should return all reifed-constructs of the given topic ;;TODO: implement make-construct -> symbol

1 0

[isidorus-cvs] r189 - branches/new-datamodel/src/model
by Lukas Giessmann 16 Feb '10

16 Feb '10

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

1 0

[isidorus-cvs] r188 - branches/new-datamodel/src/model
by Lukas Giessmann 16 Feb '10

16 Feb '10

Author: lgiessmann Date: Tue Feb 16 05:55:20 2010 New Revision: 188 Log: new-datamodel: implemented ScopableC, ScopeAssociationC and TypeAssociationC Modified: branches/new-datamodel/src/model/changes.lisp branches/new-datamodel/src/model/datamodel.lisp Modified: branches/new-datamodel/src/model/changes.lisp ============================================================================== --- branches/new-datamodel/src/model/changes.lisp (original) +++ branches/new-datamodel/src/model/changes.lisp Tue Feb 16 05:55:20 2010 @@ -1,4 +1,4 @@ -;;+----------------------------------------------------------------------------- +#;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann ;;+ @@ -208,49 +208,49 @@ 'unique-id unique-id)) -(defgeneric mark-as-deleted (construct &key source-locator revision) - (:documentation "Mark a construct as deleted if it comes from the source indicated by -source-locator")) - -(defmethod mark-as-deleted ((construct TopicMapConstructC) &key source-locator revision) - "Mark a topic as deleted if it comes from the source indicated by -source-locator" - (declare (ignorable source-locator)) - (let - ((last-version ;the last active version - (find 0 (versions construct) :key #'end-revision))) - (when last-version - (setf (end-revision last-version) revision)))) - -(defmethod mark-as-deleted :around ((ass AssociationC) &key source-locator revision) - "Mark an association and its roles as deleted" - (mapc (lambda (role) (mark-as-deleted role :revision revision :source-locator source-locator)) - (roles ass)) - (call-next-method)) - -(defmethod mark-as-deleted :around ((top TopicC) &key source-locator revision) - "Mark a topic as deleted if it comes from the source indicated by -source-locator" - ;;Part 1b, 1.4.3.3.1: - ;; Let SP be the value of the ServerSourceLocatorPrefix element in the ATOM feed F - ;; * Let SI be the value of TopicSI element in ATOM entry E - ;; * feed F contains E - ;; * entry E references topic fragment TF - ;; * Let LTM be the local topic map - ;; * Let T be the topic in LTM that has a subjectidentifier that matches SI - ;; * For all names, occurrences and associations in which T plays a role, TMC - ;; * Delete all SrcLocators of TMC that begin with SP. If the count of srclocators on TMC = 0 then delete TMC - ;; * Merge in the fragment TF using SP as the base all generated source locators. - - (when - (some (lambda (psi) (string-starts-with (uri psi) source-locator)) (psis top)) - (mapc (lambda (name) (mark-as-deleted name :revision revision :source-locator source-locator)) - (names top)) - (mapc (lambda (occ) (mark-as-deleted occ :revision revision :source-locator source-locator)) - (occurrences top)) - (mapc (lambda (ass) (mark-as-deleted ass :revision revision :source-locator source-locator)) - (find-associations-for-topic top)) - (call-next-method))) +;(defgeneric mark-as-deleted (construct &key source-locator revision) +; (:documentation "Mark a construct as deleted if it comes from the source indicated by +;source-locator")) + +;(defmethod mark-as-deleted ((construct TopicMapConstructC) &key source-locator revision) +; "Mark a topic as deleted if it comes from the source indicated by +;source-locator" +; (declare (ignorable source-locator)) +; (let +; ((last-version ;the last active version +; (find 0 (versions construct) :key #'end-revision))) +; (when last-version +; (setf (end-revision last-version) revision)))) +; +;(defmethod mark-as-deleted :around ((ass AssociationC) &key source-locator revision) +; "Mark an association and its roles as deleted" +; (mapc (lambda (role) (mark-as-deleted role :revision revision :source-locator source-locator)) +; (roles ass)) +; (call-next-method)) +; +;(defmethod mark-as-deleted :around ((top TopicC) &key source-locator revision) +; "Mark a topic as deleted if it comes from the source indicated by +;source-locator" +; ;;Part 1b, 1.4.3.3.1: +; ;; Let SP be the value of the ServerSourceLocatorPrefix element in the ATOM feed F +; ;; * Let SI be the value of TopicSI element in ATOM entry E +; ;; * feed F contains E +; ;; * entry E references topic fragment TF +; ;; * Let LTM be the local topic map +; ;; * Let T be the topic in LTM that has a subjectidentifier that matches SI +; ;; * For all names, occurrences and associations in which T plays a role, TMC +; ;; * Delete all SrcLocators of TMC that begin with SP. If the count of srclocators on TMC = 0 then delete TMC +; ;; * Merge in the fragment TF using SP as the base all generated source locators. +; +; (when +; (some (lambda (psi) (string-starts-with (uri psi) source-locator)) (psis top)) +; (mapc (lambda (name) (mark-as-deleted name :revision revision :source-locator source-locator)) +; (names top)) +; (mapc (lambda (occ) (mark-as-deleted occ :revision revision :source-locator source-locator)) +; (occurrences top)) +; (mapc (lambda (ass) (mark-as-deleted ass :revision revision :source-locator source-locator)) +; (find-associations-for-topic top)) +; (call-next-method))) (defgeneric add-source-locator (construct &key source-locator revision) (:documentation "adds an item identifier to a given construct based on the source 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 05:55:20 2010 @@ -27,6 +27,9 @@ :add-item-identifier :add-reifier :find-item-by-revision + :themes + :add-theme + :mark-as-deleted ;;globals :*TM-REVISION*)) @@ -34,7 +37,8 @@ (in-package :datamodel) - +;;TODO: extend the UML-schema -> ScopeAssociationC + TypeAssociationC +;; + PlayerAssociationC ;;TODO: implement all-reified-constructs (:with-deleted t) -> TopicC ;; the method should return all reifed-constructs of the given topic ;;TODO: implement make-construct -> symbol @@ -46,6 +50,7 @@ ;; one revision-infos + ;;; start hacks -> just some temporary hacks to avoid compiler-errors ;;;;;;;;;; (defpclass TopicC (TopicMapConstructC) () @@ -74,10 +79,6 @@ - - - - ;;; globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar *TM-REVISION* 0) @@ -264,7 +265,26 @@ t))) +(defgeneric mark-as-deleted (construct &key source-locator revision) + (:documentation "Mark a construct as deleted if it comes from the source + indicated by source-locator")) + + +(defmethod mark-as-deleted ((construct VersionedConstructC) + &key source-locator revision) + "Mark a topic as deleted if it comes from the source indicated by + source-locator" + (declare (ignorable source-locator)) + (let + ((last-version ;the last active version + (find 0 (versions construct) :key #'end-revision))) + (when last-version + (setf (end-revision last-version) revision)))) + + ;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; TypeAssociationC +;;; ScopeAssociationC ;;; ReifierAssociationC ;;; SubjectLocatorAssociationC ;;; PersistentIdAssociationC @@ -272,6 +292,58 @@ ;;; ItemIdAssociationC ;;; PointerAssociationC ;;; VersionedAssociationC +(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.")) + (:index t) + (:documentation "This class associates topics that are used as type for + typable constructcs. Additionally there are stored some + version-infos.")) + + +(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.")) + (:index t) + (:documentation "This class associates topics that are used as scope with + scopable construtcs. Additionally there are stored some + version-infos")) + + +(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 @@ -583,7 +655,62 @@ ;;; ScopableC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;TODO: implement a ScopeAssociationC-class -> extend the uml schema +(defpclass ScopableC() + ((themes :initarg :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.")) + + +(defmethod delete-construct :before ((construct ScopableC)) + "Deletes all ScopeAssociationCs that are associated with the given object." + (dolist (theme (themes construct)) + (delete-construct theme))) + + +(defgeneric themes (construct) + (:documentation "Returns all topics that are not marked as deleted and are + as a scope for the given topic.") + (:method ((construct ScopableC)) + (let ((valid-associations + (remove-if-not #'marked-as-deleted-p (slot-p construct 'themes)))) + (map 'list #'theme-topic valid-associations)))) + + +(defgeneric add-theme (construct theme-topic &key revision) + (:documentation "Adds the given theme-topic to the passed + scopable-construct.") + (:method ((construct ScopableC) (theme-topic TopicC) + &key (revision *TM-REVISION*)) + (let ((all-themes (themes construct))) + (if (find theme-topic all-themes) + (let ((theme-assoc + (loop for theme-assoc in (slot-p construct 'themes) + when (eql (theme-topic theme-assoc) theme-topic) + return theme-assoc))) + (add-to-version-history theme-assoc :start-revision revision)) + (make-instance 'ScopeAssociationC + :start-revision revision + :theme-topic theme-topic + :scopable-construct construct))) + construct)) + + +(defgeneric delete-theme (construct theme-topic &key revision) + (:documentation "Deletes the passed theme by marking it's association as + deleted in the passed revision.") + (:method ((construct ScopableC) (theme-topic TopicC) + &key (revision (error "From delete-theme(): revision must be set"))) + (let ((assoc-to-delete (loop for theme-assoc in (slot-p construct 'themes) + when (eql (theme-topic theme-assoc) theme-topic) + return theme-assoc))) + (when assoc-to-delete + (mark-as-deleted assoc-to-delete :revision revision)) + construct))) + ;;; TypableC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;TODO: implement a TypeAssociationC-class -> extend the uml schema \ No newline at end of file +;;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

1 0