[isidorus-cvs] r469 - in trunk/src: . json/JTM json/isidorus-json xml/rdf xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Tue May 10 10:56:27 UTC 2011
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)))
More information about the Isidorus-cvs
mailing list