August 2009 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r117 - in trunk/src: . model unit_tests xml/rdf
by Lukas Giessmann 24 Aug '09

24 Aug '09

Author: lgiessmann Date: Mon Aug 24 12:37:40 2009 New Revision: 117 Log: rdf-exporter: implemented a part of the rdf-exporter. currently associations, that do not represent type-instance or supertype-subtype associations are not exported; unit tests are not implemented at the moment, there is just a test file which can be xported "poems_light.xtm" Added: trunk/src/unit_tests/poems_light.xtm Modified: trunk/src/constants.lisp trunk/src/isidorus.asd trunk/src/model/datamodel.lisp trunk/src/unit_tests/poems.rdf trunk/src/unit_tests/poems_light.rdf trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_core_psis.xtm trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Mon Aug 24 12:37:40 2009 @@ -27,6 +27,7 @@ :*xml-ns* :*xmlns-ns* :*xml-string* + :*xml-uri* :*rdf2tm-ns* :*rdf-statement* :*rdf-object* @@ -37,7 +38,8 @@ :*rdf-rest* :*rdf2tm-object* :*rdf2tm-subject* - :*rdf2tm-scope-prefix*)) + :*rdf2tm-scope-prefix* + :*tm2rdf-ns*)) (in-package :constants) (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/") @@ -74,7 +76,9 @@ (defparameter *xml-string* "http://www.w3.org/2001/XMLSchema#string") -(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping#") +(defparameter *xml-uri* "http://www.w3.org/2001/XMLSchema#anyURI") + +(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/") (defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement") @@ -90,8 +94,10 @@ (defparameter *rdf-rest* "http://www.w3.org/1999/02/22-rdf-syntax-ns#rest") -(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object") +(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping/object") + +(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping/subject") -(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject") +(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope/") -(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#") \ No newline at end of file +(defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/") \ No newline at end of file Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Mon Aug 24 12:37:40 2009 @@ -107,6 +107,7 @@ (:static-file "poems.xtm") (:static-file "poems.rdf") (:static-file "poems_light.rdf") + (:static-file "poems_light.xtm") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Mon Aug 24 12:37:40 2009 @@ -66,6 +66,7 @@ :item-identifiers :item-identifiers-p :list-instanceOf + :list-super-types :locators :locators-p :make-construct @@ -105,6 +106,8 @@ :*TM-REVISION* :with-revision ;;macros + + :string-starts-with ;;helpers )) (declaim (optimize (debug 3) (safety 3) (speed 0) (space 0))) @@ -647,7 +650,6 @@ (elephant:get-instances-by-value 'PersistentIdC 'uri (uri id)) (elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id))))) 1) - ;(format t "cfdi: ~A --> ~A~%" construct (item-identifiers construct)) (error (make-condition 'duplicate-identifier-error :message (format nil "Duplicate Identifier ~a has been found" (uri id)) @@ -1174,6 +1176,33 @@ (player-in-roles topic)) (player-in-roles topic))))) + +(defgeneric list-super-types (topic &key tm) + (:documentation "Generate a list of all topics that this topic is an + subclass of, optionally filtered by a topic map")) + + +(defmethod list-super-types ((topic TopicC) &key (tm nil)) + (remove-if + #'null + (map 'list #'(lambda(x) + (when (loop for psi in (psis (instance-of x)) + when (string= (uri psi) *subtype-psi*) + return t) + (loop for role in (roles (parent x)) + when (not (eq role x)) + return (player role)))) + (if tm + (remove-if-not + (lambda (role) + (format t "player: ~a" (player role)) + (format t "parent: ~a" (parent role)) + (format t "topic: ~a~&" topic) + (in-topicmap tm (parent role))) + (player-in-roles topic)) + (player-in-roles topic))))) + + (defun string-starts-with (str prefix) "Checks if string str starts with a given prefix" (declare (string str prefix)) Modified: trunk/src/unit_tests/poems.rdf ============================================================================== --- trunk/src/unit_tests/poems.rdf (original) +++ trunk/src/unit_tests/poems.rdf Mon Aug 24 12:37:40 2009 @@ -248,8 +248,8 @@ <rdf:type rdf:resource="/types/Poem"/> <arcs:dateRange> <rdf:Description xml:base="http://does.not.exist"> - <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start> - <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end> + <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start> + <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end> </rdf:Description> </arcs:dateRange> <arcs:content rdf:parseType="Literal" xml:lang="de"> Modified: trunk/src/unit_tests/poems_light.rdf ============================================================================== --- trunk/src/unit_tests/poems_light.rdf (original) +++ trunk/src/unit_tests/poems_light.rdf Mon Aug 24 12:37:40 2009 @@ -73,119 +73,7 @@ <arcs:start rdf:datatype="#date">01.01.1797</arcs:start> <arcs:end rdf:datatype="#date">31.12.1797</arcs:end> </arcs:dateRange> - <arcs:content xml:lang="de"> - <![CDATA[Hat der alte Hexenmeister -sich doch einmal wegbegeben! -Und nun sollen seine Geister -auch nach meinem Willen leben. -Seine Wort und Werke -merkt ich und den Brauch, -und mit Geistesstärke -tu ich Wunder auch. - -Walle! walle -Manche Strecke, -daß, zum Zwecke, -Wasser fließe -und mit reichem, vollem Schwalle -zu dem Bade sich ergieße. - -Und nun komm, du alter Besen! -Nimm die schlechten Lumpenhüllen; -bist schon lange Knecht gewesen: -nun erfülle meinen Willen! -Auf zwei Beinen stehe, -oben sei ein Kopf, -eile nun und gehe -mit dem Wassertopf! - -Walle! walle -manche Strecke, -daß, zum Zwecke, -Wasser fließe -und mit reichem, vollem Schwalle -zu dem Bade sich ergieße. - -Seht, er läuft zum Ufer nieder, -Wahrlich! ist schon an dem Flusse, -und mit Blitzesschnelle wieder -ist er hier mit raschem Gusse. -Schon zum zweiten Male! -Wie das Becken schwillt! -Wie sich jede Schale -voll mit Wasser füllt! - -Stehe! stehe! -denn wir haben -deiner Gaben -vollgemessen! - -Ach, ich merk es! Wehe! wehe! -Hab ich doch das Wort vergessen! - -Ach, das Wort, worauf am Ende -er das wird, was er gewesen. -Ach, er läuft und bringt behende! -Wärst du doch der alte Besen! -Immer neue Güsse -bringt er schnell herein, -Ach! und hundert Flüsse -stürzen auf mich ein. - -Nein, nicht länger -kann ichs lassen; -will ihn fassen. -Das ist Tücke! -Ach! nun wird mir immer bänger! -Welche Mine! welche Blicke! - -O du Ausgeburt der Hölle! -Soll das ganze Haus ersaufen? -Seh ich über jede Schwelle -doch schon Wasserströme laufen. -Ein verruchter Besen, -der nicht hören will! -Stock, der du gewesen, -steh doch wieder still! - -Willst am Ende -gar nicht lassen? -Will dich fassen, -will dich halten -und das alte Holz behende -mit dem scharfen Beile spalten. - -Seht da kommt er schleppend wieder! -Wie ich mich nur auf dich werfe, -gleich, o Kobold, liegst du nieder; -krachend trifft die glatte Schärfe. -Wahrlich, brav getroffen! -Seht, er ist entzwei! -Und nun kann ich hoffen, -und ich atme frei! - -Wehe! wehe! -Beide Teile -stehn in Eile -schon als Knechte -völlig fertig in die Höhe! -Helft mir, ach! ihr hohen Mächte! - -Und sie laufen! Naß und nässer -wirds im Saal und auf den Stufen. -Welch entsetzliches Gewässer! -Herr und Meister! hör mich rufen! - -Ach, da kommt der Meister! -Herr, die Not ist groß! -Die ich rief, die Geister -werd ich nun nicht los. - -"In die Ecke, -Besen, Besen! -Seids gewesen. -Denn als Geister -ruft euch nur zu diesem Zwecke, -erst hervor der alte Meister."]]> - </arcs:content> + <arcs:content xml:lang="de"><![CDATA[Hat der alte Hexenmeister ...]]></arcs:content> </types:Poem> </rdf:li> </rdf:Bag> @@ -200,47 +88,7 @@ <arcs:start rdf:datatype="#date">01.01.1782</arcs:start> <arcs:end rdf:datatype="#date">31.12.1782</arcs:end> </arcs:dateRange> - <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de"> - <![CDATA[Wer reitet so spät durch Nacht und Wind? -Es ist der Vater mit seinem Kind; -Er hat den Knaben wohl in dem Arm, -Er faßt ihn sicher, er hält ihn warm. - -Mein Sohn, was birgst du so bang dein Gesicht? - -Siehst Vater, du den Erlkönig nicht? -Den Erlenkönig mit Kron und Schweif? - -Mein Sohn, es ist ein Nebelstreif. - - -"Du liebes Kind, komm, geh mit mir! -Gar schöne Spiele spiel ich mit dir; -Manch bunte Blumen sind an dem Strand, -Meine Mutter hat manch gülden Gewand." - -Mein Vater, mein Vater, und hörest du nicht, -Was Erlenkönig mir leise verspricht? - -Sei ruhig, bleibe ruhig, mein Kind; -In dürren Blättern säuselt der Wind. - - -"Willst, feiner Knabe, du mit mir gehn? -Meine Töchter sollen dich warten schön; -Meine Töchter führen den nächtlichen Reihn -Und wiegen und tanzen und singen dich ein." - -Mein Vater, mein Vater, und siehst du nicht dort -Erlkönigs Töchter am düstern Ort? - -Mein Sohn, mein Sohn, ich seh es genau: -Es scheinen die alten Weiden so grau. - - -"Ich liebe dich, mich reizt deine schöne Gestalt; -Und bist du nicht willig, so brauch ich Gewalt." -Mein Vater, mein Vater, jetzt faßt er mich an! -Erlkönig hat mir ein Leids getan! - - -Dem Vater grauset's, er reitet geschwind, -Er hält in den Armen das ächzende Kind, -Erreicht den Hof mit Mühe und Not; -In seinen Armen das Kind war tot.]]> - </arcs:content> + <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de">Wer reitet so spät durch Nacht und Wind? ...</arcs:content> </types:Ballad> </rdf:li> <rdf:li> @@ -248,76 +96,11 @@ <rdf:type rdf:resource="/types/Poem"/> <arcs:dateRange> <rdf:Description xml:base="http://does.not.exist"> - <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start> - <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end> + <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</arcs:start> + <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</arcs:end> </rdf:Description> </arcs:dateRange> - <arcs:content rdf:parseType="Literal" xml:lang="de"> - <![CDATA[Bedecke deinen Himmel, Zeus, -Mit Wolkendunst! -Und übe, Knaben gleich, -Der Disteln köpft, -An Eichen dich und Bergeshöh'n! -Mußt mir meine Erde -Doch lassen steh'n, -Und meine Hütte, -Die du nicht gebaut, -Und meinen Herd, -Um dessen Glut -Du mich beneidest. - -Ich kenne nichts Ärmeres -Unter der Sonn' als euch Götter! -Ihr nähret kümmerlich -Von Opfersteuern -Und Gebetshauch -Eure Majestät -Und darbtet, wären -Nicht Kinder und Bettler -Hoffnungsvolle Toren. - -Da ich ein Kind war, -Nicht wußte, wo aus, wo ein, -Kehrt' ich mein verirrtes Auge -Zur Sonne, als wenn drüber wär -Ein Ohr zu hören meine Klage, -Ein Herz wie meins, -Sich des Bedrängten zu erbarmen. - -Wer half mir -Wider der Titanen Übermut? -Wer rettete vom Tode mich, -Von Sklaverei? -Hast du's nicht alles selbst vollendet, -Heilig glühend Herz? -Und glühtest, jung und gut, -Betrogen, Rettungsdank -Dem Schlafenden dadroben? - -Ich dich ehren? Wofür? -Hast du die Schmerzen gelindert -Je des Beladenen? -Hast du die Tränen gestillet -Je des Geängsteten? -Hat nicht mich zum Manne geschmiedet -Die allmächtige Zeit -Und das ewige Schicksal, -Meine Herren und deine? - -Wähntest du etwa, -Ich sollte das Leben hassen, -In Wüsten fliehn, -Weil nicht alle Knabenmorgen- -Blütenträume reiften? - -Hier sitz' ich, forme Menschen -Nach meinem Bilde, -Ein Geschlecht, das mir gleich sei, -Zu leiden, weinen, -Genießen und zu freuen sich, -Und dein nicht zu achten, -Wie ich!]]> - </arcs:content> + <arcs:content rdf:parseType="Literal" xml:lang="de"><![CDATA[ Bedecke deinen Himmel, Zeus, ... ]]></arcs:content> </rdf:Description> </rdf:li> </rdf:Description> Added: trunk/src/unit_tests/poems_light.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/poems_light.xtm Mon Aug 24 12:37:40 2009 @@ -0,0 +1,578 @@ +<?xml version="1.0" encoding="UTF-8"?> +<tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/"> +  + <tm:topic id="goethe"> + <tm:subjectIdentifier href="http://some.where/author/Goehte"/> + <tm:instanceOf><tm:topicRef href="#author"/></tm:instanceOf> + <tm:name> + <tm:type><tm:topicRef href="#firstName"/></tm:type> + <tm:value>Johann Wolfgang</tm:value> + </tm:name> + <tm:occurrence> + <tm:type><tm:topicRef href="#lastName"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">von Goethe</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-born-event"> + <tm:instanceOf href="#event"/> + <tm:occurrence> + <tm:type><tm:topicRef href="#date"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="frankfurt_m"> + <tm:subjectIdentifier href="http://some.where/metropolis/FrankfurtMain"/> + <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#fullName"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Frankfurt am Main</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="germany"> + <tm:subjectIdentifier href="http://some.where/country/Germany"/> + <tm:instanceOf><tm:topicRef href="#country"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#nativeName"/></tm:type> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Deutschland</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="berlin"> + <tm:subjectIdentifier href="http://some.where/metropolis/Berlin"/> + <tm:instanceOf><tm:topicRef href="#metropolis"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-died-event"> + <tm:instanceOf><tm:topicRef href="#event"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#date"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">22.03.1832</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="weimar"> + <tm:subjectIdentifier href="http://some.where/city/Weimar"/> + <tm:instanceOf><tm:topicRef href="#city"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#population"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="zauberlehrling"> + <tm:subectIdentifier href="http://some.where/poem/Der_Zauberlehrling"/> + <tm:subectIdentifier href="http://some.where/poem/Zauberlehrling"/> + <tm:itemIdentity href="http://some.where/poem/Zauberlehrling_itemIdentity"/> + <tm:subjectLocator href="http://some.where/resource"/> + <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#title"/></tm:type> + <tm:scope> + <tm:topicRef href="#de"/> + <tm:topicRef href="#en"/> + </tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Zauberlehrling</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#content"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Hat der alte Hexenmeister ...</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-dateRange-1"> + <tm:occurrence> + <tm:type><tm:topicRef href="#start"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1797</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#end"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1797</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="erlkoenig"> + <tm:subjectIdentifier href="http://some.where/ballad/Der_Erlkoenig"/> + <tm:instanceOf><tm:topicRef href="#ballad"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#title"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Der Erlkönig</tm:resourceData> + <tm:scope><tm:topicRef href="#en"/></tm:scope> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#content"/></tm:type> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Wer reitet so spät durch Nacht und Wind? ...</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-dateRange-2"> + <tm:occurrence> + <tm:type><tm:topicRef href="#start"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1782</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#end"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1782</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="prometheus"> + <tm:subjectIdentifier href="http://some.where/ballad/Prometheus"/> + <tm:instanceOf><tm:topicRef href="#poem"/></tm:instanceOf> + <tm:occurrence> + <tm:type><tm:topicRef href="#title"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string">Prometheus</tm:resourceData> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#content"/></tm:type> + <tm:scope><tm:topicRef href="#de"/></tm:scope> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#string"> Bedecke deinen Himmel, Zeus, ... </tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="UUID-dateRange-3"> + <tm:occurrence> + <tm:type><tm:topicRef href="#start"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1772</tm:resourceData> + </tm:occurrence> + <tm:occurrence> + <tm:type><tm:topicRef href="#end"/></tm:type> + <tm:resourceData datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1774</tm:resourceData> + </tm:occurrence> + </tm:topic> + + <tm:topic id="dateRange"> + <tm:subjectIdentifier href="http://some.where/relationship/dateRange"/> + </tm:topic> + + <tm:topic id="officialese"> + <tm:subjectIdentifier href="http://some.where/relationship/officialese"/> + </tm:topic> + + <tm:topic id="content"> + <tm:subjectIdentifier href="http://some.where/relationship/content"/> + </tm:topic> + + <tm:topic id="start"> + <tm:subjectIdentifier href="http://some.where/relationship/start"/> + </tm:topic> + + <tm:topic id="end"> + <tm:subjectIdentifier href="http://some.where/relationship/end"/> + </tm:topic> + + <tm:topic id="de"> + <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/scope/de"/> + </tm:topic> + + <tm:topic id="en"> + <tm:subjectIdentifier href="http://some.where/scope/en"/> + </tm:topic> + + <tm:topic id="title"> + <tm:subjetcIdentifier href="http://some.where/relationship/title"/> + </tm:topic> + + <tm:topic id="poem"> + <tm:subjectIdentifier href="http://some.where/types/Poem"/> + </tm:topic> + + <tm:topic id="ballad"> + <tm:subjectIdentifier href="http://some.where/types/Ballad"/> + </tm:topic> + + <tm:topic id="supertype-subtype"> + <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/> + </tm:topic> + + <tm:topic id="supertype"> + <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype"/> + </tm:topic> + + <tm:topic id="subtype"> + <tm:subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/subtype"/> + </tm:topic> + + <tm:topic id="region"> + <tm:subjectIdentifier href="http://some.where/types/Region"/> + </tm:topic> + + <tm:topic id="city"> + <tm:subjectIdentifier href="http://some.where/types/City"/> + </tm:topic> + + <tm:topic id="died"> + <tm:subjectIdentifier href="http://some.where/relationship/died"/> + </tm:topic> + + <tm:topic id="capital"> + <tm:subjectIdentifier href="http://some.where/relationship/capital"/> + </tm:topic> + + <tm:topic id="german"> + <tm:subjectIdentifier href="http://some.where/language/German"/> + <tm:instanceOf><tm:topicRef href="#language"/></tm:instanceOf> + </tm:topic> + + <tm:topic id="language"> + <tm:subjectIdentifier href="http://some.where/types/Language"/> + </tm:topic> + + <tm:topic id="population"> + <tm:subjectIdentifier href="http://some.where/relationship/population"/> + </tm:topic> + + <tm:topic id="nativeName"> + <tm:subjectIdentifier href="http://some.where/relationship/nativeName"/> + </tm:topic> + + <tm:topic id="country"> + <tm:subjectIdentifier href="http://some.where/types/Country"/> + </tm:topic> + + <tm:topic id="metropolis"> + <tm:subjectIdentifier href="http://some.where/types/Metropolis"/> + </tm:topic> + + <tm:topic id="locatedIn"> + <tm:subjectIdentifier href="http://some.where/relationship/locatedIn"/> + </tm:topic> + + <tm:topic id="place"> + <tm:subjectIdentifier href="http://some.where/relationship/place"/> + </tm:topic> + + <tm:topic id="fullName"> + <tm:subjectIdentifier href="http://some.where/relationship/fullName"/> + </tm:topic> + + <tm:topic id="date"> + <tm:subjectIdentifier href="http://some.where/relationship/date"/> + </tm:topic> + + <tm:topic id="born"> + <tm:subjectIdentifier href="http://some.where/relationship/born"/> + </tm:topic> + + <tm:topic id="author"> + <tm:subjectIdentifier href="http://some.where/types/Author"/> + </tm:topic> + + <tm:topic id="firstName"> + <tm:subjectIdentifier href="http://some.where/relationship/firstName"/> + </tm:topic> + + <tm:topic id="lastName"> + <tm:subjectIdentifier href="http://some.where/relationsip/lastName"/> + </tm:topic> + + <tm:topic id="event"> + <tm:subjectIdentifier href="http://some.where/types/Event"/> + </tm:topic> + + <tm:topic id="isi-subject"> + <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/> + </tm:topic> + + <tm:topic id="isi-object"> + <tm:subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/> + </tm:topic> + + <tm:association> + <tm:type><tm:topicRef href="#born"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-born-event"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#place"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-born-event"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#frankfurt_m"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#locatedIn"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#frankfurt_m"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#officialese"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#german"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#locatedIn"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#berlin"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#capital"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#berlin"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#died"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-died-event"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#place"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-died-event"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#weimar"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#locatedIn"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#weimar"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#germany"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#supertype"/></tm:type> + <tm:topicRef href="#region"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#subtype"/></tm:type> + <tm:topicRef href="#city"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:itemIdentity href="http://some.where/metropolis_supertye-subtype-association"/> + <tm:type><tm:topicRef href="#supertype-subtype"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#supertype"/></tm:type> + <tm:topicRef href="#region"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#subtype"/></tm:type> + <tm:topicRef href="#metropolis"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#dateRange"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#zauberlehrling"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-dateRange-1"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#dateRange"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#erlkoenig"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-dateRange-2"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#dateRange"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#prometheus"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-dateRange-3"/> + </tm:role> + </tm:association> + +  + <tm:topic id="wrote"> + <tm:subjectIdentifier href="http://some.where/relationship/wrote"/> + </tm:topic> + + <tm:topic id="rest"> + <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#rest"/> + </tm:topic> + + <tm:topic id="first"> + <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#first"/> + </tm:topic> + + <tm:topic id="nil"> + <tm:subjectIdentifier href="http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"/> + </tm:topic> + +  + <tm:topic id="UUID-1-collection"/> + + <tm:association> + <tm:type><tm:topicRef href="#wrote"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#goethe"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-1-collection"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#first"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-1-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#zauberlehrling"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#rest"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-1-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-2-collection"/> + </tm:role> + </tm:association> + +  + <tm:topic id="UUID-2-collection"/> + + <tm:association> + <tm:type><tm:topicRef href="#first"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-2-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#erlkoenig"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#rest"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-2-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#UUID-3-collection"/> + </tm:role> + </tm:association> + +  + <tm:topic id="UUID-3-collection"/> + + <tm:association> + <tm:type><tm:topicRef href="#first"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-3-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#prometheus"/> + </tm:role> + </tm:association> + + <tm:association> + <tm:type><tm:topicRef href="#rest"/></tm:type> + <tm:role> + <tm:type><tm:topicRef href="#isi-subject"/></tm:type> + <tm:topicRef href="#UUID-3-collection"/> + </tm:role> + <tm:role> + <tm:type><tm:topicRef href="#isi-object"/></tm:type> + <tm:topicRef href="#nil"/> + </tm:role> + </tm:association> +</tm:topicMap> \ No newline at end of file Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 24 12:37:40 2009 @@ -1793,7 +1793,7 @@ (prometheus "http://some.where/poem/Prometheus") (erlkoenig "http://some.where/ballad/Der_Erlkoenig") (date "http://www.w3.org/2001/XMLSchema#date") - (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de")) + (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope/de")) (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) (is (= (length topics) 65)) (is (= (length occs) 23)) @@ -1866,6 +1866,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) "Der Zauberlehrling") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1879,6 +1880,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) (= 0 (length (d:themes x))) + (string= (d:charvalue x) "Prometheus") (string= *xml-string* (d:datatype x)) (= (length (d:psis (d:topic x))) 1) (string= (d:uri (first (d:psis (d:topic x)))) @@ -1891,6 +1893,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) "Der Erlkönig") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1904,6 +1907,7 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) "Hat der alte Hexenmeister ...") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1917,6 +1921,8 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) + " Bedecke deinen Himmel, Zeus, ... ") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) @@ -1930,6 +1936,8 @@ (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) (string= *xml-string* (d:datatype x)) + (string= (d:charvalue x) + "Wer reitet so spät durch Nacht und Wind? ...") (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) (= (length (d:psis (d:topic x))) 1) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Mon Aug 24 12:37:40 2009 @@ -4,4 +4,245 @@ ;;+ ;;+ Isidorus is freely distributable under the LGPL license. ;;+ You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. -;;+----------------------------------------------------------------------------- \ No newline at end of file +;;+----------------------------------------------------------------------------- + +(defpackage :rdf-exporter + (:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel) + (:import-from :constants + *rdf-ns* + *rdfs-ns* + *xml-ns* + *xml-string* + *xml-uri* + *rdf2tm-ns* + *rdf2tm-object* + *rdf2tm-subject* + *rdf2tm-scope-prefix* + *tm2rdf-ns*) + (:import-from :isidorus-threading + with-reader-lock + with-writer-lock) + (:import-from :exporter + *export-tm* + export-to-elem) + (:export :export-rdf)) + +(in-package :rdf-exporter) + + +(defvar *ns-map* nil) ;; ((:prefix <string> :uri <string>)) + + +(defun export-rdf (rdf-path &key tm-id (revision (get-revision))) + "Exports the topoic map bound to tm-id as RDF." + (with-reader-lock + (let ((tm (when tm-id + (get-item-by-item-identifier tm-id :revision revision)))) + (setf *ns-map* nil) + (setf *export-tm* tm) + (with-revision revision + (with-open-file (stream rdf-path :direction :output) + (cxml:with-xml-output (cxml:make-character-stream-sink + stream :canonical nil) + (cxml:with-namespace ("isi" *tm2rdf-ns*) + (cxml:with-namespace ("rdf" *rdf-ns*) + (cxml:with-namespace ("rdfs" *rdfs-ns*) + (cxml:with-namespace ("xml" *xml-ns*) + (cxml:with-element "rdf:RDF" + (export-to-elem tm #'to-rdf-elem))))))))))) + (setf *ns-map* nil)) + + +(defun get-ns-prefix (ns-uri) + (let ((ns-entry + (find-if #'(lambda(x) + (string= (getf x :uri) + ns-uri)) + *ns-map*))) + (if ns-entry + (getf ns-entry :prefix) + (let ((new-name (concatenate + 'string "ns" + (write-to-string (+ 1 (length *ns-map*)))))) + (push (list :prefix new-name + :uri ns-uri) + *ns-map*) + new-name)))) + + +(defun separate-uri (uri) + (when (or (not uri) + (= (length uri) 0) + (and uri + (> (length uri) 0) + (or (eql (elt uri (- (length uri) 1)) #\#) + (eql (elt uri (- (length uri) 1)) #\/) + (eql (elt uri 0) #\#) + (eql (elt uri 0) #\/)))) + (error "From separate-uri(): bad ns-uri: ~a" uri)) + (let ((pos-hash (position #\# uri :from-end t)) + (pos-slash (position #\/ uri :from-end t))) + (unless (or pos-hash pos-slash) + (error "From separate-uri(): bad ns-uri: ~a" uri)) + (if (not (or pos-hash pos-slash)) + (list :prefix *tm2rdf-ns* + :suffix uri) + (let ((prefix (subseq uri 0 (+ (max (or pos-hash 0) (or pos-slash 0)) 1))) + (suffix (subseq uri (+ (max (or pos-hash 0) (or pos-slash 0)) 1)))) + (list :prefix prefix + :suffix suffix))))) + + +(defun get-xml-lang (topic) + (declare (TopicC topic)) + (when (xml-lang-p topic) + (subseq (uri (first (psis topic))) (length *rdf2tm-scope-prefix*)))) + + +(defun xml-lang-p (topic) + (declare (TopicC topic)) + (when (= (length (psis topic)) 1) + (when (string-starts-with (uri (first (psis topic))) + *rdf2tm-scope-prefix*) + t))) + + +(defun make-topic-id (topic) + (declare (TopicC topic)) + (concatenate 'string "id_" (write-to-string (elephant::oid topic)))) + + +(defun make-topic-reference (topic) + (declare (TopicC topic)) + (if (psis topic) + (cxml:attribute "rdf:resource" (uri (first (psis topic)))) + (cxml:attribute "rdf:nodeID" (make-topic-id topic)))) + + + +(defgeneric to-rdf-elem (construct) + (:documentation "Exports Topic Maps Constructs as RDF. ")) + + +(defmethod to-rdf-elem ((construct PersistentIdC)) + (cxml:with-element "isi:subjectIdentifier" + (cxml:attribute "rdf:datatype" *xml-uri*) + (cxml:text (uri construct)))) + + +(defmethod to-rdf-elem ((construct SubjectLocatorC)) + (cxml:with-element "isi:subjectLocator" + (cxml:attribute "rdf:datatype" *xml-uri*) + (cxml:text (uri construct)))) + + +(defmethod to-rdf-elem ((construct ItemIdentifierC)) + (cxml:with-element "isi:itemIdentity" + (cxml:attribute "rdf:datatype" *xml-uri*) + (cxml:text (uri construct)))) + + +(defun scopes-to-rdf-elems (owner-construct) + (declare ((or AssociationC OccurrenceC NameC VariantC RoleC) owner-construct)) + (map 'list #'(lambda(x) + (cxml:with-element "isi:scope" + (make-topic-reference x))) + (themes owner-construct))) + + +(defun resourceX-to-rdf-elem (owner-construct) + (declare ((or OccurrenceC VariantC) owner-construct)) + (cxml:with-element "isi:value" + (cxml:attribute "rdf:datatype" (datatype owner-construct)) + (cxml:text (charvalue owner-construct)))) + + +(defmethod to-rdf-elem ((construct VariantC)) + (cxml:with-element "isi:variant" + (cxml:attribute "rdf:parseType" "Resource") + (map 'list #'to-rdf-elem (item-identifiers construct)) + (scopes-to-rdf-elems construct) + (resourceX-to-rdf-elem construct))) + + +(defmethod to-rdf-elem ((construct NameC)) + (cxml:with-element "isi:name" + (cxml:attribute "rdf:parseType" "Resource") + (map 'list #'to-rdf-elem (item-identifiers construct)) + (cxml:with-element "isi:nametype" + (make-topic-reference (instance-of construct))) + (scopes-to-rdf-elems construct) + (cxml:with-element "isi:value" + (cxml:attribute "rdf:datatype" *xml-string*) + (cxml:text (charvalue construct))) + (map 'list #'to-rdf-elem (variants construct)))) + + +(defmethod to-rdf-elem ((construct OccurrenceC)) + (let ((scopes (when (themes construct) + (loop for theme in (themes construct) + when (not (xml-lang-p theme)) + collect theme)))) + (if (or scopes + (item-identifiers construct) + (/= (length (psis (instance-of construct))) 1)) + (cxml:with-element "isi:occurrence" + (cxml:attribute "rdf:parseType" "Resource") + (map 'list #'to-rdf-elem (item-identifiers construct)) + (cxml:with-element "isi:occurrencetype" + (make-topic-reference (instance-of construct))) + (scopes-to-rdf-elems construct) + (resourceX-to-rdf-elem construct)) + (let ((ns-list + (separate-uri (uri (first (psis (instance-of construct))))))) + (let ((ns (getf ns-list :prefix)) + (tag-name (getf ns-list :suffix))) + (cxml:with-namespace ((get-ns-prefix ns) ns) + (cxml:with-element (concatenate 'string (get-ns-prefix ns) + ":" tag-name) + (cxml:attribute "rdf:datatype" (datatype construct)) + (when (themes construct) + (cxml:attribute "xml:lang" (get-xml-lang + (first (themes construct))))) + (cxml:text (charvalue construct))))))))) + + +(defmethod to-rdf-elem ((construct TopicC)) + ;TODO: what's with used-as-player and core-topics + (format t "--> ~a " (if (psis construct) + (uri (first (psis construct))) + (make-topic-id construct))) + (if (and (not (or (> (length (psis construct)) 1) + (item-identifiers construct) + (locators construct) + (names construct) + (occurrences construct))) + (or (used-as-type construct) + (used-as-theme construct))) + nil ;; do not export this topic explicitly, since it is exported as + ;; rdf:resource, rdf:about or any other reference + (cxml:with-element "rdf:Description" + (let ((psi (when (psis construct) + (first (psis construct))))) + (if psi + (cxml:attribute "rdf:about" (uri psi)) + (cxml:attribute "rdf:nodeID" (make-topic-id construct))) + (map 'list #'to-rdf-elem (remove psi (psis construct))) + (map 'list #'to-rdf-elem (locators construct)) + (map 'list #'to-rdf-elem (item-identifiers construct)) + (map 'list #'(lambda(x) + (cxml:with-element "rdf:type" + (make-topic-reference x))) + (list-instanceOf construct)) + (map 'list #'(lambda(x) + (cxml:with-element "rdfs:subClassOf" + (make-topic-reference x))) + (list-super-types construct)) + (map 'list #'to-rdf-elem (names construct)) + (map 'list #'to-rdf-elem (occurrences construct))))) + (format t "<--~%")) + + +(defmethod to-rdf-elem ((construct AssociationC)) + ;TODO: check if the association has to be exported or not + ) \ No newline at end of file Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Mon Aug 24 12:37:40 2009 @@ -589,7 +589,7 @@ (defun get-literals-of-node-content (node tm-id xml-base xml-lang) "Returns a list of literals that is produced of a node's content." (declare (dom:element node)) - (tm-id-p tm-id "get-literals-of-content") + (tm-id-p tm-id "get-literals-of-noode-content") (let ((properties (child-nodes-or-text node :trim t)) (fn-xml-base (get-xml-base node :old-base xml-base)) (fn-xml-lang (get-xml-lang node :old-lang xml-lang))) @@ -607,7 +607,8 @@ property nil)) (prop-content (child-nodes-or-text property))) (and (or datatype - (string= parseType "Literal") + (and parseType + (string= parseType "Literal")) (and (not (or nodeID resource UUID parseType)) (or (not prop-content) (stringp prop-content)))) Modified: trunk/src/xml/rdf/rdf_core_psis.xtm ============================================================================== --- trunk/src/xml/rdf/rdf_core_psis.xtm (original) +++ trunk/src/xml/rdf/rdf_core_psis.xtm Mon Aug 24 12:37:40 2009 @@ -11,14 +11,14 @@ <topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0"> <topic id="subject"> - <subjectIdentifier href="http://isidorus/rdf2tm_mapping#subject"/> + <subjectIdentifier href="http://isidorus/rdf2tm_mapping/subject"/> <name> <value>subject</value> </name> </topic> <topic id="object"> - <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/> + <subjectIdentifier href="http://isidorus/rdf2tm_mapping/object"/> <name> <value>object</value> </name> Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Mon Aug 24 12:37:40 2009 @@ -33,8 +33,7 @@ *rdf-rest* *rdf2tm-scope-prefix*) (:import-from :xml-constants - *rdf_core_psis.xtm*) - (:import-from :xml-constants + *rdf_core_psis.xtm* *core_psis.xtm*) (:import-from :xml-tools get-attribute @@ -306,7 +305,6 @@ (when (and (string= property-ns *rdf-ns*) (string= property-name "li")) (set-_n-name owner-identifier property))) - ;(set-_n-name property _n-counter))) t) @@ -371,6 +369,7 @@ datatype)) (when (and (or nodeID resource) (> (length content) 0)) + ;(set-_n-name property _n-counter))) (error "~awhen ~a is set no content is allowed: ~a!" err-pref (cond @@ -428,7 +427,6 @@ function and sets all rdf:li properties as a tupple to the *_n-map* list." (let ((child-nodes (child-nodes-or-text node :trim t))) - ;(_n-counter 0)) (when (get-ns-attribute node "li") (dom:map-node-map #'(lambda(attr)

1 0

[isidorus-cvs] r116 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 18 Aug '09

18 Aug '09

Author: lgiessmann Date: Tue Aug 18 13:16:21 2009 New Revision: 116 Log: rdf-importer: fixed a bug with parsing property nodes Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Tue Aug 18 13:16:21 2009 @@ -332,7 +332,6 @@ (dom:set-attribute-ns prop *rdf-ns* "unknown" "unknown") (is-true (rdf-importer::parse-property prop 0)) (dom:append-child prop text-node) - (signals error (rdf-importer::parse-property prop 0)) (dom:remove-child prop text-node) (is-true (rdf-importer::parse-property prop 0)) (dom:remove-attribute-ns prop *rdf-ns* "unknown") Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Tue Aug 18 13:16:21 2009 @@ -876,8 +876,8 @@ (error "~aliteral content not allowed here: ~a" err-pref content)) (loop for arc across content - do (import-arc arc tm-id start-revision :document-id document-id - :xml-base fn-xml-base :xml-lang fn-xml-lang)))) + collect (import-arc arc tm-id start-revision :document-id document-id + :xml-base fn-xml-base :xml-lang fn-xml-lang)))) (defun make-recursion-from-arc (arc tm-id start-revision Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Aug 18 13:16:21 2009 @@ -359,24 +359,29 @@ (when (and nodeID resource) (error "~aondly one of rdf:nodeID and rdf:resource is allowed: (~a) (~a)!" err-pref nodeID resource)) - (when (and (or nodeID resource type) + (when (and (or nodeID resource type literals) datatype) (error "~aonly one of ~a and rdf:datatype (~a) is allowed!" err-pref (cond (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) (resource (concatenate 'string "rdf:resource (" resource ")")) - (type (concatenate 'string "rdf:type (" type ")"))) + (type (concatenate 'string "rdf:type (" type ")")) + (literals literals)) datatype)) - (when (and (or type nodeID resource) + (when (and (or nodeID resource) (> (length content) 0)) (error "~awhen ~a is set no content is allowed: ~a!" err-pref (cond - (type (concatenate 'string "rdf:type (" type ")")) (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) (resource (concatenate 'string "rdf:resource (" resource ")"))) content)) + (when (and type + (stringp content) + (> (length content) 0)) + (error "~awhen rdf:type is set no literal content is allowed: ~a!" + err-pref content)) (when (and (or type (and (string= node-name "type") (string= node-ns *rdf-ns*))

1 0

[isidorus-cvs] r115 - trunk/src/xml/rdf
by Lukas Giessmann 18 Aug '09

18 Aug '09

Author: lgiessmann Date: Tue Aug 18 09:50:24 2009 New Revision: 115 Log: rdf-mporter: moved all calls of the elephant-macro "ensure-transaction" to the two public and top layered functions "setup-rdf-module" and "rdf-importer" Modified: trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Tue Aug 18 09:50:24 2009 @@ -41,12 +41,13 @@ (unless elephant:*store-controller* (elephant:open-store (get-store-spec repository-path))) - (let ((rdf-dom - (dom:document-element (cxml:parse-file - (truename rdf-xml-path) - (cxml-dom:make-dom-builder))))) - (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id)) - (setf *_n-map* nil))) + (elephant:ensure-transaction (:txn-nosync t) + (let ((rdf-dom + (dom:document-element (cxml:parse-file + (truename rdf-xml-path) + (cxml-dom:make-dom-builder))))) + (import-dom rdf-dom start-revision :tm-id tm-id :document-id document-id)) + (setf *_n-map* nil)))) (defun init-rdf-module (&optional (revision (get-revision))) @@ -57,22 +58,16 @@ (let ((core-dom (cxml:parse-file *rdf_core_psis.xtm* (cxml-dom:make-dom-builder)))) - (loop for top-elem across - (xpath-child-elems-by-qname (dom:document-element core-dom) - *xtm2.0-ns* "topic") - do - (let - ((top - (from-topic-elem-to-stub top-elem revision - :xtm-id *rdf-core-xtm*))) - (add-to-topicmap xml-importer::tm top))))))) - - -(defun tm-id-p (tm-id fun-name) - "Checks the validity of the passed tm-id." - (unless (absolute-uri-p tm-id) - (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!" - fun-name tm-id))) + (elephant:ensure-transaction (:txn-nosync t) + (loop for top-elem across + (xpath-child-elems-by-qname (dom:document-element core-dom) + *xtm2.0-ns* "topic") + do + (let + ((top + (from-topic-elem-to-stub top-elem revision + :xtm-id *rdf-core-xtm*))) + (add-to-topicmap xml-importer::tm top)))))))) (defun import-dom (rdf-dom start-revision @@ -126,24 +121,23 @@ (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) (with-tm (start-revision document-id tm-id) - (elephant:ensure-transaction (:txn-nosync t) - (let ((this - (make-topic-stub - about ID nodeID UUID start-revision xml-importer::tm - :document-id document-id))) - (make-literals this literals tm-id start-revision - :document-id document-id) - (make-associations this associations xml-importer::tm - start-revision :document-id document-id) - (make-types this types xml-importer::tm start-revision - :document-id document-id) - (make-super-classes this super-classes xml-importer::tm - start-revision :document-id document-id) - (make-recursion-from-node elem tm-id start-revision - :document-id document-id - :xml-base xml-base - :xml-lang xml-lang) - this))))))) + (let ((this + (make-topic-stub + about ID nodeID UUID start-revision xml-importer::tm + :document-id document-id))) + (make-literals this literals tm-id start-revision + :document-id document-id) + (make-associations this associations xml-importer::tm + start-revision :document-id document-id) + (make-types this types xml-importer::tm start-revision + :document-id document-id) + (make-super-classes this super-classes xml-importer::tm + start-revision :document-id document-id) + (make-recursion-from-node elem tm-id start-revision + :document-id document-id + :xml-base xml-base + :xml-lang xml-lang) + this)))))) (defun import-arc (elem tm-id start-revision @@ -360,21 +354,20 @@ (unless (or role-type-1 role-type-2) (error "~aone of the role types ~a ~a is missing!" err-pref *supertype-psi* *subtype-psi*)) - (elephant:ensure-transaction (:txn-nosync t) - (let ((a-roles (list (list :instance-of role-type-1 - :player super-top) - (list :instance-of role-type-2 - :player sub-top)))) - (when reifier-id - (make-reification reifier-id sub-top super-top - assoc-type start-revision tm - :document-id document-id)) - (add-to-topicmap - tm - (make-construct 'AssociationC - :start-revision start-revision - :instance-of assoc-type - :roles a-roles)))))) + (let ((a-roles (list (list :instance-of role-type-1 + :player super-top) + (list :instance-of role-type-2 + :player sub-top)))) + (when reifier-id + (make-reification reifier-id sub-top super-top + assoc-type start-revision tm + :document-id document-id)) + (add-to-topicmap + tm + (make-construct 'AssociationC + :start-revision start-revision + :instance-of assoc-type + :roles a-roles))))) (defun make-instance-of-association (instance-top type-top reifier-id @@ -399,21 +392,20 @@ (unless (or roletype-1 roletype-2) (error "~aone of the role types ~a ~a is missing!" err-pref *type-psi* *instance-psi*)) - (elephant:ensure-transaction (:txn-nosync t) - (let ((a-roles (list (list :instance-of roletype-1 - :player type-top) - (list :instance-of roletype-2 - :player instance-top)))) - (when reifier-id - (make-reification reifier-id instance-top type-top - assoc-type start-revision tm - :document-id document-id)) - (add-to-topicmap - tm - (make-construct 'AssociationC - :start-revision start-revision - :instance-of assoc-type - :roles a-roles)))))) + (let ((a-roles (list (list :instance-of roletype-1 + :player type-top) + (list :instance-of roletype-2 + :player instance-top)))) + (when reifier-id + (make-reification reifier-id instance-top type-top + assoc-type start-revision tm + :document-id document-id)) + (add-to-topicmap + tm + (make-construct 'AssociationC + :start-revision start-revision + :instance-of assoc-type + :roles a-roles))))) (defun make-topic-stub (about ID nodeId UUID start-revision @@ -438,20 +430,19 @@ inner-top)))) (if top top - (elephant:ensure-transaction (:txn-nosync t) - (let ((psi (when psi-uri - (make-instance 'PersistentIdC - :uri psi-uri - :start-revision start-revision)))) - (handler-case (add-to-topicmap - tm - (make-construct 'TopicC - :topicid topic-id - :psis (when psi (list psi)) - :xtm-id document-id - :start-revision start-revision)) - (Condition (err)(error "Creating topic ~a failed: ~a" - topic-id err))))))))) + (let ((psi (when psi-uri + (make-instance 'PersistentIdC + :uri psi-uri + :start-revision start-revision)))) + (handler-case (add-to-topicmap + tm + (make-construct 'TopicC + :topicid topic-id + :psis (when psi (list psi)) + :xtm-id document-id + :start-revision start-revision)) + (Condition (err)(error "Creating topic ~a failed: ~a" + topic-id err)))))))) (defun make-lang-topic (lang start-revision tm @@ -479,30 +470,29 @@ (player-id (getf association :topicid)) (player-psi (getf association :psi)) (ID (getf association :ID))) - (elephant:ensure-transaction (:txn-nosync t) - (let ((player-1 (make-topic-stub player-psi nil player-id nil - start-revision - tm :document-id document-id)) - (role-type-1 - (make-topic-stub *rdf2tm-object* nil nil nil - start-revision tm :document-id document-id)) - (role-type-2 - (make-topic-stub *rdf2tm-subject* nil nil nil - start-revision tm :document-id document-id)) - (type-top (make-topic-stub type nil nil nil start-revision - tm :document-id document-id))) - (let ((roles (list (list :instance-of role-type-1 - :player player-1) - (list :instance-of role-type-2 - :player top)))) - (when ID - (make-reification ID top player-1 type-top start-revision - tm :document-id document-id)) - (add-to-topicmap tm (make-construct 'AssociationC - :start-revision start-revision - :instance-of type-top - :roles roles))))))) - + (let ((player-1 (make-topic-stub player-psi nil player-id nil + start-revision + tm :document-id document-id)) + (role-type-1 + (make-topic-stub *rdf2tm-object* nil nil nil + start-revision tm :document-id document-id)) + (role-type-2 + (make-topic-stub *rdf2tm-subject* nil nil nil + start-revision tm :document-id document-id)) + (type-top (make-topic-stub type nil nil nil start-revision + tm :document-id document-id))) + (let ((roles (list (list :instance-of role-type-1 + :player player-1) + (list :instance-of role-type-2 + :player top)))) + (when ID + (make-reification ID top player-1 type-top start-revision + tm :document-id document-id)) + (add-to-topicmap tm (make-construct 'AssociationC + :start-revision start-revision + :instance-of type-top + :roles roles)))))) + (defun make-association-with-nodes (subject-topic object-topic associationtype-topic tm start-revision @@ -520,11 +510,10 @@ :player subject-topic) (list :instance-of role-type-2 :player object-topic)))) - (elephant:ensure-transaction (:txn-nosync t) - (add-to-topicmap tm (make-construct 'AssociationC - :start-revision start-revision - :instance-of associationtype-topic - :roles roles)))))) + (add-to-topicmap tm (make-construct 'AssociationC + :start-revision start-revision + :instance-of associationtype-topic + :roles roles))))) (defun make-reification (reifier-id subject object predicate start-revision tm @@ -545,24 +534,23 @@ tm :document-id document-id)) (statement (make-topic-stub *rdf-statement* nil nil nil start-revision tm :document-id document-id))) - (elephant:ensure-transaction (:txn-nosync t) - (make-instance-of-association reifier statement nil start-revision tm - :document-id document-id) - (make-association-with-nodes reifier subject subject-arc tm - start-revision :document-id document-id) - (make-association-with-nodes reifier predicate predicate-arc - tm start-revision :document-id document-id) - (if (typep object 'd:TopicC) - (make-association-with-nodes reifier object object-arc - tm start-revision - :document-id document-id) - (make-construct 'd:OccurrenceC - :start-revision start-revision - :topic reifier - :themes (themes object) - :instance-of (instance-of object) - :charvalue (charvalue object) - :datatype (datatype object)))))) + (make-instance-of-association reifier statement nil start-revision tm + :document-id document-id) + (make-association-with-nodes reifier subject subject-arc tm + start-revision :document-id document-id) + (make-association-with-nodes reifier predicate predicate-arc + tm start-revision :document-id document-id) + (if (typep object 'd:TopicC) + (make-association-with-nodes reifier object object-arc + tm start-revision + :document-id document-id) + (make-construct 'd:OccurrenceC + :start-revision start-revision + :topic reifier + :themes (themes object) + :instance-of (instance-of object) + :charvalue (charvalue object) + :datatype (datatype object))))) (defun make-occurrence (top literal start-revision tm-id @@ -577,26 +565,25 @@ (lang (getf literal :lang)) (datatype (getf literal :datatype)) (ID (getf literal :ID))) - (elephant:ensure-transaction (:txn-nosync t) - (let ((type-top (make-topic-stub type nil nil nil start-revision - xml-importer::tm - :document-id document-id)) - (lang-top (make-lang-topic lang start-revision - xml-importer::tm - :document-id document-id))) - (let ((occurrence - (make-construct 'OccurrenceC - :start-revision start-revision - :topic top - :themes (when lang-top - (list lang-top)) - :instance-of type-top - :charvalue value - :datatype datatype))) - (when ID - (make-reification ID top occurrence type-top start-revision - xml-importer::tm :document-id document-id)) - occurrence)))))) + (let ((type-top (make-topic-stub type nil nil nil start-revision + xml-importer::tm + :document-id document-id)) + (lang-top (make-lang-topic lang start-revision + xml-importer::tm + :document-id document-id))) + (let ((occurrence + (make-construct 'OccurrenceC + :start-revision start-revision + :topic top + :themes (when lang-top + (list lang-top)) + :instance-of type-top + :charvalue value + :datatype datatype))) + (when ID + (make-reification ID top occurrence type-top start-revision + xml-importer::tm :document-id document-id)) + occurrence))))) (defun get-literals-of-node-content (node tm-id xml-base xml-lang) Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Aug 18 09:50:24 2009 @@ -459,4 +459,11 @@ (get-absolute-attribute elem tm-id fn-xml-base "datatype"))) (if datatype datatype - *xml-string*)))) \ No newline at end of file + *xml-string*)))) + + +(defun tm-id-p (tm-id fun-name) + "Checks the validity of the passed tm-id." + (unless (absolute-uri-p tm-id) + (error "From ~a(): you must provide a stable identifier (PSI-style) for this TM: ~a!" + fun-name tm-id))) \ No newline at end of file

1 0

[isidorus-cvs] r114 - in trunk/src: unit_tests xml/xtm
by Lukas Giessmann 13 Aug '09

13 Aug '09

Author: lgiessmann Date: Thu Aug 13 17:19:31 2009 New Revision: 114 Log: rdf-importer: fixed a bug with xml-base Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/xtm/tools.lisp Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Aug 13 17:19:31 2009 @@ -59,7 +59,8 @@ :test-poems-rdf-typing :test-poems-rdf-topics :test-empty-collection - :test-collection)) + :test-collection + :test-xml-base)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) @@ -1755,7 +1756,6 @@ 4)) (is (= (length (d:player-in-roles fourth-node)) 1)) (is (= (length (d:player-in-roles fifth-node)) 1)) - (format t "--->") (let ((col-2 (d:player (find-if @@ -2981,6 +2981,73 @@ (d:player-in-roles node)))))))) +(test test-xml-base + "Tests the function get-xml-base." + (let ((doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description xml:base=\"http://base-1\"/>" + " <rdf:Description xml:base=\"http://base-2#\"/>" + " <rdf:Description xml:base=\"http://base-3/\"/>" + "</rdf:RDF>"))) + (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) + (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) + (let ((n-1 (elt (rdf-importer::child-nodes-or-text rdf-node + :trim t) 0)) + (n-2 (elt (rdf-importer::child-nodes-or-text rdf-node + :trim t) 1)) + (n-3 (elt (rdf-importer::child-nodes-or-text rdf-node + :trim t) 2))) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-1) + "test") + "http://base-1/test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-1) + "/test") + "http://base-1/test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-1) + "#test") + "http://base-1#test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-2) + "test") + "http://base-2#test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-2) + "#test") + "http://base-2#test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-2) + "/test") + "http://base-2/test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-2) + "/t/est") + "http://base-2/t/est")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-2) + "t/est") + "http://base-2/t/est")) + (signals error (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-2) "")) + (signals error (xml-tools::concatenate-uri + "" "test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-3) + "test") + "http://base-3/test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-3) + "#test") + "http://base-3/#test")) + (is (string= (xml-tools::concatenate-uri + (xml-tools:get-xml-base n-3) + "/test") + "http://base-3/test"))))))) + + (defun run-rdf-importer-tests() (when elephant:*store-controller* (elephant:close-store)) @@ -3001,4 +3068,5 @@ (it.bese.fiveam:run! 'test-poems-rdf-typing) (it.bese.fiveam:run! 'test-poems-rdf-topics) (it.bese.fiveam:run! 'test-empty-collection) - (it.bese.fiveam:run! 'test-collection)) \ No newline at end of file + (it.bese.fiveam:run! 'test-collection) + (it.bese.fiveam:run! 'test-xml-base)) \ No newline at end of file Modified: trunk/src/xml/xtm/tools.lisp ============================================================================== --- trunk/src/xml/xtm/tools.lisp (original) +++ trunk/src/xml/xtm/tools.lisp Thu Aug 13 17:19:31 2009 @@ -44,27 +44,38 @@ "Returns a string conctenated of the absolut namespace an the given value separated by either '#' or '/'." (declare (string absolute-ns value)) - (unless (or (> (length absolute-ns) 0) - (> (length value) 0)) + (unless (and (> (length absolute-ns) 0) + (> (length value) 0)) (error "From concatenate-uri(): absolute-ns and value must be of length > 0")) (unless (absolute-uri-p absolute-ns) (error "From concatenate-uri(): absolute-ns has to be an absolute URI: ~a" absolute-ns)) (let ((last-char - (elt absolute-ns (- (length absolute-ns) 1)))) + (elt absolute-ns (- (length absolute-ns) 1))) + (first-char + (elt value 0))) (let ((separator (cond - ((eql last-char #\#) - "#") - ((eql last-char #\/) - "/") + ((or (eql first-char #\#) + (eql first-char #\/)) + "") + ((or (eql last-char #\#) + (eql last-char #\/)) + "") (t - "#"))) - (prep-ns - (if (or (eql last-char #\#) - (eql last-char #\/)) - (subseq absolute-ns 0 (- (length absolute-ns) 1)) - absolute-ns))) - (concatenate 'string prep-ns separator value)))) + "/")))) + (let ((prep-ns + (if (and (eql last-char first-char) + (or (eql last-char #\#) + (eql last-char #\/))) + (subseq absolute-ns 0 (- (length absolute-ns) 1)) + (if (and (eql last-char #\#) + (find #\/ value)) + (progn + (when (not (eql first-char #\/)) + (setf separator "/")) + (subseq absolute-ns 0 (- (length absolute-ns) 1))) + absolute-ns)))) + (concatenate 'string prep-ns separator value))))) (defun absolutize-id (id xml-base tm-id) @@ -142,9 +153,11 @@ (declare (dom:element elem)) (let ((new-base (let ((inner-base - (if (find #\# (get-ns-attribute elem "base" :ns-uri *xml-ns*)) + (if (> (count #\# (get-ns-attribute elem "base" + :ns-uri *xml-ns*)) + 1) (error "From get-xml-base(): the base-uri ~a is not valid" - (get-ns-attribute elem *xml-ns* "base")) + (get-ns-attribute elem "base" :ns-uri *xml-ns*)) (when (get-ns-attribute elem "base" :ns-uri *xml-ns*) (string-trim '(#\Space #\Tab #\Newline) (get-ns-attribute elem "base" :ns-uri *xml-ns*)))))) @@ -152,7 +165,6 @@ (eql (elt inner-base 0) #\/)) (subseq inner-base 1 (length inner-base)) inner-base)))) - (if (or (absolute-uri-p new-base) (not old-base)) new-base

