Author: lgiessmann Date: Tue May 10 06:56:26 2011 New Revision: 469 Log: xtm-im/exporter | rdf-im/exporter | jtm-im/exporter | isidorus-json-im/exporter: if an untyped name is imported the default-name-type defined by TMDM 7.5 is set. This topic is contained in the file core_psis.xtm and is only imported in the topic map that is created by init-isidorus, i.e. the topic is not added to topics where it is used as name-type. When a name is exported that is typed by the defualt-name-type, the name-type is ignored and the name is exported as untyped name Modified: trunk/src/constants.lisp trunk/src/json/JTM/jtm_exporter.lisp trunk/src/json/JTM/jtm_importer.lisp trunk/src/json/isidorus-json/json_exporter.lisp trunk/src/json/isidorus-json/json_importer.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/map_to_tm.lisp trunk/src/xml/xtm/exporter_xtm1.0.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp trunk/src/xml/xtm/importer.lisp trunk/src/xml/xtm/importer_xtm1.0.lisp trunk/src/xml/xtm/importer_xtm2.0.lisp Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Tue May 10 06:56:26 2011 @@ -69,7 +69,8 @@ :*tm2rdf-player-property* :*rdf2tm-blank-node-prefix* :*tm2rdf-reifier-property* - :*xsd-ns*)) + :*xsd-ns* + :*topic-name-psi*)) (in-package :constants) @@ -193,4 +194,6 @@ (defparameter *tm2rdf-reifier-property* (concat *tm2rdf-ns* "reifier")) -(defparameter *xsd-ns* "http://www.w3.org/2001/XMLSchema#") \ No newline at end of file +(defparameter *xsd-ns* "http://www.w3.org/2001/XMLSchema#") + +(defparameter *topic-name-psi* "http://psi.topicmaps.org/iso13250/model/topic-name") \ No newline at end of file Modified: trunk/src/json/JTM/jtm_exporter.lisp ============================================================================== --- trunk/src/json/JTM/jtm_exporter.lisp (original) +++ trunk/src/json/JTM/jtm_exporter.lisp Tue May 10 06:56:26 2011 @@ -149,10 +149,14 @@ construct :prefixes prefixes :revision revision) ",")) (value (concat "\"value\":" (json:encode-json-to-string (charvalue construct)) ",")) - (type (concat "\"type\":" - (export-type-to-jtm construct :prefixes prefixes - :error-if-nil nil :revision revision) - ",")) + (type + (concat "\"type\":" + (if (eql (instance-of construct :revision revision) + (get-item-by-psi *topic-name-psi*)) + "null" + (export-type-to-jtm construct :prefixes prefixes + :error-if-nil nil :revision revision)) + ",")) (item-type (when item-type-p (concat "\"item_type\":\"" item_type-name "\","))) (name-parent Modified: trunk/src/json/JTM/jtm_importer.lisp ============================================================================== --- trunk/src/json/JTM/jtm_importer.lisp (original) +++ trunk/src/json/JTM/jtm_importer.lisp Tue May 10 06:56:26 2011 @@ -413,9 +413,11 @@ :charvalue value :themes (get-items-from-jtm-references scope :revision revision :prefixes prefixes) - :instance-of (when type - (get-item-from-jtm-reference - type :revision revision :prefixes prefixes)) + :instance-of (if type + (get-item-from-jtm-reference + type :revision revision :prefixes prefixes) + (get-item-by-psi *topic-name-psi* + :revision revision :error-if-nil t)) :parent (first local-parent) :reifier (when reifier (get-item-from-jtm-reference Modified: trunk/src/json/isidorus-json/json_exporter.lisp ============================================================================== --- trunk/src/json/isidorus-json/json_exporter.lisp (original) +++ trunk/src/json/isidorus-json/json_exporter.lisp Tue May 10 06:56:26 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :json-exporter - (:use :cl :json :datamodel :TM-SPARQL :base-tools) + (:use :cl :json :datamodel :TM-SPARQL :base-tools :constants) (:export :export-construct-as-isidorus-json-string :get-all-topic-psis :to-json-string-summary @@ -126,7 +126,10 @@ (identifiers-to-json-string instance :what 'item-identifiers :revision revision))) (type - (type-to-json-string instance :revision revision)) + (if (eql (instance-of instance :revision revision) + (get-item-by-psi *topic-name-psi* :revision revision)) + "\"type\":null" + (type-to-json-string instance :revision revision))) (scope (concat "\"scopes\":" (ref-topics-to-json-string (themes instance :revision revision) Modified: trunk/src/json/isidorus-json/json_importer.lisp ============================================================================== --- trunk/src/json/isidorus-json/json_importer.lisp (original) +++ trunk/src/json/isidorus-json/json_importer.lisp Tue May 10 06:56:26 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :json-importer - (:use :cl :json :datamodel :xtm-importer) + (:use :cl :json :datamodel :xtm-importer :constants) (:export :import-from-isidorus-json :*json-xtm*)) @@ -263,13 +263,18 @@ (psis-to-topic (getf json-decoded-list :type) :revision start-revision))) (unless namevalue (error "A name must have exactly one namevalue")) - (let ((name (make-construct 'NameC - :start-revision start-revision - :parent top - :charvalue namevalue - :instance-of instance-of - :item-identifiers item-identifiers - :themes themes))) + (let ((name (make-construct + 'NameC + :start-revision start-revision + :parent top + :charvalue namevalue + :instance-of (if instance-of + instance-of + (get-item-by-psi *topic-name-psi* + :revision start-revision + :error-if-nil t)) + :item-identifiers item-identifiers + :themes themes))) (loop for variant in (getf json-decoded-list :variants) do (json-to-variant variant name start-revision)) name)))) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Tue May 10 06:56:26 2011 @@ -27,6 +27,7 @@ *tm2rdf-variant-type-uri* *tm2rdf-occurrence-type-uri* *tm2rdf-topic-type-uri* + *topic-name-psi* *tm2rdf-association-type-uri* *tm2rdf-role-type-uri* *tm2rdf-reifier-property*) @@ -307,7 +308,9 @@ (make-isi-type *tm2rdf-name-type-uri*) (export-reifier-as-mapping construct) (map 'list #'to-rdf-elem (item-identifiers construct)) - (when (instance-of construct) + (when (and (instance-of construct) + (not (eql (instance-of construct) + (get-item-by-psi *topic-name-psi*)))) (cxml:with-element "isi:nametype" (make-topic-reference (instance-of construct)))) (scopes-to-rdf-elems construct) Modified: trunk/src/xml/rdf/map_to_tm.lisp ============================================================================== --- trunk/src/xml/rdf/map_to_tm.lisp (original) +++ trunk/src/xml/rdf/map_to_tm.lisp Tue May 10 06:56:26 2011 @@ -346,13 +346,19 @@ (elephant:ensure-transaction (:txn-nosync t) (map 'list #'d::delete-construct type-assocs) (map 'list #'d::delete-construct scope-assocs) - (let ((name (make-construct 'NameC - :start-revision start-revision - :parent top - :charvalue value - :instance-of type - :item-identifiers ids - :themes scopes))) + (let ((name + (make-construct 'NameC + :start-revision start-revision + :parent top + :charvalue value + :instance-of (if type + type + (get-item-by-psi + *topic-name-psi* + :revision start-revision + :error-if-nil t)) + :item-identifiers ids + :themes scopes))) (map 'list #'(lambda(variant-topic) (map-isi-variant name variant-topic start-revision)) Modified: trunk/src/xml/xtm/exporter_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm1.0.lisp Tue May 10 06:56:26 2011 @@ -16,6 +16,7 @@ *type-psi* *instance-psi* *type-instance-psi* + *topic-name-psi* *xml-uri* *xml-string*) (:export :to-elem Modified: trunk/src/xml/xtm/exporter_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm2.0.lisp Tue May 10 06:56:26 2011 @@ -52,7 +52,10 @@ (map 'list #'(lambda(x) (to-elem x revision)) (item-identifiers name :revision revision)) - (when (instance-of name :revision revision) + (when (and (instance-of name :revision revision) + (not (eql (instance-of name :revision revision) + (get-item-by-psi *topic-name-psi* + :revision revision)))) (cxml:with-element "t:type" (ref-to-elem (instance-of name :revision revision) revision))) (when (themes name :revision revision) Modified: trunk/src/xml/xtm/importer.lisp ============================================================================== --- trunk/src/xml/xtm/importer.lisp (original) +++ trunk/src/xml/xtm/importer.lisp Tue May 10 06:56:26 2011 @@ -23,7 +23,8 @@ *XTM1.0-NS* *XTM1.0-XLINK* *XML-STRING* - *XML-URI*) + *XML-URI* + *topic-name-psi*) (:import-from :xml-constants *core_psis.xtm*) (:import-from :xml-tools Modified: trunk/src/xml/xtm/importer_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm1.0.lisp Tue May 10 06:56:26 2011 @@ -151,12 +151,15 @@ start-revision :xtm-id xtm-id))) (baseNameString (xpath-fn-string (xpath-single-child-elem-by-qname baseName-elem *xtm1.0-ns* "baseNameString"))) - (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem start-revision))) + (reifier-topic (get-reifier-topic-xtm1.0 baseName-elem start-revision)) + (type (get-item-by-psi *topic-name-psi* :revision start-revision + :error-if-nil t))) (unless baseNameString (error "A baseName must have exactly one baseNameString")) (let ((name (make-construct 'NameC :start-revision start-revision :parent top + :instance-of type :charvalue baseNameString :reifier reifier-topic :themes themes))) Modified: trunk/src/xml/xtm/importer_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm2.0.lisp Tue May 10 06:56:26 2011 @@ -129,14 +129,19 @@ (reifier-topic (get-reifier-topic name-elem start-revision))) (unless namevalue (error "A name must have exactly one namevalue")) - (let ((name (make-construct 'NameC - :start-revision start-revision - :parent top - :charvalue namevalue - :instance-of instance-of - :item-identifiers item-identifiers - :reifier reifier-topic - :themes themes))) + (let ((name (make-construct + 'NameC + :start-revision start-revision + :parent top + :charvalue namevalue + :instance-of (if instance-of + instance-of + (get-item-by-psi *topic-name-psi* + :revision start-revision + :error-if-nil t)) + :item-identifiers item-identifiers + :reifier reifier-topic + :themes themes))) (loop for variant-elem across (xpath-child-elems-by-qname name-elem *xtm2.0-ns* "variant") do (from-variant-elem variant-elem name start-revision :xtm-id xtm-id)) name)))