Author: lgiessmann Date: Fri Jul 31 18:41:02 2009 New Revision: 101
Log: added some functions to write the actual tm constructs into elephant; added a minimal core_psis.xtm to initialize the rdf-module
Added: trunk/src/xml/rdf/rdf_core_psis.xtm Modified: trunk/src/constants.lisp trunk/src/isidorus.asd trunk/src/xml-constants.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 Jul 31 18:41:02 2009 @@ -1,3 +1,4 @@ + ;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann @@ -26,7 +27,13 @@ :*xml-ns* :*xmlns-ns* :*xml-string* - :*rdf2tm-ns*)) + :*rdf2tm-ns* + :*rdf-statement* + :*rdf-object* + :*rdf-subject* + :*rdf-predicate* + :*rdf2tm-object* + :*rdf2tm-subject*))
(in-package :constants) (defparameter *xtm2.0-ns* "http://www.topicmaps.org/xtm/") @@ -63,4 +70,16 @@
(defparameter *xml-string* "http://www.w3.org/2001/XMLSchema#string")
-(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/") \ No newline at end of file +(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping#") + +(defparameter *rdf-statement* "http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement") + +(defparameter *rdf-object* "http://www.w3.org/1999/02/22-rdf-syntax-ns#object") + +(defparameter *rdf-subject* "http://www.w3.org/1999/02/22-rdf-syntax-ns#subject") + +(defparameter *rdf-predicate* "http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate") + +(defparameter *rdf2tm-object* "http://isidorus/rdf2tm_mapping#object") + +(defparameter *rdf2tm-subject* "http://isidorus/rdf2tm_mapping#subject") \ No newline at end of file
Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Fri Jul 31 18:41:02 2009 @@ -20,6 +20,7 @@ :components ( (:file "constants") (:static-file "xml/xtm/core_psis.xtm") + (:static-file "xml/rdf/rdf_core_psis.xtm") (:file "xml-constants" :depends-on ("xml/xtm/core_psis.xtm" "constants"))
Modified: trunk/src/xml-constants.lisp ============================================================================== --- trunk/src/xml-constants.lisp (original) +++ trunk/src/xml-constants.lisp Fri Jul 31 18:41:02 2009 @@ -13,7 +13,8 @@ (:import-from :constants *isidorus-system*) (:export :*xml-component* - :*core_psis.xtm*)) + :*core_psis.xtm* + :*rdf_core_psis.xtm*))
(in-package :xml-constants)
@@ -24,3 +25,6 @@ (asdf:component-pathname (asdf:find-component *isidorus-system* "xml/xtm/core_psis.xtm")))
+(defparameter *rdf_core_psis.xtm* + (asdf:component-pathname + (asdf:find-component *isidorus-system* "xml/rdf/rdf_core_psis.xtm"))) \ 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 Jul 31 18:41:02 2009 @@ -11,11 +11,22 @@ (defvar *document-id* nil)
-(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))) +(defun setup-rdf-module (rdf-xml-path repository-path + &key tm-id (document-id (get-uuid))) + "Sets up the data base by importing core_psis.xtm and + rdf_core_psis.xtm afterwards the file corresponding + to the give file path is imported." + (declare ((or pathname string) rdf-xml-path)) + (declare ((or pathname string) repository-path)) + (unless elephant:*store-controller* + (elephant:open-store + (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 + (when elephant:*store-controller* + (elephant:close-store)))
(defun rdf-importer (rdf-xml-path repository-path @@ -23,27 +34,54 @@ (tm-id nil) (document-id (get-uuid)) (start-revision (d:get-revision))) + "Imports the file correponding to the given path." (setf *document-id* document-id) (tm-id-p tm-id "rdf-importer") + (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))))) - (unless elephant:*store-controller* - (elephant:open-store - (get-store-spec repository-path))) (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))) + "Imports the file rdf_core_psis.xtm. core_psis.xtm has to be imported + before." + (with-writer-lock + (with-tm (revision "rdf.xtm" "http://isidorus/rdf2tm_mapping/rdf.xtm") + (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))) + + (defun import-dom (rdf-dom start-revision &key (tm-id nil) (document-id *document-id*)) + "Imports the entire dom of a rdf-xml-file." (tm-id-p tm-id "import-dom") (let ((xml-base (get-xml-base rdf-dom)) (xml-lang (get-xml-lang rdf-dom)) (elem-name (get-node-name rdf-dom)) (elem-ns (dom:namespace-uri rdf-dom))) - (if (and (string= elem-ns *rdf-ns*) (string= elem-name "RDF")) (let ((children (child-nodes-or-text rdf-dom))) @@ -51,8 +89,8 @@ (loop for child across children do (import-node child tm-id start-revision :document-id document-id :xml-base xml-base :xml-lang xml-lang)))) - (import-node rdf-dom tm-id start-revision :document-id document-id - :xml-base xml-base :xml-lang xml-lang)))) + (import-node rdf-dom tm-id start-revision :document-id document-id + :xml-base xml-base :xml-lang xml-lang))))
(defun import-node (elem tm-id start-revision &key (document-id *document-id*) @@ -75,68 +113,241 @@ :psi (get-type-of-node-name elem) :ID nil)) (get-types-of-node-content elem tm-id fn-xml-base))) - (super-classes (get-super-classes-of-node-content elem tm-id xml-base))) - (let ((topic-stub (make-topic-stub-from-node about ID nodeID UUID - start-revision + (super-classes + (get-super-classes-of-node-content elem tm-id xml-base))) + (with-tm (start-revision document-id tm-id) + (let ((topic-stub + (make-topic-stub + about ID nodeID UUID start-revision xml-importer::tm + :document-id document-id))) + (map 'list #'(lambda(literal) + (make-occurrence topic-stub literal start-revision + tm-id :document-id document-id)) + literals) + (format t "~a~%" literals) + (map 'list #'(lambda(assoc) + (make-association topic-stub assoc xml-importer::tm + start-revision + :document-id document-id)) + associations) + (map 'list + #'(lambda(type) + (let ((type-topic + (make-topic-stub (getf type :psi) + (getf type :topicid) + nil nil start-revision + xml-importer::tm + :document-id document-id)) + (ID (getf type :ID))) + (make-instance-of-association topic-stub type-topic + ID start-revision + xml-importer::tm :document-id document-id))) + types) ;TODO: + ;*import standard topics from isidorus' rdf2tm namespace + ; (must be explicitly called by the user) ;*get-topic by topic id ;*make psis ;*if the topic does not exist create one with topic id ;*add psis - ;make instance-of associations - ;make topictype topics with topic id - ;make super-sub-class associations - ;make occurrencetype topics with topic id - ;make and add occurrences - ;make referenced topic with topic id - ;make and add associations + ;*make instance-of associations + reification + ;make super-sub-class associations + reification + ;*make occurrences + reification + ;*make associations + reification
;TODO: start recursion ... - (remove-node-properties-from-*_n-map* elem) - (or tm-id document-id topic-stub nodeID UUID literals ;TODO: remove - associations types super-classes))))) + (remove-node-properties-from-*_n-map* elem) + (or super-classes) ;TODO: remove + )))))
-(defun make-topic-stub-from-node (about ID nodeId UUID start-revision - &key (document-id *document-id*)) + +(defun make-instance-of-association (instance-top type-top reifier-id + start-revision tm + &key (document-id *document-id*)) + "Creates and returns an instance-of association." + (declare (TopicC type-top instance-top)) + (declare (TopicMapC tm)) + (let ((assoc-type + (get-item-by-psi *type-instance-psi*)) + (roletype-1 + (get-item-by-psi *type-psi*)) + (roletype-2 + (get-item-by-psi *instance-psi*))) + (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 + tm &key (document-id *document-id*)) "Returns a topic corresponding to the passed parameters. When the searched topic does not exist there will be created one. - If about or ID is set there will aslo be created a new PSI." -; (let ((topic-id (or about ID nodeID UUID)) -; (psi-value (or about ID)) -; (err-pref "From make-topic-stub-from-node(): ")) -; (unless topic-id -; (error "~aone of about ID nodeID UUID must be set!" -; err-pref)) -; (elephant:ensure-transaction (:txn-nosync t) -; (let ((top (get-item-by-id topic-id :xtm-id document-id -; :revision start-revision))) -; (let ((topic-psis (map 'list #'d:uri (d:psis top)))) -; (if (and psi-value -; (not (find psi-value topic-psis :test #'string=))) -; (let ((psis (list (d::make-instance -; 'd:PersistentIdC -; :uri psi-value -; :start-revision start-revision)))) -; ;create only a new topic if there existed no one -; (d::make-instance 'd:TopicC -; :topicid topic-id -; :psis psis -; :xtm-id document-id -; :start-revision start-revision)) -; top)))))) -) - - -(defun make-occurrence-from-node (top literals start-revision - &key (document-id *document-id*)) -; (loop for literal in literals -; do (let ((type - ) - + If about or ID is set there will also be created a new PSI." + (declare (TopicMapC tm)) + (let ((topic-id (or about ID nodeID UUID)) + (psi-uri (or about ID))) + (let ((top (get-item-by-id topic-id :xtm-id document-id + :revision start-revision))) + (if top + top + (elephant:ensure-transaction (:txn-nosync t) + (let ((psi (when psi-uri + (make-instance 'PersistentIdC + :uri psi-uri + :start-revision start-revision)))) + (add-to-topicmap + tm + (make-construct 'TopicC + :topicid topic-id + :psis (when psi (list psi)) + :xtm-id document-id + :start-revision start-revision)))))))) + + +(defun make-lang-topic (lang tm-id 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") + (let ((psi-and-topic-id + (absolutize-value lang nil tm-id))) + (let ((top (get-item-by-id psi-and-topic-id :xtm-id document-id + :revision start-revision))) + (if top + top + (make-topic-stub psi-and-topic-id nil nil nil start-revision + tm :document-id document-id)))))) + + +(defun make-association (top association tm start-revision + &key (document-id *document-id*)) + "Creates an association depending on the given parameters and + returns the elephat-associaton object." + (declare (TopicC top)) + (declare (TopicMapC tm)) + (let ((type (getf association :type)) + (player-id (getf association :topicid)) + (player-psi (getf association :psi)) + (ID (getf association :ID))) + (let ((player-1 (make-topic-stub player-psi player-id nil nil start-revision + tm :document-id document-id)) + (role-type-1 (get-item-by-psi *rdf2tm-object*)) + (role-type-2 (get-item-by-psi *rdf2tm-subject*)) + (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 type-top player-1 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) + "Creates an association with two roles that contains the given players." + (declare (TopicC subject-topic object-topic associationtype-topic)) + (declare (TopicMapC tm)) + (let ((role-type-1 (get-item-by-psi *rdf2tm-subject*)) + (role-type-2 (get-item-by-psi *rdf2tm-object*))) + (let ((roles (list (list :instance-of role-type-1 + :player subject-topic) + (list :instance-of role-type-2 + :player object-topic)))) + (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 + &key document-id) + "Creates a reification construct." + (declare (string reifier-id)) + (declare ((or OccurrenceC TopicC) object)) + (declare (TopicC subject predicate)) + (declare (TopicMapC tm)) + (let ((reifier (make-topic-stub reifier-id nil nil nil start-revision tm + :document-id document-id)) + (predicate-arc (make-topic-stub *rdf-predicate* nil nil nil start-revision + tm :document-id document-id)) + (object-arc (make-topic-stub *rdf-object* nil nil nil start-revision + tm :document-id document-id)) + (subject-arc (make-topic-stub *rdf-object* nil nil nil start-revision + tm :document-id document-id)) + (statement (make-topic-stub *rdf-statement* nil nil nil start-revision + tm :document-id document-id))) + (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) + (make-association-with-nodes reifier predicate-arc predicate + tm start-revision) + (if (typep object 'TopicC) + (make-association-with-nodes reifier object object-arc + tm start-revision) + (make-construct '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 + &key (document-id *document-id*)) + "Creates an accorrence from the literal list and returns + the created elephant-occurrence-object." + (declare (TopicC top)) + (tm-id-p tm-id "make-occurrence") + (with-tm (start-revision document-id tm-id) + (let ((type (getf literal :type)) + (value (getf literal :value)) + (lang (getf literal :lang)) + (datatype (getf literal :datatype)) + (ID (getf literal :ID))) + (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 + 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 type-top occurrence start-revision + xml-importer::tm :document-id document-id)) + occurrence))))) +
(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."
Added: trunk/src/xml/rdf/rdf_core_psis.xtm ============================================================================== --- (empty file) +++ trunk/src/xml/rdf/rdf_core_psis.xtm Fri Jul 31 18:41:02 2009 @@ -0,0 +1,27 @@ +<?xml version="1.0"?> +<!-- ======================================================================= --> +<!-- Isidorus --> +<!-- (c) 2008-2009 Marc Kuester, Christoph Ludwig, Lukas Giessmann --> +<!-- --> +<!-- Isidorus is freely distributable under the LGPL license. --> +<!-- You can find a detailed description in trunk/docs/LGPL-LICENSE.txt. --> +<!-- ======================================================================= --> + + +<topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0"> + + <topic id="subject"> + <subjectIdentifier href="http://isidorus/rdf2tm_mapping#subject"/> + <name> + <value>subject</value> + </name> + </topic> + + <topic id="object"> + <subjectIdentifier href="http://isidorus/rdf2tm_mapping#object"/> + <name> + <value>object</value> + </name> + </topic> + +</topicMap>
Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Fri Jul 31 18:41:02 2009 @@ -14,7 +14,19 @@ *xml-ns* *xmlns-ns* *xml-string* - *rdf2tm-ns*) + *rdf2tm-ns* + *xtm2.0-ns* + *type-instance-psi* + *type-psi* + *instance-psi* + *rdf-statement* + *rdf-object* + *rdf-subject* + *rdf-predicate* + *rdf2tm-object* + *rdf2tm-subject*) + (:import-from :xml-constants + *rdf_core_psis.xtm*) (:import-from :xml-constants *core_psis.xtm*) (:import-from :xml-tools @@ -39,7 +51,12 @@ node-to-string) (:import-from :xml-importer get-uuid - get-store-spec) + get-store-spec + with-tm + from-topic-elem-to-stub) + (:import-from :isidorus-threading + with-reader-lock + with-writer-lock) (:import-from :exceptions missing-reference-error duplicate-identifier-error)) @@ -59,6 +76,8 @@ "range" "range" "label" "comment" "member" "seeAlso" "isDefinedBy"))
+(defvar *rdf-core-xtm* "rdf_core.xtm") + (defvar *_n-map* nil)