1 0

[isidorus-cvs] r113 - in trunk/src: . unit_tests xml/rdf
by Lukas Giessmann 13 Aug '09

13 Aug '09

Author: lgiessmann Date: Thu Aug 13 15:47:53 2009 New Revision: 113 Log: rdf-importer: finalized the rdf-importer -> collections are imported as linked lists modelled as tm-associations (equal to manual created rdf-collections Modified: trunk/src/constants.lisp trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_core_psis.xtm trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Thu Aug 13 15:47:53 2009 @@ -37,7 +37,6 @@ :*rdf-rest* :*rdf2tm-object* :*rdf2tm-subject* - :*rdf2tm-collection* :*rdf2tm-scope-prefix*)) (in-package :constants) @@ -95,6 +94,4 @@ (defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject") -(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection") - (defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#") \ No newline at end of file Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Aug 13 15:47:53 2009 @@ -57,7 +57,9 @@ :test-poems-rdf-occurrences :test-poems-rdf-associations :test-poems-rdf-typing - :test-poems-rdf-topics)) + :test-poems-rdf-topics + :test-empty-collection + :test-collection)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) @@ -1034,7 +1036,7 @@ (rdf-init-db :db-dir db-dir :start-revision revision-1) (rdf-importer::import-node node tm-id revision-2 :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 20)) (let ((first-node (get-item-by-id "http://test-tm/first-node" :xtm-id document-id)) (first-type (get-item-by-id "http://test-tm/first-type" @@ -1472,8 +1474,8 @@ 2)) (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 38)) - (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 10)) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40)) + (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12)) (setf rdf-importer::*current-xtm* document-id) (is (= (length (intersection @@ -1482,7 +1484,7 @@ (list (d:get-item-by-id (concatenate 'string - constants::*rdf2tm-collection*) + constants::*rdf-nil*) :xtm-id rdf-importer::*rdf-core-xtm*) (d:get-item-by-psi constants::*type-instance-psi*) (dotimes (iter 9) @@ -1515,8 +1517,9 @@ constants:*type-instance-psi*)) (subject (d:get-item-by-psi constants::*rdf2tm-subject*)) (object (d:get-item-by-psi constants::*rdf2tm-object*)) - (collection (d:get-item-by-id - constants::*rdf2tm-collection*))) + (rdf-first (d:get-item-by-psi constants:*rdf-first*)) + (rdf-rest (d:get-item-by-psi constants:*rdf-rest*)) + (rdf-nil (d:get-item-by-psi constants:*rdf-nil*))) (is (= (length (d:psis first-node)) 1)) (is (string= (d:uri (first (d:psis first-node))) "http://test-tm/first-node")) @@ -1560,6 +1563,15 @@ (is (= (length (d:psis arc8)) 1)) (is (string= (d:uri (first (d:psis arc8))) "http://test/arcs/arc8")) + (is (= (length (d:psis rdf-first)) 1)) + (is (string= (d:uri (first (d:psis rdf-first))) + constants:*rdf-first*)) + (is (= (length (d:psis rdf-rest)) 1)) + (is (string= (d:uri (first (d:psis rdf-rest))) + constants:*rdf-rest*)) + (is (= (length (d:psis rdf-nil)) 1)) + (is (string= (d:uri (first (d:psis rdf-nil))) + constants:*rdf-nil*)) (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 1)) (is (string= (d:charvalue (first (elephant:get-instances-by-class @@ -1629,30 +1641,84 @@ (eql (d:instance-of (d:parent x)) arc4))) (d:player-in-roles uuid-1)))))))) (is-true col-1) - (is (= (length (d:player-in-roles col-1)) 2)) + (is (= (length (d:player-in-roles col-1)) 3)) (is-true (find-if #'(lambda(x) (and (eql (d:instance-of x) subject) (eql (d:instance-of (d:parent x)) - collection))) + rdf-first))) (d:player-in-roles col-1))) - (let ((col-assoc - (d:parent - (find-if + (is-true (find-if #'(lambda(x) (and (eql (d:instance-of x) subject) (eql (d:instance-of (d:parent x)) - collection))) - (d:player-in-roles col-1))))) - (is-true col-assoc) - (is (= (length (d:roles col-assoc)) 3)) - (is (= (count-if + rdf-rest))) + (d:player-in-roles col-1))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) + arc4))) + (d:player-in-roles col-1))) + (is (= (length (d:player-in-roles item-1)) 1)) + (is-true (find-if #'(lambda(x) (and (eql (d:instance-of x) object) - (or (eql (d:player x) item-1) - (eql (d:player x) item-2)))) - (d:roles col-assoc)) - 2)))) + (eql (d:instance-of (d:parent x)) + rdf-first))) + (d:player-in-roles item-1))) + (let ((col-2 + (let ((role + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-1)))) + (is (= (length (d:roles (d:parent role))) 2)) + (let ((other-role + (find-if #'(lambda(x) + (and (not (eql x role)) + (eql (d:instance-of x) + object))) + (d:roles (d:parent role))))) + (d:player other-role))))) + (is-true col-2) + (is (= (length (d:psis col-2)) 0)) + (is (= (length (d:player-in-roles col-2)) 3)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-first))) + (d:player-in-roles col-2))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-2))) + (let ((col-3 + (let ((role + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-2)))) + + (is (= (length (d:roles (d:parent role))) 2)) + (let ((other-role + (find-if + #'(lambda(x) + (not (eql x role))) + (d:roles (d:parent role))))) + (d:player other-role))))) + (is-true col-3) + (is (= (length (d:psis col-3)) 1)) + (is (string= (d:uri (first (d:psis col-3))) + constants:*rdf-nil*)) + (is (= (length (d:player-in-roles col-3)) 2))))) (is (= (length (d:player-in-roles item-1)) 1)) (is (= (length (d:player-in-roles item-2)) 2)) (is-true (find-if @@ -1689,12 +1755,13 @@ 4)) (is (= (length (d:player-in-roles fourth-node)) 1)) (is (= (length (d:player-in-roles fifth-node)) 1)) + (format t "--->") (let ((col-2 (d:player (find-if #'(lambda(y) (and (eql (d:instance-of y) object) - (= 0 (length (d:psis (d:player y)))))) + (= 1 (length (d:psis (d:player y)))))) (d:roles (d:parent (find-if @@ -1702,24 +1769,11 @@ (and (eql (d:instance-of x) subject) (eql (d:instance-of (d:parent x)) arc8))) (d:player-in-roles uuid-2)))))))) + (is (= (length (d:psis col-2)) 1)) + (is (string= constants:*rdf-nil* + (d:uri (first (d:psis col-2))))) (is-true col-2) - (is (= (length (d:player-in-roles col-2)) 2)) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - collection))) - (d:player-in-roles col-2))) - (let ((col-assoc - (d:parent - (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - collection))) - (d:player-in-roles col-2))))) - (is-true col-assoc) - (is (= (length (d:roles col-assoc)) 1)))))))))) + (is (= (length (d:player-in-roles col-2)) 2))))))))) (elephant:close-store)) @@ -1742,7 +1796,7 @@ (date "http://www.w3.org/2001/XMLSchema#date") (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de")) (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) - (is (= (length topics) 66)) + (is (= (length topics) 65)) (is (= (length occs) 23)) (is (= (length assocs) 30)) (is-true de) @@ -2350,9 +2404,7 @@ (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") (prometheus "http://some.where/poem/Prometheus") (erlkoenig "http://some.where/ballad/Der_Erlkoenig") - (country "http://some.where/types/Country") - - ) + (country "http://some.where/types/Country")) (is (= (count-if #'(lambda(x) (and (eql (d:instance-of x) supertype-subtype) @@ -2708,6 +2760,227 @@ 6)))))) +(test test-empty-collection + "Tests importing of empty collections." + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (revision-1 100) + (document-id "doc-id") + (doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description rdf:about=\"first-node\">" + " <arcs:arc rdf:parseType=\"Collection\" />" + " </rdf:Description>" + "</rdf:RDF>"))) + (let ((rdf-node (elt (dom:child-nodes + (cxml:parse doc-1 (cxml-dom:make-dom-builder))) + 0))) + (is-true rdf-node) + (rdf-init-db :db-dir db-dir :start-revision revision-1) + (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id + :document-id document-id) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 21)) + (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 1)) + (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0)) + (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0)) + (let ((first-node (d:get-item-by-id "http://test-tm/first-node" + :xtm-id document-id)) + (arc (d:get-item-by-id "http://test/arcs/arc" + :xtm-id document-id)) + (rdf-nil (d:get-item-by-id constants:*rdf-nil* + :xtm-id document-id)) + (subject (d:get-item-by-id constants:*rdf2tm-subject*)) + (object (d:get-item-by-id constants:*rdf2tm-object*))) + (is-true subject) + (is-true object) + (is-true first-node) + (is (= (length (d:psis first-node)) 1)) + (is (string= (d:uri (first (d:psis first-node))) + "http://test-tm/first-node")) + (is-true arc) + (is (= (length (d:psis arc)) 1)) + (is (string= (d:uri (first (d:psis arc))) + "http://test/arcs/arc")) + (is-true rdf-nil) + (is (= (length (d:psis rdf-nil)) 1)) + (is (string= (d:uri (first (d:psis rdf-nil))) constants:*rdf-nil*)) + (is (= (length (d:player-in-roles first-node)) 1)) + (is (= (length (d:player-in-roles arc)) 0)) + (is (= (length (d:player-in-roles rdf-nil)) 1)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc))) + (d:player-in-roles first-node))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) arc))) + (d:player-in-roles rdf-nil))))))) + + +(test test-collection + "Tests importing of non-empty collections." + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (revision-1 100) + (document-id "doc-id") + (doc-1 + (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description rdf:about=\"first-node\">" + " <arcs:arc rdf:parseType=\"Collection\">" + " <rdf:Description rdf:about=\"item-1\"/>" + " <arcs:Node rdf:about=\"item-2\"/>" + " </arcs:arc>" + " </rdf:Description>" + "</rdf:RDF>"))) + (let ((rdf-node (elt (dom:child-nodes + (cxml:parse doc-1 (cxml-dom:make-dom-builder))) + 0))) + (is-true rdf-node) + (rdf-init-db :db-dir db-dir :start-revision revision-1) + (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id + :document-id document-id) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 28)) + (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 6)) + (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 0)) + (is (= (length (elephant:get-instances-by-class 'd:NameC)) 0)) + (let ((first-node (d:get-item-by-id "http://test-tm/first-node" + :xtm-id document-id)) + (arc (d:get-item-by-id "http://test/arcs/arc" + :xtm-id document-id)) + (item-1 (d:get-item-by-id "http://test-tm/item-1" + :xtm-id document-id)) + (item-2 (d:get-item-by-id "http://test-tm/item-2" + :xtm-id document-id)) + (node (d:get-item-by-id "http://test/arcs/Node" + :xtm-id document-id)) + (rdf-first (d:get-item-by-id constants:*rdf-first* + :xtm-id document-id)) + (rdf-rest (d:get-item-by-id constants:*rdf-rest* + :xtm-id document-id)) + (rdf-nil (d:get-item-by-id constants:*rdf-nil* + :xtm-id document-id)) + (subject (d:get-item-by-id constants:*rdf2tm-subject* + :xtm-id document-id)) + (object (d:get-item-by-id constants:*rdf2tm-object* + :xtm-id document-id)) + (instance (d:get-item-by-psi constants:*instance-psi*)) + (type (d:get-item-by-psi constants:*type-psi*)) + (type-instance (d:get-item-by-psi constants:*type-instance-psi*))) + (is-true first-node) + (is (= (length (d:psis first-node)) 1)) + (is (string= (d:uri (first (d:psis first-node))) + "http://test-tm/first-node")) + (is (= (length (d:player-in-roles first-node)) 1)) + (is-true arc) + (is (= (length (d:psis arc)) 1)) + (is (string= (d:uri (first (d:psis arc))) + "http://test/arcs/arc")) + (is (= (length (d:player-in-roles arc)) 0)) + (is-true item-1) + (is (= (length (d:psis item-1)) 1)) + (is (string= (d:uri (first (d:psis item-1))) + "http://test-tm/item-1")) + (is (= (length (d:player-in-roles item-1)) 1)) + (is-true item-2) + (is (= (length (d:psis item-2)) 1)) + (is (string= (d:uri (first (d:psis item-2))) + "http://test-tm/item-2")) + (is (= (length (d:player-in-roles item-2)) 2)) + (is-true node) + (is (= (length (d:psis node)) 1)) + (is (string= (d:uri (first (d:psis node))) + "http://test/arcs/Node")) + (is (= (length (d:player-in-roles node)) 1)) + (is-true rdf-first) + (is-true rdf-rest) + (is-true rdf-nil) + (is (= (length (d:player-in-roles rdf-nil)) 1)) + (is-true subject) + (is-true object) + (let ((uuid-1 + (d:player + (find-if + #'(lambda(x) + (not (eql x (first (d:player-in-roles first-node))))) + (d:roles (d:parent (first (d:player-in-roles first-node))))))) + (uuid-2 + (d:player + (find-if + #'(lambda(x) + (not (eql x (first (d:player-in-roles rdf-nil))))) + (d:roles (d:parent (first (d:player-in-roles rdf-nil)))))))) + (is-true uuid-1) + (is (= (length (d:psis uuid-1)) 0)) + (is (= (length (d:player-in-roles uuid-1)) 3)) + (is-true uuid-2) + (is (= (length (d:psis uuid-2)) 0)) + (is (= (length (d:player-in-roles uuid-2)) 3)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc))) + (d:player-in-roles first-node))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) arc))) + (d:player-in-roles uuid-1))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) rdf-first))) + (d:player-in-roles uuid-1))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) rdf-rest))) + (d:player-in-roles uuid-1))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) rdf-first))) + (d:player-in-roles item-1))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) rdf-rest))) + (d:player-in-roles uuid-2))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) rdf-first))) + (d:player-in-roles uuid-2))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) rdf-rest))) + (d:player-in-roles uuid-2))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) rdf-rest))) + (d:player-in-roles rdf-nil))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) rdf-first))) + (d:player-in-roles item-2))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) instance) + (eql (d:instance-of (d:parent x)) type-instance))) + (d:player-in-roles item-2))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) type) + (eql (d:instance-of (d:parent x)) type-instance))) + (d:player-in-roles node)))))))) + + (defun run-rdf-importer-tests() (when elephant:*store-controller* (elephant:close-store)) @@ -2726,4 +2999,6 @@ (it.bese.fiveam:run! 'test-poems-rdf-occurrences) (it.bese.fiveam:run! 'test-poems-rdf-associations) (it.bese.fiveam:run! 'test-poems-rdf-typing) - (it.bese.fiveam:run! 'test-poems-rdf-topics)) \ No newline at end of file + (it.bese.fiveam:run! 'test-poems-rdf-topics) + (it.bese.fiveam:run! 'test-empty-collection) + (it.bese.fiveam:run! 'test-collection)) \ No newline at end of file Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Thu Aug 13 15:47:53 2009 @@ -101,8 +101,6 @@ (format t ">> import-node: ~a <<~%" (dom:node-name elem)) ;TODO: remove (tm-id-p tm-id "import-node") (parse-node elem) - ;TODO: handle Collections that are made manually without - ; parseType="Collection" -> see also import-arc (let ((fn-xml-base (get-xml-base elem :old-base xml-base)) (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))) (let ((about (get-absolute-attribute elem tm-id xml-base "about")) @@ -158,76 +156,123 @@ (let ((fn-xml-lang (get-xml-lang elem :old-lang xml-lang)) (fn-xml-base (get-xml-base elem :old-base xml-base)) (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*)) - (parseType (get-ns-attribute elem "parseType"))) - (when (or (not parseType) - (and parseType - (string/= parseType "Collection"))) - (when UUID - (parse-properties-of-node elem UUID) - (with-tm (start-revision document-id tm-id) - (let ((this (get-item-by-id UUID :xtm-id document-id - :revision start-revision))) - (let ((literals (append (get-literals-of-property elem fn-xml-lang) - (get-literals-of-node-content - elem tm-id xml-base fn-xml-lang))) - (associations - (get-associations-of-node-content elem tm-id xml-base)) - (types (remove-if - #'null - (append - (get-types-of-node-content elem tm-id fn-xml-base) - (when (get-ns-attribute elem "type") - (list :ID nil - :topicid (get-ns-attribute elem "type") - :psi (get-ns-attribute elem "type")))))) - (super-classes - (get-super-classes-of-node-content elem tm-id xml-base))) - (make-literals this literals tm-id start-revision - :document-id document-id) - (make-associations this associations xml-importer::tm - start-revision :document-id document-id) - (make-types this types xml-importer::tm start-revision - :document-id document-id) - (make-super-classes this super-classes xml-importer::tm - start-revision :document-id document-id)))))) - (make-recursion-from-arc elem tm-id start-revision - :document-id document-id - :xml-base xml-base :xml-lang xml-lang))) + (parseType (get-ns-attribute elem "parseType")) + (content (child-nodes-or-text elem :trim t))) + (with-tm (start-revision document-id tm-id) + (if (and (string= parseType "Collection") + (= (length content) 0)) + (make-topic-stub *rdf-nil* nil nil nil start-revision + xml-importer::tm :document-id document-id) + (let ((this-topic + (when (or (not parseType) + (and parseType + (string/= parseType "Collection"))) + (when UUID + (parse-properties-of-node elem UUID) + (let ((this + (get-item-by-id UUID :xtm-id document-id + :revision start-revision))) + (let ((literals + (append (get-literals-of-property + elem fn-xml-lang) + (get-literals-of-node-content + elem tm-id xml-base fn-xml-lang))) + (associations + (get-associations-of-node-content + elem tm-id xml-base)) + (types + (remove-if + #'null + (append + (get-types-of-node-content elem tm-id fn-xml-base) + (when (get-ns-attribute elem "type") + (list :ID nil + :topicid (get-ns-attribute elem "type") + :psi (get-ns-attribute elem "type")))))) + (super-classes + (get-super-classes-of-node-content + elem tm-id xml-base))) + (make-literals this literals tm-id start-revision + :document-id document-id) + (make-associations this associations xml-importer::tm + start-revision :document-id document-id) + (make-types this types xml-importer::tm start-revision + :document-id document-id) + (make-super-classes + this super-classes xml-importer::tm + start-revision :document-id document-id)) + this))))) + (make-recursion-from-arc elem tm-id start-revision + :document-id document-id + :xml-base xml-base :xml-lang xml-lang) + this-topic))))) -(defun make-collection (elem owner-top tm-id start-revision +(defun make-collection (elem tm-id start-revision &key (document-id *document-id*) (xml-base nil) (xml-lang nil)) - "Creates a TM association with a subject role containing the collection - entry point and as many roles of the type 'object' as items exists." - (declare (d:TopicC owner-top)) + "Creates a collection structure of a node that contains + parseType='Collection." + (declare (dom:element elem)) (with-tm (start-revision document-id tm-id) (let ((fn-xml-base (get-xml-base elem :old-base xml-base)) (fn-xml-lang (get-xml-lang elem :old-lang xml-lang)) - (subject (make-topic-stub *rdf2tm-subject* nil nil nil start-revision - xml-importer::tm :document-id document-id)) - (object (make-topic-stub *rdf2tm-object* nil nil nil start-revision - xml-importer::tm :document-id document-id))) - (let ((association-type (make-topic-stub *rdf2tm-collection* nil nil nil - start-revision xml-importer::tm - :document-id document-id)) - (roles - (append - (loop for item across (child-nodes-or-text elem :trim t) - collect (let ((item-top (import-node item tm-id start-revision - :document-id document-id - :xml-base fn-xml-base - :xml-lang fn-xml-lang))) - (list :player item-top - :instance-of object))) - (list (list :player owner-top - :instance-of subject))))) - (add-to-topicmap - xml-importer::tm - (make-construct 'd:AssociationC - :start-revision start-revision - :instance-of association-type - :roles roles)))))) + (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))) + (let ((this (make-topic-stub nil nil nil UUID start-revision + xml-importer::tm + :document-id document-id)) + (items (loop for item across (child-nodes-or-text elem :trim t) + collect (import-node item tm-id start-revision + :document-id document-id + :xml-base fn-xml-base + :xml-lang fn-xml-lang)))) + (let ((last-blank-node this)) + (dotimes (index (length items)) + (let ((is-end + (if (= index (- (length items) 1)) + t + nil))) + (let ((new-blank-node + (make-collection-association + last-blank-node (elt items index) tm-id start-revision + :is-end is-end :document-id document-id))) + (setf last-blank-node new-blank-node))))))))) + + +(defun make-collection-association (current-blank-node first-object tm-id + start-revision &key (is-end nil) + (document-id *document-id*)) + "Creates a 'first'-association between the current-blank-node and the + first-object. If is-end is set to true another association between + current-blank-node and the topic rdf:nil is created. Otherwise this + associaiton is made from the current-blank-node to a new created blank + node." + (declare (d:TopicC current-blank-node first-object)) + (with-tm (start-revision document-id tm-id) + (let ((first-arc + (make-topic-stub *rdf-first* nil nil nil start-revision + xml-importer::tm :document-id document-id)) + (rest-arc + (make-topic-stub *rdf-rest* nil nil nil start-revision + xml-importer::tm :document-id document-id))) + (make-association-with-nodes current-blank-node first-object first-arc + xml-importer::tm start-revision + :document-id document-id) + (if is-end + (let ((rdf-nil (make-topic-stub *rdf-nil* nil nil nil + start-revision xml-importer::tm + :document-id document-id))) + (make-association-with-nodes + current-blank-node rdf-nil rest-arc xml-importer::tm + start-revision :document-id document-id) + nil) + (let ((new-blank-node (make-topic-stub + nil nil nil (get-uuid) start-revision + xml-importer::tm :document-id document-id))) + (make-association-with-nodes + current-blank-node new-blank-node rest-arc xml-importer::tm + start-revision :document-id document-id) + new-blank-node))))) (defun make-literals (owner-top literals tm-id start-revision @@ -801,10 +846,15 @@ (not (and (string= prop-name "subClassOf") (string= prop-ns *rdfs-ns*))))) collect (let ((prop-xml-base (get-xml-base property - :old-base fn-xml-base))) + :old-base fn-xml-base)) + (content (child-nodes-or-text property :trim t)) + (parseType (get-ns-attribute property "parseType"))) (let ((resource - (get-absolute-attribute property tm-id - fn-xml-base "resource")) + (if (and (string= parseType "Collection") + (= (length content) 0)) + *rdf-nil* + (get-absolute-attribute property tm-id + fn-xml-base "resource"))) (nodeID (get-ns-attribute property "nodeID")) (UUID (get-ns-attribute property "UUID" :ns-uri *rdf2tm-ns*)) @@ -813,7 +863,7 @@ (full-name (get-type-of-node-name property))) (if (or nodeID resource UUID) (list :type full-name - :topicid (or nodeID resource UUID) + :topicid (or resource nodeID UUID) :psi resource :ID ID) (let ((refs (get-node-refs @@ -851,8 +901,7 @@ (let ((fn-xml-base (get-xml-base arc :old-base xml-base)) (fn-xml-lang (get-xml-lang arc :old-lang xml-lang)) (content (child-nodes-or-text arc)) - (parseType (get-ns-attribute arc "parseType")) - (UUID (get-ns-attribute arc "UUID" :ns-uri *rdf2tm-ns*))) + (parseType (get-ns-attribute arc "parseType"))) (let ((datatype (get-absolute-attribute arc tm-id xml-base "datatype")) (type (get-absolute-attribute arc tm-id xml-base "type")) (resource (get-absolute-attribute arc tm-id xml-base "resource")) @@ -860,32 +909,27 @@ (literals (get-literals-of-property arc xml-lang))) (if (and parseType (string= parseType "Collection")) - (let ((this - (with-tm (start-revision document-id tm-id) - (make-topic-stub nil nil nil UUID start-revision - xml-importer::tm - :document-id document-id)))) - (make-collection arc this tm-id start-revision - :document-id document-id - :xml-base xml-base - :xml-lang xml-lang)) + (make-collection arc tm-id start-revision + :document-id document-id + :xml-base xml-base + :xml-lang xml-lang) (if (or datatype resource nodeID (and parseType (string= parseType "Literal")) (and content (stringp content))) - t;; do nothing current elem is a literal node that has been - ;; already imported as an occurrence + nil;; do nothing current elem is a literal node that has been + ;; already imported as an occurrence (if (or type literals (and parseType (string= parseType "Resource"))) (loop for item across content - do (import-arc item tm-id start-revision - :document-id document-id - :xml-base fn-xml-base - :xml-lang fn-xml-lang)) + collect (import-arc item tm-id start-revision + :document-id document-id + :xml-base fn-xml-base + :xml-lang fn-xml-lang)) (loop for item across content - do (import-node item tm-id start-revision - :document-id document-id - :xml-base xml-base - :xml-lang xml-lang)))))))) + collect (import-node item tm-id start-revision + :document-id document-id + :xml-base xml-base + :xml-lang xml-lang)))))))) \ No newline at end of file Modified: trunk/src/xml/rdf/rdf_core_psis.xtm ============================================================================== --- trunk/src/xml/rdf/rdf_core_psis.xtm (original) +++ trunk/src/xml/rdf/rdf_core_psis.xtm Thu Aug 13 15:47:53 2009 @@ -23,13 +23,6 @@ <value>object</value> </name> </topic> - - <topic id="collection"> - <subjectIdentifier href="http://isidorus/rdf2tm_mapping#collection"/> - <name> - <value>object</value> - </name> - </topic> <topic id="supertype-subtype"> <subjectIdentifier href="http://psi.topicmaps.org/iso13250/model/supertype-subtype"/> Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Thu Aug 13 15:47:53 2009 @@ -31,7 +31,6 @@ *rdf-nil* *rdf-first* *rdf-rest* - *rdf2tm-collection* *rdf2tm-scope-prefix*) (:import-from :xml-constants *rdf_core_psis.xtm*)

1 0

[isidorus-cvs] r112 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 10 Aug '09

10 Aug '09

Author: lgiessmann Date: Mon Aug 10 06:48:58 2009 New Revision: 112 Log: rdf-importer: fixed a problem with rdf:li, so distributed rdf:li elementes ar not merged. intead of merging names the names of the form rdf:_n are incremented across the entire document for the same resource. when the user mixes rdf:li elements and rdf:_n elements on one resource there is no separate handling, i.e.these elements are merged anyway. Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Mon Aug 10 06:48:58 2009 @@ -880,16 +880,18 @@ (is (= (length (dom:child-nodes dom-1)))) (let ((node (elt (dom:child-nodes dom-1) 0))) (is-true (rdf-importer::parse-node node)) - (is-true (rdf-importer::parse-properties-of-node node)) - (is (= (length rdf-importer::*_n-map*) 8)) + (is-true (rdf-importer::parse-properties-of-node + node "http://xml-base/first/resource")) + (is (= (length rdf-importer::*_n-map*) 1)) + (is (= (length (getf (first rdf-importer::*_n-map*) :props)) 8)) (dotimes (iter (length rdf-importer::*_n-map*)) (is-true (find-if #'(lambda(x) - (string= (getf x :type) + (string= (getf x :name) (concatenate 'string *rdf-ns* "_" (write-to-string (+ 1 iter))))) - rdf-importer::*_n-map*))) + (getf (first rdf-importer::*_n-map*) :props)))) (let ((assocs (rdf-importer::get-associations-of-node-content node tm-id nil)) (content-literals @@ -985,8 +987,7 @@ (getf x :ID) "http://xml-base/first#rdfID-4"))) content-literals))) - (rdf-importer::remove-node-properties-from-*_n-map* node) - (is (= (length rdf-importer::*_n-map*) 0)))))) + (setf rdf-importer::*_n-map* nil))))) (test test-import-node-1 @@ -1741,7 +1742,7 @@ (date "http://www.w3.org/2001/XMLSchema#date") (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de")) (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) - (is (= (length topics) 65)) + (is (= (length topics) 66)) (is (= (length occs) 23)) (is (= (length assocs) 30)) (is-true de) @@ -2285,7 +2286,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_1")) + (concatenate 'string constants:*rdf-ns* "_2")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2304,7 +2305,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_2")) + (concatenate 'string constants:*rdf-ns* "_3")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2641,6 +2642,7 @@ (bag (get-item-by-id (concatenate 'string *rdf-ns* "Bag"))) (_1 (get-item-by-id (concatenate 'string *rdf-ns* "_1"))) (_2 (get-item-by-id (concatenate 'string *rdf-ns* "_2"))) + (_3 (get-item-by-id (concatenate 'string *rdf-ns* "_3"))) (zauberlehrling (get-item-by-id "http://some.where/poem/Der_Zauberlehrling")) (poem (get-item-by-id (concatenate 'string types "Poem"))) @@ -2685,6 +2687,7 @@ (check-topic bag (concatenate 'string *rdf-ns* "Bag")) (check-topic _1 (concatenate 'string *rdf-ns* "_1")) (check-topic _2 (concatenate 'string *rdf-ns* "_2")) + (check-topic _3 (concatenate 'string *rdf-ns* "_3")) (check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling") (check-topic poem (concatenate 'string types "Poem")) (check-topic dateRange (concatenate 'string arcs "dateRange")) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Mon Aug 10 06:48:58 2009 @@ -105,12 +105,13 @@ ; parseType="Collection" -> see also import-arc (let ((fn-xml-base (get-xml-base elem :old-base xml-base)) (fn-xml-lang (get-xml-lang elem :old-lang xml-lang))) - (parse-properties-of-node elem) (let ((about (get-absolute-attribute elem tm-id xml-base "about")) (nodeID (get-ns-attribute elem "nodeID")) (ID (get-absolute-attribute elem tm-id xml-base "ID")) - (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*)) - (literals (append (get-literals-of-node elem fn-xml-lang) + (UUID (get-ns-attribute elem "UUID" :ns-uri *rdf2tm-ns*))) + (parse-properties-of-node elem (or about nodeID ID UUID)) + + (let ((literals (append (get-literals-of-node elem fn-xml-lang) (get-literals-of-node-content elem tm-id xml-base fn-xml-lang))) (associations (get-associations-of-node-content elem tm-id xml-base)) @@ -144,8 +145,7 @@ :document-id document-id :xml-base xml-base :xml-lang xml-lang) - (remove-node-properties-from-*_n-map* elem) - this)))))) + this))))))) (defun import-arc (elem tm-id start-revision @@ -163,7 +163,7 @@ (and parseType (string/= parseType "Collection"))) (when UUID - (parse-properties-of-node elem) + (parse-properties-of-node elem UUID) (with-tm (start-revision document-id tm-id) (let ((this (get-item-by-id UUID :xtm-id document-id :revision start-revision))) Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Mon Aug 10 06:48:58 2009 @@ -108,53 +108,73 @@ (condition () nil)))))) -(defun set-_n-name (property _n-counter) - "Returns a name of the form <rdf>_[1-9][0-9]* and adds a tupple - of the form :elem <dom-elem> :type<<rdf>_[1-9][0-9]*> to the - list *_n-map*. - If the dom-elem is already contained in the list only the - <rdf>_[1-9][0-9]* name is returned." - (let ((map-item (find-if #'(lambda(x) - (eql (getf x :elem) property)) - *_n-map*))) - (if map-item - (getf map-item :type) - (let ((new-type-name - (concatenate 'string *rdf-ns* "_" (write-to-string _n-counter)))) - (push (list :elem property - :type new-type-name) - *_n-map*) - new-type-name)))) - - -(defun unset-_n-name (property) - "Deletes the passed property tupple of the *_n-map* list." - (setf *_n-map* (remove-if #'(lambda(x) - (eql (getf x :elem) property)) - *_n-map*))) +(defun find-_n-name-of-property (property) + "Returns the properties name of the form rdf:_n or nil." + (let ((owner + (find-if + #'(lambda(x) + (find-if + #'(lambda(y) + (eql (getf y :elem) property)) + (getf x :props))) + *_n-map*))) + (let ((elem (find-if #'(lambda(x) + (eql (getf x :elem) property)) + (getf owner :props)))) + (when elem + (getf elem :name))))) -(defun remove-node-properties-from-*_n-map* (node) - "Removes all node's properties from the list *_n-map*." - (declare (dom:element node)) - (let ((properties (child-nodes-or-text node :trim t))) - (when properties - (loop for property across properties - do (unset-_n-name property)))) - (dom:map-node-map - #'(lambda(attr) (unset-_n-name attr)) - (dom:attributes node))) + + +(defun find-_n-name (owner-identifier property) + "Returns a name of the form rdf:_n of the property element + when it owns the tagname rdf:li and exists in the *_n-map* list. + Otherwise the return value is nil." + (let ((owner (find-if #'(lambda(x) + (string= (getf x :owner) owner-identifier)) + *_n-map*))) + (when owner + (let ((prop (find-if #'(lambda(x) + (eql (getf x :elem) property)) + (getf owner :props)))) + (getf prop :name))))) + + +(defun set-_n-name (owner-identifier property) + "Sets a new name of the form _n for the passed property element and + adds it to the list *_n-map*. If the property already exists in the + *_n-map* list, there won't be created a new entry but returned the + stored value name." + (let ((name (find-_n-name owner-identifier property))) + (if name + name + (let ((owner (find-if #'(lambda(x) + (string= (getf x :owner) owner-identifier)) + *_n-map*))) + (if owner + (let ((new-name + (concatenate + 'string *rdf-ns* "_" + (write-to-string (+ (length (getf owner :props)) 1))))) + (push (list :elem property + :name new-name) + (getf owner :props)) + new-name) + (progn + (push + (list :owner owner-identifier + :props (list + (list :elem property + :name (concatenate 'string *rdf-ns* "_1")))) + *_n-map*) + "_1")))))) (defun get-type-of-node-name (node) - "Returns the type of the node name (namespace + tagname). - When the node is contained in *_n-map* the corresponding - value of this map will be returned." - (let ((map-item (find-if #'(lambda(x) - (eql (getf x :elem) node)) - *_n-map*))) + (let ((map-item (find-_n-name-of-property node))) (if map-item - (getf map-item :type) + map-item (let ((node-name (get-node-name node)) (node-ns (dom:namespace-uri node))) (concatenate-uri node-ns node-name))))) @@ -258,7 +278,7 @@ :psi (or ID about))))))) -(defun parse-property-name (property _n-counter) +(defun parse-property-name (property owner-identifier) "Parses the given property's name to the known rdf/rdfs nodes and arcs. If the given name es equal to an node an error is thrown otherwise there is displayed a warning when the rdf ord rdfs namespace is used." @@ -286,11 +306,12 @@ err-pref property-name))) (when (and (string= property-ns *rdf-ns*) (string= property-name "li")) - (set-_n-name property _n-counter))) + (set-_n-name owner-identifier property))) + ;(set-_n-name property _n-counter))) t) -(defun parse-property (property _n-counter) +(defun parse-property (property owner-identifier) "Parses a property that represents a rdf-arc." (declare (dom:element property)) (let ((err-pref "From parse-property(): ") @@ -305,7 +326,7 @@ (subClassOf (get-ns-attribute property "subClassOf" :ns-uri *rdfs-ns*)) (literals (get-literals-of-property property nil)) (content (child-nodes-or-text property :trim t))) - (parse-property-name property _n-counter) + (parse-property-name property owner-identifier) (when (and parseType (or nodeID resource datatype type literals)) (error "~awhen rdf:parseType is set the attributes: ~a => ~a are not allowed!" @@ -382,7 +403,7 @@ (string= node-ns *rdfs-ns*))) (and (> (length content) 0) (stringp content))) - (error "~awhen ~a not allowed to own literal content: ~a!" + (error "~awhen property is ~a literal content is not allowed: ~a!" err-pref (if (string= node-name "type") "rdf:type" "rdfs:subClassOf") @@ -398,28 +419,22 @@ t) -(defun parse-properties-of-node (node) +(defun parse-properties-of-node (node owner-identifier) "Parses all node's properties by calling the parse-propery function and sets all rdf:li properties as a tupple to the *_n-map* list." - (let ((child-nodes (child-nodes-or-text node :trim t)) - (_n-counter 0)) + (let ((child-nodes (child-nodes-or-text node :trim t))) + ;(_n-counter 0)) (when (get-ns-attribute node "li") (dom:map-node-map #'(lambda(attr) (when (and (string= (get-node-name attr) "li") (string= (dom:namespace-uri attr) *rdf-ns*)) - (incf _n-counter) - (set-_n-name attr _n-counter))) + (set-_n-name owner-identifier attr))) (dom:attributes node))) (when child-nodes (loop for property across child-nodes - do (let ((prop-name (get-node-name property)) - (prop-ns (dom:namespace-uri node))) - (when (and (string= prop-name "li") - (string= prop-ns *rdf-ns*)) - (incf _n-counter)) - (parse-property property _n-counter))))) + do (parse-property property owner-identifier)))) t)

1 0

[isidorus-cvs] r111 - in trunk/src: . unit_tests xml/rdf
by Lukas Giessmann 07 Aug '09

07 Aug '09

Author: lgiessmann Date: Fri Aug 7 11:48:40 2009 New Revision: 111 Log: finalized the unit tests for poems.rdf Modified: trunk/src/constants.lisp trunk/src/unit_tests/poems.rdf trunk/src/unit_tests/poems_light.rdf trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Fri Aug 7 11:48:40 2009 @@ -37,7 +37,8 @@ :*rdf-rest* :*rdf2tm-object* :*rdf2tm-subject* - :*rdf2tm-collection*)) + :*rdf2tm-collection* + :*rdf2tm-scope-prefix*)) (in-package :constants) (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/") @@ -94,4 +95,6 @@ (defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject") -(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection") \ No newline at end of file +(defparameter *rdf2tm-collection* "http://isidorus/rdf2tm_mapping#collection") + +(defparameter *rdf2tm-scope-prefix* "http://isidorus/rdf2tm_mapping/scope#") \ No newline at end of file Modified: trunk/src/unit_tests/poems.rdf ============================================================================== --- trunk/src/unit_tests/poems.rdf (original) +++ trunk/src/unit_tests/poems.rdf Fri Aug 7 11:48:40 2009 @@ -16,7 +16,7 @@ <types:Event> <arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date> <arcs:place> - <rdf:Description rdf:about="/region/FrankfurtMain"> + <rdf:Description rdf:about="/metropolis/FrankfurtMain"> <rdf:type> <rdf:Description rdf:about="/types/Metropolis"> <rdfs:subClassOf rdf:resource="/types/Region"/> @@ -33,7 +33,7 @@ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population> <arcs:officialese rdf:resource="language/German"/> <arcs:capital> - <rdf:Description rdf:about="http://some.where/region/Berlin"> + <rdf:Description rdf:about="http://some.where/metropolis/Berlin"> <rdf:type> <rdf:Description rdf:about="http://some.where/types/Metropolis"/> </rdf:type> @@ -54,9 +54,9 @@ <rdf:type rdf:resource="Event"/> <arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date> <arcs:place xml:base=""> - <types:City rdf:about="Weimar" arcs:fullName="Weimar"> + <types:City rdf:about="http://some.where/city/Weimar" arcs:fullName="Weimar"> <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/> - <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population> + <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</arcs:population> <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/> </types:City> </arcs:place> Modified: trunk/src/unit_tests/poems_light.rdf ============================================================================== --- trunk/src/unit_tests/poems_light.rdf (original) +++ trunk/src/unit_tests/poems_light.rdf Fri Aug 7 11:48:40 2009 @@ -16,7 +16,7 @@ <types:Event> <arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date> <arcs:place> - <rdf:Description rdf:about="/region/FrankfurtMain"> + <rdf:Description rdf:about="/metropolis/FrankfurtMain"> <rdf:type> <rdf:Description rdf:about="/types/Metropolis"> <rdfs:subClassOf rdf:resource="/types/Region"/> @@ -33,7 +33,7 @@ <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population> <arcs:officialese rdf:resource="language/German"/> <arcs:capital> - <rdf:Description rdf:about="http://some.where/region/Berlin"> + <rdf:Description rdf:about="http://some.where/metropolis/Berlin"> <rdf:type> <rdf:Description rdf:about="http://some.where/types/Metropolis"/> </rdf:type> @@ -54,9 +54,9 @@ <rdf:type rdf:resource="Event"/> <arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date> <arcs:place xml:base=""> - <types:City rdf:about="Weimar" arcs:fullName="Weimar"> + <types:City rdf:about="http://some.where/city/Weimar" arcs:fullName="Weimar"> <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/> - <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population> + <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">64720</arcs:population> <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/> </types:City> </arcs:place> Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Fri Aug 7 11:48:40 2009 @@ -55,7 +55,9 @@ :test-import-node-reification :test-import-dom :test-poems-rdf-occurrences - :test-poems-rdf-associations)) + :test-poems-rdf-associations + :test-poems-rdf-typing + :test-poems-rdf-topics)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) @@ -1728,17 +1730,31 @@ (occs (elephant:get-instances-by-class 'd:OccurrenceC)) (assocs (elephant:get-instances-by-class 'd:AssociationC)) (arcs "http://some.where/relationship/") + (goethe "http://some.where/author/Goethe") + (weimar "http://some.where/city/Weimar") + (berlin "http://some.where/metropolis/Berlin") + (frankfurt "http://some.where/metropolis/FrankfurtMain") + (germany "http://some.where/country/Germany") + (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") + (prometheus "http://some.where/poem/Prometheus") + (erlkoenig "http://some.where/ballad/Der_Erlkoenig") (date "http://www.w3.org/2001/XMLSchema#date") + (de (d:get-item-by-id "http://isidorus/rdf2tm_mapping/scope#de")) (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) (is (= (length topics) 65)) (is (= (length occs) 23)) (is (= (length assocs) 30)) + (is-true de) (is (= (count-if #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "firstName")) - (string= *xml-string* (d:datatype x)))) + (string= *xml-string* (d:datatype x)) + (= (length (d:themes x)) 0) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + goethe))) occs) 1)) (is (= (count-if @@ -1746,7 +1762,11 @@ (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "lastName")) - (string= *xml-string* (d:datatype x)))) + (string= *xml-string* (d:datatype x)) + (= (length (d:themes x)) 0) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + goethe))) occs) 1)) (is (= (count-if @@ -1754,15 +1774,61 @@ (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "fullName")) - (string= *xml-string* (d:datatype x)))) + (string= *xml-string* (d:datatype x)) + (= (length (d:themes x)) 0) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + weimar))) occs) - 2)) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "fullName")) + (string= *xml-string* (d:datatype x)) + (= (length (d:themes x)) 0) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + frankfurt))) + occs) + 1)) (is (= (count-if #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "nativeName")) - (string= *xml-string* (d:datatype x)))) + (string= *xml-string* (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + germany))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "title")) + (string= *xml-string* (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + zauberlehrling))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "title")) + (= 0 (length (d:themes x))) + (string= *xml-string* (d:datatype x)) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + prometheus))) occs) 1)) (is (= (count-if @@ -1770,31 +1836,109 @@ (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "title")) - (string= *xml-string* (d:datatype x)))) + (string= *xml-string* (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + erlkoenig))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "content")) + (string= *xml-string* (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + zauberlehrling))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "content")) + (string= *xml-string* (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + prometheus))) occs) - 3)) + 1)) (is (= (count-if #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "content")) - (string= *xml-string* (d:datatype x)))) + (string= *xml-string* (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + erlkoenig))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "population")) + (string= long (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + weimar))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "population")) + (string= long (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + frankfurt))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "population")) + (string= long (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + berlin))) occs) - 3)) + 1)) (is (= (count-if #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "population")) - (string= long (d:datatype x)))) + (string= long (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 1) + (string= (d:uri (first (d:psis (d:topic x)))) + germany))) occs) - 3)) + 1)) (is (= (count-if #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "date")) - (string= date (d:datatype x)))) + (string= date (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 0))) occs) 2)) (is (= (count-if @@ -1802,26 +1946,763 @@ (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "start")) - (string= date (d:datatype x)))) + (string= date (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 0))) + + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "start")) + (string= date (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 0))) + + occs) + 2)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "end")) + (string= date (d:datatype x)) + (= 1 (length (d:themes x))) + (eql (first (d:themes x)) de) + (= (length (d:psis (d:topic x))) 0))) occs) - 3)) + 1)) (is (= (count-if #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) (concatenate 'string arcs "end")) - (string= date (d:datatype x)))) + (string= date (d:datatype x)) + (= 0 (length (d:themes x))) + (= (length (d:psis (d:topic x))) 0))) occs) - 3))))) + 2))))) (test test-poems-rdf-associations "Tests general functionality of the rdf-importer module with the file poems_light.rdf." (with-fixture rdf-test-db () + (let ((assocs (elephant:get-instances-by-class 'd:AssociationC)) + (isi-object (d:get-item-by-psi constants::*rdf2tm-object*)) + (isi-subject (d:get-item-by-psi constants::*rdf2tm-subject*)) + (arcs "http://some.where/relationship/") + (goethe "http://some.where/author/Goethe") + (germany "http://some.where/country/Germany") + (berlin "http://some.where/metropolis/Berlin") + (german "http://some.where/language/German") + (frankfurt "http://some.where/metropolis/FrankfurtMain") + (weimar "http://some.where/city/Weimar") + (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") + (prometheus "http://some.where/poem/Prometheus") + (erlkoenig "http://some.where/ballad/Der_Erlkoenig")) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "born")) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + goethe))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "died")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + goethe))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "wrote")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + goethe))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "capital")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + germany))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + berlin))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "officialese")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + germany))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + german))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "place")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + frankfurt))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "place")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + weimar))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "locatedIn")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + frankfurt))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + germany))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "locatedIn")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + weimar))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + germany))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "locatedIn")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + berlin))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + germany))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "dateRange")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + prometheus))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "dateRange")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + zauberlehrling))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "dateRange")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + erlkoenig))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string constants:*rdf-ns* "_1")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + zauberlehrling))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string constants:*rdf-ns* "_1")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + erlkoenig))) + (d:roles x)))) + assocs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string constants:*rdf-ns* "_2")) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-subject) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) isi-object) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + prometheus))) + (d:roles x)))) + assocs) + 1))))) - )) +(test test-poems-rdf-typing + "Tests general functionality of the rdf-importer module with the file + poems_light.rdf." + (with-fixture rdf-test-db () + (let ((assocs (elephant:get-instances-by-class 'd:AssociationC)) + (type (get-item-by-psi constants:*type-psi*)) + (instance (get-item-by-psi constants:*instance-psi*)) + (type-instance (get-item-by-psi constants:*type-instance-psi*)) + (subtype (get-item-by-psi constants:*subtype-psi*)) + (supertype (get-item-by-psi constants:*supertype-psi*)) + (supertype-subtype + (get-item-by-psi constants:*supertype-subtype-psi*)) + (region "http://some.where/types/Region") + (metropolis "http://some.where/types/Metropolis") + (city "http://some.where/types/City") + (frankfurt "http://some.where/metropolis/FrankfurtMain") + (weimar "http://some.where/city/Weimar") + (berlin "http://some.where/metropolis/Berlin") + (language "http://some.where/types/Language") + (german "http://some.where/language/German") + (author "http://some.where/types/Author") + (goethe "http://some.where/author/Goethe") + (bag (concatenate 'string constants::*rdf-ns* "Bag")) + (poem "http://some.where/types/Poem") + (ballad "http://some.where/types/Ballad") + (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") + (prometheus "http://some.where/poem/Prometheus") + (erlkoenig "http://some.where/ballad/Der_Erlkoenig") + (country "http://some.where/types/Country") + + ) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) supertype-subtype) + (= (length (d:roles x)) 2) + (= (count-if + #'(lambda(y) + (or (eql (d:instance-of y) supertype) + (eql (d:instance-of y) subtype))) + (d:roles x))))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) supertype-subtype) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) supertype) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + region))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) subtype) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + metropolis))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) supertype-subtype) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) supertype) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + region))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) subtype) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + city))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + metropolis))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + frankfurt))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + metropolis))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + berlin))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + city))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + weimar))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + language))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + german))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + bag))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 0))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + author))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + goethe))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + ballad))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + erlkoenig))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + poem))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + zauberlehrling))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + poem))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + prometheus))) + (d:roles x)))) + assocs))) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) type-instance) + (= (length (d:roles x)) 2) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) type) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + country))) + (d:roles x)) + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) instance) + (= (length (d:psis (d:player y))) 1) + (string= (d:uri (first (d:psis (d:player y)))) + poem))) + (d:roles x)))) + assocs)))))) + + +(defun check-topic (top psi) + "A simple helper for test-poems-rdf-topics." + (is-true top) + (is (= (length (d:psis top)) (if psi 1 0))) + (when psi + (is (string= (d:uri (first (d:psis top))) psi))) + (is (= (length (d:names top)) 0))) + + +(test test-poems-rdf-topics + "Tests general functionality of the rdf-importer module with the file + poems_light.rdf." + (with-fixture rdf-test-db () + (let ((arcs "http://some.where/relationship/") + (types "http://some.where/types/")) + (let ((goethe (get-item-by-id "http://some.where/author/Goethe")) + (author (get-item-by-id (concatenate 'string types "Author"))) + (first-name (get-item-by-id + (concatenate 'string arcs "firstName"))) + (last-name (get-item-by-id + (concatenate 'string arcs "lastName"))) + (born (get-item-by-id (concatenate 'string arcs "born"))) + (event (get-item-by-id (concatenate 'string types "Event"))) + (date (get-item-by-id (concatenate 'string arcs "date"))) + (place (get-item-by-id (concatenate 'string arcs "place"))) + (frankfurt (get-item-by-id + "http://some.where/metropolis/FrankfurtMain")) + (metropolis (get-item-by-id (concatenate 'string types + "Metropolis"))) + (region (get-item-by-id (concatenate 'string types "Region"))) + (population (get-item-by-id (concatenate 'string arcs + "population"))) + (locatedIn (get-item-by-id (concatenate 'string arcs + "locatedIn"))) + (germany (get-item-by-id "http://some.where/country/Germany")) + (country (get-item-by-id (concatenate 'string types "Country"))) + (native-name (get-item-by-id (concatenate 'string arcs + "nativeName"))) + (officialese (get-item-by-id (concatenate 'string arcs + "officialese"))) + (german (get-item-by-id "http://some.where/language/German")) + (capital (get-item-by-id (concatenate 'string arcs "capital"))) + (berlin (get-item-by-id "http://some.where/metropolis/Berlin")) + (died (get-item-by-id (concatenate 'string arcs "died"))) + (weimar (get-item-by-id "http://some.where/city/Weimar")) + (city (get-item-by-id (concatenate 'string types "City"))) + (wrote (get-item-by-id (concatenate 'string arcs "wrote"))) + (goethe-literature (get-item-by-id "goethe_literature")) + (bag (get-item-by-id (concatenate 'string *rdf-ns* "Bag"))) + (_1 (get-item-by-id (concatenate 'string *rdf-ns* "_1"))) + (_2 (get-item-by-id (concatenate 'string *rdf-ns* "_2"))) + (zauberlehrling + (get-item-by-id "http://some.where/poem/Der_Zauberlehrling")) + (poem (get-item-by-id (concatenate 'string types "Poem"))) + (dateRange (get-item-by-id (concatenate 'string arcs "dateRange"))) + (start (get-item-by-id (concatenate 'string arcs "start"))) + (end (get-item-by-id (concatenate 'string arcs "end"))) + (title (get-item-by-id (concatenate 'string arcs "title"))) + (content (get-item-by-id (concatenate 'string arcs "content"))) + (erlkoenig (get-item-by-id "http://some.where/ballad/Der_Erlkoenig")) + (ballad (get-item-by-id (concatenate 'string types "Ballad"))) + (de (get-item-by-id (concatenate + 'string constants::*rdf2tm-scope-prefix* + "de"))) + (prometheus (get-item-by-id "http://some.where/poem/Prometheus")) + (language (get-item-by-id (concatenate 'string types "Language"))) + (full-name (get-item-by-id (concatenate 'string arcs "fullName")))) + (check-topic goethe "http://some.where/author/Goethe") + (check-topic author (concatenate 'string types "Author")) + (check-topic first-name (concatenate 'string arcs "firstName")) + (check-topic last-name (concatenate 'string arcs "lastName")) + (check-topic born (concatenate 'string arcs "born")) + (check-topic event (concatenate 'string types "Event")) + (check-topic date (concatenate 'string arcs "date")) + (check-topic place (concatenate 'string arcs "place")) + (check-topic frankfurt "http://some.where/metropolis/FrankfurtMain") + (check-topic metropolis (concatenate 'string types "Metropolis")) + (check-topic region (concatenate 'string types "Region")) + (check-topic population (concatenate 'string arcs "population")) + (check-topic locatedIn (concatenate 'string arcs "locatedIn")) + (check-topic germany "http://some.where/country/Germany") + (check-topic country (concatenate 'string types "Country")) + (check-topic native-name (concatenate 'string arcs "nativeName")) + (check-topic officialese (concatenate 'string arcs "officialese")) + (check-topic german "http://some.where/language/German") + (check-topic capital (concatenate 'string arcs "capital")) + (check-topic berlin "http://some.where/metropolis/Berlin") + (check-topic died (concatenate 'string arcs "died")) + (check-topic weimar "http://some.where/city/Weimar") + (check-topic city (concatenate 'string types "City")) + (check-topic wrote (concatenate 'string arcs "wrote")) + (check-topic goethe-literature nil) + (check-topic bag (concatenate 'string *rdf-ns* "Bag")) + (check-topic _1 (concatenate 'string *rdf-ns* "_1")) + (check-topic _2 (concatenate 'string *rdf-ns* "_2")) + (check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling") + (check-topic poem (concatenate 'string types "Poem")) + (check-topic dateRange (concatenate 'string arcs "dateRange")) + (check-topic start (concatenate 'string arcs "start")) + (check-topic end (concatenate 'string arcs "end")) + (check-topic title (concatenate 'string arcs "title")) + (check-topic content (concatenate 'string arcs "content")) + (check-topic erlkoenig "http://some.where/ballad/Der_Erlkoenig") + (check-topic ballad (concatenate 'string types "Ballad")) + (check-topic de (concatenate 'string constants::*rdf2tm-scope-prefix* + "de")) + (check-topic prometheus "http://some.where/poem/Prometheus") + (check-topic language (concatenate 'string types "Language")) + (check-topic full-name (concatenate 'string arcs "fullName")) + (is (= (count-if #'(lambda(x) + (null (d:psis x))) + (elephant:get-instances-by-class 'd:TopicC)) + 6)))))) (defun run-rdf-importer-tests() @@ -1840,4 +2721,6 @@ (it.bese.fiveam:run! 'test-import-node-reification) (it.bese.fiveam:run! 'test-import-dom) (it.bese.fiveam:run! 'test-poems-rdf-occurrences) - (it.bese.fiveam:run! 'test-poems-rdf-associations)) \ No newline at end of file + (it.bese.fiveam:run! 'test-poems-rdf-associations) + (it.bese.fiveam:run! 'test-poems-rdf-typing) + (it.bese.fiveam:run! 'test-poems-rdf-topics)) \ No newline at end of file Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Fri Aug 7 11:48:40 2009 @@ -23,8 +23,8 @@ (get-store-spec repository-path))) (xml-importer:init-isidorus) (init-rdf-module) - (rdf-importer rdf-xml-path repository-path :tm-id tm-id) - :document-id document-id + (rdf-importer rdf-xml-path repository-path :tm-id tm-id + :document-id document-id) (when elephant:*store-controller* (elephant:close-store))) @@ -409,15 +409,13 @@ topic-id err))))))))) -(defun make-lang-topic (lang tm-id start-revision tm +(defun make-lang-topic (lang start-revision tm &key (document-id *document-id*)) "Returns a topic with the topicid tm-id/lang. If no such topic exist there will be created one." - (declare (TopicMapC tm)) - (when (and lang tm-id) - (tm-id-p tm-id "make-lang-topic") + (when lang (let ((psi-and-topic-id - (absolutize-value lang nil tm-id))) + (concatenate-uri *rdf2tm-scope-prefix* lang))) (let ((top (get-item-by-id psi-and-topic-id :xtm-id document-id :revision start-revision))) (if top @@ -538,7 +536,7 @@ (let ((type-top (make-topic-stub type nil nil nil start-revision xml-importer::tm :document-id document-id)) - (lang-top (make-lang-topic lang tm-id start-revision + (lang-top (make-lang-topic lang start-revision xml-importer::tm :document-id document-id))) (let ((occurrence Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Fri Aug 7 11:48:40 2009 @@ -31,7 +31,8 @@ *rdf-nil* *rdf-first* *rdf-rest* - *rdf2tm-collection*) + *rdf2tm-collection* + *rdf2tm-scope-prefix*) (:import-from :xml-constants *rdf_core_psis.xtm*) (:import-from :xml-constants

1 0

[isidorus-cvs] r110 - trunk/src/unit_tests
by Lukas Giessmann 06 Aug '09

06 Aug '09

Author: lgiessmann Date: Thu Aug 6 14:05:08 2009 New Revision: 110 Log: added some unit tests for the rdf-importer Modified: trunk/src/unit_tests/fixtures.lisp trunk/src/unit_tests/rdf_importer_test.lisp Modified: trunk/src/unit_tests/fixtures.lisp ============================================================================== --- trunk/src/unit_tests/fixtures.lisp (original) +++ trunk/src/unit_tests/fixtures.lisp Thu Aug 6 14:05:08 2009 @@ -186,6 +186,7 @@ (tm-id "http://test-tm/") (document-id "doc-id")) (clean-out-db db-dir) + (setf d:*current-xtm* document-id) (rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id :document-id document-id) (elephant:open-store (xml-importer:get-store-spec db-dir)) Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Aug 6 14:05:08 2009 @@ -32,7 +32,8 @@ *rdf-subject* *rdf-object* *rdf-predicate* - *rdf-statement*) + *rdf-statement* + *xml-string*) (:import-from :xml-tools xpath-child-elems-by-qname xpath-single-child-elem-by-qname @@ -53,7 +54,8 @@ :test-import-node-1 :test-import-node-reification :test-import-dom - :test-poems-rdf-1)) + :test-poems-rdf-occurrences + :test-poems-rdf-associations)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) @@ -1718,26 +1720,113 @@ (elephant:close-store)) -(test test-poems-rdf-1 +(test test-poems-rdf-occurrences "Tests general functionality of the rdf-importer module with the file poems_light.rdf." - (elephant:close-store) ;TODO: remove (with-fixture rdf-test-db () (let ((topics (elephant:get-instances-by-class 'd:TopicC)) (occs (elephant:get-instances-by-class 'd:OccurrenceC)) - (assocs (elephant:get-instances-by-class 'd:AssociationC))) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 65)) - (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 23)) - (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 30)) - + (assocs (elephant:get-instances-by-class 'd:AssociationC)) + (arcs "http://some.where/relationship/") + (date "http://www.w3.org/2001/XMLSchema#date") + (long "http://www.w3.org/2001/XMLSchema#unsignedLong")) + (is (= (length topics) 65)) + (is (= (length occs) 23)) + (is (= (length assocs) 30)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "firstName")) + (string= *xml-string* (d:datatype x)))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "lastName")) + (string= *xml-string* (d:datatype x)))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "fullName")) + (string= *xml-string* (d:datatype x)))) + occs) + 2)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "nativeName")) + (string= *xml-string* (d:datatype x)))) + occs) + 1)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "title")) + (string= *xml-string* (d:datatype x)))) + occs) + 3)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "content")) + (string= *xml-string* (d:datatype x)))) + occs) + 3)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "population")) + (string= long (d:datatype x)))) + occs) + 3)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "date")) + (string= date (d:datatype x)))) + occs) + 2)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "start")) + (string= date (d:datatype x)))) + occs) + 3)) + (is (= (count-if + #'(lambda(x) + (and (= (length (d:psis (d:instance-of x))) 1) + (string= (d:uri (first (d:psis (d:instance-of x)))) + (concatenate 'string arcs "end")) + (string= date (d:datatype x)))) + occs) + 3))))) + - )) - (elephant:open-store (xml-importer:get-store-spec "data_base"))) ;TODO: remove +(test test-poems-rdf-associations + "Tests general functionality of the rdf-importer module with the file + poems_light.rdf." + (with-fixture rdf-test-db () + )) (defun run-rdf-importer-tests() + (when elephant:*store-controller* + (elephant:close-store)) (it.bese.fiveam:run! 'test-get-literals-of-node) (it.bese.fiveam:run! 'test-parse-node) (it.bese.fiveam:run! 'test-get-literals-of-property) @@ -1750,4 +1839,5 @@ (it.bese.fiveam:run! 'test-import-node-1) (it.bese.fiveam:run! 'test-import-node-reification) (it.bese.fiveam:run! 'test-import-dom) - (it.bese.fiveam:run! 'test-poems-rdf-1)) \ No newline at end of file + (it.bese.fiveam:run! 'test-poems-rdf-occurrences) + (it.bese.fiveam:run! 'test-poems-rdf-associations)) \ No newline at end of file

1 0

[isidorus-cvs] r109 - in trunk/src: . unit_tests xml/rdf
by Lukas Giessmann 06 Aug '09

06 Aug '09

Author: lgiessmann Date: Thu Aug 6 11:46:11 2009 New Revision: 109 Log: changed some rdf test files Added: trunk/src/unit_tests/poems_light.rdf Modified: trunk/src/isidorus.asd trunk/src/unit_tests/fixtures.lisp trunk/src/unit_tests/poems.rdf trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/unit_tests/unittests-constants.lisp trunk/src/xml/rdf/rdf_tools.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Thu Aug 6 11:46:11 2009 @@ -106,6 +106,7 @@ (:static-file "atom_test.xtm") (:static-file "poems.xtm") (:static-file "poems.rdf") + (:static-file "poems_light.rdf") (:file "atom-conf") (:file "unittests-constants" :depends-on ("dangling_topicref.xtm" Modified: trunk/src/unit_tests/fixtures.lisp ============================================================================== --- trunk/src/unit_tests/fixtures.lisp (original) +++ trunk/src/unit_tests/fixtures.lisp Thu Aug 6 11:46:11 2009 @@ -35,7 +35,9 @@ :*NOTIFICATIONBASE-TM* :*XTM-TM* :*XTM-MERGE1-TM* - :*XTM-MERGE2-TM*)) + :*XTM-MERGE2-TM* + :rdf-init-db + :rdf-test-db)) (in-package :fixtures) @@ -166,4 +168,26 @@ (importer *XTM-ATOM-TM* :xtm-id "atom-tm1" :tm-id "http://psi.egovpt.org/tm/egov-ontology" :revision revision1) (&body) + (tear-down-test-db))) + + +(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision))) + "Deletes the data base files and initializes isidorus for rdf." + (when elephant:*store-controller* + (elephant:close-store)) + (clean-out-db db-dir) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (xml-importer:init-isidorus start-revision) + (rdf-importer:init-rdf-module start-revision)) + + +(def-fixture rdf-test-db () + (let ((db-dir "data_base") + (tm-id "http://test-tm/") + (document-id "doc-id")) + (clean-out-db db-dir) + (rdf-importer:setup-rdf-module *poems_light.rdf* db-dir :tm-id tm-id + :document-id document-id) + (elephant:open-store (xml-importer:get-store-spec db-dir)) + (&body) (tear-down-test-db))) \ No newline at end of file Modified: trunk/src/unit_tests/poems.rdf ============================================================================== --- trunk/src/unit_tests/poems.rdf (original) +++ trunk/src/unit_tests/poems.rdf Thu Aug 6 11:46:11 2009 @@ -55,6 +55,7 @@ <arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date> <arcs:place xml:base=""> <types:City rdf:about="Weimar" arcs:fullName="Weimar"> + <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/> <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population> <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/> </types:City> @@ -66,7 +67,7 @@ <arcs:wrote> <rdf:Bag rdf:nodeID="goethe_literature"> <rdf:li> - <types:Poem> + <types:Poem rdf:about="http://some.where/poem/Der_Zauberlehrling"> <arcs:title rdf:parseType="Literal" xml:lang="de">Der Zauberlehrling</arcs:title> <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema">  <arcs:start rdf:datatype="#date">01.01.1797</arcs:start> @@ -194,10 +195,10 @@  <rdf:Description rdf:nodeID="goethe_literature"> <rdf:li> - <types:Ballad arcs:title="Der Erlkönig" xml:lang="de"> + <types:Ballad rdf:about="http://some.where/ballad/Der_Erlkoenig" arcs:title="Der Erlkönig" xml:lang="de"> <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema"> <arcs:start rdf:datatype="#date">01.01.1782</arcs:start> - <arcs:end rdf:datatype="#date">01.01.1782</arcs:end> + <arcs:end rdf:datatype="#date">31.12.1782</arcs:end> </arcs:dateRange> <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de"> <![CDATA[Wer reitet so spät durch Nacht und Wind? @@ -243,7 +244,7 @@ </types:Ballad> </rdf:li> <rdf:li> - <rdf:Description arcs:title="Prometheus"> + <rdf:Description rdf:about="http://some.where/poem/Prometheus" arcs:title="Prometheus"> <rdf:type rdf:resource="/types/Poem"/> <arcs:dateRange> <rdf:Description xml:base="http://does.not.exist"> @@ -354,7 +355,7 @@ <rdf:Description> <rdf:type rdf:resource="http://www.w3.org/1999/02/22-rdf-syntax-ns#Bag"/> <rdf:_1> - <types:Poem arcs:title="Resigantion" xml:lang="de"> + <types:Poem rdf:about="http://some.where/poem/Resignation" arcs:title="Resigantion" xml:lang="de"> <arcs:dateRange rdf:parseType="Resource"> <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1786</arcs:start> <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1786</arcs:end> @@ -471,7 +472,7 @@ </types:Poem> </rdf:_1> <rdf:_2> - <types:Drama arcs:title="Die Räuber" xml:lang="de"> + <types:Drama rdf:about="http://some.where/drama/Die_Raeuber" arcs:title="Die Räuber" xml:lang="de"> <arcs:dateRange> <rdf:Description> <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1781</arcs:start> @@ -3138,7 +3139,7 @@ <arcs:wrote> <rdf:Bag> <rdf:li> - <types:Poem arcs:title="Mondnacht"> + <types:Poem rdf:about="http://some.where/poem/Mondnacht" arcs:title="Mondnacht"> <arcs:dateRange rdf:parseType="Resource"> <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1837</arcs:start> <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1837</arcs:end> @@ -3162,7 +3163,7 @@ </types:Poem> </rdf:li> <rdf:li> - <types:Ballad> + <types:Ballad rdf:about="http://some.where/ballad/Die_zwei_Gesellen"> <arcs:title rdf:parseType="Literal">Die zwei Gesellen</arcs:title> <arcs:title rdf:parseType="Literal">Frühlingsfahrt</arcs:title> <arcs:dateRange rdf:parseType="Resource"> @@ -3256,7 +3257,7 @@ <arcs:wrote> <rdf:Bag> <rdf:_1> - <types:Poem arcs:title="Venus And Adonis"> + <types:Poem rdf:about="http://some.where/poem/Venus_And_Adonis" arcs:title="Venus And Adonis"> <arcs:dateRange rdf:parseType="Resource"> <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1592</arcs:start> <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1593</arcs:end> @@ -4677,7 +4678,7 @@ </types:Poem> </rdf:_1> <rdf:_2> - <types:Drama arcs:title="Venus And Adonis"> + <types:Drama rdf:about="http://some.where/drama/Romeo_And_Juliet" arcs:title="Romeo and Juliet"> <arcs:dateRange rdf:parseType="Resource"> <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">01.01.1597</arcs:start> <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">31.12.1597</arcs:end> Added: trunk/src/unit_tests/poems_light.rdf ============================================================================== --- (empty file) +++ trunk/src/unit_tests/poems_light.rdf Thu Aug 6 11:46:11 2009 @@ -0,0 +1,328 @@ +<?xml version="1.0" encoding="UTF-8"?> +<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" + xmlns:rdfs="http://www.w3.org/2000/01/rdf-schema#" + xmlns:poems="http://some.where/" + xmlns:arcs="http://some.where/relationship/" + xmlns:types="http://some.where/types/" + xml:base="http://some.where/"> +  + <rdf:Description rdf:about="author/Goethe"> + <rdf:type rdf:resource="types/Author"/> + <arcs:firstName>Johann Wolfgang</arcs:firstName> + <arcs:lastName rdf:parseType="Literal">von Goethe</arcs:lastName> + +  + <arcs:born> + <types:Event> + <arcs:date rdf:datatype="http://www.w3.org/2001/XMLSchema#date">28.08.1749</arcs:date> + <arcs:place> + <rdf:Description rdf:about="/region/FrankfurtMain"> + <rdf:type> + <rdf:Description rdf:about="/types/Metropolis"> + <rdfs:subClassOf rdf:resource="/types/Region"/> + </rdf:Description> + </rdf:type> + <arcs:fullName>Frankfurt am Main</arcs:fullName> + <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">659000</arcs:population> + <arcs:locatedIn> + <rdf:Description rdf:about="http://some.where/country/Germany"> + <rdf:type> + <rdf:Description rdf:about="http://some.where/types/Country"></rdf:Description> + </rdf:type> + <arcs:nativeName xml:lang="de">Deutschland</arcs:nativeName> + <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">82099232</arcs:population> + <arcs:officialese rdf:resource="language/German"/> + <arcs:capital> + <rdf:Description rdf:about="http://some.where/region/Berlin"> + <rdf:type> + <rdf:Description rdf:about="http://some.where/types/Metropolis"/> + </rdf:type> + <arcs:locatedIn rdf:resource="/country/Germany"/> + <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsignedLong">3431473</arcs:population> + </rdf:Description> + </arcs:capital> + </rdf:Description> + </arcs:locatedIn> + </rdf:Description> + </arcs:place> + </types:Event> + </arcs:born> + +  + <arcs:died> + <rdf:Description xml:base="http://some.where/types/"> + <rdf:type rdf:resource="Event"/> + <arcs:date rdf:datatype="#date" xml:base="http://www.w3.org/2001/XMLSchema">22.03.1832</arcs:date> + <arcs:place xml:base=""> + <types:City rdf:about="Weimar" arcs:fullName="Weimar"> + <rdfs:subClassOf rdf:resource="http://some.where/types/Region"/> + <arcs:population rdf:datatype="http://www.w3.org/2001/XMLSchema#unsigneLong">64720</arcs:population> + <arcs:locatedIn rdf:resource="http://some.where/country/Germany"/> + </types:City> + </arcs:place> + </rdf:Description> + </arcs:died> + +  + <arcs:wrote> + <rdf:Bag rdf:nodeID="goethe_literature"> + <rdf:li> + <types:Poem rdf:about="http://some.where/poem/Der_Zauberlehrling"> + <arcs:title rdf:parseType="Literal" xml:lang="de">Der Zauberlehrling</arcs:title> + <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema">  + <arcs:start rdf:datatype="#date">01.01.1797</arcs:start> + <arcs:end rdf:datatype="#date">31.12.1797</arcs:end> + </arcs:dateRange> + <arcs:content xml:lang="de"> + <![CDATA[Hat der alte Hexenmeister +sich doch einmal wegbegeben! +Und nun sollen seine Geister +auch nach meinem Willen leben. +Seine Wort und Werke +merkt ich und den Brauch, +und mit Geistesstärke +tu ich Wunder auch. + +Walle! walle +Manche Strecke, +daß, zum Zwecke, +Wasser fließe +und mit reichem, vollem Schwalle +zu dem Bade sich ergieße. + +Und nun komm, du alter Besen! +Nimm die schlechten Lumpenhüllen; +bist schon lange Knecht gewesen: +nun erfülle meinen Willen! +Auf zwei Beinen stehe, +oben sei ein Kopf, +eile nun und gehe +mit dem Wassertopf! + +Walle! walle +manche Strecke, +daß, zum Zwecke, +Wasser fließe +und mit reichem, vollem Schwalle +zu dem Bade sich ergieße. + +Seht, er läuft zum Ufer nieder, +Wahrlich! ist schon an dem Flusse, +und mit Blitzesschnelle wieder +ist er hier mit raschem Gusse. +Schon zum zweiten Male! +Wie das Becken schwillt! +Wie sich jede Schale +voll mit Wasser füllt! + +Stehe! stehe! +denn wir haben +deiner Gaben +vollgemessen! - +Ach, ich merk es! Wehe! wehe! +Hab ich doch das Wort vergessen! + +Ach, das Wort, worauf am Ende +er das wird, was er gewesen. +Ach, er läuft und bringt behende! +Wärst du doch der alte Besen! +Immer neue Güsse +bringt er schnell herein, +Ach! und hundert Flüsse +stürzen auf mich ein. + +Nein, nicht länger +kann ichs lassen; +will ihn fassen. +Das ist Tücke! +Ach! nun wird mir immer bänger! +Welche Mine! welche Blicke! + +O du Ausgeburt der Hölle! +Soll das ganze Haus ersaufen? +Seh ich über jede Schwelle +doch schon Wasserströme laufen. +Ein verruchter Besen, +der nicht hören will! +Stock, der du gewesen, +steh doch wieder still! + +Willst am Ende +gar nicht lassen? +Will dich fassen, +will dich halten +und das alte Holz behende +mit dem scharfen Beile spalten. + +Seht da kommt er schleppend wieder! +Wie ich mich nur auf dich werfe, +gleich, o Kobold, liegst du nieder; +krachend trifft die glatte Schärfe. +Wahrlich, brav getroffen! +Seht, er ist entzwei! +Und nun kann ich hoffen, +und ich atme frei! + +Wehe! wehe! +Beide Teile +stehn in Eile +schon als Knechte +völlig fertig in die Höhe! +Helft mir, ach! ihr hohen Mächte! + +Und sie laufen! Naß und nässer +wirds im Saal und auf den Stufen. +Welch entsetzliches Gewässer! +Herr und Meister! hör mich rufen! - +Ach, da kommt der Meister! +Herr, die Not ist groß! +Die ich rief, die Geister +werd ich nun nicht los. + +"In die Ecke, +Besen, Besen! +Seids gewesen. +Denn als Geister +ruft euch nur zu diesem Zwecke, +erst hervor der alte Meister."]]> + </arcs:content> + </types:Poem> + </rdf:li> + </rdf:Bag> + </arcs:wrote> + </rdf:Description> + +  + <rdf:Description rdf:nodeID="goethe_literature"> + <rdf:li> + <types:Ballad rdf:about="http://some.where/ballad/Der_Erlkoenig" arcs:title="Der Erlkönig" xml:lang="de"> + <arcs:dateRange rdf:parseType="Resource" xml:base="http://www.w3.org/2001/XMLSchema"> + <arcs:start rdf:datatype="#date">01.01.1782</arcs:start> + <arcs:end rdf:datatype="#date">31.12.1782</arcs:end> + </arcs:dateRange> + <arcs:content rdf:datatype="http://www.w3.org/2001/XMLSchema#string" xml:lang="de"> + <![CDATA[Wer reitet so spät durch Nacht und Wind? +Es ist der Vater mit seinem Kind; +Er hat den Knaben wohl in dem Arm, +Er faßt ihn sicher, er hält ihn warm. + +Mein Sohn, was birgst du so bang dein Gesicht? - +Siehst Vater, du den Erlkönig nicht? +Den Erlenkönig mit Kron und Schweif? - +Mein Sohn, es ist ein Nebelstreif. - + +"Du liebes Kind, komm, geh mit mir! +Gar schöne Spiele spiel ich mit dir; +Manch bunte Blumen sind an dem Strand, +Meine Mutter hat manch gülden Gewand." + +Mein Vater, mein Vater, und hörest du nicht, +Was Erlenkönig mir leise verspricht? - +Sei ruhig, bleibe ruhig, mein Kind; +In dürren Blättern säuselt der Wind. - + +"Willst, feiner Knabe, du mit mir gehn? +Meine Töchter sollen dich warten schön; +Meine Töchter führen den nächtlichen Reihn +Und wiegen und tanzen und singen dich ein." + +Mein Vater, mein Vater, und siehst du nicht dort +Erlkönigs Töchter am düstern Ort? - +Mein Sohn, mein Sohn, ich seh es genau: +Es scheinen die alten Weiden so grau. - + +"Ich liebe dich, mich reizt deine schöne Gestalt; +Und bist du nicht willig, so brauch ich Gewalt." +Mein Vater, mein Vater, jetzt faßt er mich an! +Erlkönig hat mir ein Leids getan! - + +Dem Vater grauset's, er reitet geschwind, +Er hält in den Armen das ächzende Kind, +Erreicht den Hof mit Mühe und Not; +In seinen Armen das Kind war tot.]]> + </arcs:content> + </types:Ballad> + </rdf:li> + <rdf:li> + <rdf:Description rdf:about="http://some.where/poem/Prometheus" arcs:title="Prometheus"> + <rdf:type rdf:resource="/types/Poem"/> + <arcs:dateRange> + <rdf:Description xml:base="http://does.not.exist"> + <arcs:start rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1772</arcs:start> + <arcs:end rdf:datatype="http://www.w3.org/2001/XMLSchema#date">1774</arcs:end> + </rdf:Description> + </arcs:dateRange> + <arcs:content rdf:parseType="Literal" xml:lang="de"> + <![CDATA[Bedecke deinen Himmel, Zeus, +Mit Wolkendunst! +Und übe, Knaben gleich, +Der Disteln köpft, +An Eichen dich und Bergeshöh'n! +Mußt mir meine Erde +Doch lassen steh'n, +Und meine Hütte, +Die du nicht gebaut, +Und meinen Herd, +Um dessen Glut +Du mich beneidest. + +Ich kenne nichts Ärmeres +Unter der Sonn' als euch Götter! +Ihr nähret kümmerlich +Von Opfersteuern +Und Gebetshauch +Eure Majestät +Und darbtet, wären +Nicht Kinder und Bettler +Hoffnungsvolle Toren. + +Da ich ein Kind war, +Nicht wußte, wo aus, wo ein, +Kehrt' ich mein verirrtes Auge +Zur Sonne, als wenn drüber wär +Ein Ohr zu hören meine Klage, +Ein Herz wie meins, +Sich des Bedrängten zu erbarmen. + +Wer half mir +Wider der Titanen Übermut? +Wer rettete vom Tode mich, +Von Sklaverei? +Hast du's nicht alles selbst vollendet, +Heilig glühend Herz? +Und glühtest, jung und gut, +Betrogen, Rettungsdank +Dem Schlafenden dadroben? + +Ich dich ehren? Wofür? +Hast du die Schmerzen gelindert +Je des Beladenen? +Hast du die Tränen gestillet +Je des Geängsteten? +Hat nicht mich zum Manne geschmiedet +Die allmächtige Zeit +Und das ewige Schicksal, +Meine Herren und deine? + +Wähntest du etwa, +Ich sollte das Leben hassen, +In Wüsten fliehn, +Weil nicht alle Knabenmorgen- +Blütenträume reiften? + +Hier sitz' ich, forme Menschen +Nach meinem Bilde, +Ein Geschlecht, das mir gleich sei, +Zu leiden, weinen, +Genießen und zu freuen sich, +Und dein nicht zu achten, +Wie ich!]]> + </arcs:content> + </rdf:Description> + </rdf:li> + </rdf:Description> + + <rdf:Description rdf:about="http://some.where/language/German"> + <rdf:type rdf:resource="types/Language"/> + </rdf:Description> +</rdf:RDF> Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Thu Aug 6 11:46:11 2009 @@ -52,7 +52,8 @@ :test-parse-properties-of-node :test-import-node-1 :test-import-node-reification - :test-import-dom)) + :test-import-dom + :test-poems-rdf-1)) (declaim (optimize (debug 3) (speed 0) (safety 3) (space 0) (compilation-speed 0))) @@ -65,16 +66,6 @@ (in-suite rdf-importer-test) -(defun rdf-init-db (&key (db-dir "data_base") (start-revision (get-revision))) - "Empties the data base files and initializes isidorus for rdf." - (when elephant:*store-controller* - (elephant:close-store)) - (clean-out-db db-dir) - (elephant:open-store (xml-importer:get-store-spec db-dir)) - (xml-importer:init-isidorus start-revision) - (rdf-importer:init-rdf-module start-revision)) - - (test test-get-literals-of-node "Tests the helper function get-literals-of-node." (let ((doc-1 @@ -1727,6 +1718,24 @@ (elephant:close-store)) +(test test-poems-rdf-1 + "Tests general functionality of the rdf-importer module with the file + poems_light.rdf." + (elephant:close-store) ;TODO: remove + (with-fixture rdf-test-db () + (let ((topics (elephant:get-instances-by-class 'd:TopicC)) + (occs (elephant:get-instances-by-class 'd:OccurrenceC)) + (assocs (elephant:get-instances-by-class 'd:AssociationC))) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 65)) + (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) 23)) + (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 30)) + + + )) + (elephant:open-store (xml-importer:get-store-spec "data_base"))) ;TODO: remove + + + (defun run-rdf-importer-tests() (it.bese.fiveam:run! 'test-get-literals-of-node) @@ -1740,4 +1749,5 @@ (it.bese.fiveam:run! 'test-parse-properties-of-node) (it.bese.fiveam:run! 'test-import-node-1) (it.bese.fiveam:run! 'test-import-node-reification) - (it.bese.fiveam:run! 'test-import-dom)) \ No newline at end of file + (it.bese.fiveam:run! 'test-import-dom) + (it.bese.fiveam:run! 'test-poems-rdf-1)) \ No newline at end of file Modified: trunk/src/unit_tests/unittests-constants.lisp ============================================================================== --- trunk/src/unit_tests/unittests-constants.lisp (original) +++ trunk/src/unit_tests/unittests-constants.lisp Thu Aug 6 11:46:11 2009 @@ -28,7 +28,8 @@ :*sample_objects.xtm* :*t100.xtm* :*atom_test.xtm* - :*atom-conf.lisp*)) + :*atom-conf.lisp* + :*poems_light.rdf*)) (in-package :unittests-constants) @@ -89,3 +90,7 @@ (defparameter *atom-conf.lisp* (asdf:component-pathname (asdf:find-component *unit-tests-component* "atom-conf"))) + +(defparameter *poems_light.rdf* + (asdf:component-pathname + (asdf:find-component *unit-tests-component* "poems_light.rdf"))) \ No newline at end of file Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Thu Aug 6 11:46:11 2009 @@ -75,10 +75,10 @@ (in-package :rdf-importer) (defvar *rdf-types* (list "Description" "List" "Alt" "Bag" "Seq" - "Statement" "Property" "XMLLiteral")) + "Statement" "Property" "XMLLiteral" "nil")) (defvar *rdf-properties* (list "type" "first" "rest" "subject" "predicate" - "object" "li")) + "object" "li" "first" "rest")) (defvar *rdfs-types* (list "Resource" "Literal" "Class" "Datatype" "Container" "ContainerMembershipProperty"))

