;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff ;;+ ;;+ Isidorus is freely distributable under the LLGPL license. ;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and ;;+ trunk/docs/LGPL-LICENSE.txt. ;;+----------------------------------------------------------------------------- ;; TODOs (in descending priority): ;; * resolve non-local topicRefs ;; * either check the input document for XTM2.0 conformance in advance or ;; raise some kind of error (--> condition) if something goes wrong. (defpackage :xtm-importer (:use :cl :cxml :elephant :datamodel :isidorus-threading :base-tools) (:import-from :constants *type-instance-psi* *type-psi* *instance-psi* *XTM2.0-NS* *XTM1.0-NS* *XTM1.0-XLINK* *XML-STRING* *XML-URI* *topic-name-psi*) (:import-from :xml-constants *core_psis.xtm*) (:import-from :xml-tools get-attribute xpath-fn-string xpath-child-elems-by-qname xpath-single-child-elem-by-qname xpath-select-location-path xpath-select-single-location-path) (:import-from :exceptions missing-reference-error duplicate-identifier-error) (:export :create-instanceof-association :from-association-elem :from-name-elem :from-occurrence-elem :from-role-elem :from-scope-elem :from-topic-elem-to-stub :from-type-elem :get-topicref-uri :import-only-topics :import-from-xtm :importer :init-isidorus :merge-topic-elem :setup-repository :get-topicid-by-psi :get-topic-id-xtm1.0 :from-resourceRef-elem-xtm1.0 :from-baseName-elem-xtm1.0 :from-variant-elem-xtm1.0 :from-topicRef-elem-xtm1.0 :from-resourceX-elem-xtm1.0 :from-variant-elem-xtm1.0 :from-parameters-elem-xtm1.0 :get-xlink-attribute :get-instanceOf-refs-xtm1.0 :from-roleSpec-elem-xtm1.0 :from-scope-elem-xtm1.0 :from-occurrence-elem-xtm1.0 :from-subjectIdentity-elem-xtm1.0 :from-member-elem-xtm1.0 :from-topic-elem-to-stub-xtm1.0 :merge-topic-elem-xtm1.0 :from-association-elem-xtm1.0 :importer-xtm1.0 :get-uuid :with-tm)) (in-package :xtm-importer) (defun get-topicref-uri (topicref-elem) "Extract the uri from a topicref" ;TODO: at present, this resolves only local topicRefs by cutting off ;the first character ('#') (declare (dom:element topicref-elem)) (let ((topicref (get-attribute topicref-elem "href"))) (unless (char= (elt topicref 0) #\#) (error "cannot handle topicrefs that don't start with #")) (subseq topicref 1))) (defun get-topicid-by-psi (uri &key (xtm-id d:*current-xtm*) (revision *TM-REVISION*)) (when uri (loop for item in (topic-identifiers (identified-construct (elephant:get-instance-by-value 'PersistentIdC 'uri uri)) :revision revision) when (string= xtm-id (xtm-id item)) return (uri item)))) (defmacro with-tm ((revision xtm-id tm-id) &body body) "creates a topic map object called tm and puts it into the local scope" `(let ((ii (make-construct 'ItemIdentifierC :uri ,tm-id :start-revision ,revision))) (let ((tm (make-construct 'TopicMapC :start-revision ,revision :xtm-id ,xtm-id :item-identifiers (list ii)))) (declare (ItemIdentifierC ii)) (declare (TopicMapC tm)) ,@body))) (defun init-isidorus (&optional (revision (get-revision))) "Initiatlize the database with the stubs of the core topics + PSIs defined in the XTM 1.0 spec. This includes a topic that represents the core TM" (with-writer-lock (with-tm (revision "core.xtm" "http://www.topicmaps.org/xtm/1.0/core.xtm") (let ((core-dom (cxml:parse-file *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 "core.xtm"))) (add-to-tm tm top))))))) ;TODO: replace the two importers with this macro (defmacro importer-mac (get-topic-elems get-association-elems from-topic-elem-to-stub merge-topic-elem from-association-elem) `(lambda (xtm-dom &key (xtm-id d:*current-xtm*) (revision (get-revision))) (declare (dom:element xtm-dom)) (declare (integer revision)) ;all topics that are imported in one go share the same revision (let ((topic-vector (,get-topic-elems xtm-dom)) (assoc-vector (,get-association-elems xtm-dom))) (loop for top-elem across topic-vector do (,from-topic-elem-to-stub top-elem revision :xtm-id xtm-id)) (loop for top-elem across topic-vector do (format t "t") (,merge-topic-elem top-elem revision :xtm-id xtm-id)) (loop for assoc-elem across assoc-vector do (,from-association-elem assoc-elem revision :xtm-id xtm-id))))) (defun create-instanceof-association (topicid-of-supertype player2-obj start-revision &key tm (xtm-id *current-xtm*)) "handle the instanceOf element. The instanceOf element is different from all the others in that it is not modelled one to one, but following the suggestion of the XTM 2.0 spec (4.9) and the TMDM (7.2) as an association" ;instanceOf = element instanceOf { topicRef+ } (declare (string topicid-of-supertype)) (declare (TopicC player2-obj)) (declare (TopicMapC tm)) (let ((associationtype (get-item-by-psi *type-instance-psi* :revision start-revision)) (roletype1 (get-item-by-psi *type-psi* :revision start-revision)) (roletype2 (get-item-by-psi *instance-psi* :revision start-revision)) (player1 (get-item-by-id topicid-of-supertype :xtm-id xtm-id :revision start-revision))) (unless (and associationtype roletype1 roletype2) (error "Error in the creation of an instanceof association: core topics are missing")) (unless player1 (error (make-condition 'missing-reference-error :message "could not find type topic (first player)" :reference topicid-of-supertype))) (add-to-tm tm associationtype) (add-to-tm tm roletype1) (add-to-tm tm roletype2) (add-to-tm tm (make-construct 'AssociationC :item-identifiers nil :themes nil :start-revision start-revision :instance-of associationtype :roles (list (list :start-revision start-revision :instance-of roletype1 :player player1) (list :start-revision start-revision :instance-of roletype2 :player player2-obj))))))