source: trunk/src/unit_tests/rdf_exporter_test.lisp

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

datamodel: implemented the function "open-tm-store" which wrapps elephant:open-store and uses :register t to support mutliple isidorus instances on one database; implemented the wrapper function "close-tm-store" that calls elephant:close-store; => adapted all unit-tests to these changes
File size: 31.3 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(defpackage :rdf-exporter-test
11  (:use 
12   :common-lisp
13   :xtm-importer
14   :datamodel
15   :it.bese.FiveAM
16   :fixtures
17   :base-tools)
18  (:import-from :constants
19                *rdf-ns*
20                *rdfs-ns*
21                *rdf2tm-ns*
22                *tm2rdf-ns*
23                *xml-ns*
24                *xml-string*
25                *xml-uri*)
26  (:import-from :xml-tools
27                xpath-child-elems-by-qname
28                xpath-single-child-elem-by-qname
29                xpath-select-location-path
30                get-ns-attribute)
31  (:export :run-rdf-exporter-tests
32           :test-resources
33           :test-goethe
34           :test-erlkoenig
35           :test-prometheus
36           :test-zauberlehrling
37           :test-frankfurt
38           :test-weimar
39           :test-berlin
40           :test-region
41           :test-city-and-metropolis
42           :test-germany
43           :test-german
44           :test-born-event
45           :test-died-event
46           :test-dateRange-zauberlehrling
47           :test-dateRange-erlkoenig
48           :test-dateRange-prometheus
49           :test-schiller
50           :test-single-nodes
51           :test-collection
52           :test-association))
53
54(declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0)))
55
56(in-package :rdf-exporter-test)
57
58
59(def-suite rdf-exporter-test
60     :description "tests  various key functions of the exporter")
61
62(in-suite rdf-exporter-test)
63
64
65(defvar *sw-arc* "http://some.where/relationship/")
66(defvar *xml-ulong* "http://www.w3.org/2001/XMLSchema#unsignedLong")
67(defvar *xml-date* "http://www.w3.org/2001/XMLSchema#date")
68
69
70(defun get-dom-root ()
71  "Returns the document's root node."
72  (let ((dom (cxml:parse-file "./__out__.rdf" (cxml-dom:make-dom-builder))))
73    (when dom
74      (let ((child-nodes (dom:child-nodes dom)))
75        (when (> (length child-nodes) 0)
76          (elt child-nodes 0))))))
77
78
79(defun identifier-p (owner-elem value &key (what "itemIdentity"))
80  "Returns t if the owner element owns a property correponding to the
81   attribute what and the value."
82  (literal-p owner-elem *tm2rdf-ns* what value :datatype *xml-uri*))
83
84
85(defun role-p (owner-elem roletype-uri item-identifiers 
86               &key (player-uri nil) (player-id nil))
87  "Returns t if the owner-element has a node that corresponds to a
88   role with the given parameters."
89  (loop for item across (dom:child-nodes owner-elem)
90     when (let* ((node-ns (dom:namespace-uri item))
91                 (node-name (rdf-importer::get-node-name item))
92                 (content (rdf-importer::child-nodes-or-text item :trim t))
93                 (descr (when (and (not (stringp content))
94                                   (= (length content) 1))
95                          (elt content 0))))
96            (and descr
97                 (string= (dom:namespace-uri descr) *rdf-ns*)
98                 (string= (rdf-importer::get-node-name descr) "Description")
99                 (= (length (dom:child-nodes descr)) 
100                    (+ 3 (length item-identifiers)))
101                 (string= node-ns *tm2rdf-ns*)
102                 (string= node-name "role")
103                 (type-p descr (concat *tm2rdf-ns* "types/Role"))
104                 (if player-uri
105                     (property-p descr *tm2rdf-ns* "player"
106                                 :resource player-uri)
107                     (property-p descr *tm2rdf-ns* "player"
108                                 :nodeID player-id))
109                 (property-p descr *tm2rdf-ns* "roletype"
110                             :resource roletype-uri)
111                 (= (length item-identifiers)
112                    (length (loop for ii in item-identifiers
113                               when (identifier-p descr ii)
114                               collect ii)))))
115     return t))
116
117
118(defun get-resources-by-uri (uri)
119  "Returns a list of resource elements that owns the attribute
120   about with the value of uri."
121  (let ((root (get-dom-root)))
122    (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
123      (loop for item across resources
124         when (string= (get-ns-attribute item "about") uri)
125         collect item))))
126
127
128(defun get-resources-by-id (id)
129  "Returns a list of resource elements that owns the attribute
130   nodeID with the value of id."
131  (let ((root (get-dom-root)))
132    (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
133      (loop for item across resources
134         when (string= (get-ns-attribute item "nodeID") id)
135         collect item))))
136
137
138(defun type-p (owner-elem type-uri)
139  "Returns t if the given uri is contained in a property
140   within the owner-elem."
141  (loop for item across (dom:child-nodes owner-elem)
142     when (let ((node-ns (dom:namespace-uri item))
143                (node-name (rdf-importer::get-node-name item))
144                (resource (rdf-importer::get-ns-attribute
145                           item "resource")))
146            (and (string= node-ns *rdf-ns*)
147                 (string= node-name "type")
148                 (string= resource type-uri)))
149     return t))
150
151
152(defun literal-p (owner-elem arc-uri arc-name literal-value
153                  &key (datatype *xml-string*)
154                  (xml-lang nil))
155  "Returns t if the owner-elem contains an arc with the uri
156   arc-uri, the arc-name and the literal content literal-value."
157  (loop for item across (dom:child-nodes owner-elem)
158     when (let ((node-ns (dom:namespace-uri item))
159                (node-name (rdf-importer::get-node-name item))
160                (value (rdf-importer::child-nodes-or-text item :trim nil))
161                (fn-datatype (rdf-importer::get-ns-attribute item "datatype"))
162                (fn-xml-lang (rdf-importer::get-ns-attribute
163                              item "lang" :ns-uri *xml-ns*)))
164            (and (string= node-ns arc-uri)
165                 (string= node-name arc-name)
166                 (and (stringp literal-value)
167                      (string= value literal-value))
168                 (string= datatype (if fn-datatype
169                                       fn-datatype
170                                       ""))
171                 (or (not (or xml-lang fn-xml-lang))
172                     (and (and xml-lang fn-xml-lang)
173                          (string= xml-lang fn-xml-lang)))))
174     return t))
175
176
177(defun property-p (owner-elem arc-uri arc-name
178                   &key (resource "") (nodeID ""))
179  "Returns t if the owner element owns a property with the
180   given characteristics."
181  (if (and (string= resource "") (string= nodeID ""))
182      nil
183      (loop for item across (dom:child-nodes owner-elem)
184         when (let ((node-ns (dom:namespace-uri item))
185                    (node-name (rdf-importer::get-node-name item))
186                    (fn-resource (unless (dom:text-node-p  item)
187                                   (rdf-importer::get-ns-attribute item
188                                                                   "resource")))
189                    (fn-nodeID (rdf-importer::get-ns-attribute item "nodeID")))
190                (and (string= node-ns arc-uri)
191                     (string= node-name arc-name)
192                     (or (and fn-resource
193                              (string= fn-resource resource))
194                         (and fn-nodeID
195                              (string= fn-nodeID nodeID)))))
196         return t)))
197
198
199(defun variant-p (owner-elem variant-scopes item-identifiers variant-value
200                  &key (datatype *xml-string*))
201  "Returns t if the owner contains a variant element with the passed
202   characteristics."
203    (loop for item across (dom:child-nodes owner-elem)
204       when (let* ((node-ns (dom:namespace-uri item))
205                   (node-name (rdf-importer::get-node-name item))
206                   (content (rdf-importer::child-nodes-or-text item :trim t))
207                   (descr (when (and (not (stringp content))
208                                     (= (length content) 1))
209                            (elt content 0))))
210              (and descr
211                   (string= (dom:namespace-uri descr) *rdf-ns*)
212                   (string= (rdf-importer::get-node-name descr) "Description")
213                   (rdf-importer::get-ns-attribute descr "nodeID")
214                   (= (+ (length variant-scopes)
215                         (length item-identifiers)
216                         2)
217                      (length (dom:child-nodes owner-elem)))
218                   (string= node-ns *tm2rdf-ns*)
219                   (string= node-name "variant")
220                   (literal-p descr *tm2rdf-ns* "value" variant-value
221                              :datatype datatype)
222                   (= (length variant-scopes)
223                      (length (loop for scope in variant-scopes
224                                 when (property-p descr *tm2rdf-ns* "scope"
225                                                  :resource scope)
226                                 collect scope)))
227                   (= (length item-identifiers)
228                      (length (loop for ii in item-identifiers
229                                 when (identifier-p descr ii)
230                                 collect ii)))
231                   (type-p descr (concat *tm2rdf-ns* "types/Variant"))))
232       return t))
233
234
235(defun name-p (owner-elem name-type name-scopes item-identifiers name-value
236               &key (variants nil))
237  "Returns t if the parent node owns a name with the given characterics."
238  (loop for item across (dom:child-nodes owner-elem)
239     when (let* ((node-ns (dom:namespace-uri item))
240                 (node-name (rdf-importer::get-node-name item))
241                 (content (rdf-importer::child-nodes-or-text item :trim t))
242                 (descr (when (and (not (stringp content))
243                                   (= (length content) 1))
244                          (elt content 0))))
245            (and descr
246                 (string= (dom:namespace-uri descr) *rdf-ns*)
247                 (string= (rdf-importer::get-node-name descr) "Description")
248                 (rdf-importer::get-ns-attribute descr "nodeID")
249                 (= (length (dom:child-nodes descr))
250                    (+ 3 (length name-scopes)
251                       (length item-identifiers)
252                       (length variants)))
253                 (string= node-ns *tm2rdf-ns*)
254                 (string= node-name "name")
255                 (type-p descr (concat *tm2rdf-ns* "types/Name"))
256                 (property-p descr *tm2rdf-ns* "nametype" :resource name-type)
257                 (= (length name-scopes)
258                    (length (loop for scope in name-scopes
259                               when (property-p descr *tm2rdf-ns* "scope"
260                                                :resource scope)
261                               collect scope)))
262                 (= (length item-identifiers)
263                    (length (loop for ii in item-identifiers
264                               when (identifier-p descr ii)
265                               collect ii)))
266                 (= (length variants)
267                    (length (loop for variant in variants
268                               when (variant-p
269                                     descr (getf variant :scopes)
270                                     (getf variant :item-identifiers)
271                                     (getf variant :value)
272                                     :datatype (getf variant :datatype))
273                               collect variant)))
274                 (literal-p descr *tm2rdf-ns* "value" name-value)))
275     return t))
276
277
278(defun occurrence-p (owner-elem occurrence-type occurrence-scopes
279                     item-identifiers occurrence-value 
280                     &key (datatype *xml-string*))
281  "Returns t if the parent node owns an occurrence with the given characterics."
282  (loop for item across (dom:child-nodes owner-elem)
283     when (let* ((node-ns (dom:namespace-uri item))
284                 (node-name (rdf-importer::get-node-name item))
285                 (content (rdf-importer::child-nodes-or-text item :trim t))
286                 (descr (when (and (not (stringp content))
287                                   (= (length content) 1))
288                          (elt content 0))))
289            (and descr
290                 (string= (dom:namespace-uri descr) *rdf-ns*)
291                 (string= (rdf-importer::get-node-name descr) "Description")
292                 (= (length (dom:child-nodes descr))
293                    (+ 3 (length occurrence-scopes)
294                       (length item-identifiers)))
295                 (string= node-ns *tm2rdf-ns*)
296                 (string= node-name "occurrence")
297                 (type-p descr (concat *tm2rdf-ns* "types/Occurrence"))
298                 (property-p descr *tm2rdf-ns* "occurrencetype"
299                             :resource occurrence-type)
300                 (= (length occurrence-scopes)
301                    (length (loop for scope in occurrence-scopes
302                               when (property-p descr *tm2rdf-ns* "scope"
303                                                :resource scope)
304                               collect scope)))
305                 (= (length item-identifiers)
306                    (length (loop for ii in item-identifiers
307                               when (identifier-p descr ii)
308                               collect ii)))
309                 (literal-p descr *tm2rdf-ns* "value" occurrence-value
310                            :datatype datatype)))
311     return t))
312
313           
314(test test-resources
315  "Tests the general amount of resources."
316  (with-fixture rdf-exporter-test-db ()
317    (let ((root (get-dom-root)))
318      (is-true root)
319      (let ((resources (xpath-child-elems-by-qname root *rdf-ns* "Description")))
320        (is (= (length resources) 29))
321        (is (= (length (loop for item across resources
322                          when (get-ns-attribute item "about")
323                          collect item))
324               19))
325        (is (= (length (loop for item across resources
326                          when (get-ns-attribute item "nodeID")
327                          collect item))
328               10))))))
329
330
331(test test-goethe
332  "Tests the resource goethe."
333  (with-fixture rdf-exporter-test-db ()
334    (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe")))
335      (is (= (length goethes) 1))
336      (let ((me (find-if #'(lambda(x)
337                             (= (length (dom:child-nodes x)) 7))
338                         goethes)))
339        (is-true me)
340        (is (type-p me "http://isidorus/tm2rdf_mapping/types/Topic"))
341        (is (type-p me "http://some.where/types/Author"))
342        (is (literal-p me *sw-arc* "lastName"
343                       "von Goethe"))
344        (is (name-p me "http://some.where/relationship/firstName" nil
345                    (list "http://some.where/name_ii_1") "Johann Wolfgang"))
346        (let ((born-id (concat
347                        "id_"
348                        (write-to-string
349                         (elephant::oid
350                          (d:parent
351                           (elephant:get-instance-by-value
352                            'd:OccurrenceC 'd:charvalue "28.08.1749"))))))
353              (died-id (concat
354                        "id_"
355                        (write-to-string
356                         (elephant::oid
357                          (d:parent
358                           (elephant:get-instance-by-value
359                            'd:OccurrenceC 'd:charvalue "22.03.1832")))))))
360          (is-true (property-p me *sw-arc* "born" :nodeID born-id))
361          (is-true (property-p me *sw-arc* "died" :nodeID died-id)))
362        (is-true (loop for item across (dom:child-nodes me)
363                    when (let ((node-ns (dom:namespace-uri item))
364                               (node-name (rdf-importer::get-node-name item))
365                               (nodeID (rdf-importer::get-ns-attribute
366                                        item "nodeID")))
367                           (and (string= node-ns *sw-arc*)
368                                (string= node-name "wrote")
369                                nodeID))
370                    return t))))))
371
372
373(test test-erlkoenig
374  "Tests the resource erlkoenig."
375  (with-fixture rdf-exporter-test-db ()
376    (let ((erlkoenigs (get-resources-by-uri
377                       "http://some.where/ballad/Der_Erlkoenig")))
378      (is (= (length erlkoenigs) 1))
379      (let ((me (find-if #'(lambda(x)
380                             (= (length (dom:child-nodes x)) 5))
381                         erlkoenigs)))
382        (is-true me)
383        (is-true (type-p me "http://some.where/types/Ballad"))
384        (is-true (type-p me (concat *tm2rdf-ns* "types/Topic")))
385        (is-true (literal-p me *sw-arc* "content"
386                            "Wer reitet so spÀt durch Nacht und Wind? ..."
387                            :xml-lang "de"))
388        (is-true (occurrence-p me "http://some.where/relationship/title"
389                               (list "http://some.where/scope/en") nil
390                               "Der Erlkönig"))
391        (let ((dateRange-id
392               (concat
393                "id_"
394                (write-to-string
395                 (elephant::oid
396                  (d:parent
397                   (elephant:get-instance-by-value
398                    'd:OccurrenceC 'd:charvalue "31.12.1782")))))))
399          (is-true (property-p me *sw-arc* "dateRange"
400                               :nodeID dateRange-id)))))))
401
402
403(test test-prometheus
404  "Tests the resoruce prometheus."
405  (with-fixture rdf-exporter-test-db ()
406    (let ((prometheus (get-resources-by-uri
407                       "http://some.where/poem/Prometheus")))
408      (is (= (length prometheus) 1))
409      (let ((me (find-if #'(lambda(x)
410                             (= (length (dom:child-nodes x)) 4))
411                         prometheus)))
412        (is-true me)
413        (is-true (type-p me "http://some.where/types/Poem"))
414        (is-true (literal-p me *sw-arc* "title"
415                            "Prometheus" :xml-lang "de"))
416        (is-true (literal-p me *sw-arc* "content"
417                            "Bedecke deinen Himmel, Zeus, ..."
418                            :xml-lang "de"))
419        (let ((dateRange-id
420               (concat
421                "id_"
422                (write-to-string
423                 (elephant::oid
424                  (d:parent
425                   (elephant:get-instance-by-value
426                    'd:OccurrenceC 'd:charvalue "01.01.1772")))))))
427          (is-true (property-p me *sw-arc* "dateRange"
428                               :nodeID dateRange-id)))))))
429
430
431(test test-zauberlehrling
432  "Tests the resource zauberlehrling."
433  (with-fixture rdf-exporter-test-db ()
434    (let ((zauberlehrlings (get-resources-by-uri
435                           "http://some.where/poem/Der_Zauberlehrling")))
436      (is (= (length zauberlehrlings) ))
437      (let ((me (find-if #'(lambda(x)
438                             (= (length (dom:child-nodes x)) 10))
439                         zauberlehrlings)))
440        (is-true me)
441        (is-true (type-p me "http://some.where/types/Poem"))
442        (is-true (type-p me (concat *tm2rdf-ns* "types/Topic")))
443        (is-true (identifier-p me "http://some.where/poem/Zauberlehrling"
444                               :what "subjectIdentifier"))
445        (is-true (identifier-p
446                  me "http://some.where/poem/Zauberlehrling_itemIdentity_1"))
447        (is-true (identifier-p
448                  me  "http://some.where/poem/Zauberlehrling_itemIdentity_2"))
449        (is-true (identifier-p me "http://some.where/resource_1"
450                               :what "subjectLocator"))
451        (is-true (identifier-p me "http://some.where/resource_2"
452                               :what "subjectLocator"))
453        (is-true (literal-p me "http://some.where/relationship/" "content"
454                            "Hat der alte Hexenmeister ..."))
455        (is-true (occurrence-p me "http://some.where/relationship/title"
456                               (list "http://some.where/scope/en"
457                                     "http://isidorus/rdf2tm_mapping/scope/de")
458                               (list "http://some.where/occurrence_ii_1"
459                                     "http://some.where/occurrence_ii_2")
460                               "Der Zauberlehrling"))
461        (let ((dateRange-id
462               (concat
463                "id_"
464                (write-to-string
465                 (elephant::oid
466                  (d:parent
467                   (elephant:get-instance-by-value
468                    'd:OccurrenceC 'd:charvalue "01.01.1797")))))))
469          (is-true (property-p me *sw-arc* "dateRange"
470                               :nodeID dateRange-id)))))))
471
472
473(test test-frankfurt
474  "Tests the resoruce frankfurt."
475  (with-fixture rdf-exporter-test-db ()
476    (let ((frankfurts (get-resources-by-uri
477                           "http://some.where/metropolis/FrankfurtMain")))
478      (is (= (length frankfurts) 1))
479      (let ((me (find-if #'(lambda(x)
480                             (= (length (dom:child-nodes x)) 4))
481                         frankfurts)))
482        (is-true me)
483        (is-true (type-p me "http://some.where/types/Metropolis"))
484        (is-true (literal-p me *sw-arc* "fullName" "Frankfurt am Main"))
485        (is-true (literal-p me *sw-arc* "population" "659000" 
486                            :datatype *xml-ulong*))
487        (is-true (property-p me *sw-arc* "locatedIn"
488                             :resource "http://some.where/country/Germany"))))))
489
490(test test-weimar
491  "Tests the resoruce weimar."
492  (with-fixture rdf-exporter-test-db ()
493    (let ((weimars (get-resources-by-uri
494                           "http://some.where/city/Weimar")))
495      (is (= (length weimars) 1))
496      (let ((me (find-if #'(lambda(x)
497                             (= (length (dom:child-nodes x)) 4))
498                         weimars)))
499        (is-true me)
500        (is-true (type-p me "http://some.where/types/City"))
501        (is-true (literal-p me *sw-arc* "fullName" "Weimar"))
502        (is-true (literal-p me *sw-arc* "population" "64720" 
503                            :datatype *xml-ulong*))
504        (is-true (property-p me *sw-arc* "locatedIn"
505                             :resource "http://some.where/country/Germany"))))))
506
507
508(test test-berlin
509  "Tests the resource berlin."
510  (with-fixture rdf-exporter-test-db ()
511    (let ((berlins (get-resources-by-uri
512                    "http://some.where/metropolis/Berlin")))
513      (is (= (length berlins) 1))
514      (let ((me (find-if #'(lambda(x)
515                             (= (length (dom:child-nodes x)) 4))
516                         berlins)))
517        (is-true me)
518        (is-true (type-p me "http://some.where/types/Metropolis"))
519        (is-true (literal-p me *sw-arc* "fullName" "Berlin"))
520        (is-true (literal-p me *sw-arc* "population" "3431473" 
521                            :datatype *xml-ulong*))
522        (is-true (property-p me *sw-arc* "locatedIn"
523                             :resource "http://some.where/country/Germany"))))))
524
525
526(test test-region 
527  "Tests the resource region."
528  (with-fixture rdf-exporter-test-db ()
529    (let ((regions (get-resources-by-uri
530                    "http://some.where/types/Region"))
531          (citys (get-resources-by-uri
532                  "http://some.where/types/City"))
533          (metropolis (get-resources-by-uri
534                       "http://some.where/types/Metropolis")))
535      (is (= (length regions) 1))
536      (is (= (length (dom:child-nodes (elt regions 0))) 0))
537      (is (= (length citys) 1))
538      (is (= (length (dom:child-nodes (elt citys 0))) 1))
539      (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf"
540                           :resource "http://some.where/types/Region"))
541      (is (= (length metropolis) 1))
542      (is (= (length (dom:child-nodes (elt metropolis 0))) 1))
543      (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf"
544                           :resource "http://some.where/types/Region")))))
545
546
547(test test-city-and-metropolis
548  "Tests the resource city and metropolis."
549  (with-fixture rdf-exporter-test-db ()
550      (let ((citys (get-resources-by-uri
551                  "http://some.where/types/City")))
552      (is (= (length citys) 1))
553      (is (= (length (dom:child-nodes (elt citys 0))) 1))
554      (is-true (property-p (elt citys 0) *rdfs-ns* "subClassOf"
555                           :resource "http://some.where/types/Region")))
556    (let ((metropolis (get-resources-by-uri
557                       "http://some.where/types/Metropolis")))
558      (is (= (length metropolis) 1))
559      (is (= (length (dom:child-nodes (elt metropolis 0))) 1))
560      (is-true (property-p (elt metropolis 0) *rdfs-ns* "subClassOf"
561                           :resource "http://some.where/types/Region")))))
562
563
564(test test-germany
565  "Tests the resource germany."
566    (with-fixture rdf-exporter-test-db ()
567      (let ((germanys (get-resources-by-uri
568                       "http://some.where/country/Germany")))
569      (is (= (length germanys) 1))
570      (let ((me (find-if #'(lambda(x)
571                             (= (length (dom:child-nodes x)) 5))
572                         germanys)))
573        (is-true me)
574        (is-true (type-p me "http://some.where/types/Country"))
575        (is-true (literal-p me *sw-arc* "nativeName" "Deutschland"
576                            :xml-lang "de"))
577        (is-true (literal-p me *sw-arc* "population" "82099232"
578                            :datatype *xml-ulong*))
579        (is-true (property-p me *sw-arc* "capital"
580                             :resource "http://some.where/metropolis/Berlin"))
581        (is-true (property-p me *sw-arc* "officialese"
582                             :resource "http://some.where/language/German"))))))
583
584
585(test test-german
586  "Tests the resource german."
587    (with-fixture rdf-exporter-test-db ()
588      (let ((germans (get-resources-by-uri
589                       "http://some.where/language/German")))
590      (is (= (length germans) 1))
591      (is-true (type-p (elt germans 0) "http://some.where/types/Language")))))
592
593
594(test test-born-event
595  "Tests the blank node of the born-event."
596  (with-fixture rdf-exporter-test-db ()
597    (let ((born-id (concat
598                    "id_"
599                    (write-to-string
600                     (elephant::oid
601                      (d:parent
602                       (elephant:get-instance-by-value 'd:OccurrenceC
603                                                       'd:charvalue
604                                                       "28.08.1749")))))))
605      (is-true born-id)
606      (let ((born-events (get-resources-by-id born-id)))
607        (is (= (length born-events) 1))
608        (let ((me (find-if #'(lambda(x)
609                               (= (length (dom:child-nodes x)) 3))
610                           born-events)))
611          (is-true me)
612          (is-true (literal-p me *sw-arc* "date" "28.08.1749"
613                              :datatype *xml-date*))
614          (is-true (type-p me "http://some.where/types/Event"))
615          (is-true 
616           (property-p me *sw-arc* "place"
617                       :resource
618                       "http://some.where/metropolis/FrankfurtMain")))))))
619
620
621(test test-died-event
622  "Tests the blank node of the born-event."
623  (with-fixture rdf-exporter-test-db ()
624    (let ((born-id (concat
625                    "id_"
626                    (write-to-string
627                     (elephant::oid
628                      (d:parent
629                       (elephant:get-instance-by-value 'd:OccurrenceC
630                                                       'd:charvalue
631                                                       "22.03.1832")))))))
632      (is-true born-id)
633      (let ((born-events (get-resources-by-id born-id)))
634        (is (= (length born-events) 1))
635        (let ((me (find-if #'(lambda(x)
636                               (= (length (dom:child-nodes x)) 3))
637                           born-events)))
638          (is-true me)
639          (is-true (literal-p me *sw-arc* "date" "22.03.1832"
640                              :datatype *xml-date*))
641          (is-true (type-p me "http://some.where/types/Event"))
642          (is-true 
643           (property-p me *sw-arc* "place"
644                       :resource
645                       "http://some.where/city/Weimar")))))))
646
647
648(test test-dateRange-zauberlehrling
649  "Tests the node of zauberlehrling's dateRange."
650  (with-fixture rdf-exporter-test-db ()
651    (let ((dr-id (concat
652                  "id_"
653                  (write-to-string
654                   (elephant::oid
655                    (d:parent
656                     (elephant:get-instance-by-value 'd:OccurrenceC
657                                                     'd:charvalue
658                                                     "01.01.1797")))))))
659      (is-true dr-id)
660      (let ((drs (get-resources-by-id dr-id)))
661        (is (= (length drs) 1))
662        (let ((me (elt drs 0)))
663          (is-true (literal-p me *sw-arc* "start" "01.01.1797"
664                              :datatype *xml-date*))
665          (is-true (literal-p me *sw-arc* "end" "31.12.1797"
666                              :datatype *xml-date*)))))))
667
668
669(test test-dateRange-erlkoenig
670  "Tests the node of erlkoenig's dateRange."
671  (with-fixture rdf-exporter-test-db ()
672    (let ((dr-id (concat
673                  "id_"
674                  (write-to-string
675                   (elephant::oid
676                    (d:parent
677                     (elephant:get-instance-by-value 'd:OccurrenceC
678                                                     'd:charvalue
679                                                     "01.01.1782")))))))
680      (is-true dr-id)
681      (let ((drs (get-resources-by-id dr-id)))
682        (is (= (length drs) 1))
683        (let ((me (elt drs 0)))
684          (is-true (literal-p me *sw-arc* "start" "01.01.1782"
685                              :datatype *xml-date*))
686          (is-true (literal-p me *sw-arc* "end" "31.12.1782"
687                              :datatype *xml-date*)))))))
688
689
690(test test-dateRange-prometheus
691  "Tests the node of prometheus' dateRange."
692  (with-fixture rdf-exporter-test-db ()
693    (let ((dr-id (concat
694                  "id_"
695                  (write-to-string
696                   (elephant::oid
697                    (d:parent
698                     (elephant:get-instance-by-value 'd:OccurrenceC
699                                                     'd:charvalue
700                                                     "01.01.1772")))))))
701      (is-true dr-id)
702      (let ((drs (get-resources-by-id dr-id)))
703        (is (= (length drs) 1))
704        (let ((me (elt drs 0)))
705          (is-true (literal-p me *sw-arc* "start" "01.01.1772"
706                              :datatype *xml-date*))
707          (is-true (literal-p me *sw-arc* "end" "31.12.1774"
708                              :datatype *xml-date*)))))))
709
710
711(test test-schiller
712  "Tests the node of schiller."
713  (with-fixture rdf-exporter-test-db ()
714    (let ((schiller-id (concat
715                        "id_"
716                        (write-to-string
717                         (elephant::oid
718                          (d:parent
719                           (elephant:get-instance-by-value
720                            'd:OccurrenceC 'd:charvalue
721                            "http://de.wikipedia.org/wiki/Schiller")))))))
722      (is-true schiller-id)
723      (is (= (length (get-resources-by-id schiller-id)) 1))
724      (let ((me (elt (get-resources-by-id schiller-id) 0)))
725        (is-true (type-p me "http://some.where/types/Author"))
726        (is-true (type-p me (concat *tm2rdf-ns* "types/Topic")))
727        (is-true (literal-p me *sw-arc* "authorInfo"
728                            "http://de.wikipedia.org/wiki/Schiller"
729                            :datatype *xml-uri*))
730        (is-true 
731         (name-p me "http://some.where/relationship/firstName"
732                 nil nil "Johann Christoph Friedrich"
733                 :variants
734                 (list
735                  (list 
736                   :item-identifiers
737                   (list "http://some.where/variant_ii_1")
738                   :scopes 
739                   (list "http://www.topicmaps.org/xtm/1.0/core.xtm#display")
740                   :value "Friedrich"
741                   :datatype *xml-string*))))
742        (is-true 
743         (name-p me "http://some.where/relationship/lastName"
744                 nil nil "von Schiller"))))))
745
746
747(test test-single-nodes
748  "Tests all nodes that are not part of a statement."
749  (with-fixture rdf-exporter-test-db ()
750    (let ((authors (get-resources-by-uri "http://some.where/types/Author"))
751          (events (get-resources-by-uri "http://some.where/types/Event"))
752          (country (get-resources-by-uri "http://some.where/types/Country"))
753          (poem (get-resources-by-uri "http://some.where/types/Poem"))
754          (ballad (get-resources-by-uri "http://some.where/types/Ballad"))
755          (language (get-resources-by-uri "http://some.where/types/Language"))
756          (rdf-nil (get-resources-by-uri (concat *rdf-ns* "nil"))))
757      (is-true authors)
758      (is (= (length authors) 1))
759      (is (= (length (dom:child-nodes (elt authors 0))) 0))
760      (is-true events)
761      (is (= (length events) 1))
762      (is (= (length (dom:child-nodes (elt events 0))) 0))
763      (is-true country)
764      (is (= (length country) 1))
765      (is (= (length (dom:child-nodes (elt country 0))) 0))
766      (is-true poem)
767      (is (= (length poem) 1))
768      (is (= (length (dom:child-nodes (elt poem 0))) 0))
769      (is-true ballad)
770      (is (= (length ballad) 1))
771      (is (= (length (dom:child-nodes (elt ballad 0))) 0))
772      (is-true language)
773      (is (= (length language) 1))
774      (is (= (length (dom:child-nodes (elt language 0))) 0))
775      (is-true rdf-nil)
776      (is (= (length rdf-nil) 1))
777      (is (= (length (dom:child-nodes (elt rdf-nil 0))) 0)))))
778
779
780(test test-collection
781  "Tests a collection that has be exported as a construct of rdf:first,
782   rdf:rest and rdf:nil."
783  (with-fixture rdf-exporter-test-db ()
784    (let ((goethes (get-resources-by-uri "http://some.where/author/Goethe")))
785      (let ((wrote-goethe
786             (loop for item across (dom:child-nodes (elt goethes 0))
787                when (let ((node-ns (dom:namespace-uri item))
788                           (node-name (rdf-importer::get-node-name item)))
789                       (and (string= node-ns *sw-arc*)
790                            (string= node-name "wrote")))
791                return item)))
792        (let ((id-1 (rdf-importer::get-ns-attribute wrote-goethe"nodeID")))
793          (is-true id-1)
794          (let ((node-1s (get-resources-by-id id-1)))
795            (is (= (length node-1s) 1))
796            (is (= (length (dom:child-nodes (elt node-1s 0))) 2))
797            (is-true (property-p (elt node-1s 0) *rdf-ns* "first"
798                                 :resource
799                                 "http://some.where/poem/Der_Zauberlehrling"))
800            (let ((rest-arc-1
801                   (loop for item across (dom:child-nodes (elt node-1s 0))
802                      when (let ((node-ns (dom:namespace-uri item))
803                                 (node-name (rdf-importer::get-node-name item))
804                                 (nodeID (rdf-importer::get-ns-attribute
805                                          item "nodeID")))
806                             (and (string= node-ns *rdf-ns*)
807                                  (string= node-name "rest")
808                                  nodeID))
809                      return item)))
810              (is-true rest-arc-1)
811              (let ((id-2 (rdf-importer::get-ns-attribute rest-arc-1 "nodeID")))
812                (let ((node-2s (get-resources-by-id id-2)))
813                  (is (= (length node-2s) 1))
814                  (is (= (length (dom:child-nodes (elt node-2s 0))) 2))
815                  (is-true (property-p
816                            (elt node-2s 0) *rdf-ns* "first"
817                            :resource
818                            "http://some.where/ballad/Der_Erlkoenig"))           
819                  (let ((rest-arc-2
820                         (loop for item across (dom:child-nodes (elt node-2s 0))
821                            when (let ((node-ns (dom:namespace-uri item))
822                                       (node-name (rdf-importer::get-node-name item))
823                                       (nodeID (rdf-importer::get-ns-attribute
824                                                item "nodeID")))
825                                   (and (string= node-ns *rdf-ns*)
826                                        (string= node-name "rest")
827                                        nodeID))
828                      return item)))
829                    (is-true rest-arc-2)
830                    (let ((id-3 (rdf-importer::get-ns-attribute rest-arc-2
831                                                                "nodeID")))
832                      (let ((node-3s (get-resources-by-id id-3)))
833                        (is (= (length node-3s) 1))
834                        (is (= (length (dom:child-nodes (elt node-3s 0))) 2))
835                        (is-true (property-p
836                                  (elt node-3s 0) *rdf-ns* "first"
837                                  :resource
838                                  "http://some.where/poem/Prometheus"))
839                        (is-true
840                         (property-p 
841                          (elt node-3s 0) *rdf-ns* "rest"
842                          :resource
843                          (concat *rdf-ns* "nil")))))))))))))))
844
845
846(test test-association
847  "Tests a TM association with four roles and one item-identifier."
848  (with-fixture rdf-exporter-test-db ()
849    (let ((assoc-id (elephant::oid
850                     (d:identified-construct 
851                      (elephant:get-instance-by-value 
852                       'd:ItemIdentifierC 'd:uri
853                       "http://some.where/test-association")))))
854      (is-true assoc-id)
855      (let ((assocs (get-resources-by-id
856                     (concat "id_" (write-to-string assoc-id)))))
857        (is (= (length assocs)))
858        (let ((me (elt assocs 0)))
859          (is (= (length (dom:child-nodes me)) 7))
860          (is-true (type-p me (concat *tm2rdf-ns* "types/Association")))
861          (is-true (identifier-p me "http://some.where/test-association"))
862          (is-true (property-p me *tm2rdf-ns* "associationtype"
863                               :resource (concat
864                                          *sw-arc* "associatedWithEachOther")))
865          (is-true (role-p me "http://some.where/roletype/writer"
866                           nil :player-uri "http://some.where/author/Goethe"))
867
868          (let ((schiller-id (concat
869                              "id_"
870                              (write-to-string
871                               (elephant::oid
872                                (d:parent
873                                 (elephant:get-instance-by-value
874                                  'd:OccurrenceC 'd:charvalue
875                                  "http://de.wikipedia.org/wiki/Schiller")))))))
876            (is-true (role-p me "http://some.where/roletype/writer"
877                             nil :player-id schiller-id)))
878          (is-true (role-p me "http://some.where/roletype/literature"
879                           nil :player-uri "http://some.where/types/Poem"))
880          (is-true (role-p me "http://some.where/roletype/literature"
881                           (list "http://some.where/test-role")
882                           :player-uri "http://some.where/types/Ballad")))))))
883
884
885
886
887(defun run-rdf-exporter-tests()
888  "Runs all test cases of this suite."
889  (when elephant:*store-controller*
890    (close-tm-store))
891  (it.bese.fiveam:run! 'test-resources)
892  (it.bese.fiveam:run! 'test-goethe)
893  (it.bese.fiveam:run! 'test-erlkoenig)
894  (it.bese.fiveam:run! 'test-prometheus)
895  (it.bese.fiveam:run! 'test-zauberlehrling)
896  (it.bese.fiveam:run! 'test-frankfurt)
897  (it.bese.fiveam:run! 'test-weimar)
898  (it.bese.fiveam:run! 'test-berlin)
899  (it.bese.fiveam:run! 'test-region)
900  (it.bese.fiveam:run! 'test-city-and-metropolis)
901  (it.bese.fiveam:run! 'test-germany)
902  (it.bese.fiveam:run! 'test-german)
903  (it.bese.fiveam:run! 'test-born-event)
904  (it.bese.fiveam:run! 'test-died-event)
905  (it.bese.fiveam:run! 'test-dateRange-zauberlehrling)
906  (it.bese.fiveam:run! 'test-dateRange-erlkoenig)
907  (it.bese.fiveam:run! 'test-dateRange-prometheus)
908  (it.bese.fiveam:run! 'test-schiller)
909  (it.bese.fiveam:run! 'test-single-nodes)
910  (it.bese.fiveam:run! 'test-collection)
911  (it.bese.fiveam:run! 'test-association))
Note: See TracBrowser for help on using the repository browser.