Author: lgiessmann Date: Fri Feb 12 16:11:54 2010 New Revision: 184 Log: new-datamodel: added all PointerC-classes and all PointerAssociationC-classes 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 Fri Feb 12 16:11:54 2010 @@ -13,12 +13,17 @@ (in-package :datamodel) +;;; globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar *TM-REVISION* 0) + ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun slot-p (instance slot-symbol) "Returns t if the slot depending on slot-symbol is bound and not nil." - (and (slot-boundp instance slot-symbol) - (slot-value instance slot-symbol))) + (when (slot-boundp instance slot-symbol) + (let ((value (slot-value instance slot-symbol))) + (when value + value)))) (defun delete-1-n-association(instance slot-symbol) @@ -144,57 +149,110 @@ :versioned-construct construct))))))) +(defgeneric marked-as-deleted-p (construct) + (:documentation "Returns t if the construct was marked-as-deleted.") + (:method ((construct VersionedConstructC)) + (if (find-if #'(lambda(vi) + (= (end-revision vi) 0)) + (versions construct)) + nil + t))) + + ;;; Versioned-Associations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ReifierAssociationC ;;; SubjectLocatorAssociationC ;;; PersistentIdAssociationC ;;; TopicIdAssociationC ;;; ItemIdAssociationC ;;; PointerAssociationC ;;; VersionedAssociationC +(defpclass ReifierAssociationC(VersionedAssociationC) + ((reifiable-construct :initarg :reifiable-construct + :accessor reifiable-construct + :associate ReifiableConstructC + :documentation "The actual construct which is reified + by a topic.") + (reifier-topic :initarg :reifier-topic + :accessor reifier-topic + :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.")) + + +(defmethod delete-construct :before ((construct ReifierAssociationC)) + "Deletes the association-construct and the reifier-topic when it + is not used as a reifier of another construct." + (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) + (delete-construct reifier-top)))) + + (defpclass SubjectLocatorAssociationC(PointerAssociationC) - ((identified-construct :initarg :identified-construct - :accessor identified-construct - :associate TopicC - :documentation "The actual topic which is associated - with the subject-locator.")) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :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.")) +(defmethod delete-construct :before ((construct SubjectLocatorAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + (defpclass PersistentIdAssociationC(PointerAssociationC) - ((identified-construct :initarg :identified-construct - :accessor identified-construct - :associate TopicC - :documentation "The actual topic which is associated - with the subject-identifier/psi.")) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :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.")) +(defmethod delete-construct :before ((construct PersistentIdAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + (defpclass TopicIdAssociationC(PointerAssociationC) - ((identified-construct :initarg :identified-construct - :accessor identified-construct - :associate TopicC - :documentation "The actual topic which is associated - with the topic-identifier.")) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :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.")) +(defmethod delete-construct :before ((construct TopicIdAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + (defpclass ItemIdAssociationC(PointerAssociationC) - ((identified-construct :initarg :identified-construct - :accessor identified-construct - :associate ReifiableConstructC - :documentation "The actual parent which is associated - with the item-identifier.")) + ((parent-construct :initarg :parent-construct + :accessor parent-construct + :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.")) +(defmethod delete-construct :before ((construct ItemIdAssociationC)) + (delete-1-n-association construct 'parent-construct)) + + (defpclass PointerAssociationC (VersionedAssociationC) ((identifier :initarg :identifier :accessor identifier @@ -205,6 +263,15 @@ pointer-associations.")) +(defmethod delete-construct :before ((construct PointerAssociationC)) + "Deletes the association-construct and the pointer if it is not used + 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) + (delete-construct id)))) + + (defpclass VersionedAssociationC() () (:documentation "An abstract base class for all versioned associations.")) @@ -267,11 +334,34 @@ :index t :documentation "The actual value of a pointer, i.e. uri or ID.") (identified-construct :initarg :identified-construct - :accessor identified-construct :associate (PointerAssociationC identifier))) (:documentation "An abstract base class for all pointers.")) +(defgeneric identified-construct (construct &key revision) + (:documentation "Returns the identified-construct -> ReifiableConstructC or + TopicC that corresponds with the passed revision.") + (:method ((construct PointerC) &key (revision *TM-REVISION*)) + (let ((results + (map 'list #'parent-construct + (filter-slot-value-by-revision construct 'identified-construct + :start-revision revision)))) + (when results ;result must be nil or a list with one item + (first results))))) + + +(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 @@ -284,9 +374,63 @@ (:documentation "Reifiable constructs as per TMDM.")) -;;TODO: implement reader for item-identifiers and reifier (version) -;;TODO: implement add-item-identifier and add-reifier (version) +(defgeneric item-identifiers (construct &key revision) + (:documentation "Returns the ItemIdentifierC-objects that correspond + with the passed construct and the passed version.") + (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'item-identifiers :start-revision revision))) + (map 'list #'identifier assocs)))) + + +(defgeneric reifier (construct &key revision) + (:documentation "Returns the reifier-topic that corresponds + with the passed construct and the passed version.") + (:method ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) + (let ((assocs (filter-slot-value-by-revision + construct 'item-identifiers :start-revision revision))) + (when assocs ;assocs must be nil or a list with exactly one item + (reifier (first assocs)))))) + + +(defmethod delete-construct :before ((construct ReifiableConstructC)) + "Deletes the passed construct its item-identifiers and its + reifiers. An item-identifier and a reifeir is only deleted + when these constructs are not referenced by other parent-objects." + (dolist (item-identifier (slot-p construct 'item-identifiers)) + (delete-construct item-identifier)) + (dolist (reifier-top (slot-p construct 'reifier)) + (delete-construct reifier-top))) + + +(defgeneric add-item-identifier (construct item-identifier &key revision) + (:documentation "Adds the passed item-identifier to the passed construct. + If the item-identifier is already related with the passed + construct a new revision is added.") + (: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))) + (all-constructs + (merge-constructs (first all-constructs) (second all-constructs))) + (t + (make-construct 'ItemIdAssociationC + :start-revision revision + :parent-construct construct + :identifier item-identifier)))) + item-identifier)) + +;;TODO: implement add-reifier (version) +;;TODO: implement make-construct (symbol) +;;TODO: implement merge-construct ;;; TopicMapConstructC ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpclass TopicMapConstructC()