Changeset 193 for branches/new-datamodel/src/model

Timestamp:

02/17/10 18:59:30 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: fixed some problems; removed some unnecessary functions; implemented RoleC, PlayerAssociationC, RoleAssociationC; updated the UML-schema

File:

• branches/new-datamodel/src/model/datamodel.lisp (modified) (25 diffs)

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -12 +12 @@
   (:nicknames :d)
   (:export ;;classes
+           :RoleC
+           :OccurrenceC
+           :NameC
+           :VariantC
            :PersistentIdC
            :ItemIdentifierC
@@ -22 +26 @@
            :uri
            :identifieid-construct
-           :all-identified-constructs
            :item-identifiers
            :reifier
@@ -38 +41 @@
            :add-parent
            :delete-parent
+           :variants
+           :add-variant
+           :delete-variant
+           :parent
+           :add-parent
+           :delete-parent
+           :player
+           :add-player
+           :delete-player
            :mark-as-deleted
 
@@ -45 +57 @@
 (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
@@ -61 +70 @@
 
 ;;; 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."))
+
+(defpclass AssociationC (TopicMapConstructC)
+  ()
+  (:documentation "A temporary emtpy class to avoid compiler-errors."))
+
 
 (defgeneric merge-constructs(construc-1 construct-2 &key revision)
@@ -78 +83 @@
             &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)))
 
 
@@ -302 +302 @@
 
 ;;; 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)
@@ -422 +490 @@
 
 ;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; PlayerAssociationC
+;;; RoleAssociationC
 ;;; VariantAssociationC
 ;;; NameAssociationC
@@ -435 +505 @@
 ;;; 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
@@ -441 +558 @@
          :associate NameC
          :documentation "Associates this object with a name."))
-  (:index t)
   (:documentation "Associates variant objects with name obejcts.
                    Additionally version-infos are stored."))
@@ -456 +572 @@
           :associate TopicC
           :documentation "Associates this object with a topic."))
-  (:index t)
   (:documentation "Associates name objects with their parent topics.
                    Additionally version-infos are stored."))
@@ -471 +586 @@
           :associate TopicC
           :documentation "Associates this object with a topic."))
-  (:index t)
   (:documentation "Associates occurrence objects with their parent topics.
                    Additionally version-infos are stored."))
@@ -515 +629 @@
                                       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
@@ -541 +654 @@
                                        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
@@ -566 +678 @@
                   :documentation "The reifier-topic that reifies the
                                   reifiable-construct."))
-  (:index t)
   (:documentation "A versioned-association that relates a reifiable-construct
                    with a topic."))
@@ -588 +699 @@
                      :documentation "The actual topic which is associated
                                      with the subject-locator."))
-  (:index t)
   (:documentation "A pointer that associates subject-locators, versions
                    and topics."))
@@ -604 +714 @@
                      :documentation "The actual topic which is associated
                                      with the subject-identifier/psi."))
-  (:index t)
   (:documentation "A pointer that associates subject-identifiers, versions
                    and topics."))
@@ -620 +729 @@
                      :documentation "The actual topic which is associated
                                      with the topic-identifier."))
-  (:index t)
   (:documentation "A pointer that associates topic-identifiers, versions
                    and topics."))
@@ -636 +744 @@
                      :documentation "The actual parent which is associated
                                      with the item-identifier."))
-  (:index t)
   (:documentation "A pointer that associates item-identifiers, versions
                    and reifiable-constructs."))
@@ -662 +769 @@
   (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))))
 
@@ -669 +776 @@
   ()
   (: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)))
 
 
@@ -746 +966 @@
 
 
-(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)
@@ -809 +1017 @@
   (: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
@@ -910 +1120 @@
 
 (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*))
@@ -924 +1134 @@
   (: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