1 0

[isidorus-cvs] r108 - in trunk/src: unit_tests xml/rdf
by Lukas Giessmann 05 Aug '09

05 Aug '09

Author: lgiessmann Date: Wed Aug 5 11:45:12 2009 New Revision: 108 Log: rdf-importer: added some unit tests Modified: trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/xml/rdf/importer.lisp Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Wed Aug 5 11:45:12 2009 @@ -1443,37 +1443,288 @@ (doc-1 (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " "xmlns:arcs=\"http://test/arcs/\">" - "<rdf:Description rdf:about=\"first-node\">" - "<rdf:type rdf:nodeID=\"second-node\"/>" - "<arcs:arc1 rdf:resource=\"third-node\"/>" - "<arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>" - "<arcs:arc3>" - "<rdf:Description>" - "<arcs:arc4 rdf:parseType=\"Collection\">" - "<rdf:Description rdf:about=\"item-1\"/>" - "<rdf:Description rdf:about=\"item-2\">" - "<arcs:arc5 rdf:parseType=\"Resource\">" - "<arcs:arc6 rdf:resource=\"fourth-node\"/>" - "<arcs:arc7>" - "<rdf:Description rdf:about=\"fifth-node\"/>" - "</arcs:arc7>" - "<arcs:arc8 rdf:parseType=\"Collection\" />" - "</arcs:arc5>" - "</rdf:Description>" - "</arcs:arc4>" - "</rdf:Description>" - "</arcs:arc3>" - "</rdf:Description>" - "<rdf:Description rdf:nodeID=\"second-node\" />" + " <rdf:Description rdf:about=\"first-node\">" + " <rdf:type rdf:nodeID=\"second-node\"/>" + " <arcs:arc1 rdf:resource=\"third-node\"/>" + " <arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>" + " <arcs:arc3>" + " <rdf:Description>" + " <arcs:arc4 rdf:parseType=\"Collection\">" + " <rdf:Description rdf:about=\"item-1\"/>" + " <rdf:Description rdf:about=\"item-2\">" + " <arcs:arc5 rdf:parseType=\"Resource\">" + " <arcs:arc6 rdf:resource=\"fourth-node\"/>" + " <arcs:arc7>" + " <rdf:Description rdf:about=\"fifth-node\"/>" + " </arcs:arc7>" + " <arcs:arc8 rdf:parseType=\"Collection\" />" + " </arcs:arc5>" + " </rdf:Description>" + " </arcs:arc4>" + " </rdf:Description>" + " </arcs:arc3>" + " </rdf:Description>" + " <rdf:Description rdf:nodeID=\"second-node\" />" "</rdf:RDF>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)) 1)) (rdf-init-db :db-dir db-dir :start-revision revision-1) (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) - (is (= (length (dom:child-nodes rdf-node)) 2)) + (is (= (length (rdf-importer::child-nodes-or-text rdf-node + :trim t)) + 2)) (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id - :document-id document-id))))) + :document-id document-id) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 38)) + (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 10)) + (setf rdf-importer::*current-xtm* document-id) + (is (= (length + (intersection + (map 'list #'d:instance-of + (elephant:get-instances-by-class 'd:AssociationC)) + (list + (d:get-item-by-id (concatenate + 'string + constants::*rdf2tm-collection*) + :xtm-id rdf-importer::*rdf-core-xtm*) + (d:get-item-by-psi constants::*type-instance-psi*) + (dotimes (iter 9) + (let ((pos (+ iter 1)) + (topics nil)) + (when (/= pos 2) + (push (get-item-by-id + (concatenate + 'string "http://test/arcs/arc" + (write-to-string pos))) topics)) + topics))))))) + (let ((first-node (get-item-by-id "http://test-tm/first-node")) + (second-node (get-item-by-id "second-node")) + (third-node (get-item-by-id "http://test-tm/third-node")) + (fourth-node (get-item-by-id "http://test-tm/fourth-node")) + (fifth-node (get-item-by-id "http://test-tm/fifth-node")) + (item-1 (get-item-by-id "http://test-tm/item-1")) + (item-2 (get-item-by-id "http://test-tm/item-2")) + (arc1 (get-item-by-id "http://test/arcs/arc1")) + (arc2 (get-item-by-id "http://test/arcs/arc2")) + (arc3 (get-item-by-id "http://test/arcs/arc3")) + (arc4 (get-item-by-id "http://test/arcs/arc4")) + (arc5 (get-item-by-id "http://test/arcs/arc5")) + (arc6 (get-item-by-id "http://test/arcs/arc6")) + (arc7 (get-item-by-id "http://test/arcs/arc7")) + (arc8 (get-item-by-id "http://test/arcs/arc8")) + (instance (d:get-item-by-psi constants::*instance-psi*)) + (type (d:get-item-by-psi constants::*type-psi*)) + (type-instance (d:get-item-by-psi + constants:*type-instance-psi*)) + (subject (d:get-item-by-psi constants::*rdf2tm-subject*)) + (object (d:get-item-by-psi constants::*rdf2tm-object*)) + (collection (d:get-item-by-id + constants::*rdf2tm-collection*))) + (is (= (length (d:psis first-node)) 1)) + (is (string= (d:uri (first (d:psis first-node))) + "http://test-tm/first-node")) + (is (= (length (d:psis second-node)) 0)) + (is (= (length (d:psis third-node)) 1)) + (is (string= (d:uri (first (d:psis third-node))) + "http://test-tm/third-node")) + (is (= (length (d:psis fourth-node)) 1)) + (is (string= (d:uri (first (d:psis fourth-node))) + "http://test-tm/fourth-node")) + (is (= (length (d:psis fifth-node)) 1)) + (is (string= (d:uri (first (d:psis fifth-node))) + "http://test-tm/fifth-node")) + (is (= (length (d:psis item-1)) 1)) + (is (string= (d:uri (first (d:psis item-1))) + "http://test-tm/item-1")) + (is (= (length (d:psis item-2)) 1)) + (is (string= (d:uri (first (d:psis item-2))) + "http://test-tm/item-2")) + (is (= (length (d:psis arc1)) 1)) + (is (string= (d:uri (first (d:psis arc1))) + "http://test/arcs/arc1")) + (is (= (length (d:psis arc2)) 1)) + (is (string= (d:uri (first (d:psis arc2))) + "http://test/arcs/arc2")) + (is (= (length (d:psis arc3)) 1)) + (is (string= (d:uri (first (d:psis arc3))) + "http://test/arcs/arc3")) + (is (= (length (d:psis arc4)) 1)) + (is (string= (d:uri (first (d:psis arc4))) + "http://test/arcs/arc4")) + (is (= (length (d:psis arc5)) 1)) + (is (string= (d:uri (first (d:psis arc5))) + "http://test/arcs/arc5")) + (is (= (length (d:psis arc6)) 1)) + (is (string= (d:uri (first (d:psis arc6))) + "http://test/arcs/arc6")) + (is (= (length (d:psis arc7)) 1)) + (is (string= (d:uri (first (d:psis arc7))) + "http://test/arcs/arc7")) + (is (= (length (d:psis arc8)) 1)) + (is (string= (d:uri (first (d:psis arc8))) + "http://test/arcs/arc8")) + (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) + 1)) + (is (string= (d:charvalue (first (elephant:get-instances-by-class + 'd:OccurrenceC))) + "123")) + (is (string= (d:datatype (first (elephant:get-instances-by-class + 'd:OccurrenceC))) + "http://test-tm/long")) + (is (= (length (d:occurrences first-node)) 1)) + (is (= (length (d:player-in-roles first-node)) 3)) + (is (= (count-if + #'(lambda(x) + (or (and (eql (d:instance-of x) instance) + (eql (d:instance-of (d:parent x)) + type-instance)) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc1)) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc3)))) + (d:player-in-roles first-node)) + 3)) + (is (= (length (d:player-in-roles second-node)) 1)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) type) + (eql (d:instance-of (d:parent x)) + type-instance))) + (d:player-in-roles second-node))) + (is (= (length (d:player-in-roles third-node)) 1)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) + arc1))) + (d:player-in-roles third-node))) + (let ((uuid-1 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc3))) + (d:player-in-roles first-node)))))))) + (is-true uuid-1) + (is (= (length (d:player-in-roles uuid-1)) 2)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc4))) + (d:player-in-roles uuid-1))) + (let ((col-1 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc4))) + (d:player-in-roles uuid-1)))))))) + (is-true col-1) + (is (= (length (d:player-in-roles col-1)) 2)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + collection))) + (d:player-in-roles col-1))) + (let ((col-assoc + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + collection))) + (d:player-in-roles col-1))))) + (is-true col-assoc) + (is (= (length (d:roles col-assoc)) 3)) + (is (= (count-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (or (eql (d:player x) item-1) + (eql (d:player x) item-2)))) + (d:roles col-assoc)) + 2)))) + (is (= (length (d:player-in-roles item-1)) 1)) + (is (= (length (d:player-in-roles item-2)) 2)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc5))) + (d:player-in-roles item-2))) + (let ((uuid-2 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc5))) + (d:player-in-roles item-2)))))))) + (is-true uuid-2) + (is (= (length (d:player-in-roles uuid-2)) 4)) + (is (= (count-if + #'(lambda(x) + (or (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) arc5)) + (and (eql (d:instance-of x) subject) + (or + (eql (d:instance-of (d:parent x)) arc6) + (eql (d:instance-of (d:parent x)) arc7) + (eql (d:instance-of + (d:parent x)) arc8))))) + (d:player-in-roles uuid-2)) + 4)) + (is (= (length (d:player-in-roles fourth-node)) 1)) + (is (= (length (d:player-in-roles fifth-node)) 1)) + (let ((col-2 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc8))) + (d:player-in-roles uuid-2)))))))) + (is-true col-2) + (is (= (length (d:player-in-roles col-2)) 2)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + collection))) + (d:player-in-roles col-2))) + (let ((col-assoc + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + collection))) + (d:player-in-roles col-2))))) + (is-true col-assoc) + (is (= (length (d:roles col-assoc)) 1)))))))))) + (elephant:close-store)) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Wed Aug 5 11:45:12 2009 @@ -167,12 +167,19 @@ (with-tm (start-revision document-id tm-id) (let ((this (get-item-by-id UUID :xtm-id document-id :revision start-revision))) - (let ((literals (append (get-literals-of-node elem fn-xml-lang) + (let ((literals (append (get-literals-of-property elem fn-xml-lang) (get-literals-of-node-content elem tm-id xml-base fn-xml-lang))) (associations (get-associations-of-node-content elem tm-id xml-base)) - (types (get-types-of-node-content elem tm-id fn-xml-base)) + (types (remove-if + #'null + (append + (get-types-of-node-content elem tm-id fn-xml-base) + (when (get-ns-attribute elem "type") + (list :ID nil + :topicid (get-ns-attribute elem "type") + :psi (get-ns-attribute elem "type")))))) (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) (make-literals this literals tm-id start-revision @@ -286,8 +293,6 @@ super-classes)) - - (defun make-supertype-subtype-association (sub-top super-top reifier-id start-revision tm &key (document-id *document-id*))

1 0