Changeset 298 for branches/new-datamodel/src

Timestamp:

06/13/10 14:42:34 (15 years ago)

Author:

lgiessmann

Message:

new-datamodel: adpted all unit-test for the xtm-importer (xtm2.0); fixed two bug in make-pointerc; fixed a bug when importing topics, names, occurrences, variants and tm-identifiers; fixed a bug in add-to-tm; fixed a bug when mergin was caused by an item-identifier

Location:

branches/new-datamodel/src

Files:

• model/datamodel.lisp (modified) (5 diffs)
• unit_tests/fixtures.lisp (modified) (1 diff)
• unit_tests/importer_test.lisp (modified) (24 diffs)
• xml/xtm/importer.lisp (modified) (1 diff)
• xml/xtm/importer_xtm2.0.lisp (modified) (8 diffs)

branches/new-datamodel/src/model/datamodel.lisp ¶

@@ -161 +161 @@
 
 
-;;TODO: adapt changes.lisp --> changed-p
 ;;TODO: implement a macro with-merge-constructs, that merges constructs
 ;;      after all operations in the body were called
@@ -1587 +1586 @@
                    returns one of the topic-ids in that TM
                    (which must then exist).")
-  (:method ((construct TopicC) &optional (xtm-id nil) (revision *TM-REVISION*))
-    (declare (type (or null string) xtm-id) (integer revision))
+  (:method ((construct TopicC) &optional (revision *TM-REVISION*) (xtm-id nil))
+    (declare (type (or string null) xtm-id)
+             (type (or integer null) revision))
     (if xtm-id
         (let ((possible-identifiers
@@ -3128 +3128 @@
              (when (not (eql id-owner construct))
                id-owner))))
+      (when (and construct-to-be-merged
+                 (not (eql (type-of construct-to-be-merged)
+                           (type-of construct))))
+        (error (make-not-mergable-condition (format nil "From add-item-identifier(): ~a and ~a can't be merged since the identified-constructs are not of the same type"
+                                                    construct construct-to-be-merged)
+                                            construct construct-to-be-merged)))
       (let ((merged-construct construct))
         (cond (construct-to-be-merged
@@ -3486 +3492 @@
 
 (defmethod add-to-tm ((construct TopicMapC) (construct-to-add TopicC))
-  (add-association construct 'topics construct-to-add))
+  (add-association construct 'topics construct-to-add)
+  construct-to-add)
 
 
 (defmethod add-to-tm ((construct TopicMapC) (construct-to-add AssociationC))
-  (add-association construct 'associations construct-to-add))
+  (add-association construct 'associations construct-to-add)
+  construct-to-add)
 
 
@@ -3807 +3815 @@
                    (map 'list 
                         #'(lambda(existing-pointer)
-                            (when (equivalent-construct existing-pointer uri
-                                                        xtm-id)
+                            (when (equivalent-construct existing-pointer :uri uri
+                                                        :xtm-id xtm-id)
                               existing-pointer))
                         (elephant:get-instances-by-value class-symbol 'd::uri uri)))))
-             (if existing-pointer existing-pointer
+             (if existing-pointer
+                 (first existing-pointer)
                  (make-instance class-symbol :uri uri :xtm-id xtm-id)))))
       (when identified-construct

branches/new-datamodel/src/unit_tests/fixtures.lisp ¶

@@ -95 +95 @@
 
 (def-fixture initialized-test-db (&optional (xtm *NOTIFICATIONBASE-TM*))
-  (let
-      ((revision (get-revision)))
+  (let ((revision (get-revision)))
     (declare (ignorable revision))
+    (setf *TM-REVISION* revision)
     (setf *XTM-TM* xtm)
     (set-up-test-db revision)
-    (let
-        ((tm 
-          (get-item-by-item-identifier "http://www.isidor.us/unittests/testtm" :revision (d:get-revision))))
+    (let ((tm 
+           (get-item-by-item-identifier "http://www.isidor.us/unittests/testtm"
+                                        :revision revision)))
       (declare (ignorable tm))
       (&body)

branches/new-datamodel/src/unit_tests/importer_test.lisp ¶

@@ -23 +23 @@
   (:import-from :exceptions
                 missing-reference-error
-                duplicate-identifier-error)
+                duplicate-identifier-error
+                not-mergable-error )
   (:export :importer-test 
            :test-error-detection
@@ -58 +59 @@
   (with-fixture 
       initialized-test-db()
-    (let 
-        ((type-elems 
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "topic")
-             (*xtm2.0-ns* "occurrence")
-             (*xtm2.0-ns* "type")))))
+    (let ((type-elems 
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "topic")
+              (*xtm2.0-ns* "occurrence")
+              (*xtm2.0-ns* "type"))))
+          (rev-1 *TM-REVISION*))
       (loop for type-elem in type-elems do
-           (is (typep (from-type-elem type-elem) 'TopicC)))
-      (is-false (from-type-elem nil))
+           (is (typep (from-type-elem type-elem rev-1) 'TopicC)))
+      (is-false (from-type-elem nil rev-1))
       (let
           ((t100-occtype
-            (from-type-elem (first type-elems))))        
+            (from-type-elem (first type-elems) rev-1)))        
         (format t "occtype: ~a~&" t100-occtype)
         (format t "occtype: ~a~&" (psis t100-occtype))
@@ -83 +84 @@
   (with-fixture 
       initialized-test-db()
-    (let 
-        ((scope-elems 
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "topic")
-             (*xtm2.0-ns* "name")
-             (*xtm2.0-ns* "scope")))))
+    (let ((scope-elems 
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "topic")
+              (*xtm2.0-ns* "name")
+              (*xtm2.0-ns* "scope"))))
+          (rev-1 *TM-REVISION*))
       (loop for scope-elem in scope-elems do
-           (is (>= (length (from-scope-elem scope-elem)) 1)))
-      (is-false (from-scope-elem nil))
+           (is (>= (length (from-scope-elem scope-elem rev-1)) 1)))
+      (is-false (from-scope-elem nil rev-1))
       (let
           ((t101-themes
-            (from-scope-elem (first scope-elems))))
+            (from-scope-elem (first scope-elems) rev-1)))
         (is (= 1 (length t101-themes)))
         (is 
@@ -106 +107 @@
   (with-fixture 
       initialized-test-db()
-    (let 
-        ((name-elems
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "topic")
-             (*xtm2.0-ns* "name"))))
-         (top (get-item-by-id "t1"))) ;an arbitrary topic
+    (let ((name-elems
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "topic")
+              (*xtm2.0-ns* "name"))))
+          (top (get-item-by-id "t1")) ;an arbitrary topic
+          (rev-1 *TM-REVISION*))
       (loop for name-elem in name-elems do
-           (is (typep (from-name-elem name-elem top revision) 'NameC)))
+           (is (typep (from-name-elem name-elem top rev-1) 'NameC)))
       (let
-          ((t1-name (from-name-elem (first name-elems) top revision))
-           (t1-name-copy (from-name-elem (first name-elems) top revision))
-           (t101-longname (from-name-elem (nth 27 name-elems) top revision)))
+          ((t1-name (from-name-elem (first name-elems) top rev-1))
+           (t1-name-copy (from-name-elem (first name-elems) top rev-1))
+           (t101-longname (from-name-elem (nth 27 name-elems) top rev-1)))
         (is (string= (charvalue t1-name) "Topic Type"))
-        (is (string= 
-             (charvalue t101-longname) 
-             "ISO/IEC 13250:2002: Topic Maps"))
-        (is (= 1 (length (item-identifiers t101-longname))))
- 
-        (is (string= 
-             (uri (first (psis (instance-of t101-longname))))
-             "http://psi.egovpt.org/types/long-name"))
-        (is (themes t101-longname))
+        (is (string= (charvalue t101-longname) 
+                     "ISO/IEC 13250:2002: Topic Maps"))
+        (is (= 1 (length (item-identifiers t101-longname :revision rev-1))))
+        (is (string= (uri (first (psis (instance-of t101-longname))))
+                     "http://psi.egovpt.org/types/long-name"))
+        (is (themes t101-longname :revision rev-1))
         (is (string= 
-             (topic-id (first (themes t101-longname)) *TEST-TM*)
+             (topic-id (first (themes t101-longname :revision rev-1))
+                       rev-1 *TEST-TM*)
              "t50a"))
-        (is (eq t1-name t1-name-copy)) ;must be merged
-            ))))
+        (is (eq t1-name t1-name-copy)))))) ;must be merged
+
 
 (test test-from-occurrence-elem
@@ -139 +138 @@
   (with-fixture 
       initialized-test-db()
-    (let 
-        ((occ-elems
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "topic")
-             (*xtm2.0-ns* "occurrence"))))
-         (top (get-item-by-id "t1"))) ;an abritrary topic
-
+    (let ((occ-elems
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "topic")
+              (*xtm2.0-ns* "occurrence"))))
+          (top (get-item-by-id "t1")) ;an abritrary topic
+          (rev-1 *TM-REVISION*))
       (loop for occ-elem in occ-elems do
-           (is (typep (from-occurrence-elem occ-elem top revision)
-                    'OccurrenceC)))
+           (is (typep (from-occurrence-elem occ-elem top rev-1)
+                      'OccurrenceC)))
       (is (= 1 (length (elephant:get-instances-by-value 
-              'ItemIdentifierC
-              'uri
-              "http://psi.egovpt.org/itemIdentifiers#t100_o1"))))
+                        'ItemIdentifierC
+                        'uri
+                        "http://psi.egovpt.org/itemIdentifiers#t100_o1"))))
       (let
           ((t100-occ1
@@ -167 +165 @@
               'uri
               "http://psi.egovpt.org/itemIdentifiers#t100_o2"))))
-        (is (= 1 (length (item-identifiers t100-occ1))));just to double-check
+        (is (= 1 (length (item-identifiers t100-occ1 :revision rev-1)))) ;just to double-check
         (is (string=
-             (uri (first (item-identifiers t100-occ1)))
+             (uri (first (item-identifiers t100-occ1 :revision rev-1)))
              "http://psi.egovpt.org/itemIdentifiers#t100_o1"))
         (is (string= (charvalue t100-occ1) "http://www.budabe.de/"))
@@ -180 +178 @@
   (with-fixture 
       initialized-test-db()
-    (let 
-        ((topic-elems
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "topic")))))
-                                             
+    (let ((topic-elems
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "topic"))))
+          (rev-1 *TM-REVISION*))
       (loop for topic-elem in topic-elems do
            (is (typep 
-                (merge-topic-elem topic-elem revision :tm fixtures::tm)
+                (merge-topic-elem topic-elem rev-1 :tm fixtures::tm)
                     'TopicC)))
       (let
           ((top-t1 (merge-topic-elem (first topic-elems) 
-                                     revision :tm fixtures::tm))
+                                     rev-1 :tm fixtures::tm))
            (top-t57 (get-item-by-id "t57"))
            (top-t101 (get-item-by-id "t101"))
@@ -199 +196 @@
            ;one of the core PSIs
            (top-sup-sub (get-item-by-id "supertype-subtype" :xtm-id "core.xtm")))
-        (is (= (internal-id top-t301) 
-               (internal-id top-t301a)))
-        (is (= (length (occurrences top-t1)) 0))
-        (is (= (length (occurrences top-t101)) 4))
-        (is (= (length (names top-t57)) 1))
-        (is (string= (uri (first (item-identifiers top-t57)))
+        (is (= (elephant::oid top-t301) (elephant::oid top-t301a)))
+        (is-true top-t301a)
+        (is (= (length (occurrences top-t1 :revision rev-1)) 0))
+        (is (= (length (occurrences top-t101 :revision rev-1)) 4))
+        (is (= (length (names top-t57 :revision rev-1)) 1))
+        (is (string= (uri (first (item-identifiers top-t57 :revision rev-1)))
                      "http://psi.egovpt.org/itemIdentifiers#t57"))
-        (is (= 2 (length (names top-t101))))
-        (is (= 2 (length (names top-t301)))) ;after merge
-        (is-true (item-identifiers (first (names top-t301)))) ;after merge
-        (is (= 2 (length (psis top-t301)))) ;after merge
-        (is (= 3 (length (occurrences top-t301)))) ;after merge
+        (is (= 2 (length (names top-t101 :revision rev-1))))
+        (is (= 2 (length (names top-t301 :revision rev-1)))) ;after merge
+        (is-true (item-identifiers (first (names top-t301 :revision rev-1))
+                                   :revision rev-1)) ;after merge
+        (is (= 2 (length (psis top-t301 :revision rev-1)))) ;after merge
+        (is (= 3 (length (occurrences top-t301 :revision rev-1)))) ;after merge
         (is (string= "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype"
-                     (uri (first (psis top-sup-sub)))))))
-
+                     (uri (first (psis top-sup-sub :revision rev-1)))))))
     ;34 topics in 35 topic elements in notificationbase.xtm and 13
     ;core topics
@@ -227 +224 @@
            *XTM-TM*
            '((*xtm2.0-ns* "association")
-             (*xtm2.0-ns* "role")))))
+             (*xtm2.0-ns* "role"))))
+         (rev-1 *TM-REVISION*))
       (loop for role-elem in role-elems do
            (is (typep (from-role-elem role-elem revision) 'list)))
@@ -235 +233 @@
         (is (string= "t101" 
                      (topic-id 
-                      (getf 12th-role :player) *TEST-TM*))) 
+                      (getf 12th-role :player) rev-1 *TEST-TM*))) 
         (is (string=  "t62" 
                       (topic-id
-                       (getf 12th-role :instance-of) *TEST-TM*)))))))
+                       (getf 12th-role :instance-of) rev-1 *TEST-TM*)))))))
+
 
 (test test-from-association-elem
@@ -244 +243 @@
   (with-fixture 
       initialized-test-db()
-    (let 
-        ((assoc-elems
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "association")))))
+    (let ((assoc-elems
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "association"))))
+          (rev-1 *TM-REVISION*))
       (loop for assoc-elem in assoc-elems do
            (is 
-            (typep (from-association-elem assoc-elem revision :tm fixtures::tm)
+            (typep (from-association-elem assoc-elem rev-1 :tm fixtures::tm)
                 'AssociationC)))
-      ;(trace datamodel:item-identifiers datamodel::filter-slot-value-by-revision)
-      (let 
-          ((6th-assoc
-            (sixth (elephant:get-instances-by-class 'AssociationC)))
-           (last-assoc
-            (seventh (elephant:get-instances-by-class 'AssociationC))))
-        (is (= 2 (length (roles last-assoc))))
-        (is (= 1 (length (item-identifiers last-assoc))))
+      (let ((6th-assoc
+             (sixth (elephant:get-instances-by-class 'AssociationC)))
+            (last-assoc
+             (seventh (elephant:get-instances-by-class 'AssociationC))))
+        (is (= 2 (length (roles last-assoc :revision rev-1))))
+        (is (= 1 (length (item-identifiers last-assoc :revision rev-1))))
         (is (string= "t300"
-             (topic-id (player (first (roles 6th-assoc)))  *TEST-TM*)))
+             (topic-id (player (first (roles 6th-assoc :revision rev-1))
+                               :revision rev-1) rev-1 *TEST-TM*)))
         (is (string= "t63" 
-             (topic-id (instance-of (first (roles 6th-assoc)))
-                      *TEST-TM*)))
+             (topic-id (instance-of (first (roles 6th-assoc :revision rev-1))
+                                    :revision rev-1) rev-1 *TEST-TM*)))
         (is (string= "t301" 
-             (topic-id (player (first (roles last-assoc)))
-                      *TEST-TM*))))
-      ;(untrace datamodel:item-identifiers datamodel::filter-slot-value-by-revision))
-      )
-    ;(map 'list (lambda (a) (format t "~a" (exporter:to-string a))) (elephant:get-instances-by-class 'AssociationC))
+             (topic-id (player (first (roles last-assoc :revision rev-1))
+                               :revision rev-1) rev-1 *TEST-TM*)))))
     (is (= 7
            (length (elephant:get-instances-by-class 'AssociationC))))))
@@ -281 +276 @@
   (with-fixture 
       initialized-test-db()
-    (let
-        ((topic-elems
-          (xpath-select-location-path
-           *XTM-TM*
-           '((*xtm2.0-ns* "topic")))))
+    (let ((topic-elems
+           (xpath-select-location-path
+            *XTM-TM*
+            '((*xtm2.0-ns* "topic"))))
+          (rev-1 *TM-REVISION*))
       (loop for topic-elem in topic-elems do
-           (let
-               (
-                ;this already implicitly creates the instanceOf
-                ;associations as needed
-                (topic (merge-topic-elem topic-elem revision :tm fixtures::tm)))
-             ;(format t "instanceof-topicrefs: ~a~&" instanceof-topicrefs)
-             (dolist (io-role 
-                       (elephant:get-instances-by-value
-                        'RoleC
-                        'player topic))
-               (let
-                   ((io-assoc (parent io-role)))
-                 ;(format t "(io-topicref: ~a, topic: ~a)~&" io-topicref topic)
-                 (is 
-                  (typep io-assoc
-                      'AssociationC))
-                 (is (string= (topic-id topic)
-                            (topic-id (player (second (roles io-assoc))))))))))
-
-      (let*
-          ((t101-top (get-item-by-id "t101"))
+           (let (;this already implicitly creates the instanceOf
+                 ;associations as needed
+                 (topic (merge-topic-elem topic-elem rev-1 :tm fixtures::tm)))
+              (dolist (io-role (map 'list #'d::parent-construct
+                                    (d::slot-p topic 'd::player-in-roles)))
+                (let ((io-assoc (parent io-role :revision rev-1)))
+                  (is (typep io-assoc 'AssociationC))
+                  (is (string= (topic-id topic rev-1)
+                               (topic-id (player (second
+                                                  (roles io-assoc :revision rev-1))
+                                                 :revision rev-1) rev-1)))))))
+      (let* ((t101-top (get-item-by-id "t101" :revision rev-1))
                                         ;get all the roles t101 is involved in
-           (roles-101 (elephant:get-instances-by-value 'RoleC 'player t101-top))
+             (roles-101 (map 'list #'d::parent-construct
+                             (d::slot-p t101-top 'd::player-in-roles)))
                                         ;and filter those whose roletype is "instance"
                                         ;(returning, of course, a list)
-           
                                         ;TODO: what we'd really need
                                         ;is a filter that works
@@ -318 +304 @@
                                         ;rather than instantiating
                                         ;many unnecessary role objects
-           (role-101 (remove-if-not 
-                      (lambda (role)
-                        (string= (uri (first (psis (instance-of role))))
-                                 "http://psi.topicmaps.org/iso13250/model/instance")) roles-101)))
+             (role-101 (remove-if-not 
+                        (lambda (role)
+                          (string= (uri (first (psis
+                                                (instance-of role :revision rev-1)
+                                                :revision rev-1)))
+                                   "http://psi.topicmaps.org/iso13250/model/instance"))
+                        roles-101)))
                                         ;Topic t101 (= Topic Maps 2002
                                         ;standard) is subclass of
                                         ;topic t3a (semantic standard)
-
         (is-true t101-top)
         (is (= 1 (length role-101)))
-        ;(is (= 1 (length (d::versions role-101))))
         (is (string= "t3a"
-                     (topic-id (player (first (roles (parent (first role-101))))) *TEST-TM*)))
+                     (topic-id (player (first (roles (parent (first role-101))
+                                                     :revision rev-1))
+                                       :revision rev-1)
+                               rev-1 *TEST-TM*)))
         (is (string= "type-instance"
                      (topic-id (instance-of 
-                               (parent (first role-101))) "core.xtm")))
-        ))))
+                                (parent (first role-101) :revision rev-1))
+                               rev-1 "core.xtm")))))))
+
 
 (test test-error-detection
@@ -357 +348 @@
                   :tm-id "http://www.isidor.us/unittests/baretests"))))
   (with-fixture bare-test-db()
-    (signals duplicate-identifier-error
+    (signals not-mergable-error
       (let 
           ((xtm-dom
@@ -374 +365 @@
                                      :tm-id "http://www.isidor.us/unittests/topic-t100")
       (elephant:open-store (xml-importer:get-store-spec dir))
-
       (is (= 25 (length (elephant:get-instances-by-class 'TopicC)))) ;; are all topics in the db +std topics
-      (is-true (get-item-by-id "t100")) ;; main topic
-      (is-true (get-item-by-id "t3a"))  ;; instanceOf
-      (is-true (get-item-by-id "t50a")) ;; scope
-      (is-true (get-item-by-id "t51"))   ;; occurrence/type
-      (is-true (get-item-by-id "t52"))   ;; occurrence/resourceRef
-      (is-true (get-item-by-id "t53"))   ;; occurrence/type
-      (is-true (get-item-by-id "t54"))   ;; occurrence/type
-      (is-true (get-item-by-id "t55"))  ;; occurrence/type
-      (let ((t100 (get-item-by-id "t100")))
+      (is-true (get-item-by-id "t100" :revision 0)) ;; main topic
+      (is-true (get-item-by-id "t3a" :revision 0))  ;; instanceOf
+      (is-true (get-item-by-id "t50a" :revision 0)) ;; scope
+      (is-true (get-item-by-id "t51" :revision 0))   ;; occurrence/type
+      (is-true (get-item-by-id "t52" :revision 0))   ;; occurrence/resourceRef
+      (is-true (get-item-by-id "t53" :revision 0))   ;; occurrence/type
+      (is-true (get-item-by-id "t54" :revision 0))   ;; occurrence/type
+      (is-true (get-item-by-id "t55" :revision 0))  ;; occurrence/type
+      (let ((t100 (get-item-by-id "t100" :revision 0)))
         ;; checks instanceOf
-        (is (= 1 (length (player-in-roles t100))))
-        (let* 
-            ((role-t100 (first (player-in-roles t100)))
-             (assoc (parent role-t100))
-             (role-t3a (first (roles assoc))))
-          (is (= 1 (length (psis (instance-of role-t100)))))
-          (is (string= (uri (first (psis (instance-of role-t100)))) "http://psi.topicmaps.org/iso13250/model/instance"))
-          (is (= 1 (length (psis (instance-of role-t3a)))))
-          (is (string= (uri (first (psis (instance-of role-t3a)))) "http://psi.topicmaps.org/iso13250/model/type")))
-        
+        (is (= 1 (length (player-in-roles t100 :revision 0))))
+        (let* ((role-t100 (first (player-in-roles t100 :revision 0)))
+               (assoc (parent role-t100 :revision 0))
+               (role-t3a (first (roles assoc :revision 0))))
+          (is (= 1 (length (psis (instance-of role-t100 :revision 0) :revision 0))))
+          (is (string= (uri (first (psis (instance-of role-t100 :revision 0)
+                                         :revision 0)))
+                       "http://psi.topicmaps.org/iso13250/model/instance"))
+          (is (= 1 (length (psis (instance-of role-t3a :revision 0) :revision 0))))
+          (is (string= (uri (first (psis (instance-of role-t3a :revision 0)
+                                         :revision 0)))
+                       "http://psi.topicmaps.org/iso13250/model/type")))
         ;; checks subjectIdentifier
-        (is (= 1 (length (psis t100))))
+        (is (= 1 (length (psis t100 :revision 0))))
         (is (string= "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata"
-                     (uri (first (psis t100)))))
-        (is (equal (identified-construct (first (psis t100))) t100)) ;;other association part
-          
+                     (uri (first (psis t100 :revision 0)))))
+        (is (equal (identified-construct (first (psis t100 :revision 0))
+                                         :revision 0) t100)) ;;other association part
         ;; checks names
-        (is (= 2 (length (names t100))))
-        (loop for item in (names t100)
+        (is (= 2 (length (names t100 :revision 0))))
+        (loop for item in (names t100 :revision 0)
            do (is (or (string= (charvalue item) "ISO 19115")
                       (and (string= (charvalue item) "ISO 19115:2003 Geographic Information - Metadata")
-                           (= (length (themes item)) 1)
-                           (= (length (psis (first (themes item)))))
-                           (string= (uri (first (psis (first (themes item))))) "http://psi.egovpt.org/types/long-name")))))
-        (is-true (used-as-theme (get-item-by-id "t50a"))) ;checks the other part of the association -> fails
-
+                           (= (length (themes item :revision 0)) 1)
+                           (= (length (psis (first (themes item :revision 0))
+                                            :revision 0)))
+                           (string= (uri (first (psis (first (themes item :revision 0))
+                                                      :revision 0)))
+                                    "http://psi.egovpt.org/types/long-name")))))
+        (is-true (used-as-theme (get-item-by-id "t50a" :revision 0)
+                                :revision 0)) ;checks the other part of the association -> fails
         ;; checks occurrences
+        (setf *TM-REVISION* 0)
         (is (= 4 (length (occurrences (get-item-by-id "t100")))))
         (loop for item in (occurrences t100)
@@ -434 +430 @@
            do (progn
                 (is (string= (charvalue item) "http://www.editeur.org/standards/ISO19115.pdf"))
-                (is (string= (uri (first (psis (instance-of item)))) "http://psi.egovpt.org/types/links")))
-           when (and (not (elephant:associatedp (get-item-by-id "t51") 'datamodel::used-as-type item))
-                     (not (elephant:associatedp (get-item-by-id "t53") 'datamodel::used-as-type item))
-                     (not (elephant:associatedp (get-item-by-id "t54") 'datamodel::used-as-type item))
-                     (not (elephant:associatedp (get-item-by-id "t55") 'datamodel::used-as-type item)))
-           do (is-true nil))))))
+                (is (string= (uri (first (psis (instance-of item)))) "http://psi.egovpt.org/types/links"))))))))
 
 
@@ -451 +442 @@
        :tm-id "http://www.isidor.us/unittests/xtm1.0-tests"
        :xtm-id *TEST-TM* :xtm-format '1.0)
-
+      (setf *TM-REVISION* 0)
       (elephant:open-store (xml-importer:get-store-spec dir))
       (is (=  36 (length (elephant:get-instances-by-class 'TopicC)))) ;13 + (23 core topics)
@@ -508 +499 @@
 
 
-
 (test test-variants
   (let
@@ -515 +505 @@
       (xml-importer:setup-repository
        *notificationbase.xtm* dir :xtm-id *TEST-TM*)
-
+      (setf *TM-REVISION* 0)
       (elephant:open-store (xml-importer:get-store-spec dir))
       (let ((variants (elephant:get-instances-by-class 'VariantC)))
@@ -524 +514 @@
                     (string-type "http://www.w3.org/2001/XMLSchema#string")
                     (itemIdentities (map 'list #'uri (item-identifiers variant)))
-                    (parent-name-value (charvalue (name variant)))
+                    (parent-name-value (charvalue (parent variant)))
                     (scopes (map 'list #'uri
                                   (map 'list #'(lambda(x)
@@ -535 +525 @@
                   ((string= resourceData "Long-Version")
                    (is (string= parent-name-value "long version of a name"))
-                   (is (= (length (variants (name variant))) 1))
-                   (is (eql variant (first (variants (name variant)))))
+                   (is (= (length (variants (parent variant))) 1))
+                   (is (eql variant (first (variants (parent variant)))))
                    (check-for-duplicate-identifiers variant)
                    (is-false itemIdentities)
@@ -544 +534 @@
                   ((string= resourceData "Geographic Information - Metadata")
                    (is (string= parent-name-value "ISO 19115"))
-                   (is (= (length (variants (name variant))) 2))
-                   (is (or (eql variant (first (variants (name variant))))
-                           (eql variant (second (variants (name variant))))))
+                   (is (= (length (variants (parent variant))) 2))
+                   (is (or (eql variant (first (variants (parent variant))))
+                           (eql variant (second (variants (parent variant))))))
                    (check-for-duplicate-identifiers variant)
                    (is (= (length scopes) 1))
@@ -562 +552 @@
                   ((string= resourceData "ISO/IEC-13250:2002")
                    (is (string= parent-name-value "ISO/IEC 13250:2002: Topic Maps"))
-                   (is (= (length (variants (name variant))) 1))
-                   (is (eql variant (first (variants (name variant)))))
+                   (is (= (length (variants (parent variant))) 1))
+                   (is (eql variant (first (variants (parent variant)))))
                    (check-for-duplicate-identifiers variant)
                    (check-for-duplicate-identifiers variant)               
@@ -655 +645 @@
           "http://www.topicmaps.org/xtm/1.0/core.xtm")
         (mapcan (lambda (tm) 
-                 (mapcar #'uri (item-identifiers tm)))
+                 (mapcar #'uri (item-identifiers tm :revision 0)))
                 tms) :test #'string=)))))
 

branches/new-datamodel/src/xml/xtm/importer.lisp ¶

@@ -197 +197 @@
       :start-revision start-revision
       :instance-of associationtype
-      :roles (list (list :instance-of roletype1 :player player1)
-                   (list :instance-of roletype2 :player player2-obj))))))
+      :roles (list (list :start-revision start-revision
+                         :instance-of roletype1
+                         :player player1)
+                   (list :start-revision start-revision
+                         :instance-of roletype2
+                         :player player2-obj))))))

branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp ¶

@@ -35 +35 @@
   (declare (integer start-revision))
   (let
-      ((id (make-instance classsymbol
+      ((id (make-construct classsymbol
                           :uri (get-attribute elem "href")
                           :start-revision start-revision)))
@@ -131 +131 @@
     (let ((name (make-construct 'NameC 
                                 :start-revision start-revision
-                                :topic top
+                                :parent top
                                 :charvalue namevalue
                                 :instance-of instance-of
@@ -201 +201 @@
                     :datatype (getf variant-value :type)
                     :reifier reifier-topic
-                    :name name)))
+                    :parent name)))
                            
 
@@ -227 +227 @@
     (make-construct 'OccurrenceC 
                     :start-revision start-revision
-                    :topic top
+                    :parent top
                     :themes themes
                     :item-identifiers item-identifiers
@@ -253 +253 @@
           (make-identifiers 'PersistentIdC topic-elem "subjectIdentifier" start-revision))
          (subjectlocators
-          (make-identifiers 'SubjectLocatorC topic-elem "subjectLocator" start-revision)))
+          (make-identifiers 'SubjectLocatorC topic-elem "subjectLocator" start-revision))
+         (topic-ids (when (get-attribute topic-elem "id")
+                      (list (make-construct 'TopicIdentificationC
+                                            :uri (get-attribute topic-elem "id")
+                                            :xtm-id xtm-id)))))
       (make-construct 'TopicC
                       :start-revision start-revision
@@ -259 +263 @@
                       :locators subjectlocators
                       :psis subjectidentifiers
-                      :topicid (get-attribute topic-elem "id")
+                      :topic-identifiers topic-ids
                       :xtm-id xtm-id))))
           
@@ -284 +288 @@
                   (*xtm2.0-ns* "topicRef"))))))
       (unless top
-        (error "topic ~a could not be found" (get-attribute topic-elem "id")))
+        (error "topic ~a could not be found (xtm-id: ~a, revision: ~a)"
+               (get-attribute topic-elem "id") xtm-id start-revision))
       (map 'list
        (lambda
@@ -336 +341 @@
              *xtm2.0-ns*
              "topicRef"))))
-      (list :reifier reifier-topic
+      (list :start-revision start-revision
+            :reifier reifier-topic
             :instance-of instance-of
             :player player