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

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Apr  6 15:56:27 2010
New Revision: 266

Log:
new-datamodel: added "merge-constructs" --> "AssociationC"

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 Apr  6 15:56:27 2010
@@ -3607,7 +3607,34 @@
 	  older-tm))))
 
 
-
+(defmethod merge-constructs ((construct-1 AssociationC) (construct-2 AssociationC)
+			     &key revision)
+  (declare (integer revision))
+  (if (eql construct-1 construct-2)
+      construct-1
+      (let ((older-assoc (find-oldest-construct construct-1 construct-2)))
+	(let ((newer-assoc (if (eql older-assoc construct-1)
+			       construct-2
+			       construct-1)))
+	  (unless (strictly-equivalent-constructs construct-1 construct-2
+						  :revision revision)
+	    (error "From merge-constructs(): ~a and ~a are not mergable"
+		   construct-1 construct-2))
+	  (move-referenced-constructs newer-assoc older-assoc)
+	  (dolist (newer-role (roles newer-assoc :revision revision))
+	    (let ((equivalent-role
+		   (find-if #'(lambda(older-role)
+				(strictly-equivalent-constructs
+				 older-role newer-role :revision revision))
+			    (roles older-assoc :revision revision))))
+	      (move-referenced-constructs newer-role equivalent-role
+					  :revision revision)
+	      (delete-role newer-assoc newer-role :revision revision)
+	      (add-role older-assoc equivalent-role :revision revision)))
+	  (mark-as-deleted newer-assoc :revision revision)
+	  (when (exist-in-revision-history-? newer-assoc)
+	    (delete-construct newer-assoc))
+	  older-assoc))))
 
 ;TODO: merge-constructs: RoleC (merge parents), AssociationC