source: branches/new-datamodel/src/unit_tests/rdf_exporter_test.lisp

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

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