source: trunk/src/xml/xtm/importer_xtm1.0.lisp

Last change on this file was 469, checked in by lgiessmann, 14 years ago

xtm-im/exporter | rdf-im/exporter | jtm-im/exporter | isidorus-json-im/exporter: if an untyped name is imported the default-name-type defined by TMDM 7.5 is set. This topic is contained in the file core_psis.xtm and is only imported in the topic map that is created by init-isidorus, i.e. the topic is not added to topics where it is used as name-type. When a name is exported that is typed by the defualt-name-type, the name-type is ignored and the name is exported as untyped name
  • Property svn:eol-style set to native
File size: 21.0 KB
Line 
1;;+-----------------------------------------------------------------------------
2;;+  Isidorus
3;;+  (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
4;;+
5;;+  Isidorus is freely distributable under the LLGPL license.
6;;+  You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
7;;+  trunk/docs/LGPL-LICENSE.txt.
8;;+-----------------------------------------------------------------------------
9
10(in-package :xtm-importer)
11
12(defun get-reifier-topic-xtm1.0 (reifiable-elem start-revision)
13  "Returns a reifier topic of the reifiable-element or nil."
14  (declare (dom:element reifiable-elem))
15  (let ((reifier-uri
16         (when (dom:get-attribute-node reifiable-elem "id")
17           (dom:node-value (dom:get-attribute-node reifiable-elem "id")))))
18    (when (and (stringp reifier-uri)
19               (> (length reifier-uri) 0))
20      (let ((psi
21             (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
22                                             (concat "#" reifier-uri))))
23        (when psi
24          (let ((reifier-topic (identified-construct psi :revision start-revision)))
25            (when reifier-topic
26              reifier-topic)))))))
27
28
29(defun get-topic-id-xtm1.0 (topic-elem)
30  "returns the id attribute of a topic element"
31  (declare (dom:element topic-elem))
32  (dom:node-value (dom:get-attribute-node topic-elem "id")))
33
34
35(defun from-resourceRef-elem-xtm1.0 (resourceRef-elem)
36  "returns the href attrubte of the passed resourceRef element"
37  (when resourceRef-elem
38    (dom:get-attribute-ns resourceRef-elem *xtm1.0-xlink* "href")))
39
40
41(defun from-resourceX-elem-xtm1.0 (parent-elem)
42  "handles the following problem: { resourceRef | resourceData }
43   and returns a list with a data and a type node"
44  (when parent-elem
45    (let ((data
46           (let ((resourceRef-elem
47                  (xpath-single-child-elem-by-qname parent-elem *xtm1.0-ns* "resourceRef")))
48             (if resourceRef-elem
49                 (from-resourceRef-elem-xtm1.0 resourceRef-elem)
50                 (let ((resourceData-elem
51                        (xpath-single-child-elem-by-qname parent-elem *xtm1.0-ns* "resourceData")))
52                   (if resourceData-elem
53                       (xpath-fn-string resourceData-elem)
54                       nil)))))
55          (type
56           (let ((data-elem (xpath-single-child-elem-by-qname parent-elem *xtm1.0-ns* "resourceData")))
57             (declare (dom:element parent-elem))
58             (if data-elem
59                 *XML-STRING*
60                 *XML-URI*))))
61      (unless data
62        (error "from-resourceX-elem-xtm1.0: one of resourceRef or resourceData must be set"))
63      (list :data data :type type))))
64
65
66(defun from-variant-elem-xtm1.0 (variant-elem parent-construct start-revision &key (xtm-id *current-xtm*))
67  "geberates a VariantC object;
68   variant = element variant { parameters, variantName?, variant* }"
69  (declare (dom:element variant-elem))
70  (declare (CharacteristicC parent-construct)) ;;parent name or parent variant object
71  (let ((parameters 
72         (remove-duplicates
73          (remove-if #'null
74                     (append
75                      (from-parameters-elem-xtm1.0
76                       (xpath-single-child-elem-by-qname variant-elem *xtm1.0-ns* "parameters")
77                       start-revision :xtm-id xtm-id)
78                      (themes parent-construct :revision start-revision)))))
79        (variantName (from-resourceX-elem-xtm1.0
80                      (xpath-single-child-elem-by-qname variant-elem *xtm1.0-ns* "variantName")))
81        (parent-name (cond
82                       ((typep parent-construct 'NameC)
83                        parent-construct)
84                       ((typep parent-construct 'VariantC)
85                        (parent parent-construct))
86                       (t
87                        (error "from-variant-elem-xtm1.0: parent-construct is neither NameC nor VariantC"))))
88        (reifier-topic (get-reifier-topic-xtm1.0 variant-elem start-revision)))
89    (unless (and variantName parameters)
90      (error "from-variant-elem-xtm1.0: parameters and variantName must be set"))
91    (let ((variant (make-construct 'VariantC
92                                   :start-revision start-revision
93                                   :themes parameters
94                                   :charvalue (getf variantName :data)
95                                   :datatype (getf variantName :type)
96                                   :reifier reifier-topic
97                                   :parent parent-name)))
98      (let ((inner-variants
99             (map 'list #'(lambda(x)
100                            (from-variant-elem-xtm1.0 x variant start-revision :xtm-id xtm-id))
101                  (xpath-child-elems-by-qname variant-elem *xtm1.0-ns* "variant"))))
102        (append (list variant) inner-variants)))))
103
104
105(defun from-parameters-elem-xtm1.0 (parameters-elem start-revision &key (xtm-id *current-xtm*))
106  "handles a parameters element and returns all referenced TopicC objects
107   parameters = element { (topicRef | subjectIndicatorRef)+ }"
108  (when parameters-elem
109    (let ((parameters
110           (let ((topicRefs
111                  (map 'list #'from-topicRef-elem-xtm1.0
112                       (xpath-child-elems-by-qname parameters-elem *xtm1.0-ns*
113                                                   "topicRef")))
114                 (subjectIndicatorRefs
115                  (map 'list #'(lambda(x)
116                                 (get-xlink-attribute x "href"))
117                       (xpath-child-elems-by-qname parameters-elem *xtm1.0-ns*
118                                                   "subjectIndicatorRef"))))
119             (let ((topic-list
120                    (append
121                     (map 'list #'(lambda(x)
122                                    (get-item-by-id x :xtm-id xtm-id
123                                                    :revision start-revision))
124                          topicRefs)
125                     (map 'list #'(lambda(x)
126                                    (get-item-by-psi x :revision start-revision))
127                          subjectIndicatorRefs))))
128               (unless (= (+ (length topicRefs) (length subjectIndicatorRefs)) (length topic-list))
129                 (error "from-parameters-elem-xtm1.0: a topic reference is missing"))
130               (remove-duplicates topic-list)))))
131      (declare (dom:element parameters-elem))
132      parameters)))
133
134
135(defun get-xlink-attribute (elem attribute-name)
136  "returns the attribute \"attribute-name of\" elem"
137  (declare (dom:element elem))
138  (declare (string attribute-name))
139  (dom:get-attribute-ns elem *xtm1.0-xlink* attribute-name))
140
141
142(defun from-baseName-elem-xtm1.0 (baseName-elem top start-revision &key (xtm-id *current-xtm*))
143  "creates NameC instances for the TopicC top
144   baseName = element baseName { scope?, baseNameString, variant* }"
145  (declare (dom:element baseName-elem))
146  (declare (TopicC top))
147  (declare (optimize (debug 3)))
148  (let ((themes (when (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "scope")
149                  (from-scope-elem-xtm1.0
150                   (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "scope")
151                   start-revision :xtm-id xtm-id)))
152        (baseNameString (xpath-fn-string
153                         (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString")))
154        (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem start-revision))
155        (type (get-item-by-psi *topic-name-psi* :revision start-revision
156                               :error-if-nil t)))
157    (unless baseNameString
158      (error "A baseName must have exactly one baseNameString"))
159    (let ((name (make-construct 'NameC 
160                                :start-revision start-revision
161                                :parent top
162                                :instance-of type
163                                :charvalue baseNameString
164                                :reifier reifier-topic
165                                :themes themes)))
166      (map 'list #'(lambda(x)
167                     (from-variant-elem-xtm1.0 x name start-revision :xtm-id xtm-id))
168           (xpath-child-elems-by-qname baseName-elem *xtm1.0-ns* "variant"))
169      name)))
170
171
172(defun from-topicRef-elem-xtm1.0 (topicRef-elem)
173  "returns all the href attribute of the given topicRef-elem without
174   '#' character"
175  (when topicRef-elem
176    (let ((href (get-xlink-attribute topicRef-elem "href")))
177      (declare (dom:element topicRef-elem))
178      (unless (char= (elt href 0) #\#)
179        (error "cannot handle topicrefs that don't start with #"))
180      (subseq href 1))))
181
182
183(defun get-instanceOf-refs-xtm1.0 (parent-elem &key (xtm-id d:*current-xtm*))
184  "returns the topic ids of the topics referenced by the element topicRef and
185   subjectIndicatorRef as a list of strings"
186  (when parent-elem
187    (let ((instanceOf-elems (xpath-child-elems-by-qname parent-elem *xtm1.0-ns* "instanceOf")))
188      (when (> (length instanceOf-elems) 0)
189        (let ((topicRefs
190               (map 'list #'(lambda(x)
191                              (when (xpath-single-child-elem-by-qname
192                                     x *xtm1.0-ns* "topicRef")
193                                (from-topicRef-elem-xtm1.0
194                                 (xpath-single-child-elem-by-qname x *xtm1.0-ns*
195                                                                   "topicRef"))))
196                              instanceOf-elems))
197              (subjectIndicatorRefs
198               (map 'list #'(lambda(x)
199                              (when (xpath-single-child-elem-by-qname
200                                     x *xtm1.0-ns* "subjectIndicatorRef")
201                                (get-xlink-attribute
202                                 (xpath-single-child-elem-by-qname
203                                  x *xtm1.0-ns* "subjectIndicatorRef") "href")))
204                    instanceOf-elems)))
205          (let ((ids
206                 (remove-if #'null
207                            (append
208                             (map 'list #'(lambda(x)
209                                            (get-topicid-by-psi x :xtm-id xtm-id))
210                                  subjectIndicatorRefs)
211                             topicRefs))))
212            (declare (dom:element parent-elem))
213            ids))))))
214
215
216(defun from-roleSpec-elem-xtm1.0 (roleSpec-elem start-revision
217                                  &key (xtm-id *current-xtm*))
218  "returns the referenced topic of the roleSpec's topicRef and subjectIndicatorRef element."
219  (when roleSpec-elem
220    (let ((top-id
221           (when (xpath-single-child-elem-by-qname roleSpec-elem *xtm1.0-ns*
222                                                   "topicRef")
223             (from-topicRef-elem-xtm1.0
224              (xpath-single-child-elem-by-qname roleSpec-elem *xtm1.0-ns*
225                                                "topicRef"))))
226          (sIRs (map 'list #'(lambda(uri)
227                               (get-topicid-by-psi uri :xtm-id xtm-id
228                                                   :revision start-revision))
229                     (map 'list #'(lambda(x)
230                                    (dom:get-attribute-ns x *xtm1.0-xlink* "href"))
231                          (xpath-child-elems-by-qname roleSpec-elem *xtm1.0-ns*
232                                                      "subjectIndicatorRef")))))
233      (let ((ref-topic
234             (first (remove-if #'null
235                               (append
236                                (when top-id
237                                  (list (get-item-by-id top-id :xtm-id xtm-id
238                                                        :revision start-revision)))
239                                (map 'list #'(lambda(id)
240                                               (get-item-by-id
241                                                id :xtm-id xtm-id
242                                                :revision start-revision))
243                                     sIRs))))))
244        (declare (dom:element roleSpec-elem))
245        (unless ref-topic
246          (error (make-condition 'missing-reference-error
247                                 :message (format nil "from-roleSpec-elem-xtm1.0: could not resolve topicid ~a" top-id))))
248        ref-topic))))
249
250
251(defun from-scope-elem-xtm1.0 (scope-elem start-revision &key (xtm-id *current-xtm*))
252  "returns the topics referenced by this scope element.
253   the nested elements resourceRef and subjectIndicatorRef are ignored"
254  (when scope-elem
255    (when (xpath-child-elems-by-qname scope-elem *xtm1.0-ns* "topicRef")
256      (let ((refs 
257             (append (map 'list #'from-topicRef-elem-xtm1.0
258                          (xpath-child-elems-by-qname scope-elem *xtm1.0-ns*
259                                                      "topicRef"))
260                     (map 'list #'(lambda(uri)(get-topicid-by-psi uri :xtm-id xtm-id))
261                          (map 'list #'(lambda(x)
262                                         (dom:get-attribute-ns x *xtm1.0-xlink*
263                                                               "href"))
264                               (xpath-child-elems-by-qname scope-elem *xtm1.0-ns*
265                                                           "subjectIndicatorRef"))))))
266        (let ((ref-topics (map 'list
267                               #'(lambda(x)
268                                   (let ((ref-topic
269                                          (get-item-by-id x :xtm-id xtm-id
270                                                          :revision start-revision)))
271                                     (if ref-topic
272                                         ref-topic
273                                         (error (make-condition 'missing-reference-error
274                                                                :message (format nil "from-scope-elem-xtm1.0: could not resolve reference ~a" x))))))
275                               refs)))
276          (declare (dom:element scope-elem))
277          (unless (>= (length ref-topics) 1)
278            (error "need at least one topic in a scope"))
279          ref-topics)))))
280
281
282(defun from-occurrence-elem-xtm1.0 (occ-elem top start-revision &key (xtm-id *current-xtm*))
283  "creates instances of OccurrenceC with the nested elements instanceOf,
284   scope, resourceRef and resourceData"
285  (declare (dom:element occ-elem))
286  (declare (TopicC top))
287  (declare (integer start-revision))
288  (let* 
289      ((instanceOf (when (get-instanceOf-refs-xtm1.0 occ-elem :xtm-id xtm-id)
290                       (get-item-by-id 
291                        (first (get-instanceOf-refs-xtm1.0 occ-elem
292                                                           :xtm-id xtm-id))
293                        :xtm-id xtm-id :revision start-revision)))
294       (themes (from-scope-elem-xtm1.0
295                (xpath-single-child-elem-by-qname occ-elem *xtm1.0-ns* "scope") 
296                start-revision :xtm-id xtm-id))
297       (occurrence-value
298        (from-resourceX-elem-xtm1.0 occ-elem))
299       (reifier-topic (get-reifier-topic-xtm1.0 occ-elem start-revision)))
300    (unless occurrence-value
301      (error "from-occurrence-elem-xtm1.0: one of resourceRef and resourceData must be set"))
302    (unless instanceOf
303      (format t "from-occurrence-elem-xtm1.0: type is missing -> ~a~%"
304              *type-instance-psi*)
305      (setf instanceOf (get-item-by-psi *type-instance-psi*
306                                        :revision start-revision)))
307    (make-construct 'OccurrenceC
308                    :start-revision start-revision
309                    :parent top
310                    :themes themes
311                    :instance-of instanceOf
312                    :charvalue (getf occurrence-value :data)
313                    :reifier reifier-topic
314                    :datatype (getf occurrence-value :type))))
315
316
317(defun from-subjectIdentity-elem-xtm1.0 (subjectIdentity-elem start-revision)
318  "creates PersistentIdC's from the element subjectIdentity"
319  (when subjectIdentity-elem
320    (let ((psi-refs
321           (map 'list #'(lambda(x)
322                          (get-xlink-attribute x "href"))
323                (xpath-child-elems-by-qname subjectIdentity-elem *xtm1.0-ns*
324                                            "subjectIndicatorRef")))
325          (locator-refs
326           (map 'list #'(lambda(x)
327                          (get-xlink-attribute x "href"))
328                (xpath-child-elems-by-qname subjectIdentity-elem *xtm1.0-ns*
329                                            "resourceRef"))))
330      (let ((psis
331             (map 'list #'(lambda(uri)
332                            (let ((id
333                                   (make-construct 'PersistentIdC
334                                                   :uri uri
335                                                   :start-revision start-revision)))
336                              id))
337                  psi-refs))
338            (locators (map 'list 
339                           #'(lambda(uri)
340                               (let ((loc
341                                      (make-construct 'SubjectLocatorC
342                                                      :uri uri
343                                                      :start-revision start-revision)))
344                                 loc))
345                           locator-refs)))
346        (declare (dom:element subjectIdentity-elem))
347        (declare (integer start-revision))
348        (list :psis psis :locators locators)))))
349
350
351(defun from-member-elem-xtm1.0 (member-elem start-revision
352                                &key (xtm-id *current-xtm*))
353  "returns a list with the role- type, player and itemIdentities"
354  (when member-elem
355    (elephant:ensure-transaction (:txn-nosync t)
356      (let ((type (from-roleSpec-elem-xtm1.0 
357                   (xpath-single-child-elem-by-qname member-elem *xtm1.0-ns*
358                                                     "roleSpec")
359                   start-revision :xtm-id xtm-id))
360           (player
361            (let ((topicRef
362                   (from-topicRef-elem-xtm1.0 (xpath-single-child-elem-by-qname
363                                               member-elem *xtm1.0-ns* "topicRef")))
364                  (sIRs (xpath-child-elems-by-qname
365                         member-elem *xtm1.0-ns* "subjectIndicatorRef")))
366              (remove-if
367               #'null 
368               (append
369                (when topicRef
370                  (list (get-item-by-id topicRef
371                                        :xtm-id xtm-id
372                                        :revision start-revision)))
373                (map 'list #'(lambda(topicid)
374                               (get-item-by-id
375                                topicid 
376                                :xtm-id xtm-id
377                                :revision start-revision))
378                     (map 'list #'(lambda(uri)
379                                    (get-topicid-by-psi uri :xtm-id xtm-id))
380                          (map 'list #'(lambda(x)
381                                         (get-xlink-attribute x "href"))
382                               sIRs)))))))
383            (reifier-topic (get-reifier-topic-xtm1.0 member-elem start-revision)))
384        (declare (dom:element member-elem))
385        (unless player ; if no type is given a standard type will be assigend later in from-assoc...
386          (error "from-member-elem-xtm1.0: missing player in role"))
387        (list :start-revision start-revision
388              :instance-of type
389              :player (first player)
390              :item-identifiers nil
391              :reifier reifier-topic)))))
392
393
394(defun from-topic-elem-to-stub-xtm1.0 (topic-elem start-revision 
395                                       &key 
396                                       (xtm-id *current-xtm*))
397  "creates a TopicC instance with a start-revision, all psis, the topicid and the xtm-id"
398  (declare (dom:element topic-elem))
399  (declare (integer start-revision))
400  (elephant:ensure-transaction (:txn-nosync t) 
401    (let ((identifiers (from-subjectIdentity-elem-xtm1.0
402                        (xpath-single-child-elem-by-qname
403                         topic-elem
404                         *xtm1.0-ns*
405                         "subjectIdentity")
406                        start-revision))
407          (topic-identifiers
408           (list (make-construct 'TopicIdentificationC
409                                 :uri (get-topic-id-xtm1.0 topic-elem)
410                                 :xtm-id xtm-id))))
411      (make-construct 'TopicC :start-revision start-revision
412                      :psis (getf identifiers :psis)
413                      :locators (getf identifiers :locators)
414                      :topic-identifiers topic-identifiers))))
415
416
417(defun merge-topic-elem-xtm1.0 (topic-elem start-revision 
418                                &key
419                                tm
420                                (xtm-id *current-xtm*))
421  "Adds further elements (names, occurrences) and instanceOf
422   associations to the topic"
423  (declare (dom:element topic-elem))
424  (declare (integer start-revision))
425  (declare (TopicMapC tm))
426  (elephant:ensure-transaction (:txn-nosync t)
427    (let ((top
428           (get-item-by-id
429            (get-topic-id-xtm1.0 topic-elem) 
430            :xtm-id xtm-id :revision start-revision))
431          (instanceOf-topicRefs
432           (remove-if #'null (get-instanceOf-refs-xtm1.0 topic-elem
433                                                         :xtm-id xtm-id)))
434          (baseName-elems
435           (xpath-child-elems-by-qname topic-elem *xtm1.0-ns* "baseName"))
436          (occ-elems (xpath-child-elems-by-qname topic-elem *xtm1.0-ns* "occurrence")))
437      (unless top
438        (error (make-condition 'missing-reference-error
439                               :message (format nil "topic ~a could not be found"
440                                                (get-attribute topic-elem "id")))))
441      ;;names
442      (map 'list #'(lambda(x)
443                     (from-baseName-elem-xtm1.0 x top start-revision :xtm-id xtm-id))
444           baseName-elems)
445      ;;occurrences
446      (map 'list #'(lambda(x)
447                     (from-occurrence-elem-xtm1.0 x top start-revision :xtm-id xtm-id))
448           occ-elems)
449      ;;instanceOf
450      (dolist (instanceOf-topicRef instanceOf-topicRefs)
451        (create-instanceof-association instanceOf-topicRef top start-revision
452                                       :xtm-id xtm-id :tm tm))
453      (add-to-tm tm top))))
454
455
456(defun from-association-elem-xtm1.0 (assoc-elem start-revision
457                                     &key tm (xtm-id *current-xtm*))
458  (declare (dom:element assoc-elem))
459  (declare (integer start-revision))
460  (declare (TopicMapC tm))
461  (elephant:ensure-transaction (:txn-nosync t)
462    (let ((type (when (get-instanceOf-refs-xtm1.0 assoc-elem :xtm-id xtm-id)
463                  (get-item-by-id (first (get-instanceOf-refs-xtm1.0 assoc-elem
464                                                                     :xtm-id xtm-id))
465                                  :xtm-id xtm-id
466                                  :revision start-revision)))
467          (themes 
468           (from-scope-elem-xtm1.0 
469            (xpath-single-child-elem-by-qname assoc-elem *xtm1.0-ns* "scope") 
470            start-revision :xtm-id xtm-id))
471          (roles (map 'list 
472                      #'(lambda(member-elem)
473                          (from-member-elem-xtm1.0 member-elem start-revision 
474                                                   :xtm-id xtm-id))
475                      (xpath-child-elems-by-qname assoc-elem *xtm1.0-ns* "member")))
476          (reifier-topic (get-reifier-topic-xtm1.0 assoc-elem start-revision)))
477      (unless roles
478        (error "from-association-elem-xtm1.0: roles are missing in association"))
479      (setf roles (set-standard-role-types roles start-revision))
480      (unless type
481        (format t "from-association-elem-xtm1.0: type is missing -> http://www.topicmaps.org/xtm/1.0/core.xtm#association~%")
482        (setf type (get-item-by-id "association" :xtm-id "core.xtm"
483                                   :revision start-revision)))
484      (add-to-tm tm
485                 (make-construct 'AssociationC
486                                 :start-revision start-revision
487                                 :instance-of type
488                                 :themes themes
489                                 :reifier reifier-topic
490                                 :roles roles)))))
491
492
493(defun set-standard-role-types (roles start-revision)
494  "sets the missing role types of the passed roles to the default types."
495  (when roles
496    (let ((empty-roles (loop for role in roles
497                          when (not (getf role :instance-of))
498                          collect role)))
499      (when empty-roles
500        (let ((is-type (loop for role in roles
501                          when (and (getf role :instance-of)
502                                    (loop for psi in (psis (getf role :instance-of))
503                                       when (string= (uri psi) *type-psi*)
504                                       return t))
505                          return t)))
506          (declare (list roles))
507          (when (not is-type)
508            (loop for role in roles
509               when (not (getf role :instance-of))
510               do (setf (getf role :instance-of)
511                        (get-item-by-psi *type-psi* :revision start-revision))
512                  (format t "set-standard-role-types: role type is missing -> ~a~%"
513                          *type-psi*)
514                 (return t)))
515          (when (or (> (length empty-roles) 1) (and empty-roles (not is-type)))
516            (loop for role in roles
517               when (not (getf role :instance-of))
518               do (setf (getf role :instance-of)
519                        (get-item-by-psi *instance-psi* :revision start-revision))
520                  (format t "set-standard-role-types: role type is missing -> ~a~%"
521                          *instance-psi*))))))
522    roles))
523
524
525(defun importer-xtm1.0 (xtm-dom 
526                        &key 
527                        (tm-id (error "you must provide a stable identifier (PSI-style) for this TM"))
528                        (xtm-id d:*current-xtm*) 
529                        (revision (get-revision)))
530  "imports the elements topic and association from a passed dom by caling
531   the from-<elem>-xtm1.0 functions"
532  ;TODO: remove code duplication between importer-xtm1.0 and importer
533  (declare (dom:element xtm-dom))
534  (declare (integer revision))
535  (assert elephant:*store-controller*)
536  (with-writer-lock
537    (with-tm (revision xtm-id tm-id)
538      (let 
539          ((topic-vector (xpath-child-elems-by-qname xtm-dom *xtm1.0-ns* "topic"))
540           (assoc-vector (xpath-child-elems-by-qname  xtm-dom *xtm1.0-ns* "association")))   
541        (loop for topic across topic-vector
542           do (from-topic-elem-to-stub-xtm1.0 topic revision 
543                                              :xtm-id xtm-id))
544        (loop for top-elem across topic-vector
545           do
546             (format t "t")
547             (merge-topic-elem-xtm1.0 top-elem revision
548                                      :tm tm
549                                      :xtm-id xtm-id))
550        (loop for assoc-elem across assoc-vector 
551           do
552             (format t "a")
553             (from-association-elem-xtm1.0 assoc-elem revision
554                                           :tm tm
555                                           :xtm-id xtm-id))
556        (let ((reifier-topic (get-reifier-topic-xtm1.0 xtm-dom revision)))
557          (when reifier-topic
558            (add-reifier tm reifier-topic :revision revision)))))))
Note: See TracBrowser for help on using the repository browser.