[isidorus-cvs] r194 - in branches/new-datamodel: docs src/model
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Feb 17 19:55:30 UTC 2010
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
More information about the Isidorus-cvs
mailing list