[isidorus-cvs] r193 - in branches/new-datamodel: docs src/model

Lukas Giessmann lgiessmann at common-lisp.net
Wed Feb 17 18:59:30 UTC 2010


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)




More information about the Isidorus-cvs mailing list