source: branches/gdl-frontend/src/xml/xtm/importer_xtm2.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: 16.8 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(reifiable-elem start-revision)
13  "Returns the reifier topic of the reifierable-element or nil."
14  (declare (dom:element reifiable-elem))
15  (let ((reifier-uri (get-attribute reifiable-elem "reifier"))
16        (err "From get-reifier-topic(): "))
17    (when (and (stringp reifier-uri)
18               (> (length reifier-uri) 0))
19      (let ((ii
20             (elephant:get-instance-by-value 'd:ItemIdentifierC 'd:uri reifier-uri)))
21        (if ii
22            (let ((reifier-topic (identified-construct ii :revision start-revision)))
23              (if reifier-topic
24                  reifier-topic
25                  (error "~aitem-identifier ~a not found" err reifier-uri)))
26            (error "~aitem-identifier ~a not found" err reifier-uri))))))
27
28
29(defun from-identifier-elem (classsymbol elem start-revision)
30  "Generate an identifier object of type 'classsymbol' (a subclass of
31IdentifierC) from a given identifier element for a revision and return
32that object"
33  (declare (symbol classsymbol))
34  (declare (dom:element elem))
35  (declare (integer start-revision))
36  (let
37      ((id (make-construct classsymbol
38                          :uri (get-attribute elem "href")
39                          :start-revision start-revision)))
40    id))
41 
42         
43(defun make-identifiers (classsymbol start-elem elem-name start-revision)
44  (map 'list 
45       (lambda (elem) 
46         (from-identifier-elem classsymbol elem start-revision))
47       (xpath-child-elems-by-qname 
48        start-elem
49        *xtm2.0-ns* elem-name)))
50
51
52(defun from-type-elem (type-elem start-revision &key (xtm-id *current-xtm*))
53  "Returns the topic that reifies this type or nil if no element is
54input"
55  ; type = element type { topicRef }
56  ;the from-type-elem function does not need a revision element as it
57  ;just points to an existing topic with its own revision history
58  (when type-elem
59    (let*
60        ((topicid 
61          (get-topicref-uri 
62            (xpath-single-child-elem-by-qname 
63             type-elem 
64             *xtm2.0-ns* "topicRef")))
65         (top (get-item-by-id topicid :xtm-id xtm-id :revision start-revision)))
66      (declare (dom:element type-elem))
67      (unless top
68        (error (make-condition 'missing-reference-error
69                               :message (format nil "Could not resolve topicid ~a" topicid))))
70      top)))
71
72
73(defun from-scope-elem (scope-elem start-revision &key (xtm-id *current-xtm*))
74  "Generate set of themes (= topics) from this scope element and
75return that set. If the input is nil, the list of themes is empty
76 scope = element scope { topicRef+ }"
77  ;the from-scope-elem function does not need a revision element as it
78  ;just points to existing topics with their own revision histories
79  (when scope-elem
80    (let*
81        ((topicrefs
82          (map 'list 
83               #'get-topicref-uri
84               (xpath-child-elems-by-qname 
85                scope-elem 
86                *xtm2.0-ns* "topicRef")))
87         (tops 
88          (map 'list 
89               (lambda (topicid)
90                 (let
91                     ((top
92                       (get-item-by-id topicid :xtm-id xtm-id 
93                                       :revision start-revision)))
94                   (if top
95                       top
96                       (error (make-condition 'missing-reference-error
97                               :message (format nil "from-scope-elem: could not resolve reference ~a" topicid))))))
98               topicrefs)))
99      (declare (dom:element scope-elem))
100      (unless (>= (length tops) 1)
101        (error "need at least one topic in a scope"))
102      tops)))
103
104   
105(defun from-name-elem (name-elem top start-revision &key (xtm-id *current-xtm*))
106  "Generate a NameC object from a name element name = element name {
107   reifiable, type?, scope?, value, variant* }. If a topic is given, the
108   name first checks for possible equality and then adds an association
109   to it"
110  (declare (dom:element name-elem))
111  (declare (TopicC top))
112  (declare (optimize (debug 3)))
113  (let 
114      ((item-identifiers
115        (make-identifiers 'ItemIdentifierC name-elem "itemIdentity" start-revision))
116       (namevalue
117         (xpath-fn-string (xpath-single-child-elem-by-qname 
118          name-elem 
119          *xtm2.0-ns* "value")))
120       (themes
121        (from-scope-elem 
122         (xpath-single-child-elem-by-qname 
123          name-elem  *xtm2.0-ns* "scope")
124         start-revision :xtm-id xtm-id))     
125        (instance-of
126         (from-type-elem (xpath-single-child-elem-by-qname 
127                          name-elem 
128                          *xtm2.0-ns* "type") start-revision :xtm-id xtm-id))
129       (reifier-topic (get-reifier-topic name-elem start-revision)))
130    (unless namevalue
131        (error "A name must have exactly one namevalue"))
132    (let ((name (make-construct
133                 'NameC 
134                 :start-revision start-revision
135                 :parent top
136                 :charvalue namevalue
137                 :instance-of (if instance-of
138                                  instance-of
139                                  (get-item-by-psi *topic-name-psi*
140                                                   :revision start-revision
141                                                   :error-if-nil t))
142                 :item-identifiers item-identifiers
143                 :reifier reifier-topic
144                 :themes themes)))
145      (loop for variant-elem across (xpath-child-elems-by-qname name-elem *xtm2.0-ns* "variant")
146         do (from-variant-elem variant-elem name start-revision :xtm-id xtm-id))
147      name)))
148
149
150(defun from-resourceX-elem (parent-elem)
151  "handles the following problem: { resourceRef | resourceData }
152   and returns a list with a data and a type node"
153  (when parent-elem
154       (let ((data
155              (let
156                  ((href 
157                    (get-attribute
158                     (xpath-single-child-elem-by-qname
159                      parent-elem
160                      *xtm2.0-ns* "resourceRef") "href")))
161                (if href
162                    href
163                    (xpath-fn-string 
164                     (xpath-single-child-elem-by-qname
165                      parent-elem
166                      *xtm2.0-ns* "resourceData")))))
167             (type
168              (let
169                  ((resourcedata-elem
170                    (xpath-single-child-elem-by-qname
171                     parent-elem
172                     *xtm2.0-ns* "resourceData")))
173                (if resourcedata-elem
174                    (let ((attr (get-attribute resourcedata-elem "datatype")))
175                      (if attr
176                          attr         
177                          "http://www.w3.org/2001/XMLSchema#string"))
178                    "http://www.w3.org/2001/XMLSchema#anyURI")))) ;the datatype of resourceRefs is IRI, cf. TMDM 4.4 and 5.6
179         (unless data
180           (error "from-resourceX-elem: one of resourceRef or resourceData must be set"))
181         (list :data data :type type))))
182
183
184(defun from-variant-elem (variant-elem name start-revision &key (xtm-id *current-xtm*))
185  "Generate a VariantC object from a variant element
186   variant = element variant { reifiable, scope, (resourceRef | resourceData) }"
187  (declare (dom:element variant-elem))
188  (declare (optimize (debug 3)))
189  (declare (NameC name))
190  (let 
191      ((item-identifiers (make-identifiers 'ItemIdentifierC variant-elem "itemIdentity" start-revision))
192       ;;all themes of the parent name element are inherited to the variant elements
193       (themes (append
194                (from-scope-elem (xpath-single-child-elem-by-qname variant-elem *xtm2.0-ns* "scope")
195                                 start-revision :xtm-id xtm-id)
196                (themes name :revision start-revision)))
197       (variant-value (from-resourceX-elem variant-elem))
198       (reifier-topic (get-reifier-topic variant-elem start-revision)))
199    (unless variant-value
200      (error "VariantC: one of resourceRef and resourceData must be set"))
201    (make-construct 'VariantC
202                    :start-revision start-revision
203                    :item-identifiers item-identifiers
204                    :themes themes
205                    :charvalue (getf variant-value :data)
206                    :datatype (getf variant-value :type)
207                    :reifier reifier-topic
208                    :parent name)))
209                           
210
211(defun from-occurrence-elem (occ-elem top start-revision &key (xtm-id *current-xtm*))
212  "Generate an OccurrenceC object from an occurrence element
213occurrence = element occurrence { reifiable,
214  type, scope?, ( resourceRef | resourceData ) }"
215  (declare (dom:element occ-elem))
216  (declare (TopicC top))
217  (declare (integer start-revision))
218  (let
219      ((themes
220        (from-scope-elem (xpath-single-child-elem-by-qname 
221                          occ-elem  *xtm2.0-ns* "scope") start-revision :xtm-id xtm-id))
222       (item-identifiers
223        (make-identifiers 'ItemIdentifierC occ-elem "itemIdentity" start-revision))
224       (instance-of 
225        (from-type-elem (xpath-single-child-elem-by-qname 
226                          occ-elem 
227                          *xtm2.0-ns* "type") start-revision :xtm-id xtm-id))
228       (occurrence-value (from-resourceX-elem occ-elem))
229       (reifier-topic (get-reifier-topic occ-elem start-revision)))
230    (unless occurrence-value
231      (error "OccurrenceC: one of resourceRef and resourceData must be set"))
232    (make-construct 'OccurrenceC 
233                    :start-revision start-revision
234                    :parent top
235                    :themes themes
236                    :item-identifiers item-identifiers
237                    :instance-of instance-of
238                    :charvalue (getf occurrence-value :data)
239                    :reifier reifier-topic
240                    :datatype (getf occurrence-value :type))))
241   
242   
243
244(defun from-topic-elem-to-stub (topic-elem start-revision
245                                &key 
246                                (xtm-id d:*current-xtm*))
247  "Creates the pure stub of a topic together with topicid, PSI and
248subject locators. Merges new topic stubs with existing stubs if
249applicable"
250  (declare (dom:element topic-elem))
251  (declare (integer start-revision))
252  (elephant:ensure-transaction (:txn-nosync t) 
253    (let 
254        ((itemidentifiers
255          (make-identifiers 'ItemIdentifierC topic-elem "itemIdentity" start-revision))
256         (subjectidentifiers
257          (make-identifiers 'PersistentIdC topic-elem "subjectIdentifier" start-revision))
258         (subjectlocators
259          (make-identifiers 'SubjectLocatorC topic-elem "subjectLocator" start-revision))
260         (topic-ids (when (get-attribute topic-elem "id")
261                      (list (make-construct 'TopicIdentificationC
262                                            :uri (get-attribute topic-elem "id")
263                                            :xtm-id xtm-id)))))
264      (make-construct 'TopicC
265                      :start-revision start-revision
266                      :item-identifiers itemidentifiers
267                      :locators subjectlocators
268                      :psis subjectidentifiers
269                      :topic-identifiers topic-ids))))
270         
271
272(defun merge-topic-elem (topic-elem start-revision
273                         &key tm (xtm-id *current-xtm*))
274  "Adds further elements (names, occurrences) and instanceOf
275associations to the topic"
276  (declare (dom:element topic-elem))
277  (declare (integer start-revision))
278  (declare (TopicMapC tm))
279  (elephant:ensure-transaction (:txn-nosync t) 
280    (let
281        ((top  ;retrieve the already existing topic stub
282          (get-item-by-id (get-attribute topic-elem "id") 
283           :xtm-id xtm-id :revision start-revision)))
284      (let
285          ((instanceof-topicrefs
286            (map 'list 
287               #'get-topicref-uri
288               (xpath-select-location-path
289                topic-elem
290                '((*xtm2.0-ns* "instanceOf")
291                  (*xtm2.0-ns* "topicRef"))))))
292      (unless top
293        (error "topic ~a could not be found (xtm-id: ~a, revision: ~a)"
294               (get-attribute topic-elem "id") xtm-id start-revision))
295      (map 'list
296       (lambda
297           (name-elem)
298         (from-name-elem name-elem top start-revision :xtm-id xtm-id))
299       (xpath-child-elems-by-qname 
300        topic-elem 
301        *xtm2.0-ns* "name"))
302      (map 'list
303       (lambda
304           (occ-elem)
305         (from-occurrence-elem occ-elem top start-revision :xtm-id xtm-id))
306       (xpath-child-elems-by-qname 
307        topic-elem 
308        *xtm2.0-ns* "occurrence"))
309
310      ;this is a very special process
311      (dolist (topicref instanceof-topicrefs)
312        (create-instanceof-association topicref top start-revision
313                                       :tm tm
314                                       :xtm-id xtm-id))
315      (add-to-tm tm top)
316      top))))
317
318
319(defun from-role-elem (role-elem start-revision &key (xtm-id *current-xtm*))
320  "Constructs a tuple of (instance-of, player, item-identifiers) from
321a role element and returns it role = element role { reifiable, type,
322topicRef }"
323  (declare (dom:element role-elem))
324  (declare (integer start-revision))
325  (elephant:ensure-transaction (:txn-nosync t) 
326    (let 
327        ((item-identifiers
328          (make-identifiers 'ItemIdentifierC role-elem "itemIdentity" start-revision))
329         (instance-of
330          (from-type-elem 
331           (xpath-single-child-elem-by-qname
332            role-elem *xtm2.0-ns* "type")
333           start-revision :xtm-id xtm-id))
334         (player
335          (get-item-by-id (get-topicref-uri 
336                           (xpath-single-child-elem-by-qname 
337                            role-elem *xtm2.0-ns* "topicRef"))
338                          :xtm-id xtm-id :revision start-revision))
339         (reifier-topic (get-reifier-topic role-elem start-revision)))
340      (unless player ;instance-of will be set later - if there is no one
341        (error "Role in association with topicref ~a not complete" (get-topicref-uri 
342            (xpath-single-child-elem-by-qname 
343             role-elem
344             *xtm2.0-ns*
345             "topicRef"))))
346      (list :start-revision start-revision
347            :reifier reifier-topic
348            :instance-of instance-of
349            :player player
350            :item-identifiers item-identifiers))))
351
352
353(defun from-association-elem (assoc-elem start-revision
354                              &key
355                              tm
356                              (xtm-id *current-xtm*))
357  "Constructs an AssociationC object from an association element
358   association = element association { reifiable, type, scope?, role+ }"
359  (declare (dom:element assoc-elem))
360  (declare (integer start-revision))
361  (declare (TopicMapC tm))
362  (elephant:ensure-transaction (:txn-nosync t) 
363    (let
364        ((item-identifiers
365          (make-identifiers 'ItemIdentifierC assoc-elem "itemIdentity" start-revision))
366         (instance-of
367          (from-type-elem 
368           (xpath-single-child-elem-by-qname 
369            assoc-elem *xtm2.0-ns* "type") 
370           start-revision :xtm-id xtm-id))
371         (themes
372          (from-scope-elem 
373           (xpath-single-child-elem-by-qname assoc-elem *xtm2.0-ns* "scope")
374           start-revision :xtm-id xtm-id))
375         (roles ;a list of tuples
376          (map 'list 
377               (lambda 
378                   (role-elem)
379                 (from-role-elem role-elem start-revision :xtm-id xtm-id))
380               (xpath-child-elems-by-qname 
381                assoc-elem
382                *xtm2.0-ns* "role")))
383         (reifier-topic (get-reifier-topic assoc-elem start-revision)))
384      (setf roles (set-standard-role-types roles start-revision)); sets standard role types if there are missing some of them
385      (add-to-tm
386       tm 
387       (make-construct 'AssociationC
388                       :start-revision start-revision
389                       :item-identifiers item-identifiers
390                       :instance-of instance-of
391                       :themes themes
392                       :reifier reifier-topic
393                       :roles roles)))))
394
395(defun get-topic-elems (xtm-dom)
396  (xpath-child-elems-by-qname xtm-dom
397                              *xtm2.0-ns* "topic"))
398
399
400(defun get-association-elems (xtm-dom)
401  (xpath-child-elems-by-qname  xtm-dom
402                               *xtm2.0-ns* "association"))
403
404
405(defun import-only-topics
406    (xtm-dom
407     &key   
408     (tm-id (error "you must provide a stable identifier (PSI-style) for this TM"))
409     (xtm-id d:*current-xtm*)
410     (revision (get-revision)))
411  (with-tm (revision xtm-id tm-id)
412    (let
413        ((topic-vector (get-topic-elems xtm-dom)))
414      (loop for top-elem across topic-vector do
415           (add-to-tm 
416            tm 
417            (from-topic-elem-to-stub top-elem revision 
418                                     :xtm-id xtm-id))))))
419
420(defun importer (xtm-dom 
421                 &key 
422                 (tm-id (error "you must provide a stable identifier (PSI-style) for this TM"))
423                 (xtm-id d:*current-xtm*)
424                 (revision (get-revision)))
425  (declare (dom:element xtm-dom))
426  (declare (integer revision))
427   ;all topics/associations that are imported in one go share the same revision
428  (assert elephant:*store-controller*)
429  (with-writer-lock
430    (with-tm (revision xtm-id tm-id)
431      (let ((topic-vector (get-topic-elems xtm-dom))
432            (assoc-vector (get-association-elems xtm-dom))
433            (tm-ids
434             (make-identifiers 'ItemIdentifierC xtm-dom "itemIdentity" revision)))
435        (loop for top-elem across topic-vector do
436             (from-topic-elem-to-stub top-elem revision 
437                                      :xtm-id xtm-id))
438        (loop for top-elem across topic-vector do
439             (format t "t")
440             (merge-topic-elem top-elem revision 
441                               :tm tm
442                               :xtm-id xtm-id))
443        (loop for assoc-elem across assoc-vector do
444             (format t "a")
445             (from-association-elem assoc-elem revision 
446                                    :tm tm
447                                    :xtm-id xtm-id))
448        (loop for tm-id in tm-ids do
449             (add-item-identifier tm tm-id :revision revision))
450        (let ((reifier-topic (get-reifier-topic xtm-dom revision)))
451          (when reifier-topic
452            (add-reifier tm reifier-topic :revision revision)))))))
453         
Note: See TracBrowser for help on using the repository browser.