[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