[isidorus-cvs] r188 - branches/new-datamodel/src/model

Lukas Giessmann lgiessmann at common-lisp.net
Tue Feb 16 10:55:20 UTC 2010


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




More information about the Isidorus-cvs mailing list