[isidorus-cvs] r200 - branches/new-datamodel/src/model
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Feb 22 19:05:08 UTC 2010
Author: lgiessmann
Date: Mon Feb 22 14:05:06 2010
New Revision: 200
Log:
new-datamode: fixed a problem with elephant-associaitons in the 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 Mon Feb 22 14:05:06 2010
@@ -144,29 +144,56 @@
class.")))
-;;; pointers ...
-(defpclass SubjectLocatorC(IdentifierC)
+;;; base classes ...
+(defpclass TopicMapConstructC()
()
- (:index t)
- (:documentation "A subject-locator that contains an uri-value and an
- association to SubjectLocatorAssociationC's which are in
- turn associated with TopicC's."))
+ (:documentation "An abstract base class for all classes that describes
+ Topic Maps data."))
-(defpclass PersistentIdC(IdentifierC)
- ()
- (:index t)
- (:documentation "A subject-identifier that contains an uri-value and an
- association to PersistentIdAssociationC's which are in
- turn associated with TopicC's."))
+(defpclass ScopableC()
+ ((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."))
-(defpclass ItemIdentifierC(IdentifierC)
- ()
+(defpclass TypableC()
+ ((instance-of :associate (TypeAssociationC type-topic)
+ :inherit t
+ :documentation "Contains all association-objects that contain
+ the actual type-topic."))
+ (:documentation "An abstract base class for all typed constructcs."))
+
+
+(defpclass DatatypableC()
+ ((datatype :accessor datatype
+ :initarg :datatype
+ :initform constants:*xml-string*
+ :type string
+ :documentation "The XML Schema datatype of the occurrencevalue
+ (optional, always IRI for resourceRef)."))
(:index t)
- (:documentation "An item-identifier that contains an uri-value and an
- association to ItemIdAssociationC's which are in turn
- associated with RiefiableConstructC's."))
+ (:documentation "An abstract base class for characteristics that own
+ an xml-datatype."))
+
+
+;;; pointers ...
+(defpclass PointerC(TopicMapConstructC)
+ ((uri :initarg :uri
+ :accessor uri
+ :inherit t
+ :type string
+ :initform (error "From PointerC(): uri must be set for a pointer")
+ :index t
+ :documentation "The actual value of a pointer, i.e. uri or ID.")
+ (identified-construct :associate (PointerAssociationC identifier)
+ :inherit t
+ :documentation "Associates a association-object that
+ additionally stores some
+ version-infos."))
+ (:documentation "An abstract base class for all pointers."))
(defpclass IdentifierC(PointerC)
@@ -187,23 +214,42 @@
representing one of them."))
-(defpclass PointerC(TopicMapConstructC)
- ((uri :initarg :uri
- :accessor uri
- ;:inherit t
- :type string
- :initform (error "From PointerC(): uri must be set for a pointer")
- :index t
- :documentation "The actual value of a pointer, i.e. uri or ID.")
- (identified-construct :associate (PointerAssociationC identifier)
- :inherit t
- :documentation "Associates a association-object that
- additionally stores some
- version-infos."))
- (:documentation "An abstract base class for all pointers."))
+(defpclass SubjectLocatorC(IdentifierC)
+ ()
+ (:index t)
+ (:documentation "A subject-locator that contains an uri-value and an
+ association to SubjectLocatorAssociationC's which are in
+ turn associated with TopicC's."))
+
+
+(defpclass PersistentIdC(IdentifierC)
+ ()
+ (:index t)
+ (:documentation "A subject-identifier that contains an uri-value and an
+ association to PersistentIdAssociationC's which are in
+ turn associated with TopicC's."))
+
+
+(defpclass ItemIdentifierC(IdentifierC)
+ ()
+ (:index t)
+ (:documentation "An item-identifier that contains an uri-value and an
+ association to ItemIdAssociationC's which are in turn
+ associated with RiefiableConstructC's."))
;;; reifiables ...
+(defpclass ReifiableConstructC(TopicMapConstructC)
+ ((item-identifiers :associate (ItemIdAssociationC parent-construct)
+ :inherit t
+ :documentation "A relation to all item-identifiers of
+ this construct.")
+ (reifier :associate (ReifierAssociationC reified-construct)
+ :inherit t
+ :documentation "A relation to a reifier-topic."))
+ (:documentation "Reifiable constructs as per TMDM."))
+
+
(defpclass AssociationC(ReifiableConstructC ScopableC TypableC)
((roles :associate (RoleAssociationC association)
:documentation "Contains all association-objects of all roles this
@@ -223,17 +269,6 @@
:documentation "Associates this object with a player-association.")))
-(defpclass ReifiableConstructC(TopicMapConstructC)
- ((item-identifiers :associate (ItemIdAssociationC parent-construct)
- :inherit t
- :documentation "A relation to all item-identifiers of
- this construct.")
- (reifier :associate (ReifierAssociationC reified-construct)
- :inherit t
- :documentation "A relation to a reifier-topic."))
- (:documentation "Reifiable constructs as per TMDM."))
-
-
(elephant:defpclass TopicMapC (ReifiableConstructC)
((topics :accessor topics
:associate (TopicC in-topicmaps)
@@ -284,6 +319,22 @@
;;; characteristics ...
+(defpclass CharacteristicC(ReifiableConstructC ScopableC TypableC)
+ ((parent :associate (CharacteriticAssociationC characteristic)
+ :inherit t
+ :documentation "Assocates the characterist obejct with the
+ parent-association.")
+ (charvalue :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)."))
+
+
(defpclass OccurrenceC(CharacteristicC DatatypableC)
()
(:documentation "Represents a TM occurrence."))
@@ -300,23 +351,12 @@
(:documentation "Represents a TM variant."))
-(defpclass CharacteristicC(ReifiableConstructC ScopableC TypableC)
- ((parent :associate (CharacteriticAssociationC characteristic)
- :inherit t
- :documentation "Assocates the characterist obejct with the
- parent-association.")
- (charvalue :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)."))
+;;; versioned associations ...
+(defpclass VersionedAssociationC(VersionedConstructC)
+ ()
+ (:documentation "An abstract base class for all versioned associations."))
-;;; versioned associations ...
(defpclass TypeAssociationC(VersionedAssociationC)
((type-topic :initarg :type-topic
:accessor type-topic
@@ -372,13 +412,19 @@
with a topic."))
-(defpclass VersionedAssociationC(VersionedConstructC)
- ()
- (:documentation "An abstract base class for all versioned associations."))
-
+;;; pointer associations ...
+(defpclass PointerAssociationC (VersionedAssociationC)
+ ((identifier :initarg :identifier
+ :accessor identifier
+ :inherit t
+ :initform (error "From PointerAssociationC(): identifier must be set")
+ :associate PointerC
+ :documentation "The actual data that is associated with
+ the pointer-association's parent."))
+ (:documentation "An abstract base class for all versioned
+ pointer-associations."))
-;;; pointer associations ...
(defpclass SubjectLocatorAssociationC(PointerAssociationC)
((parent-construct :initarg :parent-construct
:accessor parent-construct
@@ -423,19 +469,19 @@
and reifiable-constructs."))
-(defpclass PointerAssociationC (VersionedAssociationC)
- ((identifier :initarg :identifier
- :accessor identifier
- ;:inherit t
- :initform (error "From PointerAssociationC(): identifier must be set")
- :associate PointerC
- :documentation "The actual data that is associated with
- the pointer-association's parent."))
- (:documentation "An abstract base class for all versioned
- pointer-associations."))
+;;; characteristic associations ...
+(defpclass CharacteristicAssociationC(VersionedAssociationC)
+ ((characteristic :initarg :characteristic
+ :accessor characteristic
+ :inherit t
+ :initform (error "From CharacteristicCAssociation(): characteristic must be set")
+ :associate CharactersiticC
+ :documentation "Associates this object with the actual
+ characteristic object."))
+ (:documentation "An abstract base class for all association-objects that
+ associates characteristics with topics."))
-;;; characteristic associations ...
(defpclass VariantAssociationC(CharateristicAssociationC)
((parent-construct :initarg :parent-construct
:accessor parent-construct
@@ -466,18 +512,6 @@
Additionally version-infos are stored."))
-(defpclass CharacteristicAssociationC(VersionedAssociationC)
- ((characteristic :initarg :characteristic
- :accessor characteristic
- ;:inherit t
- :initform (error "From CharacteristicCAssociation(): characteristic must be set")
- :associate CharactersiticC
- :documentation "Associates this object with the actual
- characteristic object."))
- (:documentation "An abstract base class for all association-objects that
- associates characteristics with topics."))
-
-
;;; roles/association associations ...
(defpclass PlayerAssociationC(VersionedAssociationC)
((player-topic :initarg :player-topic
@@ -511,48 +545,19 @@
version-infos between these realtions."))
-;;; base classes ...
-(defpclass TopicMapConstructC()
- ()
- (:documentation "An abstract base class for all classes that describes
- Topic Maps data."))
-
-
-(defpclass ScopableC()
- ((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."))
-
-
-(defpclass TypableC()
- ((instance-of :associate (TypeAssociationC type-topic)
- :inherit t
- :documentation "Contains all association-objects that contain
- the actual type-topic."))
- (:documentation "An abstract base class for all typed constructcs."))
-
-
-(defpclass DatatypableC()
- ((datatype :accessor datatype
- :initarg :datatype
- :initform constants:*xml-string*
- :type string
- :documentation "The XML Schema datatype of the occurrencevalue
- (optional, always IRI for resourceRef)."))
- (:index t)
- (:documentation "An abstract base class for characteristics that own
- an xml-datatype."))
-
-
;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun slot-p (instance slot-symbol)
"Returns t if the slot depending on slot-symbol is bound and not nil."
- (when (slot-boundp instance slot-symbol)
- (let ((value (slot-value instance slot-symbol)))
- (when value
- value))))
+ (if (slot-boundp instance slot-symbol)
+ (let ((value (slot-value instance slot-symbol)))
+ (when value
+ value))
+ ;elephant-relations are handled separately, since slot-boundp does not
+ ;here
+ (handler-case (let ((value (slot-value instance slot-symbol)))
+ (when value
+ value))
+ (error () nil))))
(defun delete-1-n-association(instance slot-symbol)
@@ -1517,10 +1522,11 @@
:revision revision)
construct))
(t
- (make-instance 'ItemIdAssociationC
- :start-revision revision
- :parent-construct construct
- :identifier item-identifier)))
+ (let ((assoc
+ (make-instance 'ItemIdAssociationC
+ :parent-construct construct
+ :identifier item-identifier)))
+ (add-to-version-history assoc :start-revision revision))))
construct)))
More information about the Isidorus-cvs
mailing list