- isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[isidorus-cvs] r244 - in branches/new-datamodel/src: model unit_tests
by Lukas Giessmann 22 Mar '10

22 Mar '10

Author: lgiessmann Date: Mon Mar 22 09:04:20 2010 New Revision: 244 Log: new-datamodel: add "find-item-by-revision" to classes that are non-VersionedConstructC classes but that are related with their parent-constructs via VersionedAssociationCs. added alsome some unit-tests for this generic Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.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 Mar 22 09:04:20 2010 @@ -156,12 +156,13 @@ - +;;TOOD: replace the key argument (revision 0)/(start-revision 0) +;; by (start-revision *TM-REVISION*) (revision *TM-REVISION*) +;; to be compatible to the macro with-revision ;;TODO: check merge-constructs in add-topic-identifier, -;; add-item-identifier/add-reifier (can merge the parent construct -;; and the parent's parent construct), add-psi, add-locator -;; (--> duplicate-identifier-error) -;;TODO: finalize add-reifier +;; add-item-identifier/add-reifier (can merge the parent constructs +;; and the parent's parent construct + the reifier constructs), +;; add-psi, add-locator (--> duplicate-identifier-error) ;;TODO: implement a macro "with-merge-construct" that merges constructs ;; after some data-operations are completed (should be passed as body) ;; and a merge should be done @@ -171,7 +172,7 @@ ;; the method should merge two constructs that are inherited from ;; ReifiableConstructC ;;TODO: implement find-item-by-revision for all classes that don't have their -;; one revision-infos +;; one revision-infos --> PointerC, CharacteristicC, RoleC ;;; globals ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -746,6 +747,16 @@ ;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric find-item-by-revision (construct revision + &optional parent-construct) + (:documentation "Returns the given object if it exists in the passed + version otherwise nil. + Constructs that exist to be owned by parent-constructs + must provide their parent-construct to get the corresponding + revision of the relationship between the construct itself and + its parent-construct.")) + + (defgeneric check-for-duplicate-identifiers (construct) (:documentation "Check for possibly duplicate identifiers and signal an duplicate-identifier-error is such duplicates are found")) @@ -817,6 +828,21 @@ (delete-construct version-info))) +(defmethod find-item-by-revision ((construct VersionedConstructC) + (revision integer) &optional parent-construct) + (declare (ignorable parent-construct)) + (cond ((= revision 0) + (find-most-recent-revision construct)) + (t + (when (find-if + #'(lambda(vi) + (and (>= revision (start-revision vi)) + (or (< revision (end-revision vi)) + (= 0 (end-revision vi))))) + (versions construct)) + construct)))) + + (defmethod get-most-recent-version-info ((construct VersionedConstructC)) (let ((result (find 0 (versions construct) :key #'end-revision))) (if result @@ -836,22 +862,6 @@ construct))) -(defgeneric find-item-by-revision (construct revision) - (:documentation "Returns the given object if it exists in the passed - version otherwise nil.") - (:method ((construct VersionedConstructC) (revision integer)) - (cond ((= revision 0) - (find-most-recent-revision construct)) - (t - (when (find-if - #'(lambda(vi) - (and (>= revision (start-revision vi)) - (or (< revision (end-revision vi)) - (= 0 (end-revision vi))))) - (versions construct)) - construct))))) - - (defgeneric add-to-version-history (construct &key start-revision end-revision) (:documentation "Adds version history to a versioned construct") (:method ((construct VersionedConstructC) @@ -951,6 +961,33 @@ (string= (uri construct) uri)) +(defmethod find-item-by-revision ((construct PointerC) + (revision integer) &optional parent-construct) + (if parent-construct + (let ((parent-assoc + (let ((assocs + (remove-if + #'null + (map 'list #'(lambda(assoc) + (when (eql (parent-construct assoc) + parent-construct) + assoc)) + (slot-p construct 'identified-construct))))) + (when assocs + (first assocs))))) + (cond ((= revision 0) + (find-most-recent-revision parent-assoc)) + (t + (when (find-if + #'(lambda(vi) + (and (>= revision (start-revision vi)) + (or (< revision (end-revision vi)) + (= 0 (end-revision vi))))) + (versions parent-assoc)) + construct)))) + nil)) + + (defmethod delete-construct :before ((construct PointerC)) (dolist (p-assoc (slot-p construct 'identified-construct)) (delete-construct p-assoc))) @@ -1685,6 +1722,35 @@ :start-revision start-revision))) +(defmethod find-item-by-revision ((construct CharacteristicC) + (revision integer) &optional parent-construct) + (if parent-construct + (let ((parent-assoc + (let ((assocs + (remove-if + #'null + (map 'list #'(lambda(assoc) + (when (eql (parent-construct assoc) + parent-construct) + assoc)) + (slot-p construct 'parent))))) + (when assocs + (first assocs))))) + (cond ((= revision 0) + (when + (find-most-recent-revision parent-assoc) + construct)) + (t + (when (find-if + #'(lambda(vi) + (and (>= revision (start-revision vi)) + (or (< revision (end-revision vi)) + (= 0 (end-revision vi))))) + (versions parent-assoc)) + construct)))) + nil)) + + (defmethod delete-construct :before ((construct CharacteristicC)) (dolist (characteristic-assoc-to-delete (slot-p construct 'parent)) (delete-construct characteristic-assoc-to-delete))) @@ -1997,6 +2063,33 @@ (eql player (player construct :revision start-revision)))) +(defmethod find-item-by-revision ((construct RoleC) + (revision integer) &optional parent-construct) + (let ((parent-assoc + (let ((assocs + (remove-if + #'null + (map 'list #'(lambda(assoc) + (when (eql (parent-construct assoc) + parent-construct) + assoc)) + (slot-p construct 'parent))))) + (when assocs + (first assocs))))) + (cond ((= revision 0) + (when + (find-most-recent-revision parent-assoc) + construct)) + (t + (when (find-if + #'(lambda(vi) + (and (>= revision (start-revision vi)) + (or (< revision (end-revision vi)) + (= 0 (end-revision vi))))) + (versions parent-assoc)) + construct))))) + + (defmethod delete-construct :before ((construct RoleC)) (dolist (role-assoc-to-delete (slot-p construct 'parent)) (delete-construct role-assoc-to-delete)) Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Mon Mar 22 09:04:20 2010 @@ -58,9 +58,12 @@ :test-equivalent-AssociationC :test-equivalent-TopicC :test-equivalent-TopicMapC - :test-class-p)) + :test-class-p + :test-find-item-by-revision)) +;;TODO: complete all test of the form test-add-<whatever> +;; --> indirect call of add-to-version-history ;;TODO: test make-construct ;;TODO: test merge-constructs @@ -1627,6 +1630,80 @@ (is-false (d:PointerC-p class)))))) +(test test-find-item-by-revision () + "Tests the function find-item-by-revision." + (with-fixture with-empty-db (*db-dir*) + (let ((top-1 (make-instance 'TopicC)) + (top-2 (make-instance 'TopicC)) + (assoc-1 (make-instance 'AssociationC)) + (assoc-2 (make-instance 'AssociationC)) + (ii-1 (make-instance 'ItemIdentifierC :uri "ii-1")) + (ii-2 (make-instance 'ItemIdentifierC :uri "ii-2")) + (psi-1 (make-instance 'PersistentIdC :uri "psi-1")) + (name-1 (make-instance 'NameC)) + (name-2 (make-instance 'NameC)) + (variant-1 (make-instance 'VariantC)) + (role-1 (make-instance 'RoleC)) + (rev-0 0) + (rev-0-5 50) + (rev-1 100) + (rev-2 200) + (rev-3 300) + (rev-4 400) + (rev-5 500)) + (setf *TM-REVISION* rev-1) + (d::add-to-version-history top-1 :start-revision rev-1) + (d::add-to-version-history top-1 :start-revision rev-3) + (is (eql top-1 (find-item-by-revision top-1 rev-1))) + (is (eql top-1 (find-item-by-revision top-1 rev-0))) + (is (eql top-1 (find-item-by-revision top-1 rev-4))) + (is (eql top-1 (find-item-by-revision top-1 rev-2))) + (is-false (find-item-by-revision top-1 rev-0-5)) + (add-item-identifier top-1 ii-1 :revision rev-3) + (add-item-identifier top-1 ii-2 :revision rev-3) + (add-item-identifier top-1 ii-1 :revision rev-4) + (delete-item-identifier top-1 ii-1 :revision rev-5) + (add-item-identifier top-2 ii-1 :revision rev-5) + (add-psi top-2 psi-1 :revision rev-1) + (is (eql ii-1 (find-item-by-revision ii-1 rev-3 top-1))) + (is (eql ii-1 (find-item-by-revision ii-1 rev-4 top-1))) + (is-false (find-item-by-revision ii-1 rev-2 top-1)) + (is-false (find-item-by-revision ii-1 rev-5 top-1)) + (is-false (find-item-by-revision ii-1 rev-3)) + (is-false (find-item-by-revision ii-1 rev-0 top-1)) + (is (eql ii-1 (find-item-by-revision ii-1 rev-5 top-2))) + (add-role assoc-1 role-1 :revision rev-1) + (delete-role assoc-1 role-1 :revision rev-3) + (add-role assoc-2 role-1 :revision rev-5) + (is (eql role-1 (find-item-by-revision role-1 rev-1 assoc-1))) + (is (eql role-1 (find-item-by-revision role-1 rev-2 assoc-1))) + (is (eql role-1 (find-item-by-revision role-1 rev-5 assoc-2))) + (is (eql role-1 (find-item-by-revision role-1 rev-0 assoc-2))) + (is-false (find-item-by-revision role-1 rev-0-5 assoc-1)) + (is-false (find-item-by-revision role-1 rev-0 assoc-1)) + (is-false (find-item-by-revision role-1 rev-3 assoc-1)) + (is-false (find-item-by-revision role-1 rev-3 assoc-2)) + (add-name top-1 name-1 :revision rev-1) + (delete-name top-1 name-1 :revision rev-3) + (add-name top-2 name-1 :revision rev-3) + (is (eql name-1 (find-item-by-revision name-1 rev-1 top-1))) + (is (eql name-1 (find-item-by-revision name-1 rev-2 top-1))) + (is (eql name-1 (find-item-by-revision name-1 rev-5 top-2))) + (is (eql name-1 (find-item-by-revision name-1 rev-0 top-2))) + (is-false (find-item-by-revision name-1 rev-0-5 top-1)) + (is-false (find-item-by-revision name-1 rev-0 top-1)) + (is-false (find-item-by-revision name-1 rev-3 top-1)) + (add-variant name-1 variant-1 :revision rev-1) + (delete-variant name-1 variant-1 :revision rev-3) + (add-variant name-2 variant-1 :revision rev-3) + (is (eql variant-1 (find-item-by-revision variant-1 rev-1 name-1))) + (is (eql variant-1 (find-item-by-revision variant-1 rev-2 name-1))) + (is (eql variant-1 (find-item-by-revision variant-1 rev-5 name-2))) + (is (eql variant-1 (find-item-by-revision variant-1 rev-0 name-2))) + (is-false (find-item-by-revision variant-1 rev-0-5 name-1)) + (is-false (find-item-by-revision variant-1 rev-0 name-1)) + (is-false (find-item-by-revision variant-1 rev-3 name-1))))) + @@ -1672,4 +1749,5 @@ (it.bese.fiveam:run! 'test-equivalent-TopicC) (it.bese.fiveam:run! 'test-equivalent-TopicMapC) (it.bese.fiveam:run! 'test-class-p) + (it.bese.fiveam:run! 'test-find-item-by-revision) ) \ No newline at end of file

1 0

[isidorus-cvs] r243 - in branches/new-datamodel/src: model unit_tests
by Lukas Giessmann 22 Mar '10

22 Mar '10

Author: lgiessmann Date: Mon Mar 22 07:54:27 2010 New Revision: 243 Log: new-datamodel: added "make-construct" for VersionedAssocitionC and unknown classes via "(apply make-instance class-symbol args)" replaced all "make-instance" and "add-to-version-history" calls by "make-construct" in all add-<whatever> generics Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.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 Mar 22 07:54:27 2010 @@ -146,6 +146,7 @@ :changed-p :check-for-duplicate-identifiers :find-item-by-content + :rec-remf ;;globals :*TM-REVISION* @@ -161,8 +162,6 @@ ;; and the parent's parent construct), add-psi, add-locator ;; (--> duplicate-identifier-error) ;;TODO: finalize add-reifier -;;TODO: replace add-to-version-history in VersionedAssociationC with a pseudo -;; initarg in make-construct ;;TODO: implement a macro "with-merge-construct" that merges constructs ;; after some data-operations are completed (should be passed as body) ;; and a merge should be done @@ -623,6 +622,15 @@ ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun rec-remf (plist keyword) + "Calls remf for the past plist with the given keyword until + all key-value-pairs corresponding to the passed keyword were removed." + (declare (list plist) (keyword keyword)) + (loop while (getf plist keyword) + do (remf plist keyword)) + plist) + + (defun get-item-by-content (content &key (revision *TM-REVISION*)) "Finds characteristics by their (atomic) content." (flet @@ -1220,10 +1228,10 @@ return ti-assoc))) (add-to-version-history ti-assoc :start-revision revision))) (t - (let ((assoc (make-instance 'TopicIdAssociationC - :parent-construct construct - :identifier topic-identifier))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'TopicIdAssociationC + :parent-construct construct + :identifier topic-identifier + :start-revision revision))) (add-to-version-history merged-construct :start-revision revision) merged-construct)))) @@ -1275,10 +1283,10 @@ return psi-assoc))) (add-to-version-history psi-assoc :start-revision revision))) (t - (let ((assoc (make-instance 'PersistentIdAssociationC - :parent-construct construct - :identifier psi))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'PersistentIdAssociationC + :parent-construct construct + :identifier psi + :start-revision revision))) (add-to-version-history merged-construct :start-revision revision) merged-construct)))) @@ -1331,11 +1339,10 @@ return loc-assoc))) (add-to-version-history loc-assoc :start-revision revision))) (t - (let ((assoc - (make-instance 'SubjectLocatorAssociationC - :parent-construct construct - :identifier locator))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'SubjectLocatorAssociationC + :parent-construct construct + :identifier locator + :start-revision revision))) (add-to-version-history merged-construct :start-revision revision) merged-construct)))) @@ -1390,11 +1397,10 @@ construct) return name-assoc))) (add-to-version-history name-assoc :start-revision revision)) - (let ((assoc - (make-instance 'NameAssociationC - :parent-construct construct - :characteristic name))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'NameAssociationC + :parent-construct construct + :characteristic name + :start-revision revision))) (add-to-version-history construct :start-revision revision) construct)) @@ -1440,11 +1446,10 @@ when (eql (parent-construct occ-assoc) construct) return occ-assoc))) (add-to-version-history occ-assoc :start-revision revision)) - (let ((assoc - (make-instance 'OccurrenceAssociationC - :parent-construct construct - :characteristic occurrence))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'OccurrenceAssociationC + :parent-construct construct + :characteristic occurrence + :start-revision revision))) (add-to-version-history construct :start-revision revision) construct)) @@ -1732,10 +1737,10 @@ 'NameAssociationC) (t 'VariantAssociationC)))) - (let ((assoc (make-instance association-type - :characteristic construct - :parent-construct parent-construct))) - (add-to-version-history assoc :start-revision revision)))))) + (make-construct association-type + :characteristic construct + :parent-construct parent-construct + :start-revision revision))))) construct)) @@ -1864,11 +1869,10 @@ when (eql (characteristic variant-assoc) variant) return variant-assoc))) (add-to-version-history variant-assoc :start-revision revision)) - (let ((assoc - (make-instance 'VariantAssociationC - :characteristic variant - :parent-construct construct))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'VariantAssociationC + :characteristic variant + :parent-construct construct + :start-revision revision))) construct)) @@ -1949,11 +1953,10 @@ when (eql (role role-assoc) role) return role-assoc))) (add-to-version-history role-assoc :start-revision revision)) - (let ((assoc - (make-instance 'RoleAssociationC - :role role - :parent-construct construct))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'RoleAssociationC + :role role + :parent-construct construct + :start-revision revision))) (add-to-version-history construct :start-revision revision) construct)) @@ -2043,10 +2046,10 @@ (same-parent-assoc (add-to-version-history same-parent-assoc :start-revision revision)) (t - (let ((assoc (make-instance 'RoleAssociationC - :role construct - :parent-construct parent-construct))) - (add-to-version-history assoc :start-revision revision))))) + (make-construct 'RoleAssociationC + :role construct + :parent-construct parent-construct + :start-revision revision)))) (add-to-version-history parent-construct :start-revision revision) construct) @@ -2095,10 +2098,10 @@ (same-player-assoc (add-to-version-history same-player-assoc :start-revision revision)) (t - (let ((assoc (make-instance 'PlayerAssociationC - :parent-construct construct - :player-topic player-topic))) - (add-to-version-history assoc :start-revision revision))))) + (make-construct 'PlayerAssociationC + :parent-construct construct + :player-topic player-topic + :start-revision revision)))) construct)) @@ -2237,10 +2240,10 @@ return ii-assoc))) (add-to-version-history ii-assoc :start-revision revision))) (t - (let ((assoc (make-instance 'ItemIdAssociationC - :parent-construct construct - :identifier item-identifier))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'ItemIdAssociationC + :parent-construct construct + :identifier item-identifier + :start-revision revision))) (when (or (typep merged-construct 'TopicC) (typep merged-construct 'AssociationC) (typep merged-construct 'TopicMapC)) @@ -2291,10 +2294,10 @@ (all-constructs (merge-constructs (first all-constructs) construct)) (t - (let ((assoc (make-instance 'ReifierAssociationC - :reifiable-construct construct - :reifier-topic merged-reifier-topic))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'ReifierAssociationC + :reifiable-construct construct + :reifier-topic merged-reifier-topic + :start-revision revision))) (when (or (typep merged-construct 'TopicC) (typep merged-construct 'AssociationC) (typep merged-construct 'TopicMapC)) @@ -2409,11 +2412,10 @@ when (eql (theme-topic theme-assoc) theme-topic) return theme-assoc))) (add-to-version-history theme-assoc :start-revision revision)) - (let ((assoc - (make-instance 'ScopeAssociationC - :theme-topic theme-topic - :scopable-construct construct))) - (add-to-version-history assoc :start-revision revision)))) + (make-construct 'ScopeAssociationC + :theme-topic theme-topic + :scopable-construct construct + :start-revision revision))) (when (typep construct 'AssociationC) (add-to-version-history construct :start-revision revision)) construct)) @@ -2481,11 +2483,10 @@ (same-type-assoc (add-to-version-history same-type-assoc :start-revision revision)) (t - (let ((assoc - (make-instance 'TypeAssociationC - :type-topic type-topic - :typable-construct construct))) - (add-to-version-history assoc :start-revision revision))))) + (make-construct 'TypeAssociationC + :type-topic type-topic + :typable-construct construct + :start-revision revision)))) (when (typep construct 'AssociationC) (add-to-version-history construct :start-revision revision)) construct)) @@ -2582,6 +2583,8 @@ (apply #'make-role args)) ((AssociationC-p class-symbol) (apply #'make-association args)) + ((VersionedConstructC-p class-symbol) + (apply #'make-instance (rec-remf args :start-revision))) (t (apply #'make-instance class-symbol args)))) (start-revision (getf args :start-revision))) Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Mon Mar 22 07:54:27 2010 @@ -908,7 +908,6 @@ (topics tm-1))) 1)) (is (= (length (union (list tm-1) (in-topicmaps top-1))) 1)) - (is-false (topics tm-1 :revision revision-0-5)) (is-false (in-topicmaps top-1 :revision revision-0-5)) (d::add-to-version-history assoc-1 :start-revision revision-1) (add-to-tm tm-1 assoc-1) @@ -916,14 +915,12 @@ (associations tm-1))) 1)) (is (= (length (union (list tm-1) (in-topicmaps assoc-1))) 1)) - (is-false (associations tm-1 :revision revision-0-5)) (is-false (in-topicmaps assoc-1 :revision revision-0-5)) (add-to-tm tm-2 top-1) (is (= (length (union (list top-1) (topics tm-2))) 1)) (is (= (length (union (list tm-2 tm-1) (in-topicmaps top-1))) 2)) - (is-false (topics tm-2 :revision revision-0-5)) (is-false (in-topicmaps top-1 :revision revision-0-5)) (d::add-to-version-history assoc-1 :start-revision revision-1) (add-to-tm tm-2 assoc-1) @@ -931,7 +928,6 @@ (associations tm-2))) 1)) (is (= (length (union (list tm-2 tm-1) (in-topicmaps assoc-1))) 2)) - (is-false (associations tm-2 :revision revision-0-5)) (is-false (in-topicmaps assoc-1 :revision revision-0-5)))))

1 0

[isidorus-cvs] r242 - in branches/new-datamodel/src: json xml/xtm
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 15:25:42 2010 New Revision: 242 Log: new-datamodel: changed some code sections that caused problems with the package "json" --> the compilation of isidorus succeeds now without errors and warnings but most likely there currently exist some semantic errors Modified: branches/new-datamodel/src/json/json_importer.lisp branches/new-datamodel/src/xml/xtm/importer.lisp Modified: branches/new-datamodel/src/json/json_importer.lisp ============================================================================== --- branches/new-datamodel/src/json/json_importer.lisp (original) +++ branches/new-datamodel/src/json/json_importer.lisp Sun Mar 21 15:25:42 2010 @@ -68,7 +68,7 @@ (declare (integer start-revision)) (declare (TopicMapC tm)) (setf roles (xml-importer::set-standard-role-types roles)) - (add-to-topicmap tm + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision :item-identifiers item-identifiers @@ -127,7 +127,7 @@ do (json-to-occurrence occurrence-values top start-revision)) (dolist (instanceOf-top instanceof-topics) (json-create-instanceOf-association instanceOf-top top start-revision :tm tm)) -; (add-to-topicmap tm top) ; will be done in "json-to-stub" +; (add-to-tm tm top) ; will be done in "json-to-stub" top))))) @@ -157,7 +157,7 @@ :psis subject-identifiers :topicid (getf json-decoded-list :id) :xtm-id xtm-id))) - (add-to-topicmap tm top) + (add-to-tm tm top) top))))) @@ -329,7 +329,7 @@ (unless (and associationtype roletype1 roletype2) (error "Error in the creation of an instanceof association: core topics are missing")) - (add-to-topicmap + (add-to-tm tm (make-construct 'AssociationC Modified: branches/new-datamodel/src/xml/xtm/importer.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/importer.lisp (original) +++ branches/new-datamodel/src/xml/xtm/importer.lisp Sun Mar 21 15:25:42 2010 @@ -136,7 +136,7 @@ (let ((top (from-topic-elem-to-stub top-elem revision :xtm-id "core.xtm"))) - (add-to-topicmap tm top))))))) + (add-to-tm tm top))))))) ;TODO: replace the two importers with this macro (defmacro importer-mac @@ -190,7 +190,7 @@ (make-condition 'missing-reference-error :message "could not find type topic (first player)" :reference topicid-of-supertype))) - (add-to-topicmap + (add-to-tm tm (make-construct 'AssociationC

1 0

[isidorus-cvs] r241 - in branches/new-datamodel/src: model xml/rdf
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 15:17:59 2010 New Revision: 241 Log: new-datamodel: changed some code sections that caused problems with the package "xml" Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/xml/rdf/importer.lisp branches/new-datamodel/src/xml/rdf/map_to_tm.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Mar 21 15:17:59 2010 @@ -22,6 +22,8 @@ :TopicMapConstructC :VersionedConstructC :ReifiableConstructC + :ScopableC + :TypableC :TopicMapC :AssociationC :RoleC Modified: branches/new-datamodel/src/xml/rdf/importer.lisp ============================================================================== --- branches/new-datamodel/src/xml/rdf/importer.lisp (original) +++ branches/new-datamodel/src/xml/rdf/importer.lisp Sun Mar 21 15:17:59 2010 @@ -67,7 +67,7 @@ ((top (from-topic-elem-to-stub top-elem revision :xtm-id *rdf-core-xtm*))) - (add-to-topicmap xml-importer::tm top)))))))) + (add-to-tm xml-importer::tm top)))))))) (defun import-dom (rdf-dom start-revision @@ -355,7 +355,7 @@ (list :instance-of role-type-2 :player sub-top)))) (let ((assoc - (add-to-topicmap + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision @@ -396,7 +396,7 @@ (list :instance-of roletype-2 :player instance-top)))) (let ((assoc - (add-to-topicmap + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision @@ -449,7 +449,7 @@ :uri ii-uri :start-revision start-revision))))) (handler-case (let ((top - (add-to-topicmap + (add-to-tm tm (make-construct 'TopicC @@ -502,7 +502,7 @@ (list :instance-of role-type-2 :player top)))) (let ((assoc - (add-to-topicmap tm (make-construct 'AssociationC + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision :instance-of type-top :roles roles)))) @@ -531,7 +531,7 @@ (list :instance-of role-type-2 :player object-topic)))) (let ((assoc - (add-to-topicmap + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision :instance-of associationtype-topic Modified: branches/new-datamodel/src/xml/rdf/map_to_tm.lisp ============================================================================== --- branches/new-datamodel/src/xml/rdf/map_to_tm.lisp (original) +++ branches/new-datamodel/src/xml/rdf/map_to_tm.lisp Sun Mar 21 15:17:59 2010 @@ -188,7 +188,7 @@ (delete-related-associations assoc-top) (d::delete-construct assoc-top) (with-tm (start-revision document-id tm-id) - (add-to-topicmap + (add-to-tm xml-importer::tm (let ((association (make-construct 'AssociationC @@ -229,9 +229,9 @@ (new-item-ids (map-isi-identifiers top start-revision)) (occurrence-topics (get-isi-occurrences top start-revision)) (name-topics (get-isi-names top start-revision))) - (bound-subject-identifiers top new-psis) - (bound-subject-locators top new-locators) - (bound-item-identifiers top new-item-ids) + (bound-subject-identifiers top new-psis start-revision) + (bound-subject-locators top new-locators start-revision) + (bound-item-identifiers top new-item-ids start-revision) (map 'list #'(lambda(occurrence-topic) (map-isi-occurrence top occurrence-topic start-revision)) occurrence-topics) @@ -560,7 +560,7 @@ ids))))) -(defun bound-item-identifiers (construct identifiers) +(defun bound-item-identifiers (construct identifiers start-revision) "Bounds the passed item-identifier to the passed construct." (declare (ReifiableConstructC construct)) (dolist (id identifiers) @@ -569,11 +569,12 @@ (string= (uri ii) (uri id))) (item-identifiers construct)) (d::delete-construct id) - (setf (identified-construct id) construct))) + (add-item-identifier (identified-construct id :revision start-revision) + construct :revision start-revision))) construct) -(defun bound-subject-identifiers (top identifiers) +(defun bound-subject-identifiers (top identifiers start-revision) "Bounds the passed psis to the passed topic." (declare (TopicC top)) (dolist (id identifiers) @@ -582,11 +583,12 @@ (string= (uri psi) (uri id))) (psis top)) (d::delete-construct id) - (setf (identified-construct id) top))) + (add-psi (identified-construct id :revision start-revision) + top :revision start-revision))) top) -(defun bound-subject-locators (top locators) +(defun bound-subject-locators (top locators start-revision) "Bounds the passed locators to the passed topic." (declare (TopicC top)) (dolist (id locators) @@ -595,7 +597,8 @@ (string= (uri locator) (uri id))) (locators top)) (d::delete-construct id) - (setf (identified-construct id) top))) + (add-locator (identified-construct id :revision start-revision) + top :revision start-revision))) top)

1 0

[isidorus-cvs] r240 - in branches/new-datamodel/src: model rest_interface xml/rdf xml/xtm
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 14:15:47 2010 New Revision: 240 Log: new-datamodel: changed some code sections that caused problems with "rdf_exporter.lisp" Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/rest_interface/read.lisp branches/new-datamodel/src/xml/rdf/exporter.lisp branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Mar 21 14:15:47 2010 @@ -20,12 +20,17 @@ *instance-psi*) (:export ;;classes :TopicMapConstructC + :VersionedConstructC + :ReifiableConstructC :TopicMapC :AssociationC :RoleC + :CharacteristicC :OccurrenceC :NameC :VariantC + :PointerC + :IdentifierC :PersistentIdC :ItemIdentifierC :SubjectLocatorC @@ -124,6 +129,7 @@ :VersionedConstructC-p :make-construct :list-instanceOf + :list-super-types :in-topicmap :string-starts-with :get-fragments @@ -131,6 +137,7 @@ :get-all-revisions :unique-id :topic + :referenced-topics :revision :get-all-revisions-for-tm :add-source-locator @@ -1591,28 +1598,56 @@ :error-if-nil error-if-nil)) - -(defgeneric list-instanceOf (topic &key tm) +(defgeneric list-instanceOf (topic &key tm revision) (:documentation "Generates a list of all topics that this topic is an - instance of, optionally filtered by a topic map")) - - -(defmethod list-instanceOf ((topic TopicC) &key (tm nil)) - (remove-if - #'null - (map 'list #'(lambda(x) - (when (loop for psi in (psis (instance-of x)) - when (string= (uri psi) constants:*instance-psi*) - return t) - (loop for role in (roles (parent x)) - when (not (eq role x)) - return (player role)))) - (if tm - (remove-if-not - (lambda (role) - (in-topicmap tm (parent role))) - (player-in-roles topic)) - (player-in-roles topic))))) + instance of, optionally filtered by a topic map") + (:method ((topic TopicC) &key (tm nil) (revision 0)) + (declare (type (or null TopicMapC) tm) + (integer revision)) + (remove-if + #'null + (map 'list + #'(lambda(x) + (when (loop for psi in (psis (instance-of x :revision revision) + :revision revision) + when (string= (uri psi) constants:*instance-psi*) + return t) + (loop for role in (roles (parent x :revision revision) + :revision revision) + when (not (eq role x)) + return (player role :revision revision)))) + (if tm + (remove-if-not + (lambda (role) + (in-topicmap tm (parent role :revision revision))) + (player-in-roles topic :revision revision)) + (player-in-roles topic :revision revision)))))) + + +(defgeneric list-super-types (topic &key tm revision) + (:documentation "Generate a list of all topics that this topic is an + subclass of, optionally filtered by a topic map") + (:method ((topic TopicC) &key (tm nil) (revision 0)) + (declare (type (or null TopicMapC) tm) + (integer revision)) + (remove-if + #'null + (map 'list + #'(lambda(x) + (when (loop for psi in (psis (instance-of x :revision revision) + :revision revision) + when (string= (uri psi) *subtype-psi*) + return t) + (loop for role in (roles (parent x :revision revision) + :revision revision) + when (not (eq role x)) + return (player role :revision revision)))) + (if tm + (remove-if-not + (lambda (role) + (in-topicmap tm (parent role :revision revision))) + (player-in-roles topic :revision revision)) + (player-in-roles topic :revision revision)))))) ;;; CharacteristicC Modified: branches/new-datamodel/src/rest_interface/read.lisp ============================================================================== --- branches/new-datamodel/src/rest_interface/read.lisp (original) +++ branches/new-datamodel/src/rest_interface/read.lisp Sun Mar 21 14:15:47 2010 @@ -67,7 +67,7 @@ (source-locator (source-locator-prefix feed))) ;check if xtm-id has already been imported or if the entry is older ;than the snapshot feed. If so, don't do it again - (unless (or (xtm-id-p xtm-id) (string> (atom:updated entry) (atom:updated imported-snapshot-entry))) + (unless (or (string> (atom:updated entry) (atom:updated imported-snapshot-entry))) (when top (mark-as-deleted top :source-locator source-locator :revision revision)) ;(format t "Fragment feed: ~a~&" (link entry)) @@ -98,10 +98,11 @@ (find most-recent-update entry-list :key #'updated :test #'string=))) (defun most-recent-imported-snapshot (all-snapshot-entries) - (let - ((all-imported-entries - (remove-if-not #'xtm-id-p all-snapshot-entries :key #'atom:id))) - (most-recent-entry all-imported-entries))) +; (let +; ((all-imported-entries +; (remove-if-not #'xtm-id-p all-snapshot-entries :key #'atom:id))) +; (most-recent-entry all-imported-entries)) + (most-recent-entry all-snapshot-entries)) (defun import-snapshots-feed (snapshot-feed-url &key tm-id) "checks if we already imported any of this feed's snapshots. If not, Modified: branches/new-datamodel/src/xml/rdf/exporter.lisp ============================================================================== --- branches/new-datamodel/src/xml/rdf/exporter.lisp (original) +++ branches/new-datamodel/src/xml/rdf/exporter.lisp Sun Mar 21 14:15:47 2010 @@ -216,7 +216,7 @@ (declare (TopicC topic)) (if (psis topic) (cxml:attribute "rdf:resource" - (if (reified topic) + (if (reified-construct topic) (let ((psi (get-reifier-psi topic))) (if psi (concatenate 'string "#" (get-reifier-uri topic)) @@ -592,7 +592,7 @@ (t-occs (occurrences construct)) (t-assocs (list-rdf-mapped-associations construct))) (if psi - (if (reified construct) + (if (reified-construct construct) (let ((reifier-uri (get-reifier-uri construct))) (if reifier-uri (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) @@ -627,7 +627,7 @@ (ii (item-identifiers construct)) (sl (locators construct))) (if psi - (if (reified construct) + (if (reified-construct construct) (let ((reifier-uri (get-reifier-uri construct))) (if reifier-uri (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) Modified: branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp (original) +++ branches/new-datamodel/src/xml/xtm/importer_xtm1.0.lisp Sun Mar 21 14:15:47 2010 @@ -83,7 +83,7 @@ ((typep parent-construct 'NameC) parent-construct) ((typep parent-construct 'VariantC) - (name parent-construct)) + (parent parent-construct)) (t (error "from-variant-elem-xtm1.0: parent-construct is neither NameC nor VariantC")))) (reifier-topic (get-reifier-topic-xtm1.0 variant-elem))) @@ -394,7 +394,7 @@ (dolist (instanceOf-topicRef instanceOf-topicRefs) (create-instanceof-association instanceOf-topicRef top start-revision :xtm-id xtm-id :tm tm)) - (add-to-topicmap tm top)))) + (add-to-tm tm top)))) (defun from-association-elem-xtm1.0 (assoc-elem start-revision &key tm (xtm-id *current-xtm*)) @@ -420,7 +420,7 @@ (unless type (format t "from-association-elem-xtm1.0: type is missing -> http://www.topicmaps.org/xtm/1.0/core.xtm#association~%") (setf type (get-item-by-id "association" :xtm-id "core.xtm"))) - (add-to-topicmap tm + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision :instance-of type Modified: branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp (original) +++ branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp Sun Mar 21 14:15:47 2010 @@ -313,7 +313,7 @@ (create-instanceof-association topicref top start-revision :tm tm :xtm-id xtm-id)) - (add-to-topicmap tm top) + (add-to-tm tm top) top)))) @@ -386,7 +386,7 @@ *xtm2.0-ns* "role"))) (reifier-topic (get-reifier-topic assoc-elem))) (setf roles (set-standard-role-types roles)); sets standard role types if there are missing some of them - (add-to-topicmap + (add-to-tm tm (make-construct 'AssociationC :start-revision start-revision @@ -415,7 +415,7 @@ (let ((topic-vector (get-topic-elems xtm-dom))) (loop for top-elem across topic-vector do - (add-to-topicmap + (add-to-tm tm (from-topic-elem-to-stub top-elem revision :xtm-id xtm-id))))))

1 0

[isidorus-cvs] r239 - branches/new-datamodel/src/model
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 13:26:05 2010 New Revision: 239 Log: new-datamodel: optimized "make-construct" 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 Sun Mar 21 13:26:05 2010 @@ -2534,17 +2534,19 @@ (let ((construct (cond ((PointerC-p class-symbol) - (make-pointer class-symbol (getf args :uri) args)) + (apply #'make-pointer class-symbol args)) ((CharacteristicC-p class-symbol) - (make-characteristic class-symbol args)) + (apply #'make-characteristic class-symbol args)) ((TopicC-p class-symbol) - (make-topic args)) + (apply #'make-topic args)) ((TopicMapC-p class-symbol) - (make-tm args)) + (apply #'make-tm args)) ((RoleC-p class-symbol) - (make-role args)) + (apply #'make-role args)) ((AssociationC-p class-symbol) - (make-association args)))) + (apply #'make-association args)) + (t + (apply #'make-instance class-symbol args)))) (start-revision (getf args :start-revision))) (when (typep construct 'TypableC) (complete-typable construct (getf args :instance-of) @@ -2552,6 +2554,10 @@ (when (typep construct 'ScopableC) (complete-scopable construct (getf args :themes) :start-revision start-revision)) + (when (typep construct 'VersionedConstructC) + (unless start-revision + (error "From make-construct(): start-revision must be set")) + (add-to-version-history construct :start-revision start-revision)) (if (typep construct 'ReifiableConstructC) (complete-reifiable construct (getf args :item-identtifiers) (getf args :reifier) :start-revision start-revision) @@ -2562,14 +2568,13 @@ "Returns an association object. If the association has already existed the existing one is returned otherwise a new one is created. This function exists only for being used by make-construct!" - (let ((instance-of (getf (first args) :instance-of)) - (start-revision (getf (first args) :start-revision)) - (themes (get (first args) :themes)) - (roles (get (first args) :roles)) - (err "From make-association(): ")) - (unless start-revision (error "~astart-revision must be set" err)) - (unless roles (error "~aroles must be set" err)) - (unless instance-of (error "~ainstance-of must be set" err)) + (let ((instance-of (getf args :instance-of)) + (start-revision (getf args :start-revision)) + (themes (get args :themes)) + (roles (get args :roles))) + (when (and (or roles instance-of themes) + (not start-revision)) + (error "From make-association(): start-revision must be set")) (let ((association (let ((existing-association (remove-if @@ -2597,11 +2602,10 @@ (let ((parent (getf args :parent)) (instance-of (getf args :instance-of)) (player (getf args :player)) - (start-revision (getf args :start-revision)) - (err "From make-role(): ")) - (unless start-revision (error "~astart-revision must be set" err)) - (unless instance-of (error "~ainstance-of must be set" err)) - (unless player (error "~aplayer must be set" err)) + (start-revision (getf args :start-revision))) + (when (and (or instance-of player parent) + (not start-revision)) + (error "From make-role(): start-revision must be set")) (let ((role (let ((existing-role (remove-if @@ -2631,10 +2635,10 @@ (reifier (getf args :reifier)) (topics (getf args :topics)) (assocs (getf args :associations)) - (start-revision (getf args :start-revision)) - (err "From make-tm(): ")) - (unless item-identifiers (error "~aitem-identifiers must be set" err)) - (unless start-revision (error "~astart-revision must be set" err)) + (start-revision (getf args :start-revision))) + (when (and (or item-identifiers reifier) + (not start-revision)) + (error "From make-tm(): start-revision must be set")) (let ((tm (let ((existing-tms (remove-if @@ -2667,10 +2671,11 @@ (item-identifiers (getf args :item-identifiers)) (topic-identifiers (getf args :topic-identifiers)) (names (getf args :names)) - (occurrences (getf args :occurrences)) - (err "From make-topic(): ")) - (unless topic-identifiers (error "~atopic-identifiers must be set" err)) - (unless start-revision (error "~astart-revision must be set" err)) + (occurrences (getf args :occurrences))) + (when (and (or psis locators item-identifiers topic-identifiers + names occurrences) + (not start-revision)) + (error "From make-topic(): start-revision must be set")) (let ((topic (let ((existing-topics (remove-if @@ -2711,19 +2716,16 @@ To check if there is existing an equivalent construct the parameter parent-construct must be set. This function only exists for being used by make-construct!" - (let ((charvalue (getf (first args) :charvalue)) - (start-revision (getf (first args) :start-revision)) - (datatype (getf (first args) :datatype)) - (instance-of (getf (first args) :instance-of)) - (themes (getf (first args) :themes)) - (variants (getf (first args) :variants)) - (parent (getf (first args) :parent)) - (err "From make-characteristic(): ")) - (unless start-revision (error "~astart-revision must be set" err)) - (unless charvalue (error "~acharvalue must be set" err)) - (when (and (or (OccurrenceC-p class-symbol) (NameC-p class-symbol)) - (not instance-of)) - (error "~ainstance-of must be set" err)) + (let ((charvalue (getf args :charvalue)) + (start-revision (getf args :start-revision)) + (datatype (getf args :datatype)) + (instance-of (getf args :instance-of)) + (themes (getf args :themes)) + (variants (getf args :variants)) + (parent (getf args :parent))) + (when (and (or instance-of themes variants parent) + (not start-revision)) + (error "From make-characteristic(): start-revision must be set")) (let ((characteristic (let ((existing-characteristic (when parent @@ -2752,13 +2754,12 @@ "Returns a pointer object with the specified parameters. If an equivalen construct has already existed this one is returned. This function only exists for beoing used by make-construct!" - (let ((uri (getf (first args) :uri)) - (xtm-id (getf (first args) :xtm-id)) - (start-revision (getf (first args) :start-revision)) - (identified-construct (getf (first args) :identified-construct)) - (err "From make-pointer(): ")) + (let ((uri (getf args :uri)) + (xtm-id (getf args :xtm-id)) + (start-revision (getf args :start-revision)) + (identified-construct (getf args :identified-construct))) (when (and identified-construct (not start-revision)) - (error "~astart-revision must be set" err)) + (error "From make-pointer(): start-revision must be set")) (let ((identifier (let ((existing-pointer (remove-if

1 0

[isidorus-cvs] r238 - in branches/new-datamodel/src: json model unit_tests xml/xtm
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 12:53:44 2010 New Revision: 238 Log: new-datamodel: changed some sections that causes errors with other packages Modified: branches/new-datamodel/src/json/json_exporter.lisp branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/importer_test.lisp branches/new-datamodel/src/unit_tests/json_test.lisp branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp Modified: branches/new-datamodel/src/json/json_exporter.lisp ============================================================================== --- branches/new-datamodel/src/json/json_exporter.lisp (original) +++ branches/new-datamodel/src/json/json_exporter.lisp Sun Mar 21 12:53:44 2010 @@ -46,7 +46,7 @@ (eql (elt value 0) #\#)) (get-item-by-id (subseq value 1) :xtm-id xtm-id)))) (if ref-topic - (concatenate 'string "#" (topicid ref-topic)) + (concatenate 'string "#" (topic-id ref-topic)) value)))) (json:encode-json-to-string inner-value)) ",\"resourceData\":null") @@ -147,7 +147,7 @@ (defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*)) "transforms an TopicC object to a json string" (let ((id - (concatenate 'string "\"id\":" (json:encode-json-to-string (topicid instance)))) + (concatenate 'string "\"id\":" (json:encode-json-to-string (topic-id instance)))) (itemIdentity (concatenate 'string "\"itemIdentities\":" (identifiers-to-json-string instance :what 'item-identifiers))) @@ -188,7 +188,7 @@ subjectIdentifiers" (when topic (let ((id - (concatenate 'string "\"id\":" (json:encode-json-to-string (topicid topic)))) + (concatenate 'string "\"id\":" (json:encode-json-to-string (topic-id topic)))) (itemIdentity (concatenate 'string "\"itemIdentities\":" (identifiers-to-json-string topic :what 'item-identifiers))) @@ -310,7 +310,7 @@ *occurrences (jonly the resourceRef and resourceData elements)" (declare (TopicC topic)) (let ((id - (concatenate 'string "\"id\":\"" (topicid topic) "\"")) + (concatenate 'string "\"id\":\"" (topic-id topic) "\"")) (itemIdentity (concatenate 'string "\"itemIdentities\":" (identifiers-to-json-string topic :what 'item-identifiers))) Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Mar 21 12:53:44 2010 @@ -12,11 +12,14 @@ (:nicknames :d) (:import-from :exceptions duplicate-identifier-error) + (:import-from :exceptions + object-not-found-error) (:import-from :constants *xml-string*) (:import-from :constants *instance-psi*) (:export ;;classes + :TopicMapConstructC :TopicMapC :AssociationC :RoleC @@ -28,6 +31,7 @@ :SubjectLocatorC :TopicIdentificationC :TopicC + :FragmentC ;;methods, functions and macros :xtm-id @@ -40,6 +44,7 @@ :add-reifier :delete-reifier :find-item-by-revision + :find-most-recent-revision :themes :add-theme :delete-theme @@ -68,6 +73,7 @@ :topic-identifiers :add-topic-identifier :delete-topic-identifier + :topic-id :locators :add-locator :delete-locator @@ -92,6 +98,7 @@ :get-item-by-psi :get-item-by-item-identifier :get-item-by-locator + :get-item-by-content :string-integer-p :with-revision :get-latest-fragment-of-topic @@ -118,7 +125,18 @@ :make-construct :list-instanceOf :in-topicmap - :string-start-with + :string-starts-with + :get-fragments + :get-fragment + :get-all-revisions + :unique-id + :topic + :revision + :get-all-revisions-for-tm + :add-source-locator + :changed-p + :check-for-duplicate-identifiers + :find-item-by-content ;;globals :*TM-REVISION* @@ -596,6 +614,19 @@ ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun get-item-by-content (content &key (revision *TM-REVISION*)) + "Finds characteristics by their (atomic) content." + (flet + ((get-existing-instances (class-symbol) + (delete-if-not + #'(lambda (constr) + (find-item-by-revision constr revision)) + (elephant:get-instances-by-value class-symbol 'charvalue content)))) + (nconc (get-existing-instances 'OccurenceC) + (get-existing-instances 'NameC) + (get-existing-instances 'VariantC)))) + + (defmacro with-revision (revision &rest body) `(let ((*TM-REVISION* ,revision)) @@ -698,6 +729,11 @@ ;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric check-for-duplicate-identifiers (construct) + (:documentation "Check for possibly duplicate identifiers and signal an + duplicate-identifier-error is such duplicates are found")) + + (defgeneric get-all-identifiers-of-construct (construct &key revision) (:documentation "Get all identifiers that a given construct has")) @@ -855,6 +891,12 @@ ;;; TopicMapconstructC +(defmethod check-for-duplicate-identifiers ((construct TopicMapConstructC)) + (declare (ignore construct)) + ;do nothing + ) + + (defmethod get-all-characteristics ((parent-construct TopicC) (characteristic-symbol symbol)) (cond ((OccurrenceC-p characteristic-symbol) @@ -1109,6 +1151,30 @@ t)) +(defgeneric topic-id (construct &optional revision xtm-id) + (:documentation "Returns the primary id of this item + (= essentially the OID). If xtm-id is explicitly given, + returns one of the topic-ids in that TM + (which must then exist).") + (:method ((construct TopicC) &optional (xtm-id nil) (revision 0)) + (declare (type (or null string) xtm-id) (integer revision)) + (if xtm-id + (let ((possible-identifiers + (remove-if-not + #'(lambda(top-id) + (string= (xtm-id top-id) xtm-id)) + (topic-identifiers construct :revision revision)))) + (unless possible-identifiers + (error (make-condition + 'object-not-found-error + :message + (format nil "Could not find an object ~a in xtm-id ~a" + construct xtm-id)))) + (uri (first possible-identifiers))) + (concatenate 'string "t" (write-to-string (internal-id construct)))))) + + + (defgeneric topic-identifiers (construct &key revision) (:documentation "Returns the TopicIdentificationC-objects that correspond with the passed construct and the passed version.") @@ -2014,6 +2080,22 @@ ;;; ReifiableConstructC +(defmethod check-for-duplicate-identifiers ((construct ReifiableConstructC)) + (dolist (id (get-all-identifiers-of-construct construct)) + (when (> + (length + (union + (elephant:get-instances-by-value 'ItemIdentifierC 'uri (uri id)) + (union + (elephant:get-instances-by-value 'PersistentIdC 'uri (uri id)) + (elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id))))) + 1) + (error + (make-condition 'duplicate-identifier-error + :message (format nil "Duplicate Identifier ~a has been found" (uri id)) + :uri (uri id)))))) + + (defgeneric ReifiableConstructC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to ReifiableConstructC or one of its subtypes.") Modified: branches/new-datamodel/src/unit_tests/importer_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/importer_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/importer_test.lisp Sun Mar 21 12:53:44 2010 @@ -98,7 +98,7 @@ (is (= 1 (length t101-themes))) (is (string= - (topicid (first t101-themes) *TEST-TM*) + (topic-id (first t101-themes) *TEST-TM*) "t50a")))))) (test test-from-name-elem @@ -129,7 +129,7 @@ "http://psi.egovpt.org/types/long-name")) (is (themes t101-longname)) (is (string= - (topicid (first (themes t101-longname)) *TEST-TM*) + (topic-id (first (themes t101-longname)) *TEST-TM*) "t50a")) (is (eq t1-name t1-name-copy)) ;must be merged )))) @@ -233,10 +233,10 @@ ((12th-role (from-role-elem (nth 11 role-elems) revision))) (is (string= "t101" - (topicid + (topic-id (getf 12th-role :player) *TEST-TM*))) (is (string= "t62" - (topicid + (topic-id (getf 12th-role :instance-of) *TEST-TM*))))))) (test test-from-association-elem @@ -261,12 +261,12 @@ (is (= 2 (length (roles last-assoc)))) (is (= 1 (length (item-identifiers last-assoc)))) (is (string= "t300" - (topicid (player (first (roles 6th-assoc))) *TEST-TM*))) + (topic-id (player (first (roles 6th-assoc))) *TEST-TM*))) (is (string= "t63" - (topicid (instance-of (first (roles 6th-assoc))) + (topic-id (instance-of (first (roles 6th-assoc))) *TEST-TM*))) (is (string= "t301" - (topicid (player (first (roles last-assoc))) + (topic-id (player (first (roles last-assoc))) *TEST-TM*)))) ;(untrace datamodel:item-identifiers datamodel::filter-slot-value-by-revision)) ) @@ -302,8 +302,8 @@ (is (typep io-assoc 'AssociationC)) - (is (string= (topicid topic) - (topicid (player (second (roles io-assoc)))))))))) + (is (string= (topic-id topic) + (topic-id (player (second (roles io-assoc)))))))))) (let* ((t101-top (get-item-by-id "t101")) @@ -329,9 +329,9 @@ (is (= 1 (length role-101))) ;(is (= 1 (length (d::versions role-101)))) (is (string= "t3a" - (topicid (player (first (roles (parent (first role-101))))) *TEST-TM*))) + (topic-id (player (first (roles (parent (first role-101))))) *TEST-TM*))) (is (string= "type-instance" - (topicid (instance-of + (topic-id (instance-of (parent (first role-101))) "core.xtm"))) )))) Modified: branches/new-datamodel/src/unit_tests/json_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/json_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/json_test.lisp Sun Mar 21 12:53:44 2010 @@ -70,27 +70,27 @@ (let ((t50a (get-item-by-id "t50a"))) (let ((t50a-string (to-json-string t50a)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) + (concatenate 'string "{\"id\":\"" (topic-id t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) (is (string= t50a-string json-string))) (let ((t8 (get-item-by-id "t8"))) (let ((t8-string (to-json-string t8)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) + (concatenate 'string "{\"id\":\"" (topic-id t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) (is (string= t8-string json-string)))) (let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm"))) (let ((t-topic-string (to-json-string t-topic)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) + (concatenate 'string "{\"id\":\"" (topic-id t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) (is (string= t-topic-string json-string)))) (let ((t301 (get-item-by-id "t301"))) (let ((t301-string (to-json-string t301)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}"))) + (concatenate 'string "{\"id\":\"" (topic-id t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}"))) (is (string= t301-string json-string)))) (let ((t100 (get-item-by-id "t100"))) (let ((t100-string (to-json-string t100)) (json-string - (concatenate 'string "{\"id\":\"" (topicid t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}"))) + (concatenate 'string "{\"id\":\"" (topic-id t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}"))) (is (string= t100-string json-string)))))))) @@ -156,9 +156,9 @@ (frag-topic (create-latest-fragment-of-topic "http://www.topicmaps.org/xtm/1.0/core.xtm#topic"))) (let ((frag-t100-string - (concatenate 'string "{\"topic\":{\"id\":\"" (d:topicid (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}")) + (concatenate 'string "{\"topic\":{\"id\":\"" (d:topic-id (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}")) (frag-topic-string - (concatenate 'string "{\"topic\":{\"id\":\"" (topicid (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}"))) + (concatenate 'string "{\"topic\":{\"id\":\"" (topic-id (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}"))) (is (string= frag-t100-string (to-json-string frag-t100))) (is (string= frag-topic-string (to-json-string frag-topic)))))))) @@ -181,7 +181,7 @@ (json:decode-json-from-string json-fragment)))) (let ((topic (getf fragment-list :topic))) (is (string= (getf topic :ID) - (d:topicid + (d:topic-id (d:identified-construct (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri "http://psi.egovpt.org/standard/Topic+Maps+2002"))))) (is-false (getf topic :itemIdentities)) @@ -294,7 +294,7 @@ "http://psi.egovpt.org/types/standardHasStatus")) (is-false (getf occurrence-1 :scopes)) (is (string= (getf occurrence-1 :resourceRef) - (concatenate 'string "#" (d:topicid ref-topic)))) + (concatenate 'string "#" (d:topic-id ref-topic)))) (is-false (getf occurrence-1 :resourceData)) (is-false (getf occurrence-2 :itemIdentities)) (is (= (length (getf occurrence-2 :type)) 1)) @@ -357,7 +357,7 @@ subjectIdentifier)))) (is-true topic) (is-false subjectLocators) - (is (string= (d:topicid topic) id)) + (is (string= (d:topic-id topic) id)) (cond ((string= subjectIdentifier "http://psi.egovpt.org/types/semanticstandard") (is (= (length itemIdentities) 1)) Modified: branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp (original) +++ branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp Sun Mar 21 12:53:44 2010 @@ -31,7 +31,7 @@ (defun to-topicRef-elem-xtm1.0 (topic) (declare (TopicC topic)) (cxml:with-element "t:topicRef" - (cxml:attribute "xlink:href" (format nil "#~a" (topicid topic))))) + (cxml:attribute "xlink:href" (format nil "#~a" (topic-id topic))))) (defun to-reifier-elem-xtm1.0 (reifiable-construct) @@ -67,7 +67,7 @@ (let ((ref-topic (when (and (> (length characteristic-value) 0) (eql (elt characteristic-value 0) #\#)) (get-item-by-id (subseq characteristic-value 1))))) - (if ref-topic (concatenate 'string "#" (topicid ref-topic)) characteristic-value)))) + (if ref-topic (concatenate 'string "#" (topic-id ref-topic)) characteristic-value)))) (cxml:with-element "t:resourceData" (cxml:text characteristic-value))))) @@ -83,7 +83,7 @@ (declare (TopicC topic)) (cxml:with-element "t:instanceOf" (cxml:with-element "t:topicRef" - (cxml:attribute "xlink:href" (concatenate 'string "#" (topicid topic)))))) + (cxml:attribute "xlink:href" (concatenate 'string "#" (topic-id topic)))))) (defun to-subjectIdentity-elem-xtm1.0 (psis locator) @@ -145,7 +145,7 @@ "topic = element topic { id, instanceOf*, subjectIdentity, (baseName | occurrence)* }" (cxml:with-element "t:topic" - (cxml:attribute "id" (topicid topic)) + (cxml:attribute "id" (topic-id topic)) (when (list-instanceOf topic :tm *export-tm*) (map 'list #'to-instanceOf-elem-xtm1.0 (list-instanceOf topic :tm *export-tm*))) (when (or (psis topic) (locators topic)) @@ -188,7 +188,7 @@ with a topicid, psis and subjectLocators" (declare (TopicC topic)) (cxml:with-element "t:topic" - (cxml:attribute "id" (topicid topic)) + (cxml:attribute "id" (topic-id topic)) (to-subjectIdentity-elem-xtm1.0 (psis topic) (first (locators topic))))) Modified: branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp (original) +++ branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp Sun Mar 21 12:53:44 2010 @@ -25,7 +25,7 @@ ;;TODO: this is pretty much of a hack that works only for local ;;references (cxml:attribute "href" - (format nil "#~a" (topicid topic))))) + (format nil "#~a" (topic-id topic))))) (defgeneric to-elem (instance) (:documentation "converts the Topic Maps construct instance to an XTM 2.0 element")) @@ -74,7 +74,7 @@ (get-item-by-id (subseq characteristic-value 1))))) (cxml:attribute "href" (if ref-topic - (concatenate 'string "#" (topicid ref-topic)) + (concatenate 'string "#" (topic-id ref-topic)) characteristic-value)))) (cxml:with-element "t:resourceData" (when (slot-boundp characteristic 'datatype) @@ -124,7 +124,7 @@ (itemIdentity | subjectLocator | subjectIdentifier)*, instanceOf?, (name | occurrence)* }" (cxml:with-element "t:topic" - (cxml:attribute "id" (topicid topic)) + (cxml:attribute "id" (topic-id topic)) (map 'list #'to-elem (item-identifiers topic)) (map 'list #'to-elem (locators topic)) (map 'list #'to-elem (psis topic)) @@ -132,7 +132,7 @@ (cxml:with-element "t:instanceOf" (loop for item in (list-instanceOf topic :tm *export-tm*) do (cxml:with-element "t:topicRef" - (cxml:attribute "href" (concatenate 'string "#" (topicid item))))))) + (cxml:attribute "href" (concatenate 'string "#" (topic-id item))))))) (map 'list #'to-elem (names topic)) (map 'list #'to-elem (occurrences topic)))) @@ -142,7 +142,7 @@ with a topicid, a subjectLocator and an itemIdentity element" (declare (TopicC topic)) (cxml:with-element "t:topic" - (cxml:attribute "id" (topicid topic)) + (cxml:attribute "id" (topic-id topic)) (map 'list #'to-elem (psis topic)) (map 'list #'to-elem (item-identifiers topic)) (map 'list #'to-elem (locators topic))))

1 0

[isidorus-cvs] r237 - branches/new-datamodel/src/model
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 05:14:10 2010 New Revision: 237 Log: new-datamodel: fixed some sections that cauesd errors with the "changes.lisp" 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 Sun Mar 21 05:14:10 2010 @@ -14,6 +14,8 @@ duplicate-identifier-error) (:import-from :constants *xml-string*) + (:import-from :constants + *instance-psi*) (:export ;;classes :TopicMapC :AssociationC @@ -114,6 +116,9 @@ :TopicMapConstructC-p :VersionedConstructC-p :make-construct + :list-instanceOf + :in-topicmap + :string-start-with ;;globals :*TM-REVISION* @@ -315,9 +320,11 @@ (elephant:defpclass TopicMapC (ReifiableConstructC VersionedConstructC) ((topics :associate (TopicC in-topicmaps) :many-to-many t + :accessor topics :documentation "List of topics that explicitly belong to this TM.") (associations :associate (AssociationC in-topicmaps) :many-to-many t + :accessor associations :documentation "List of associations that belong to this TM.")) (:documentation "Represnets a topic map.")) @@ -673,7 +680,28 @@ (merge-constructs merged-construct construct-to-be-merged))))) +(defgeneric internal-id (construct) + (:documentation "Returns the internal id that uniquely identifies a + construct (currently simply its OID).")) + + +(defmethod internal-id ((construct TopicMapConstructC)) + (slot-value construct (find-symbol "OID" 'elephant))) + + +(defun string-starts-with (str prefix) + "Checks if string str starts with a given prefix." + (declare (string str prefix)) + (string= str prefix :start1 0 :end1 + (min (length prefix) + (length str)))) + + ;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric get-all-identifiers-of-construct (construct &key revision) + (:documentation "Get all identifiers that a given construct has")) + + (defgeneric get-all-characteristics (parent-construct characteristic-symbol) (:documentation "Returns all characterisitcs of the passed type the parent construct was ever associated with.")) @@ -700,7 +728,7 @@ (defgeneric in-topicmaps (construct &key revision) - (:documentation "Returns all TopicMapS-obejcts where the constrict is + (:documentation "Returns all TopicMaps-obejcts where the construct is contained in.")) @@ -1250,6 +1278,14 @@ construct))) +(defmethod get-all-identifiers-of-construct ((construct TopicC) + &key (revision 0)) + (declare (integer revision)) + (append (psis construct :revision revision) + (locators construct :revision revision) + (item-identifiers construct :revision revision))) + + (defgeneric names (construct &key revision) (:documentation "Returns the NameC-objects that correspond with the passed construct and the passed version.") @@ -1489,6 +1525,30 @@ :error-if-nil error-if-nil)) + +(defgeneric list-instanceOf (topic &key tm) + (:documentation "Generates a list of all topics that this topic is an + instance of, optionally filtered by a topic map")) + + +(defmethod list-instanceOf ((topic TopicC) &key (tm nil)) + (remove-if + #'null + (map 'list #'(lambda(x) + (when (loop for psi in (psis (instance-of x)) + when (string= (uri psi) constants:*instance-psi*) + return t) + (loop for role in (roles (parent x)) + when (not (eq role x)) + return (player role)))) + (if tm + (remove-if-not + (lambda (role) + (in-topicmap tm (parent role))) + (player-in-roles topic)) + (player-in-roles topic))))) + + ;;; CharacteristicC (defgeneric CharacteristicC-p (class-symbol) (:documentation "Returns t if the passed symbol is equal to CharacteristicC @@ -2135,6 +2195,13 @@ (mark-as-deleted assoc-to-delete :revision revision)) construct))) + +(defmethod get-all-identifiers-of-construct ((construct ReifiableConstructC) + &key (revision 0)) + (declare (integer revision)) + (item-identifiers construct :revision revision)) + + ;;; TypableC (defgeneric TypableC-p (class-symbol) (:documentation "Returns t if the passed class is equal to TypableC or @@ -2343,20 +2410,6 @@ (remove-association construct 'associations assoc))) -(defgeneric topics (construct &key revision) - (:documentation "Returns all TopicC-objects that are contained in the tm.") - (:method ((construct TopicMapC) &key (revision 0)) - (filter-slot-value-by-revision construct 'topics - :start-revision revision))) - - -(defgeneric associations (construct &key revision) - (:documentation "Returns all AssociationC-objects that are contained in the tm.") - (:method ((construct TopicMapC) &key (revision 0)) - (filter-slot-value-by-revision construct 'associations - :start-revision revision))) - - (defmethod add-to-tm ((construct TopicMapC) (construct-to-add TopicC)) (add-association construct 'topics construct-to-add)) @@ -2374,6 +2427,21 @@ (remove-association construct 'associations construct-to-delete)) +(defgeneric in-topicmap (tm construct &key revision) + (:documentation "Is a given construct (topic or assiciation) in this + topic map?")) + + +(defmethod in-topicmap ((tm TopicMapC) (top TopicC) &key (revision 0)) + (when (find-item-by-revision top revision) + (find (internal-id top) (topics tm) :test #'= :key #'internal-id))) + + +(defmethod in-topicmap ((tm TopicMapC) (ass AssociationC) &key (revision 0)) + (when (find-item-by-revision ass revision) + (find (internal-id ass) (associations tm) :test #'= :key #'internal-id))) + + ;;; make-construct ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun make-construct (class-symbol &rest args) "Creates a new topic map construct if necessary or @@ -2386,7 +2454,7 @@ ((PointerC-p class-symbol) (make-pointer class-symbol (getf args :uri) args)) ((CharacteristicC-p class-symbol) - (make-characteristic class-symbol (getf args :charvalue) args)) + (make-characteristic class-symbol args)) ((TopicC-p class-symbol) (make-topic args)) ((TopicMapC-p class-symbol)

1 0

[isidorus-cvs] r236 - branches/new-datamodel/src/model
by Lukas Giessmann 21 Mar '10

21 Mar '10

Author: lgiessmann Date: Sun Mar 21 04:36:20 2010 New Revision: 236 Log: new-datamodel: optimized "make-construct" Modified: branches/new-datamodel/src/model/changes.lisp branches/new-datamodel/src/model/datamodel.lisp Modified: branches/new-datamodel/src/model/changes.lisp ============================================================================== --- branches/new-datamodel/src/model/changes.lisp (original) +++ branches/new-datamodel/src/model/changes.lisp Sun Mar 21 04:36:20 2010 @@ -1,4 +1,4 @@ -#;;+----------------------------------------------------------------------------- +;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann ;;+ Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Mar 21 04:36:20 2010 @@ -1645,7 +1645,7 @@ (eql class-symbol 'NameC))) -(defgeneric initialize-name (construct variants &key start-revision) +(defgeneric complete-name (construct variants &key start-revision) (:documentation "Adds all given variants to the passed construct.") (:method ((construct NameC) (variants list) &key (start-revision *TM-REVISION*)) @@ -1966,7 +1966,7 @@ (CharacteristicC-p class-symbol)))) -(defgeneric initialize-reifiable (construct item-identifiers reifier +(defgeneric complete-reifiable (construct item-identifiers reifier &key start-revision) (:documentation "Adds all item-identifiers and the reifier to the passed construct.") @@ -2146,7 +2146,7 @@ (CharacteristicC-p class-symbol)))) -(defgeneric initialize-typable (construct instance-of &key start-revision) +(defgeneric complete-typable (construct instance-of &key start-revision) (:documentation "Adds the passed instance-of to the given construct.") (:method ((construct TypableC) instance-of &key (start-revision *TM-REVISION*)) @@ -2176,7 +2176,7 @@ (CharacteristicC-p class-symbol)))) -(defgeneric initialize-scopable (construct themes &key start-revision) +(defgeneric complete-scopable (construct themes &key start-revision) (:documentation "Adds all passed themes to the given construct.") (:method ((construct ScopableC) (themes list) &key (start-revision *TM-REVISION*)) @@ -2394,17 +2394,25 @@ ((RoleC-p class-symbol) (make-role args)) ((AssociationC-p class-symbol) - (make-association args))))) - construct)) + (make-association args)))) + (start-revision (getf args :start-revision))) + (when (typep construct 'TypableC) + (complete-typable construct (getf args :instance-of) + :start-revision start-revision)) + (when (typep construct 'ScopableC) + (complete-scopable construct (getf args :themes) + :start-revision start-revision)) + (if (typep construct 'ReifiableConstructC) + (complete-reifiable construct (getf args :item-identtifiers) + (getf args :reifier) :start-revision start-revision) + construct))) (defun make-association (args) "Returns an association object. If the association has already existed the existing one is returned otherwise a new one is created. This function exists only for being used by make-construct!" - (let ((item-identifiers (getf (first args) :item-identifiers)) - (reifier (getf (first args) :reifier)) - (instance-of (getf (first args) :instance-of)) + (let ((instance-of (getf (first args) :instance-of)) (start-revision (getf (first args) :start-revision)) (themes (get (first args) :themes)) (roles (get (first args) :roles)) @@ -2427,23 +2435,16 @@ (if existing-association existing-association (make-instance 'AssociationC))))) - (initialize-typable association instance-of :start-revision - start-revision) (dolist (role roles) (add-role association role :revision start-revision)) - (dolist (theme themes) - (add-theme association theme :revision start-revision)) - (initialize-reifiable association item-identifiers reifier - :start-revision start-revision)))) + association))) (defun make-role (args) "Returns a role object. If the role has already existed the existing one is returned otherwise a new one is created. This function exists only for being used by make-construct!" - (let ((item-identifiers (getf args :item-identifiers)) - (reifier (getf args :reifier)) - (parent (getf args :parent)) + (let ((parent (getf args :parent)) (instance-of (getf args :instance-of)) (player (getf args :player)) (start-revision (getf args :start-revision)) @@ -2467,11 +2468,9 @@ (make-instance 'RoleC))))) (when player (add-player role player :revision start-revision)) - (initialize-typable role instance-of :start-revision start-revision) (when parent (add-parent role parent :revision start-revision)) - (initialize-reifiable role item-identifiers reifier - :start-revision start-revision)))) + role))) (defun make-tm (args) @@ -2505,8 +2504,7 @@ (make-instance 'TopicMapC)))))) (dolist (top-or-assoc (union topics assocs)) (add-to-tm tm top-or-assoc)) - (initialize-reifiable tm item-identifiers reifier - :start-revision start-revision)))) + tm))) (defun make-topic (&rest args) @@ -2543,9 +2541,6 @@ (t (make-instance 'TopicC)))))) (let ((merged-topic topic)) - (setf merged-topic - (initialize-reifiable topic item-identifiers nil - :start-revision start-revision)) (dolist (psi psis) (setf merged-topic (add-psi merged-topic psi :revision start-revision))) @@ -2572,9 +2567,7 @@ (instance-of (getf (first args) :instance-of)) (themes (getf (first args) :themes)) (variants (getf (first args) :variants)) - (reifier (getf (first args) :reifier)) (parent (getf (first args) :parent)) - (item-identifiers (getf (first args) :item-identifiers)) (err "From make-characteristic(): ")) (unless start-revision (error "~astart-revision must be set" err)) (unless charvalue (error "~acharvalue must be set" err)) @@ -2599,14 +2592,10 @@ existing-characteristic (make-instance class-symbol :charvalue charvalue :datatype datatype))))) - (initialize-scopable characteristic themes :start-revision start-revision) - (initialize-typable characteristic instance-of - :start-revision start-revision) - (initialize-name characteristic variants :start-revision start-revision) + (complete-name characteristic variants :start-revision start-revision) (when parent (add-parent characteristic parent :revision start-revision)) - (initialize-reifiable characteristic item-identifiers - reifier :start-revision start-revision)))) + characteristic))) (defun make-pointer (class-symbol &rest args)

1 0

[isidorus-cvs] r235 - in branches/new-datamodel/src: model unit_tests
by Lukas Giessmann 20 Mar '10

20 Mar '10

Author: lgiessmann Date: Sat Mar 20 18:00:40 2010 New Revision: 235 Log: new-datamodel: finalized "make-construct" Modified: branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sat Mar 20 18:00:40 2010 @@ -663,6 +663,16 @@ (condition () nil))) +(defun merge-all-constructs(constructs-to-be-merged) + "Merges all constructs contained in the given list." + (declare (list constructs-to-be-merged)) + (let ((constructs-to-be-merged (subseq constructs-to-be-merged 1)) + (merged-construct (elt constructs-to-be-merged 0))) + (loop for construct-to-be-merged in constructs-to-be-merged + do (setf merged-construct + (merge-constructs merged-construct construct-to-be-merged))))) + + ;;; generic definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric get-all-characteristics (parent-construct characteristic-symbol) (:documentation "Returns all characterisitcs of the passed type the parent @@ -2378,29 +2388,104 @@ ((CharacteristicC-p class-symbol) (make-characteristic class-symbol (getf args :charvalue) args)) ((TopicC-p class-symbol) - (make-topic args))))) + (make-topic args)) + ((TopicMapC-p class-symbol) + (make-tm args)) + ((RoleC-p class-symbol) + (make-role args)) + ((AssociationC-p class-symbol) + (make-association args))))) construct)) -(defun merge-all-constructs(constructs-to-be-merged) - "Merges all constructs contained in the given list." - (declare (list constructs-to-be-merged)) - (let ((constructs-to-be-merged (subseq constructs-to-be-merged 1)) - (merged-construct (elt constructs-to-be-merged 0))) - (loop for construct-to-be-merged in constructs-to-be-merged - do (setf merged-construct - (merge-constructs merged-construct construct-to-be-merged))))) +(defun make-association (args) + "Returns an association object. If the association has already existed the + existing one is returned otherwise a new one is created. + This function exists only for being used by make-construct!" + (let ((item-identifiers (getf (first args) :item-identifiers)) + (reifier (getf (first args) :reifier)) + (instance-of (getf (first args) :instance-of)) + (start-revision (getf (first args) :start-revision)) + (themes (get (first args) :themes)) + (roles (get (first args) :roles)) + (err "From make-association(): ")) + (unless start-revision (error "~astart-revision must be set" err)) + (unless roles (error "~aroles must be set" err)) + (unless instance-of (error "~ainstance-of must be set" err)) + (let ((association + (let ((existing-association + (remove-if + #'null + (map 'list #'(lambda(existing-association) + (when (equivalent-construct + existing-association + :start-revision start-revision + :roles roles :themes themes + :instance-of instance-of) + existing-association)) + (elephant:get-instances-by-class 'AssociationC))))) + (if existing-association + existing-association + (make-instance 'AssociationC))))) + (initialize-typable association instance-of :start-revision + start-revision) + (dolist (role roles) + (add-role association role :revision start-revision)) + (dolist (theme themes) + (add-theme association theme :revision start-revision)) + (initialize-reifiable association item-identifiers reifier + :start-revision start-revision)))) -(defun make-tm (&rest args) +(defun make-role (args) + "Returns a role object. If the role has already existed the + existing one is returned otherwise a new one is created. + This function exists only for being used by make-construct!" + (let ((item-identifiers (getf args :item-identifiers)) + (reifier (getf args :reifier)) + (parent (getf args :parent)) + (instance-of (getf args :instance-of)) + (player (getf args :player)) + (start-revision (getf args :start-revision)) + (err "From make-role(): ")) + (unless start-revision (error "~astart-revision must be set" err)) + (unless instance-of (error "~ainstance-of must be set" err)) + (unless player (error "~aplayer must be set" err)) + (let ((role + (let ((existing-role + (remove-if + #'null + (map 'list #'(lambda(existing-role) + (when (equivalent-construct + existing-role + :player player + :instance-of instance-of) + existing-role)) + (slot-p parent 'roles))))) + (if existing-role + existing-role + (make-instance 'RoleC))))) + (when player + (add-player role player :revision start-revision)) + (initialize-typable role instance-of :start-revision start-revision) + (when parent + (add-parent role parent :revision start-revision)) + (initialize-reifiable role item-identifiers reifier + :start-revision start-revision)))) + + +(defun make-tm (args) "Returns a topic map object. If the topic map has already existed the existing one is returned otherwise a new one is created. This function exists only for being used by make-construct!" - (let ((item-identifiers (getf (first args) :item-identifiers)) - (reifier (getf (first args) :reifier)) - (topics (getf (first args) :topics)) - (assocs (getf (first args) :associations)) - (start-revision (getf (first args) :start-revision))) + (let ((item-identifiers (getf args :item-identifiers)) + (reifier (getf args :reifier)) + (topics (getf args :topics)) + (assocs (getf args :associations)) + (start-revision (getf args :start-revision)) + (err "From make-tm(): ")) + (unless item-identifiers (error "~aitem-identifiers must be set" err)) + (unless start-revision (error "~astart-revision must be set" err)) (let ((tm (let ((existing-tms (remove-if @@ -2420,21 +2505,24 @@ (make-instance 'TopicMapC)))))) (dolist (top-or-assoc (union topics assocs)) (add-to-tm tm top-or-assoc)) - (add-to-version-history tm :start-revision start-revision) - tm))) + (initialize-reifiable tm item-identifiers reifier + :start-revision start-revision)))) (defun make-topic (&rest args) "Returns a topic object. If the topic has already existed the existing one is returned otherwise a new one is created. This function exists only for being used by make-construct!" - (let ((start-revision (getf (first args) :start-revision)) - (psis (getf (first args) :psis)) - (locators (getf (first args) :locators)) - (item-identifiers (getf (first args) :item-identifiers)) - (topic-identifiers (getf (first args) :topic-identifiers)) - (names (getf (first args) :names)) - (occurrences (getf (first args) :occurrences))) + (let ((start-revision (getf args :start-revision)) + (psis (getf args :psis)) + (locators (getf args :locators)) + (item-identifiers (getf args :item-identifiers)) + (topic-identifiers (getf args :topic-identifiers)) + (names (getf args :names)) + (occurrences (getf args :occurrences)) + (err "From make-topic(): ")) + (unless topic-identifiers (error "~atopic-identifiers must be set" err)) + (unless start-revision (error "~astart-revision must be set" err)) (let ((topic (let ((existing-topics (remove-if @@ -2454,9 +2542,10 @@ (first existing-topics)) (t (make-instance 'TopicC)))))) - (initialize-reifiable topic item-identifiers nil - :start-revision start-revision) (let ((merged-topic topic)) + (setf merged-topic + (initialize-reifiable topic item-identifiers nil + :start-revision start-revision)) (dolist (psi psis) (setf merged-topic (add-psi merged-topic psi :revision start-revision))) @@ -2464,10 +2553,10 @@ (setf merged-topic (add-locator merged-topic locator :revision start-revision))) (dolist (name names) - (setf merged-topic (add-name topic name :revision start-revision))) + (setf merged-topic (add-name merged-topic name + :revision start-revision))) (dolist (occ occurrences) (add-occurrence merged-topic occ :revision start-revision)) - (add-to-version-history merged-topic :start-revision start-revision) merged-topic)))) @@ -2484,11 +2573,17 @@ (themes (getf (first args) :themes)) (variants (getf (first args) :variants)) (reifier (getf (first args) :reifier)) - (parent-construct (getf (first args) :parent-construct)) - (item-identifiers (getf (first args) :item-identifiers))) + (parent (getf (first args) :parent)) + (item-identifiers (getf (first args) :item-identifiers)) + (err "From make-characteristic(): ")) + (unless start-revision (error "~astart-revision must be set" err)) + (unless charvalue (error "~acharvalue must be set" err)) + (when (and (or (OccurrenceC-p class-symbol) (NameC-p class-symbol)) + (not instance-of)) + (error "~ainstance-of must be set" err)) (let ((characteristic (let ((existing-characteristic - (when parent-construct + (when parent (remove-if #'null (map 'list #'(lambda(existing-characteristic) @@ -2499,26 +2594,19 @@ :charvalue charvalue :themes themes :instance-of instance-of) existing-characteristic)) - (get-all-characteristics parent-construct - class-symbol)))))) + (get-all-characteristics parent class-symbol)))))) (if existing-characteristic existing-characteristic (make-instance class-symbol :charvalue charvalue :datatype datatype))))) - (let ((merged-characteristic characteristic)) - (setf merged-characteristic - (initialize-reifiable merged-characteristic item-identifiers - reifier :start-revision start-revision)) - (initialize-scopable merged-characteristic themes - :start-revision start-revision) - (initialize-typable merged-characteristic instance-of - :start-revision start-revision) - (initialize-name merged-characteristic variants - :start-revision start-revision) - (when parent-construct - (add-parent merged-characteristic parent-construct - :revision start-revision)) - merged-characteristic)))) + (initialize-scopable characteristic themes :start-revision start-revision) + (initialize-typable characteristic instance-of + :start-revision start-revision) + (initialize-name characteristic variants :start-revision start-revision) + (when parent + (add-parent characteristic parent :revision start-revision)) + (initialize-reifiable characteristic item-identifiers + reifier :start-revision start-revision)))) (defun make-pointer (class-symbol &rest args) @@ -2528,7 +2616,10 @@ (let ((uri (getf (first args) :uri)) (xtm-id (getf (first args) :xtm-id)) (start-revision (getf (first args) :start-revision)) - (identified-construct (getf (first args) :identified-construct))) + (identified-construct (getf (first args) :identified-construct)) + (err "From make-pointer(): ")) + (when (and identified-construct (not start-revision)) + (error "~astart-revision must be set" err)) (let ((identifier (let ((existing-pointer (remove-if Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Sat Mar 20 18:00:40 2010 @@ -61,11 +61,8 @@ :test-class-p)) -;;TODO: test merge-constructs when merging was caused by an item-dentifier, -;; a psi, a subject-locator, a topic-id -;;TODO: test merge-constructs when merging was caused by reifiers -;; (occurrences, names, variants, associations, roles) -;;TODO: test ReifiableConstructC --> reifier has to be merged +;;TODO: test make-construct +;;TODO: test merge-constructs

1 0