[isidorus-cvs] r15 - in trunk: docs src src/json src/model src/rest_interface src/unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Mar 9 18:20:13 UTC 2009
Author: lgiessmann
Date: Mon Mar 9 18:20:10 2009
New Revision: 15
Log:
added all necessary file for the json-restful-interface and some small changes, e.g. resourceRef-topics will be added to the referenced topics of a fragment-main-topic, the add-association function was changed to make sure that the association will be made by both instances, the unittest versions-test was fixed+ssh://lgiessmann@common-lisp.net/project/isidorus/svn
Added:
trunk/docs/xtm_json.txt (contents, props changed)
trunk/src/json/json_importer.lisp
trunk/src/json/json_interface.html
trunk/src/rest_interface/set-up-json-interface.lisp
Modified:
trunk/docs/install_isidorus.txt
trunk/src/isidorus.asd
trunk/src/json/json_exporter.lisp
trunk/src/model/changes.lisp
trunk/src/model/datamodel.lisp
trunk/src/rest_interface/rest-interface.lisp
trunk/src/unit_tests/json_test.lisp
trunk/src/unit_tests/versions_test.lisp
Modified: trunk/docs/install_isidorus.txt
==============================================================================
--- trunk/docs/install_isidorus.txt (original)
+++ trunk/docs/install_isidorus.txt Mon Mar 9 18:20:10 2009
@@ -19,7 +19,7 @@
darcs get http://www.common-lisp.net/project/elephant/darcs/elephant-unstable/
Also install all of its dependencies as described in elephant_install.txt. In particular these are:
-
+ * (require 'asdf-install)
* (asdf-install:install 'CL-BASE64)
* (asdf-install:install 'uffi)
Added: trunk/docs/xtm_json.txt
==============================================================================
--- (empty file)
+++ trunk/docs/xtm_json.txt Mon Mar 9 18:20:10 2009
@@ -0,0 +1,300 @@
+resourceData:
+{
+ "datatype" : "Text",
+ "value" : "Text"
+}
+
+
+variant:
+{
+ "itemIdentities" : [ "Text" , "..." ],
+ "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+ "resourceRef" : "Text",
+ "resourceData" : { <resourceData> }
+}
+
+
+name:
+{
+ "itemIdentities" : [ "Text", "..." ],
+ "type" : [ "PSI-1", "PSI-2", "..." ],
+ "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+ "value" : "Text",
+ "variants" : [ {<variant>}, { <...> ] }
+}
+
+
+occurrence:
+{
+ "itemIdentities" : [ "Text", "..." ],
+ "type" : [ "PSI-1", "PSI-2", "..." ],
+ "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+ "resourceRef" : "Text",
+ "resourceData" : { <resourceData> }
+}
+
+
+topic:
+{
+ "id" : "Text",
+ "itemIdentities" : [ "Text", "..." ],
+ "subjectLocators" : [ "Text", "..." ],
+ "subjectIdentifiers" : [ "Text", "..." ],
+ "instanceOfs" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+ "names" : [ { <name> }, { <...> } ],
+ "occurrences" : [ { <occurrence> }, { <...> } ]
+}
+
+
+role:
+{
+ "itemIdentities" : [ "Text", "..." ],
+ "type" : [ "PSI-1", "PSI-2", "..." ],
+ "topicRef" : [ "PSI-1", "PSI-2", "..." ]
+}
+
+
+association:
+{
+ "itemIdentities" : [ "Text", "..." ],
+ "type" : [ "PSI-1", "PSI-2", "..." ],
+ "scopes" : [ [ "PSI-1-t1", "PSI-2-t1", "..." ], [ "PSI-1-t2", "PSI-2-t2", "..." ], [ "..." ] ],
+ "roles" : [ { <role> }, { <...> } ]
+}
+
+
+topicStub:
+{
+ "id" : "Text",
+ "itemIdentities" : [ "Text", "..." ],
+ "subjectLocators" : [ "Text", "..." ],
+ "subjectIdentifiers" : [ "Text", "..." ]
+}
+
+
+fragment
+{
+ "topic" : { <topic> },
+ "topicStubs" : [ { <topicStub> }, { <...> } ],
+ "associations" : [ { <association> }, { <...> } ],
+ "tm-ids" : [ "id-1", "id-2", "..." ]
+}
+// the field tm-ids should have only one tm-id in the list, because
+// there will be used only the first if the fragment is an incoming one
+// outgoing fragment have a list with more tm-ids but at least one
+
+
+
+=== example fragment with one topic, a few topicStubs and associations =========
+{
+ "topic" : {
+ "id" : "t403",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata" ],
+ "instanceOfs" : [ [ "http : //psi.egovpt.org/types/semanticstandard" ] ],
+ "names" : [ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_n1" ],
+ "type" : null,
+ "scopes" : null,
+ "value" : "ISO 19115",
+ "variants" : [ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_n1_v1" ],
+ "scopes" : [ [ "http : //www.topicmaps.org/xtm/1.0/core.xtm#display" ] ],
+ "resourceRef" : null,
+ "resourceData" : {
+ "datatype" : "http : //www.w3.org/2001/XMLSchema#string",
+ "value" : "Geographic Information - Metadata"
+ }
+ },
+ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_n1_v2" ],
+ "scopes" : [ [ "http : //www.topicmaps.org/xtm/1.0/core.xtm#sort" ] ],
+ "resourceRef" : null,
+ "resourceData" : {
+ "datatype" : "http : //www.w3.org/2001/XMLSchema#string",
+ "value" : "ISO-19115"
+ }
+ }
+ ]
+ }
+ ],
+ "occurrences" : [ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_o1" ],
+ "type" : [ "http : //psi.egovpt.org/types/standardHasStatus" ],
+ "scopes" : null,
+ "resourceRef" : "http : //www.budabe.de/","resourceData" : null
+ },
+ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_o2" ],
+ "type" : [ "http : //psi.egovpt.org/types/description" ],
+ "scopes" : null,
+ "resourceRef" : null,
+ "resourceData" : {
+ "datatype" : "http : //www.w3.org/2001/XMLSchema#string",
+ "value" : "The ISO 19115 standard ..."
+ }
+ },
+ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_o3" ],
+ "type" : [ "http : //psi.egovpt.org/types/standardValidFromDate" ],
+ "scopes" : null,
+ "resourceRef" : null,
+ "resourceData" : {
+ "datatype" : "http : //www.w3.org/2001/XMLSchema#date",
+ "value" : "2003-01-01"
+ }
+ },
+ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t100_o4" ],
+ "type" : [ "http : //psi.egovpt.org/types/links" ],
+ "scopes" : null,
+ "resourceRef" : "http : //www.editeur.org/standards/ISO19115.pdf",
+ "resourceData" : null
+ }
+ ]
+ },
+ "topicStubs" : [ {
+ "id" : "t227",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t3a" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/semanticstandard" ]
+ },
+ {
+ "id" : "t73",
+ "itemIdentities" : null,
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //www.topicmaps.org/xtm/1.0/core.xtm#display" ]
+ },
+ {
+ "id" : "t67",
+ "itemIdentities" : null,
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //www.topicmaps.org/xtm/1.0/core.xtm#sort" ]
+ },
+ {
+ "id" : "t291",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t51" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/standardHasStatus" ]
+ },
+ {
+ "id" : "t307",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t53" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/description" ]
+ },
+ {
+ "id" : "t315",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t54" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/standardValidFromDate" ]
+ },
+ {
+ "id" : "t323",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t55" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/links" ]
+ },
+ {
+ "id" : "t433",
+ "itemIdentities" : null,
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/subject/GeoData" ]
+ },
+ {
+ "id" : "t363",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t60" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/standardIsAboutSubject" ]
+ },
+ {
+ "id" : "t371",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t61" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/SubjectRoleType" ]
+ },
+ {
+ "id" : "t421",
+ "itemIdentities" : null,
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/subject/Semantic+Description" ]
+ },
+ {
+ "id" : "t395",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t64" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/serviceUsesStandard" ]
+ },
+ {
+ "id" : "t387",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t63" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/ServiceRoleType" ]
+ },
+ {
+ "id" : "t451",
+ "itemIdentities" : null,
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/service/Google+Maps",
+ "http : //maps.google.com" ]
+ },
+ {
+ "id" : "t379",
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#t62" ],
+ "subjectLocators" : null,
+ "subjectIdentifiers" : [ "http : //psi.egovpt.org/types/StandardRoleType" ]
+ }
+ ],
+ "associations" : [ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/standardIsAboutSubject" ],
+ "scopes" : null,
+ "roles" : [ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/StandardRoleType" ],
+ "topicRef" : [ "http : //psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata" ]
+ },
+ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/SubjectRoleType" ],
+ "topicRef" : [ "http : //psi.egovpt.org/subject/GeoData" ]
+ }
+ ]
+ },
+ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/standardIsAboutSubject" ],
+ "scopes" : null,
+ "roles" : [ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/StandardRoleType" ],
+ "topicRef" : [ "http : //psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata" ]
+ },
+ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/SubjectRoleType" ],
+ "topicRef" : [ "http : //psi.egovpt.org/subject/Semantic+Description" ]
+ }
+ ]
+ },
+ {
+ "itemIdentities" : [ "http : //psi.egovpt.org/itemIdentifiers#assoc_7" ],
+ "type" : [ "http : //psi.egovpt.org/types/serviceUsesStandard" ],
+ "scopes" : null,
+ "roles" : [ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/ServiceRoleType" ],
+ "topicRef" : [ "http : //psi.egovpt.org/service/Google+Maps",
+ "http : //maps.google.com" ]
+ },
+ {
+ "itemIdentities" : null,
+ "type" : [ "http : //psi.egovpt.org/types/StandardRoleType" ],
+ "topicRef" : [ "http : //psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata" ]
+ }
+ ]
+ }
+ ],
+ "tm-ids" : [ "test-tm"]
+}
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Mon Mar 9 18:20:10 2009
@@ -62,6 +62,8 @@
:components ((:file "rest-interface")
(:file "publish_feeds"
:depends-on ("rest-interface"))
+ (:file "set-up-json-interface"
+ :depends-on ("rest-interface"))
(:file "read"
:depends-on ("rest-interface")))
:depends-on ("model"
@@ -115,8 +117,10 @@
"xml"
"json"))
(:module "json"
- :components ((:file "json_exporter"))
- :depends-on ("model"))
+ :components ((:file "json_exporter")
+ (:file "json_importer")
+ (:static-file "json_interface.html"))
+ :depends-on ("model" "xml"))
(:module "threading"
:components ((:file "reader-writer"))))
:depends-on (:cxml
Modified: trunk/src/json/json_exporter.lisp
==============================================================================
--- trunk/src/json/json_exporter.lisp (original)
+++ trunk/src/json/json_exporter.lisp Mon Mar 9 18:20:10 2009
@@ -6,8 +6,8 @@
;; the json schema for our datamodel is in ".../docs/xtm_json.txt"
-(defgeneric to-json-string (instance)
- (:documentation "converts the Topic Maps construct instance to an json string"))
+(defgeneric to-json-string (instance &key xtm-id)
+ (:documentation "converts the Topic Maps construct instance to a json string"))
(defun identifiers-to-json-string (parent-construct &key (what 'd:psis))
@@ -20,12 +20,19 @@
(json:encode-json-to-string items))))
-(defun resourceX-to-json-string (value datatype)
+(defun resourceX-to-json-string (value datatype &key (xtm-id d:*current-xtm*))
"returns a resourceRef and resourceData json object"
;(declare (string value datatype))
(if (string= datatype "http://www.w3.org/2001/XMLSchema#anyURI")
- (concatenate 'string "\"resourceRef\":"
- (json:encode-json-to-string value)
+ (concatenate 'string "\"resourceRef\":"
+ (let ((inner-value
+ (let ((ref-topic (when (and (> (length value) 0)
+ (eql (elt value 0) #\#))
+ (get-item-by-id (subseq value 1) :xtm-id xtm-id))))
+ (if ref-topic
+ (concatenate 'string "#" (topicid ref-topic))
+ value))))
+ (json:encode-json-to-string inner-value))
",\"resourceData\":null")
(concatenate 'string "\"resourceRef\":null,"
"\"resourceData\":{\"datatype\":"
@@ -56,7 +63,7 @@
"null")))
-(defmethod to-json-string ((instance VariantC))
+(defmethod to-json-string ((instance VariantC) &key (xtm-id d:*current-xtm*))
"transforms a VariantC object to a json string"
(let ((itemIdentity
(concatenate 'string "\"itemIdentities\":"
@@ -70,11 +77,11 @@
(type
(when (slot-boundp instance 'datatype)
(datatype instance))))
- (resourceX-to-json-string value type))))
+ (resourceX-to-json-string value type :xtm-id xtm-id))))
(concatenate 'string "{" itemIdentity "," scope "," resourceX "}")))
-(defmethod to-json-string ((instance NameC))
+(defmethod to-json-string ((instance NameC) &key (xtm-id d:*current-xtm*))
"transforms a NameC object to a json string"
(let ((itemIdentity
(concatenate 'string "\"itemIdentities\":"
@@ -93,14 +100,15 @@
(concatenate 'string "\"variants\":"
(let ((j-variants "["))
(loop for variant in (variants instance)
- do (setf j-variants (concatenate 'string j-variants
- (json-exporter::to-json-string variant) ",")))
+ do (setf j-variants
+ (concatenate 'string j-variants
+ (json-exporter::to-json-string variant :xtm-id xtm-id) ",")))
(concatenate 'string (subseq j-variants 0 (- (length j-variants) 1)) "]")))
(concatenate 'string "\"variants\":null"))))
(concatenate 'string "{" itemIdentity "," type "," scope "," value "," variant "}")))
-(defmethod to-json-string ((instance OccurrenceC))
+(defmethod to-json-string ((instance OccurrenceC) &key (xtm-id d:*current-xtm*))
"transforms an OccurrenceC object to a json string"
(let ((itemIdentity
(concatenate 'string "\"itemIdentities\":"
@@ -116,11 +124,11 @@
(type
(when (slot-boundp instance 'datatype)
(datatype instance))))
- (resourceX-to-json-string value type))))
+ (resourceX-to-json-string value type :xtm-id xtm-id))))
(concatenate 'string "{" itemIdentity "," type "," scope "," resourceX "}")))
-(defmethod to-json-string ((instance TopicC))
+(defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*))
"transforms an OccurrenceC object to a json string"
(let ((id
(concatenate 'string "\"id\":\"" (topicid instance) "\""))
@@ -140,7 +148,8 @@
(if (names instance)
(let ((j-names "["))
(loop for item in (names instance)
- do (setf j-names (concatenate 'string j-names (to-json-string item) ",")))
+ do (setf j-names
+ (concatenate 'string j-names (to-json-string item :xtm-id xtm-id) ",")))
(concatenate 'string (subseq j-names 0 (- (length j-names) 1)) "]"))
"null")))
(occurrence
@@ -148,15 +157,39 @@
(if (occurrences instance)
(let ((j-occurrences "["))
(loop for item in (occurrences instance)
- do (setf j-occurrences (concatenate 'string j-occurrences (to-json-string item) ",")))
+ do (setf j-occurrences
+ (concatenate 'string j-occurrences (to-json-string item :xtm-id xtm-id) ",")))
(concatenate 'string (subseq j-occurrences 0 (- (length j-occurrences) 1)) "]"))
"null"))))
(concatenate 'string "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier ","
- instanceOf "," name "," occurrence "}")))
+ instanceOf "," name "," occurrence "}")))
-(defmethod to-json-string ((instance RoleC))
+(defun to-json-topicStub-string (topic)
+ "transforms the passed TopicC object to a topic stub
+ string in the json format, which contains an id,
+ all itemIdentities, all subjectLocators and all
+ subjectIdentifiers"
+ (when topic
+ (let ((id
+ (concatenate 'string "\"id\":\"" (topicid topic) "\""))
+ (itemIdentity
+ (concatenate 'string "\"itemIdentities\":"
+ (identifiers-to-json-string topic :what 'item-identifiers)))
+ (subjectLocator
+ (concatenate 'string "\"subjectLocators\":"
+ (identifiers-to-json-string topic :what 'locators)))
+ (subjectIdentifier
+ (concatenate 'string "\"subjectIdentifiers\":"
+ (identifiers-to-json-string topic :what 'psis))))
+ (declare (TopicC topic))
+ (concatenate 'string "{" id "," itemIdentity "," subjectLocator ","
+ subjectIdentifier "}"))))
+
+
+(defmethod to-json-string ((instance RoleC) &key (xtm-id d:*current-xtm*))
"transforms an RoleC object to a json string"
+ (declare (ignorable xtm-id))
(let ((itemIdentity
(concatenate 'string "\"itemIdentities\":"
(identifiers-to-json-string instance :what 'item-identifiers)))
@@ -170,7 +203,7 @@
(concatenate 'string "{" itemIdentity "," type "," topicRef "}")))
-(defmethod to-json-string ((instance AssociationC))
+(defmethod to-json-string ((instance AssociationC) &key (xtm-id d:*current-xtm*))
"transforms an AssociationC object to a json string"
(let ((itemIdentity
(concatenate 'string "\"itemIdentities\":"
@@ -185,7 +218,54 @@
(if (roles instance)
(let ((j-roles "["))
(loop for item in (roles instance)
- do (setf j-roles (concatenate 'string j-roles (to-json-string item) ",")))
+ do (setf j-roles
+ (concatenate 'string j-roles (to-json-string item :xtm-id xtm-id) ",")))
(concatenate 'string (subseq j-roles 0 (- (length j-roles) 1)) "]"))
"null"))))
- (concatenate 'string "{" itemIdentity "," type "," scope "," role "}")))
\ No newline at end of file
+ (concatenate 'string "{" itemIdentity "," type "," scope "," role "}")))
+
+
+(defmethod to-json-string ((instance TopicMapC) &key (xtm-id d:*current-xtm*))
+ "returns the ItemIdentifier's uri"
+ (declare (ignorable xtm-id))
+ (let ((ii (item-identifiers instance)))
+ (when ii
+ (uri (first ii)))))
+
+
+(defmethod to-json-string ((instance FragmentC) &key (xtm-id d:*current-xtm*))
+ "transforms an FragmentC object to a json string,
+ which contains the main topic, all depending topicStubs
+ and all associations depending on the main topic"
+ (let ((main-topic
+ (concatenate 'string "\"topic\":"
+ (to-json-string (topic instance) :xtm-id xtm-id)))
+ (topicStubs
+ (concatenate 'string "\"topicStubs\":"
+ (if (referenced-topics instance)
+ (let ((j-topicStubs "["))
+ (loop for item in (referenced-topics instance)
+ do (setf j-topicStubs (concatenate 'string j-topicStubs
+ (to-json-topicStub-string item) ",")))
+ (concatenate 'string (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]"))
+ "null")))
+ (associations
+ (concatenate 'string "\"associations\":"
+ (if (associations instance)
+ (let ((j-associations "["))
+ (loop for item in (associations instance)
+ do (setf j-associations
+ (concatenate 'string j-associations
+ (to-json-string item :xtm-id xtm-id) ",")))
+ (concatenate 'string (subseq j-associations 0 (- (length j-associations) 1)) "]"))
+ "null")))
+ (tm-ids
+ (concatenate 'string "\"tm-ids\":"
+ (if (in-topicmaps (topic instance))
+ (let ((j-tm-ids "["))
+ (loop for item in (in-topicmaps (topic instance))
+ do (setf j-tm-ids (concatenate 'string j-tm-ids "\""
+ (d:uri (first (d:item-identifiers item))) "\",")))
+ (concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]"))
+ "null"))))
+ (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}")))
\ No newline at end of file
Added: trunk/src/json/json_importer.lisp
==============================================================================
--- (empty file)
+++ trunk/src/json/json_importer.lisp Mon Mar 9 18:20:10 2009
@@ -0,0 +1,630 @@
+(defpackage :json-importer
+ (:use :cl :json :datamodel :xml-importer)
+ (:export :json-to-elem
+ :*json-xtm*))
+
+(in-package :json-importer)
+
+;; the json schema for our datamodel is in "docs/xtm_json.txt"
+
+
+(defvar *json-xtm* "json-xtm"); Represents the currently active TM of the JSON-Importer
+
+
+(defun json-to-elem(json-string &key (xtm-id *json-xtm*))
+ "creates all objects (topics, topic stubs, associations)
+ of the passed json-decoded-list (=fragment)"
+ (when json-string
+ (let ((fragment-values
+ (get-fragment-values-from-json-list
+ (json:decode-json-from-string json-string))))
+ (declare (string json-string))
+ (let ((topic-values (getf fragment-values :topic))
+ (topicStubs-values (getf fragment-values :topicStubs))
+ (associations-values (getf fragment-values :associations))
+ (rev (get-revision))) ; creates a new revision, equal for all elements of the passed fragment
+; (xtm-id "json-xtm"))
+ (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
+ (loop for topicStub-values in (append topicStubs-values (list topic-values))
+ do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
+ (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
+ (loop for association-values in associations-values
+ do (json-to-association association-values rev :tm xml-importer::tm)))))))
+
+
+(defun json-to-association (json-decoded-list start-revision
+ &key tm )
+ "creates an association element of the passed json-decoded-list"
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let
+ ((item-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'ItemIdentifierC uri start-revision))
+ (getf json-decoded-list :itemIdentities)))
+ (instance-of
+ (psis-to-topic (getf json-decoded-list :type)))
+ (themes
+ (json-to-scope (getf json-decoded-list :scopes)))
+ (roles
+ (map 'list #'(lambda(role-values)
+ (json-to-role role-values start-revision))
+ (getf json-decoded-list :roles))))
+ (declare (list json-decoded-list))
+ (declare (integer start-revision))
+ (declare (TopicMapC tm))
+ (setf roles (xml-importer::set-standard-role-types roles))
+ (add-to-topicmap tm
+ (make-construct 'AssociationC
+ :start-revision start-revision
+ :item-identifiers item-identifiers
+ :instance-of instance-of
+ :themes themes
+ :roles roles)))))
+
+
+(defun json-to-role (json-decoded-list start-revision)
+ "creates a role element"
+ (when json-decoded-list
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let
+ ((item-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'ItemIdentifierC uri start-revision))
+ (getf json-decoded-list :itemIdentities)))
+ (instance-of
+ (psis-to-topic (getf json-decoded-list :type)))
+ (player
+ (psis-to-topic (getf json-decoded-list :topicRef))))
+ (declare (list json-decoded-list))
+ (declare (integer start-revision))
+ (unless player
+ (error "Role in association with topicref ~a not complete" (getf json-decoded-list :topicRef)))
+ (list :instance-of instance-of :player player :item-identifiers item-identifiers)))))
+
+
+(defun json-merge-topic (json-decoded-list start-revision
+ &key tm (xtm-id *json-xtm*))
+ "merges the a topic by setting the name, occurrence and instanceOf
+ elements from the json-decoded-list"
+ (when json-decoded-list
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((top
+ (d:get-item-by-id
+ (getf json-decoded-list :id)
+ :revision start-revision
+ :xtm-id xtm-id)))
+ (declare (list json-decoded-list))
+ (declare (integer start-revision))
+ (declare (TopicMapC tm))
+ (unless top
+ (error "topic ~a could not be found" (getf json-decoded-list :id)))
+
+ (let ((instanceof-topics
+ (remove-duplicates
+ (map 'list
+ #'psis-to-topic
+ (getf json-decoded-list :instanceOfs)))))
+
+ (loop for name-values in (getf json-decoded-list :names)
+ do (json-to-name name-values top start-revision))
+
+ (loop for occurrence-values in (getf json-decoded-list :occurrences)
+ do (json-to-occurrence occurrence-values top start-revision))
+ (dolist (instanceOf-top instanceof-topics)
+ (json-create-instanceOf-association instanceOf-top top start-revision :tm tm))
+; (add-to-topicmap tm top) ; will be done in "json-to-stub"
+ top)))))
+
+
+(defun json-to-stub(json-decoded-list start-revision &key tm (xtm-id *json-xtm*))
+ "creates a topic stub from the passed json-decoded list"
+ (when json-decoded-list
+ (elephant:ensure-transaction (:txn-nosync t)
+ (let ((item-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'ItemIdentifierC uri start-revision))
+ (getf json-decoded-list :itemIdentities)))
+ (subject-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'PersistentIdC uri start-revision))
+ (getf json-decoded-list :subjectIdentifiers)))
+ (subject-locators
+ (map 'list #'(lambda(uri)
+ (make-identifier 'SubjectLocatorC uri start-revision))
+ (getf json-decoded-list :subjectLocators))))
+ ;; all topic stubs has to be added top a topicmap object in this method
+ ;; becuase the only one topic that is handled in "json-merge-topic"
+ ;; is the main topic of the fragment
+ (let ((top
+ (make-construct 'TopicC :start-revision start-revision
+ :item-identifiers item-identifiers
+ :locators subject-locators
+ :psis subject-identifiers
+ :topicid (getf json-decoded-list :id)
+ :xtm-id xtm-id)))
+ (add-to-topicmap tm top)
+ top)))))
+
+
+(defun json-to-occurrence (json-decoded-list top start-revision)
+ "Creates an occurrence element"
+ (when json-decoded-list
+ (let
+ ((themes
+ (json-to-scope (getf json-decoded-list :scopes)))
+ (item-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'ItemIdentifierC uri start-revision))
+ (getf json-decoded-list :itemIdentities)))
+ (instance-of
+ (psis-to-topic (getf json-decoded-list :type)))
+ (occurrence-value
+ (json-to-resourceX json-decoded-list)))
+
+ (unless occurrence-value
+ (error "OccurrenceC: one of resourceRef and resourceData must be set"))
+ (make-construct 'OccurrenceC
+ :start-revision start-revision
+ :topic top
+ :themes themes
+ :item-identifiers item-identifiers
+ :instance-of instance-of
+ :charvalue (getf occurrence-value :data)
+ :datatype (getf occurrence-value :type)))))
+
+
+(defun make-identifier (classsymbol uri start-revision)
+ "creates an instance of a PersistentIdc, SubjectlocatorC or
+ ItemIdentifierC"
+ (declare (symbol classsymbol))
+ (declare (string uri))
+ (declare (integer start-revision))
+ (let ((id (make-instance classsymbol
+ :uri uri
+ :start-revision start-revision)))
+ id))
+
+
+(defun json-to-scope (json-decoded-list)
+ "Generate set of themes (= topics) from this scope element and
+ return that set. If the input is nil, the list of themes is empty"
+ (when json-decoded-list
+ (let ((tops
+ (map 'list #'psis-to-topic json-decoded-list)))
+ (declare (list json-decoded-list))
+ (unless (>= (length tops) 1)
+ (error "need at least one topic in a scope"))
+ tops)))
+
+
+(defun psis-to-topic(psis)
+ "searches for a topic of the passed psis-list describing
+ exactly one topic"
+ (when psis
+ (let ((top
+ (let ((psi
+ (loop for uri in psis
+ when (elephant:get-instance-by-value
+ 'd:PersistentIdC 'd:uri uri)
+ return (elephant:get-instance-by-value
+ 'd:PersistentIdC 'd:uri uri))))
+ (when psi
+ (d:identified-construct psi)))))
+ (unless top
+ (error (make-condition 'missing-reference-error
+ :message (format nil "psis-to-topic: could not resolve reference ~a" psis))))
+ top)))
+
+
+(defun json-to-name (json-decoded-list top start-revision)
+ "creates a name element (NameC) of the passed json-decoded-list"
+ (when json-decoded-list
+ (let ((item-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'ItemIdentifierC uri start-revision))
+ (getf json-decoded-list :itemIdentities)))
+ (namevalue (getf json-decoded-list :value))
+ (themes
+ (json-to-scope (getf json-decoded-list :scopes)))
+ (instance-of
+ (psis-to-topic (getf json-decoded-list :type))))
+ (declare (list json-decoded-list))
+ (declare (TopicC top))
+
+ (unless namevalue
+ (error "A name must have exactly one namevalue"))
+
+ (let ((name (make-construct 'NameC
+ :start-revision start-revision
+ :topic top
+ :charvalue namevalue
+ :instance-of instance-of
+ :item-identifiers item-identifiers
+ :themes themes)))
+ (loop for variant in (getf json-decoded-list :variants)
+ do (json-to-variant variant name start-revision))
+ ;(json-to-variant (getf json-decoded-list :variants) name start-revision)
+ name))))
+
+
+(defun json-to-variant(json-decoded-list name start-revision)
+ "creates a variant element (VariantC) of the passed json-decoded-list"
+ (when json-decoded-list
+ (let ((item-identifiers
+ (map 'list #'(lambda(uri)
+ (make-identifier 'ItemIdentifierC uri start-revision))
+ (getf json-decoded-list :itemIdentities)))
+ (themes
+ (remove-duplicates (append (d:themes name)
+ (json-to-scope (getf json-decoded-list :scopes)))))
+ (variant-value
+ (json-to-resourceX json-decoded-list)))
+ (declare (list json-decoded-list))
+ ;(declare (NameC name))
+ (make-construct 'VariantC
+ :start-revision start-revision
+ :item-identifiers item-identifiers
+ :themes themes
+ :charvalue (getf variant-value :data)
+ :datatype (getf variant-value :type)
+ :name name))))
+
+
+(defun json-to-resourceX(json-decoded-list)
+ "creates a resourceRef or resourceData element"
+ (when json-decoded-list
+ (let ((resourceRef
+ (getf json-decoded-list :resourceRef))
+ (resourceData
+ (getf json-decoded-list :resourceData)))
+ (declare (list json-decoded-list))
+ (let ((value
+ (if resourceRef
+ (list :data resourceRef
+ :type "http://www.w3.org/2001/XMLSchema#anyURI")
+ (list :data (getf resourceData :value)
+ :type (if (getf resourceData :datatype)
+ (getf resourceData :datatype)
+ "http://www.w3.org/2001/XMLSchema#string")))))
+ (unless (getf value :data)
+ (error "json-to-resourceX: one of resourceRef or resourceData must be set"))
+ value))))
+
+
+(defun json-create-instanceOf-association (supertype player2-obj start-revision
+ &key tm)
+ "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"
+
+ (declare (TopicC supertype))
+ (declare (TopicC player2-obj))
+ (declare (TopicMapC tm))
+ (let
+ ((associationtype
+ (get-item-by-psi constants:*type-instance-psi*))
+ (roletype1
+ (get-item-by-psi constants:*type-psi*))
+ (roletype2
+ (get-item-by-psi constants:*instance-psi*))
+ (player1 supertype))
+
+ (unless (and associationtype roletype1 roletype2)
+ (error "Error in the creation of an instanceof association: core topics are missing"))
+
+ (add-to-topicmap
+ tm
+ (make-construct
+ 'AssociationC
+ :item-identifiers nil
+ :themes nil
+ :start-revision start-revision
+ :instance-of associationtype
+ :roles (list (list :instance-of roletype1 :player player1)
+ (list :instance-of roletype2 :player player2-obj))))))
+
+
+(defun get-fragment-values-from-json-list(json-decoded-list)
+ "returns all fragment values of the passed json-decoded-list
+ as a named list"
+ (when json-decoded-list
+ (let ((topic nil)
+ (topicStubs nil)
+ (associations nil)
+ (tm-ids nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :topic)
+ (setf topic (cdr j-elem)))
+ ((string= (car j-elem) :topic-Stubs)
+ (setf topicStubs (cdr j-elem)))
+ ((string= (car j-elem) :associations)
+ (setf associations (cdr j-elem)))
+ ((string= (car j-elem) :tm-ids)
+ (setf tm-ids (cdr j-elem)))
+ (t
+ (error "json-importer:get-fragment-values-from-json-string:
+ bad item-specifier found in json-list"))))
+ (unless topic
+ (error "json-importer:get-fragment-values-from-json-string: the element topic must be set"))
+ (unless (= (length tm-ids) 1)
+ (error "There must be given exactly one tm-id in the tm-ids list"))
+ (let ((topic-list (get-topic-values-from-json-list topic))
+ (topicStubs-list (map 'list #'get-topicStub-values-from-json-list topicStubs))
+ (associations-list (map 'list #'get-association-values-from-json-list associations)))
+ (list :topic topic-list
+ :topicStubs topicStubs-list
+ :associations associations-list
+ :tm-ids tm-ids)))))
+
+
+(defun get-topicStub-values-from-json-list (json-decoded-list)
+ "returns all topicStub values of the passed json-decoded-list
+ as a named list"
+ (when json-decoded-list
+ (let ((id nil)
+ (itemIdentities nil)
+ (subjectLocators nil)
+ (subjectIdentifiers nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :ID)
+ (setf id (cdr j-elem)))
+ ((string= (car j-elem) :item-Identities)
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :subject-Locators)
+ (setf subjectLocators (cdr j-elem)))
+ ((string= (car j-elem) :subject-Identifiers)
+ (setf subjectIdentifiers (cdr j-elem)))
+ (t
+ (error "json-importer:get-topicStub-values-from-json-string:
+ bad item-specifier found in json-list"))))
+ (unless (or itemIdentities subjectLocators subjectIdentifiers)
+ (error "json-importer:get-topicStub-values-from-json-string: one of the elements
+ itemIdentity, sbjectLocator or subjectIdentifier must be set"))
+ (unless id
+ (error "json-importer:get-topic-valuesStub-from-json-string: the element id must be set"))
+ (list :id id
+ :itemIdentities itemIdentities
+ :subjectLocators subjectLocators
+ :subjectIdentifiers subjectIdentifiers))))
+
+
+(defun get-topic-values-from-json-list (json-decoded-list)
+ "extracts all values of the passed json-list and
+ returns them as a named list"
+ (when json-decoded-list
+ (let ((id nil)
+ (itemIdentities nil)
+ (subjectLocators nil)
+ (subjectIdentifiers nil)
+ (instanceOfs nil)
+ (names nil)
+ (occurrences nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :ID)
+ (setf id (cdr j-elem)))
+ ((string= (car j-elem) :item-Identities) ;json-decoder transforms camelcase to '-' from
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :subject-Locators)
+ (setf subjectLocators (cdr j-elem)))
+ ((string= (car j-elem) :subject-Identifiers)
+ (setf subjectIdentifiers (cdr j-elem)))
+ ((string= (car j-elem) :instance-Ofs)
+ (setf instanceOfs (cdr j-elem)))
+ ((string= (car j-elem) :names)
+ (setf names (cdr j-elem)))
+ ((string= (car j-elem) :occurrences)
+ (setf occurrences (cdr j-elem)))
+ (t
+ (error "json-importer:get-topic-values-from-json-string:
+ bad item-specifier found in json-list ~a" (car j-elem)))))
+ (unless (or itemIdentities subjectLocators subjectIdentifiers)
+ (error "json-importer:get-topic-values-from-json-string: one of the elements
+ itemIdentity, sbjectLocator or subjectIdentifier must be set"))
+ (unless id
+ (error "json-importer:get-topic-values-from-json-string: the element id must be set"))
+ (let ((names-list (map 'list #'get-name-values-from-json-list names))
+ (occurrences-list (map 'list #'get-occurrence-values-from-json-list occurrences)))
+ (list :id id
+ :itemIdentities itemIdentities
+ :subjectLocators subjectLocators
+ :subjectIdentifiers subjectIdentifiers
+ :instanceOfs instanceOfs
+ :names names-list
+ :occurrences occurrences-list)))))
+
+
+(defun get-name-values-from-json-list (json-decoded-list)
+ "returns all element values of a name element as
+ a named list"
+ (when json-decoded-list
+ (let ((itemIdentities nil)
+ (type nil)
+ (scopes nil)
+ (value nil)
+ (variants nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :item-Identities)
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :type)
+ (setf type (cdr j-elem)))
+ ((string= (car j-elem) :scopes)
+ (setf scopes (cdr j-elem)))
+ ((string= (car j-elem) :value)
+ (setf value (cdr j-elem)))
+ ((string= (car j-elem) :variants)
+ (setf variants (cdr j-elem)))
+ (t
+ (error "json-importer:get-name-values-from-json-list:
+ bad item-specifier found in json-list"))))
+ (unless value
+ (error "json-importer:get-name-values-from-json-list: value must be set"))
+ (let ((variants-list (map 'list #'get-variant-values-from-json-list variants)))
+ (list :itemIdentities itemIdentities
+ :type type
+ :scopes scopes
+ :value value
+ :variants variants-list)))))
+
+
+(defun get-variant-values-from-json-list (json-decoded-list)
+ "returns all element values of a variant element as
+ a named list"
+ (when json-decoded-list
+ (let ((itemIdentities nil)
+ (scopes nil)
+ (resourceRef nil)
+ (resourceData nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :item-Identities)
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :scopes)
+ (setf scopes (cdr j-elem)))
+ ((string= (car j-elem) :resource-Ref)
+ (setf resourceRef (cdr j-elem)))
+ ((string= (car j-elem) :resource-Data)
+ (setf resourceData (cdr j-elem)))
+ (t
+ (error "json-importer:get-variant-values-from-json-list:
+ bad item-specifier found in json-list"))))
+ (when (or (and (not resourceRef)
+ (not resourceData))
+ (and resourceRef resourceData))
+ (error "json-importer:get-variant-values-from-json-list: ONE of the elements
+ resourceRef or resourceData must be set"))
+ (let ((resourceData-list (get-resourceData-values-from-json-list resourceData)))
+ (list :itemIdentities itemIdentities
+ :scopes scopes
+ :resourceRef resourceRef
+ :resourceData resourceData-list)))))
+
+
+(defun get-resourceData-values-from-json-list (json-decoded-list)
+ "returns the resourceData value and the datatype value, if there
+ is no datatype given, there will be set the standard type string"
+ (when json-decoded-list
+ (let ((value nil)
+ (datatype nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :value)
+ (setf value (cdr j-elem)))
+ ((string= (car j-elem) :datatype)
+ (setf datatype (cdr j-elem)))
+ (t
+ (error "json-importer:get-resourceData-values-from-json-list:
+ bad item-specifier found in json-list"))))
+ (unless value
+ (error "json-importer:get-resourceData-values-from-json-list: resourceData must have a value"))
+ (list :value value
+ :datatype (if datatype datatype "http://www.w3.org/2001/XMLSchema#string")))))
+
+
+(defun get-occurrence-values-from-json-list (json-decoded-list)
+ "returns all occurrence values of the passed json-list as
+ a named list"
+ (when json-decoded-list
+ (let ((itemIdentities nil)
+ (type nil)
+ (scopes nil)
+ (resourceRef nil)
+ (resourceData nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :item-Identities)
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :type)
+ (setf type (cdr j-elem)))
+ ((string= (car j-elem) :scopes)
+ (setf scopes (cdr j-elem)))
+ ((string= (car j-elem) :resource-Ref)
+ (setf resourceRef (cdr j-elem)))
+ ((string= (car j-elem) :resource-Data)
+ (setf resourceData (cdr j-elem)))
+ (t
+ (error "json-importer:get-occurrence-values-from-json-list:
+ bad item-specifier found in json-list"))))
+ (when (or (and (not resourceRef)
+ (not resourceData))
+ (and resourceRef resourceData))
+ (error "json-importer:get-occurrence-values-from-json-list: ONE of the elements
+ resourceRef or resourceData must be set"))
+ (unless type
+ (error "json-importer:get-occurrence-values-from-json-list: type must be set"))
+ (let ((resourceData-list (get-resourceData-values-from-json-list resourceData)))
+ (list :itemIdentities itemIdentities
+ :type type
+ :scopes scopes
+ :resourceRef resourceRef
+ :resourceData resourceData-list)))))
+
+
+(defun get-association-values-from-json-list (json-decoded-list)
+ "extracts all values of the passed json-list and
+ returns them as a named list"
+ (when json-decoded-list
+ (let ((itemIdentities nil)
+ (type nil)
+ (scopes nil)
+ (roles nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :item-Identities)
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :type)
+ (setf type (cdr j-elem)))
+ ((string= (car j-elem) :scopes)
+ (setf scopes (cdr j-elem)))
+ ((string= (car j-elem) :roles)
+ (setf roles (cdr j-elem)))
+ (t
+ (error "json-importer:get-association-values-from-json-list:
+ bad item-specifier found in json-list"))))
+ (unless (and type roles)
+ (error "json-importer:get-occurrence-values-from-json-list: type and role must be set"))
+ (let ((roles-list (map 'list #'get-role-values-from-json-list roles)))
+ (list :itemIdentities itemIdentities
+ :type type
+ :scopes scopes
+ :roles roles-list)))))
+
+
+(defun get-role-values-from-json-list (json-decoded-list)
+ "extracts all values of the passed json-list and
+ returns them as a named list"
+ (when json-decoded-list
+ (let ((itemIdentities nil)
+ (type nil)
+ (topicRef nil))
+ (declare (list json-decoded-list))
+ (loop for j-elem in json-decoded-list
+ do (cond
+ ((string= (car j-elem) :item-Identities)
+ (setf itemIdentities (cdr j-elem)))
+ ((string= (car j-elem) :type)
+ (setf type (cdr j-elem)))
+ ((string= (car j-elem) :topic-Ref)
+ (setf topicRef (cdr j-elem)))
+ (t
+ (error "json-importer:get-role-values-from-json-list:
+ bad item-specifier found in json-list"))))
+ (unless (and type topicRef)
+ (error "json-importer:get-occurrence-values-from-json-list: type and topicRef must be set"))
+ (list :itemIdentities itemIdentities
+ :type type
+ :topicRef topicRef))))
+
+
Added: trunk/src/json/json_interface.html
==============================================================================
--- (empty file)
+++ trunk/src/json/json_interface.html Mon Mar 9 18:20:10 2009
@@ -0,0 +1,231 @@
+<html>
+ <head>
+ <title>isidorus</title>
+ <script type="text/javascript">
+ // --- here we can handle timeouts of the passed XMLHttpRequest-objects
+ // --- this function has to be set and cleared in every XMLHttpRequest-object
+ function ajaxTimeout(xhr){
+ xhr.abort();
+ alert("The AJAX request timed out. Did you lose network connectivity for some reason?");
+ }
+
+ // --- the timeout interval in seconds
+ const TIMEOUT = 5000;
+ // --- the XMLHttpRequest base url
+ const BASE_URL = "http://localhost:8000/json/psi/";
+ const OWN_URL = "http://localhost:8000/isidorus";
+
+
+ function back()
+ {
+ window.location.href = OWN_URL;
+ }
+
+
+ // --- creates a XMLHttpReques object
+ function connect()
+ {
+ try { return new XMLHttpRequest(); } catch(err){}
+ try { return new AcitveXObject("Msxml2.XMLHTTP"); } catch(err){}
+ try { return new ActiveXObject("Microsoft.XMLHTTP"); } catch(err){}
+
+ alert("error creating request object");
+ return null;
+ }
+
+
+ // ========================================================================
+ // --- get request -> aks for json-data
+ // ========================================================================
+ var xhrGet = null;
+
+ // --- creates a XMLHttpReques object
+ function connectGet()
+ {
+ // --- firefox
+ try{ return new XMLHttpRequest(); } catch(err){}
+
+ // --- internet explorer
+ try{ return new ActiveXObject("Msxml2.XMLHTTP"); } catch(err){}
+ try{ return new ActiveXObject("Microsoft.XMLHTTP"); } catch(err){}
+
+ alert("error creating request object");
+ return null;
+ }
+
+
+ // --- handles the json response
+ function handleJson()
+ {
+ if(xhrGet.readyState == 4){ // state 4 --> response is complete
+ if(xhrGet.status != 200){
+ alert("error: " + xhrGet.status);
+ return false;
+ }
+
+ // --- resets the timeout
+ clearTimeout(xhrGet.timeout);
+
+ // --- handle the data
+ var json = eval("(" + xhrGet.responseText + ")");
+ var psis = json.topic.subjectIdentifiers;
+ document.getElementById("psis").innerHTML = "";
+ for each(var psi in psis)
+ document.getElementById("psis").innerHTML += "psi: " + psi + '<br/>';
+
+ document.getElementById("real_text").value = xhrGet.responseText;
+ //alert("header: " + xhrGet.getAllResponseHeaders());
+ }
+ else{
+ return false;
+ }
+ }
+
+
+ // --- sends a request for the json data
+ function getData(xhr)
+ {
+ var topic_psi = document.getElementById("topic_psi").value;
+ var url = BASE_URL + topic_psi;
+
+ // --- sets the timeout for this XMLHttpRequest object; 5 seconds
+ xhrGet.timeout = setTimeout("ajaxTimeout(xhrGet);", TIMEOUT);
+
+ try{
+ xhrGet.open("GET", url, true); // true --> asynchronous call, so the user is able to continue working on other things
+ }catch(err) {alert("err: " + err); }
+
+ // --- registers a callback handler for the readystatechange event of the XMLHttpRequest/ActiveXObject-Object
+ xhrGet.onreadystatechange = handleJson;
+ xhrGet.send(null);
+ }
+
+
+ // --- calls all necessary functions to get a fragment belonging to the
+ // --- psi of the topic_psi text field
+ function doIt()
+ {
+ xhrGet = connectGet();
+
+ if(xhrGet != null)
+ getData(xhrGet);
+ }
+
+ // ========================================================================
+ // --- put request -> commit json-data
+ // ========================================================================
+ var xhrPut = null;
+
+ // --- commits the textarea's json data to the server
+ function commitJson()
+ {
+ xhrPut = connect();
+
+ if(xhrPut != null)
+ sendData(xhrPut);
+ }
+
+
+ // --- handles the committing of json data
+ function handleCommit()
+ {
+ alert("readyState: " + xhrPut.readyState + "\nstatus: " + xhrPut.status + "\nresponsetext: " + xhrPut.responseText);
+ if(xhrPut.readyState == 4){ // state 4 --> response is complete
+ //if(xhrPut.status == 200){
+ // alert("error: " + xhrPut.status);
+ // return false;
+ //}
+
+ // --- resets the timeout
+ clearTimeout(xhrPut.timeout);
+ alert("data commited successfully");
+ //doIt();
+ }
+ else{
+ return false;
+ }
+ }
+
+
+ // --- sends the json data to the server
+ function sendData(xhr)
+ {
+ var json = document.getElementById("real_text").value;
+ var topicPsi = document.getElementById("topic_psi").value;
+ var url = BASE_URL + topicPsi;
+ xhrPut.open("PUT", url, true);
+
+ // --- sets the timeout for this XMLHttpRequest object; 5 seconds
+ xhrPut.timeout = setTimeout("ajaxTimeout(xhrPut);", TIMEOUT);
+
+ // --- registers a callback handler for the readystatechange event of the XMLHttpRequest/ActiveXObject-Object
+ xhrPut.onreadystatechange = handleCommit;
+ xhrPut.setRequestHeader("Content-type", "application/json");
+ xhrPut.send(json);
+ }
+
+
+ // ========================================================================
+ // --- post request -> commit json-data
+ // ========================================================================
+ var xhrPost = null;
+
+
+ function commitJsonPost()
+ {
+ xhrPost = connect();
+
+ if(xhrPost != null)
+ sendDataPost(xhrPost);
+ }
+
+
+ function handlePostCommit()
+ {
+ alert("readyState: " + xhrPost.readyState + "\nstatus: " + xhrPost.status + "\nresponsetext: " + xhrPost.responseText);
+ if(xhrPost.readyState == 4){ // state 4 --> response is complete
+ //if(xhrPut.status == 200){
+ // alert("error: " + xhrPut.status);
+ // return false;
+ //}
+
+ // --- resets the timeout
+ clearTimeout(xhrPost.timeout);
+ alert("data commited successfully");
+ //doIt();
+ }
+ else{
+ return false;
+ }
+ }
+
+
+ function sendDataPost(xhr)
+ {
+ var json = document.getElementById("real_text").value;
+ var topicPsi = document.getElementById("topic_psi").value;
+ var url = BASE_URL + topicPsi;
+ xhrPost.open("POST", url, true);
+
+ // --- sets the timeout for this XMLHttpRequest object; 5 seconds
+ xhrPost.timeout = setTimeout("ajaxTimeout(xhrPost);", TIMEOUT);
+
+ // --- registers a callback handler for the readystatechange event of the XMLHttpRequest/ActiveXObject-Object
+ xhrPost.onreadystatechange = handlePostCommit;
+ }
+
+
+ </script>
+ </head>
+ <body>
+ <div id="content" style="width: 80%; height: 80%; border: dashed 1px;">
+ <input id="topic_psi" type="text" value="http://psi.egovpt.org/types/topicInTaxonomy" name="topic_psi" style="margin-left:10px; margin-top:10px;"/>
+ <input type="button" onclick="doIt();" value="get json" style="margin-top:10px;"/>
+ <div id="psis" style="background-color: silver; width: 70%; margin: 10px;"></div>
+ <textarea id ="real_text" name="text" cols="120" rows="10" style="margin: 10px;"></textarea><br/>
+ <input type="button" onclick="commitJson()" value="commit json via PUT" style="margin-left: 10px;"/>
+ <input type="button" onclick="commitJsonPost()" value="commit json via POST" style="margin-left: 10px; margin-right: 10px;"/>
+ <input type="button" onclick="back()" value="back"/>
+ </div>
+ </body>
+</html>
Modified: trunk/src/model/changes.lisp
==============================================================================
--- trunk/src/model/changes.lisp (original)
+++ trunk/src/model/changes.lisp Mon Mar 9 18:20:10 2009
@@ -50,7 +50,12 @@
(append
(themes characteristic)
(when (instance-of-p characteristic)
- (list (instance-of characteristic)))))
+ (list (instance-of characteristic)))
+ (when (and (typep characteristic 'OccurrenceC)
+ (> (length (charvalue characteristic)) 0)
+ (eq #\# (elt (charvalue characteristic) 0)))
+ (list (get-item-by-id (subseq (charvalue characteristic) 1))))))
+
(defmethod find-referenced-topics ((role RoleC))
(append
@@ -140,6 +145,7 @@
(topic :type TopicC
:initarg :topic
:accessor topic
+ :index t
:documentation "changed topic (topicSI in Atom")
(referenced-topics
:type list
@@ -252,4 +258,23 @@
(mapc (lambda (occ) (add-source-locator occ :revision revision :source-locator source-locator))
(occurrences top))
(mapc (lambda (ass) (add-source-locator ass :revision revision :source-locator source-locator))
- (find-associations-for-topic top)))
\ No newline at end of file
+ (find-associations-for-topic top)))
+
+
+(defun get-latest-fragment-of-topic (topic-psi)
+ "returns the latest fragment of the passed topic-psi"
+ (declare (string topic-psi))
+ (let ((topic-psi topic-psi))
+ (let ((psi
+ (elephant:get-instance-by-value 'PersistentIdC 'uri topic-psi)))
+ (when psi
+ (let ((topic
+ (identified-construct psi)))
+ (when topic
+ (loop for current-revision in (versions topic)
+ do (get-fragments (start-revision current-revision)))
+ (let ((fragments
+ (elephant:get-instances-by-value 'FragmentC 'topic topic)))
+ ;; maybe there are more fragments of this topic in different revisions,
+ ;; so we need to search the fragment with a certain revision
+ (first (sort fragments #'> :key 'revision)))))))))
\ No newline at end of file
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Mon Mar 9 18:20:10 2009
@@ -28,6 +28,7 @@
:VariantC
;; functions and slot accessors
+ :in-topicmaps
:add-to-topicmap
:add-source-locator
:associations
@@ -89,6 +90,7 @@
:used-as-theme
:variants
:xor
+ :get-latest-fragment-of-topic
:*current-xtm* ;; special variables
:*TM-REVISION*
@@ -948,9 +950,9 @@
(:method ((topic TopicC) &key (revision *TM-REVISION*))
(filter-slot-value-by-revision topic 'used-as-theme :start-revision revision)))
-(defgeneric in-topicmaps (topic)
- (:method ((topic TopicC))
- (filter-slot-value-by-revision topic 'in-topicmaps :start-revision *TM-REVISION*)))
+(defgeneric in-topicmaps (topic &key revision)
+ (:method ((topic TopicC) &key (revision *TM-REVISION*))
+ (filter-slot-value-by-revision topic 'in-topicmaps :start-revision revision)))
(defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil))
"implement the pseudo-initargs :topic-ids, :persistent-ids, and :subject-locators"
@@ -1313,6 +1315,10 @@
(:index t))
+(defmethod in-topicmaps ((association AssociationC) &key (revision *TM-REVISION*))
+ (filter-slot-value-by-revision association 'in-topicmaps :start-revision revision))
+
+
(defgeneric AssociationC-p (object)
(:documentation "test if object is a of type AssociationC")
(:method ((object t)) nil)
@@ -1439,11 +1445,13 @@
(defmethod add-to-topicmap ((tm TopicMapC) (top TopicC))
;TODO: add logic not to add pure topic stubs unless they don't exist yet in the store
- (elephant:add-association tm 'topics top)
+; (elephant:add-association tm 'topics top) ;by adding the elephant association in this order, there will be missing one site of this association
+ (elephant:add-association top 'in-topicmaps tm)
top)
(defmethod add-to-topicmap ((tm TopicMapC) (ass AssociationC))
- (elephant:add-association tm 'associations ass)
+ ;(elephant:add-association tm 'associations ass)
+ (elephant:add-association ass 'in-topicmaps tm)
ass)
(defgeneric in-topicmap (tm constr &key revision)
Modified: trunk/src/rest_interface/rest-interface.lisp
==============================================================================
--- trunk/src/rest_interface/rest-interface.lisp (original)
+++ trunk/src/rest_interface/rest-interface.lisp Mon Mar 9 18:20:10 2009
@@ -6,14 +6,20 @@
:datamodel
:exporter
:xml-tools
- :xml-importer)
+ :xml-importer
+ :json-exporter
+ :json-importer)
(:export :import-fragments-feed
:import-snapshots-feed
:import-tm-feed
:read-url
:read-fragment-feed
:start-tm-engine
- :shutdown-tm-engine))
+ :shutdown-tm-engine
+ :*json-rest-prefix*
+ :*json-user-interface-url*
+ :*json-user-interface-file-path*))
+
(in-package :rest-interface)
@@ -63,17 +69,36 @@
;; (exporter:export-xtm-fragment fragment :xtm-format '1.0)
;; (format nil "<t:topicMap xmlns:t=\"http://www.topicmaps.org/xtm/1.0/\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"/>"))))
-(defun make-json (&optional uri)
- "returns a json-string of the topic with the passed psi-uri"
- (assert uri)
- (let ((topic
- (let ((psi
- (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri uri)))
- (when psi
- (d:identified-construct psi)))))
- (if topic
- (json-exporter:to-json-string topic)
- (format nil "Could not find topic with psi \"~a\"" uri))))
+
+;;(defun make-json (&optional uri)
+;; "returns a json-string of the topic with the passed psi-uri"
+;; (assert uri)
+;; ;decodes the url-encoding "%23" to "#" character (only the first which will be found)
+;; (let ((identifier (let ((pos (search "%23" uri)))
+;; (if pos
+;; (let ((str-1 (subseq uri 0 pos))
+;; (str-2 (if (> (length uri) (+ pos 3))
+;; (subseq uri (+ pos 3))
+;; "")))
+;; (concatenate 'string str-1 "#" str-2))
+;; uri)))
+;; (http-method (request-method))
+;; (external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) ;;is needed to get a string of the put-request
+;; (if (eq http-method :GET)
+;; (progn
+;; (setf (hunchentoot:content-type) "application/json")
+;; (let ((fragment
+;; (get-latest-fragment-of-topic identifier)))
+;; (if fragment
+;; (handler-case (to-json-string fragment)
+;; (condition (err) (format nil "{\"fault\":\"~a\"}" err)))
+;; "{}")))
+;; (if (eq http-method :PUT)
+;; (let ((put-data (raw-post-data :external-format external-format :force-text t)))
+;; (handler-case (json-importer:json-to-elem put-data)
+;; (condition () (setf (return-code) +http-internal-server-error+))))
+;; (setf (return-code) +http-internal-server-error+))))) ; for all htt-methods except for get and post
+
;; (push
;; (create-regex-dispatcher "/feeds/?$" #'feeds)
@@ -99,9 +124,9 @@
;; (create-regex-dispatcher "/testtm/fragments/([0-9]+)$" #'fragments)
;; hunchentoot:*dispatch-table*)
-(push
- (create-regex-dispatcher "/json/psi/(.+)$" #'make-json)
- hunchentoot:*dispatch-table*)
+;;(push
+;; (create-regex-dispatcher "/json/psi/(.+)$" #'make-json)
+;; hunchentoot:*dispatch-table*)
(defvar *server*)
@@ -118,6 +143,7 @@
(xml-importer:get-store-spec repository-path))
(load conffile)
(publish-feed atom:*tm-feed*)
+ (set-up-json-interface)
(setf *server* (hunchentoot:start-server :address host-name :port port)))
(defun shutdown-tm-engine ()
Added: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- (empty file)
+++ trunk/src/rest_interface/set-up-json-interface.lisp Mon Mar 9 18:20:10 2009
@@ -0,0 +1,112 @@
+(in-package :rest-interface)
+
+(defparameter *json-rest-prefix* "/json/psi")
+(defparameter *json-user-interface-url* "/isidorus")
+(defparameter *json-user-interface-file-path* "json/json_interface.html")
+
+(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (ui-url *json-user-interface-url*) (ui-file-path *json-user-interface-file-path*))
+ "registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
+ and also registers a file-hanlder to the html-user-interface"
+ (declare (string rest-prefix ui-url ui-file-path))
+ (let ((rest-regex (concatenate 'string rest-prefix "/(.+)$"))
+ (ui-regex (concatenate 'string ui-url "/?$")))
+ ;(format t "rest-interface: ~a~%user-interface: ~a~%user-interface-file-path: ~a~%" rest-regex ui-regex ui-file-path)
+ (push
+ (create-regex-dispatcher ui-regex #'(lambda()
+ (hunchentoot:handle-static-file ui-file-path)))
+ hunchentoot:*dispatch-table*)
+ (push
+ (create-regex-dispatcher rest-regex
+ #'(lambda (&optional uri)
+ (assert uri)
+ ;decodes the url-encoding "%23" to "#" character (only the first which will be found)
+ (let ((identifier (let ((pos (search "%23" uri)))
+ (if pos
+ (let ((str-1 (subseq uri 0 pos))
+ (str-2 (if (> (length uri) (+ pos 3))
+ (subseq uri (+ pos 3))
+ "")))
+ (concatenate 'string str-1 "#" str-2))
+ uri)))
+ (http-method (request-method))
+ (external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) ;is needed to get a string of the put-request
+ (with-open-file (stream "/home/lukas/Desktop/tmp2.txt" :direction :output :if-exists :supersede)
+ (format stream "http-method: ~a~%" http-method))
+ (cond
+ ((eq http-method :GET)
+ (progn
+ (setf (hunchentoot:content-type) "application/json") ;RFC 4627
+ (let ((fragment
+ (get-latest-fragment-of-topic identifier)))
+ (if fragment
+ (handler-case (to-json-string fragment)
+ (condition (err) (progn
+ (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+ (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))
+ "{}"))))
+ ((eq http-method :PUT)
+ (let ((put-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+ (handler-case (progn
+ (json-importer:json-to-elem put-data)
+ (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+ (setf (hunchentoot:content-type) "text")
+ (format nil "~a" hunchentoot:+http-ok+))
+ (condition (err) (progn
+ (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+ (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
+ ((eq http-method :POST)
+ (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+ (with-open-file (stream "/home/lukas/Desktop/tmp.txt" :direction :output :if-exists :supersede)
+ (format stream "post-data: ~a~%" post-data))
+ (handler-case (progn
+ (json-importer:json-to-elem post-data)
+ (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+ (setf (hunchentoot:content-type) "text")
+ (format nil "~a" hunchentoot:+http-ok+))
+ (condition (err) (progn
+ (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+ (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))))
+ (t
+ (progn ;for all htt-methods except for get and post
+ (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+ (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method)))))))
+ hunchentoot:*dispatch-table*)))
+
+
+
+;
+; (if (eq http-method :GET)
+; (progn
+; (setf (hunchentoot:content-type) "application/json") ;RFC 4627
+; (let ((fragment
+; (get-latest-fragment-of-topic identifier)))
+; (if fragment
+; (handler-case (to-json-string fragment)
+; (condition (err) (progn
+; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))
+; "{}")))
+; (if (eq http-method :PUT)
+; (let ((put-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+; (handler-case (progn
+; (json-importer:json-to-elem put-data)
+; (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+; (setf (hunchentoot:content-type) "text")
+; (format nil "~a" hunchentoot:+http-ok+))
+; (condition (err) (progn
+; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))
+; (if (eq http-method :POST)
+; (let ((post-data (hunchentoot:post-parameter "json-data")))
+; (handler-case (progn
+; (json-importer:json-to-elem post-data)
+; (setf (hunchentoot:return-code) hunchentoot:+http-ok+)
+; (setf (hunchentoot:content-type) "text")
+; (format nil "~a" hunchentoot:+http-ok+))
+; (condition (err) (progn
+; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))
+; (progn ;for all htt-methods except for get and post
+; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+)
+; (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method))))))))
+; hunchentoot:*dispatch-table*)))
\ No newline at end of file
Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp (original)
+++ trunk/src/unit_tests/json_test.lisp Mon Mar 9 18:20:10 2009
@@ -3,13 +3,18 @@
:common-lisp
:xml-importer
:json-exporter
+ :json-importer
:datamodel
:it.bese.FiveAM
:unittests-constants
:fixtures)
(:export :test-to-json-string-topics
:test-to-json-string-associations
- :run-json-tests))
+ :test-to-json-string-fragments
+ :test-get-fragment-values-from-json-list
+ :run-json-tests
+ :test-json-importer
+ :test-json-importer-merge))
(in-package :json-test)
@@ -26,7 +31,8 @@
((dir "data_base"))
(with-fixture initialize-destination-db (dir)
(xml-importer:setup-repository
- *notificationbase.xtm* dir :xtm-id *TEST-TM*)
+ *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+ :xtm-id *TEST-TM*)
(elephant:open-store (xml-importer:get-store-spec dir))
(let ((t50a (get-item-by-id "t50a")))
@@ -56,12 +62,14 @@
(is (string= t100-string json-string))))))))
+
(test test-to-json-string-associations
(let
((dir "data_base"))
(with-fixture initialize-destination-db (dir)
(xml-importer:setup-repository
- *notificationbase.xtm* dir :xtm-id *TEST-TM*)
+ *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+ :xtm-id *TEST-TM*)
(elephant:open-store (xml-importer:get-store-spec dir))
(let ((t57 (get-item-by-id "t57"))
@@ -102,6 +110,826 @@
(is (string= association-7-string json-string))))))))
+
+(test test-to-json-string-fragments
+ (let
+ ((dir "data_base"))
+ (with-fixture initialize-destination-db (dir)
+ (xml-importer:setup-repository
+ *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+ :xtm-id *TEST-TM*)
+
+ (elephant:open-store (xml-importer:get-store-spec dir))
+ (let ((frag-t100
+ (get-latest-fragment-of-topic
+ "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata"))
+ (frag-topic
+ (get-latest-fragment-of-topic "http://www.topicmaps.org/xtm/1.0/core.xtm#topic")))
+ (let ((frag-t100-string
+ (concatenate 'string "{\"topic\":{\"id\":\"" (d:topicid (d:topic frag-t100)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"" (topicid (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tm-ids\":[\"http://www.isidor.us/unittests/testtm\"]}"))
+ (frag-topic-string
+ (concatenate 'string "{\"topic\":{\"id\":\"" (topicid (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tm-ids\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm\"]}")))
+ (is (string= frag-t100-string (to-json-string frag-t100)))
+ (is (string= frag-topic-string (to-json-string frag-topic))))))))
+
+
+
+(test test-get-fragment-values-from-json-list
+ (let
+ ((dir "data_base"))
+ (with-fixture initialize-destination-db (dir)
+ (xml-importer:setup-repository
+ *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm"
+ :xtm-id *TEST-TM*)
+
+ (elephant:open-store (xml-importer:get-store-spec dir))
+ (let ((json-fragment
+ (let ((fragment-obj
+ (get-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002")))
+ (to-json-string fragment-obj))))
+ (let ((fragment-list
+ (json-importer::get-fragment-values-from-json-list
+ (json:decode-json-from-string json-fragment))))
+ (let ((topic (getf fragment-list :topic))
+ (topicStubs (getf fragment-list :topicStubs))
+ (f-associations (getf fragment-list :associations)))
+ (is (string= (getf topic :ID)
+ (d:topicid
+ (d:identified-construct (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+ "http://psi.egovpt.org/standard/Topic+Maps+2002")))))
+ (is-false (getf topic :itemIdentities))
+ (is-false (getf topic :subjectLocators))
+ (is (= (length (getf topic :subjectIdentifiers)) 1))
+ (is (string= (first (getf topic :subjectIdentifiers))
+ "http://psi.egovpt.org/standard/Topic+Maps+2002"))
+ (is (= (length (getf topic :instanceOfs)) 1))
+ (is (= (length (first (getf topic :instanceOfs))) 1))
+ (is (string= (first (first (getf topic :instanceOfs)))
+ "http://psi.egovpt.org/types/semanticstandard"))
+ (is (= (length (getf topic :names)) 2))
+ (let ((name-1 (first (getf topic :names)))
+ (name-2 (second (getf topic :names))))
+ (is-false (getf name-1 :itemIdentities))
+ (is-false (getf name-1 :type))
+ (is-false (getf name-1 :scopes))
+ (is (string= (getf name-1 :value)
+ "Topic Maps 2002"))
+ (is-false (getf name-1 :variants))
+ (is (= (length (getf name-2 :itemIdentities)) 1))
+ (is (string= (first (getf name-2 :itemIdentities))
+ "http://psi.egovpt.org/itemIdentifiers#t101_n2"))
+ (is (= (length (getf name-2 :type)) 1))
+ (is (string= (first (getf name-2 :type))
+ "http://psi.egovpt.org/types/long-name"))
+ (is (= (length (getf name-2 :scopes)) 1))
+ (is (= (length (first (getf name-2 :scopes))) 1))
+ (is (string= (first (first (getf name-2 :scopes)))
+ "http://psi.egovpt.org/types/long-name"))
+ (is (string= (getf name-2 :value)
+ "ISO/IEC 13250:2002: Topic Maps"))
+ (is (= (length (getf name-2 :variants)) 1))
+ (let ((variant (first (getf name-2 :variants))))
+ (is (= (length (getf variant :itemIdentities)) 2))
+ (is (or (string= (first (getf variant :itemIdentities))
+ "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
+ (string= (first (getf variant :itemIdentities))
+ "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
+ (is (or (string= (second (getf variant :itemIdentities))
+ "http://psi.egovpt.org/itemIdentifiers#t101_n2_v1")
+ (string= (second (getf variant :itemIdentities))
+ "http://psi.egovpt.org/itemIdentifiers#t101_n2_v2")))
+ (is (= (length (getf variant :scopes)) 2))
+ (is (= (length (first (getf variant :scopes))) 1))
+ (is (= (length (second (getf variant :scopes))) 1))
+ (is (or (string= (first (first (getf variant :scopes)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+ (string= (first (first (getf variant :scopes)))
+ "http://psi.egovpt.org/types/long-name")))
+ (is (or (string= (first (second (getf variant :scopes)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+ (string= (first (second (getf variant :scopes)))
+ "http://psi.egovpt.org/types/long-name")))
+ (is-false (getf variant :resourceRef))
+ (is (string= (getf (getf variant :resourceData) :datatype)
+ "http://www.w3.org/2001/XMLSchema#string"))
+ (is (string= (getf (getf variant :resourceData) :value)
+ "ISO/IEC-13250:2002"))
+ (is (= (length (getf topic :occurrences)) 4))))
+ (let ((occurrence-1 (first (getf topic :occurrences)))
+ (occurrence-2 (second (getf topic :occurrences)))
+ (occurrence-3 (third (getf topic :occurrences)))
+ (occurrence-4 (fourth (getf topic :occurrences)))
+ (ref-topic
+ (d:identified-construct
+ (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+ "http://psi.egovpt.org/status/InternationalStandard"))))
+ (is-false (getf occurrence-1 :itemIdentities))
+ (is (= (length (getf occurrence-1 :type)) 1))
+ (is (string= (first (getf occurrence-1 :type))
+ "http://psi.egovpt.org/types/standardHasStatus"))
+ (is-false (getf occurrence-1 :scopes))
+ (is (string= (getf occurrence-1 :resourceRef)
+ (concatenate 'string "#" (d:topicid ref-topic))))
+ (is-false (getf occurrence-1 :resourceData))
+ (is-false (getf occurrence-2 :itemIdentities))
+ (is (= (length (getf occurrence-2 :type)) 1))
+ (is (string= (first (getf occurrence-2 :type))
+ "http://psi.egovpt.org/types/description"))
+ (is-false (getf occurrence-2 :scopes))
+ (is-false (getf occurrence-2 :resourceRef))
+ (is (string= (getf (getf occurrence-2 :resourceData) :datatype)
+ "http://www.w3.org/2001/XMLSchema#string"))
+ (is-true (getf (getf occurrence-2 :resourceData) :value))
+ (is-false (getf occurrence-3 :itemIdentities))
+ (is (= (length (getf occurrence-3 :type)) 1))
+ (is (string= (first (getf occurrence-3 :type))
+ "http://psi.egovpt.org/types/standardValidFromDate"))
+ (is-false (getf occurrence-3 :scopes))
+ (is-false (getf occurrence-3 :resourceRef))
+ (is (string= (getf (getf occurrence-3 :resourceData) :datatype)
+ "//www.w3.org/2001/XMLSchema#date"))
+ (is (string= (getf (getf occurrence-3 :resourceData) :value)
+ "2002-05-19"))
+ (is-false (getf occurrence-4 :itemIdentities))
+ (is (= (length (getf occurrence-4 :type)) 1))
+ (is (string= (first (getf occurrence-4 :type))
+ "http://psi.egovpt.org/types/links"))
+ (is-false (getf occurrence-4 :scopes))
+ (is (string= (getf occurrence-4 :resourceRef)
+ "http://www1.y12.doe.gov/capabilities/sgml/sc34/document/0322_files/iso13250-2nd-ed-v2.pdf"))
+ (is-false (getf occurrence-4 :resourceData)))
+ (is (= (length topicStubs) 15))
+ (loop for topicStub in topicStubs
+ do (let ((id (getf topicStub :ID))
+ (itemIdentities (getf topicStub :itemIdentities))
+ (subjectLocators (getf topicStub :subjectLocators))
+ (subjectIdentifiers (getf topicStub :subjectIdentifiers)))
+ (is (= (length subjectIdentifiers) 1))
+ (let ((subjectIdentifier
+ (first subjectIdentifiers)))
+ (let ((topic
+ (d:identified-construct
+ (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri
+ subjectIdentifier))))
+ (is-true topic)
+ (is-false subjectLocators)
+ (is (string= (d:topicid topic) id))
+ (cond
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/semanticstandard")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t3a")))
+ ((string= subjectIdentifier "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+ (is-false itemIdentities))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/long-name")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t50a")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/standardHasStatus")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t51")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/description")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t53")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/standardValidFromDate")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t54")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/links")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t55")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/standardIsAboutSubject")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t60")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/SubjectRoleType")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t61")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/subject/Semantic+Description")
+ (is-false itemIdentities))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/serviceUsesStandard")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t64")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/ServiceRoleType")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t63")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/service/Norwegian+National+Curriculum")
+ (is-false itemIdentities))
+ ((string= subjectIdentifier "http://psi.egovpt.org/types/StandardRoleType")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t62")))
+ ((string= subjectIdentifier "http://psi.egovpt.org/status/InternationalStandard")
+ (is (= (length itemIdentities) 1))
+ (is (string= (first itemIdentities)
+ "http://psi.egovpt.org/itemIdentifiers#t52")))
+ (t
+ (is-true (format t "bad subjectIdentifier found in topicStubs"))))))))
+ (is (= (length f-associations) 2))
+ (is (= (length (getf (first f-associations) :type)) 1))
+ (is (= (length (getf (second f-associations) :type)) 1))
+ (let ((association-1
+ (if (string= (first (getf (first f-associations) :type))
+ "http://psi.egovpt.org/types/standardIsAboutSubject")
+ (first f-associations)
+ (second f-associations)))
+ (association-2
+ (if (string= (first (getf (first f-associations) :type))
+ "http://psi.egovpt.org/types/serviceUsesStandard")
+ (first f-associations)
+ (second f-associations))))
+ (is-true association-1)
+ (is-true association-2)
+ (is-false (getf association-1 :itemIdentities))
+ (is-false (getf association-1 :scopes))
+ (is (= (length (getf association-1 :roles)) 2))
+ (let ((role-1 (first (getf association-1 :roles)))
+ (role-2 (second (getf association-1 :roles))))
+ (is-false (getf role-1 :itemIdentities))
+ (is (= (length (getf role-1 :type))))
+ (is (string= (first (getf role-1 :type))
+ "http://psi.egovpt.org/types/StandardRoleType"))
+ (is (= (length (getf role-1 :topicRef)) 1))
+ (is (string= (first (getf role-1 :topicRef))
+ "http://psi.egovpt.org/standard/Topic+Maps+2002"))
+ (is-false (getf role-2 :itemIdentities))
+ (is (= (length (getf role-2 :itemIdentities))))
+ (is (string= (first (getf role-2 :type))
+ "http://psi.egovpt.org/types/SubjectRoleType"))
+ (is (= (length (getf role-2 :topicRef)) 1))
+ (is (string= (first (getf role-2 :topicRef))
+ "http://psi.egovpt.org/subject/Semantic+Description")))
+ (is-false (getf association-2 :itemIdentities))
+ (is-false (getf association-2 :scopes))
+ (is (= (length (getf association-2 :roles)) 2))
+ (let ((role-1 (first (getf association-2 :roles)))
+ (role-2 (second (getf association-2 :roles))))
+ (is-false (getf role-1 :itemIdentities))
+ (is (= (length (getf role-1 :type))))
+ (is (string= (first (getf role-1 :type))
+ "http://psi.egovpt.org/types/ServiceRoleType"))
+ (is (= (length (getf role-1 :topicRef)) 1))
+ (is (string= (first (getf role-1 :topicRef))
+ "http://psi.egovpt.org/service/Norwegian+National+Curriculum"))
+ (is-false (getf role-2 :itemIdentities))
+ (is (= (length (getf role-2 :itemIdentities))))
+ (is (string= (first (getf role-2 :type))
+ "http://psi.egovpt.org/types/StandardRoleType"))
+ (is (= (length (getf role-2 :topicRef)) 1))
+ (is (string= (first (getf role-2 :topicRef))
+ "http://psi.egovpt.org/standard/Topic+Maps+2002"))))))))))
+
+
+(test test-json-importer
+ (let
+ ((dir "data_base"))
+ (with-fixture initialize-destination-db (dir)
+ (elephant:open-store (xml-importer:get-store-spec dir))
+ (xml-importer:init-isidorus)
+ (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+
+ (let ((json-fragment-t64
+ "{\"topic\":{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"instanceOfs\":[[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"service uses standard\",\"variants\":null}],\"occurrences\":null},\"topicStubs\":[{\"id\":\"t260\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t7\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.networkedplanet.com/psi/npcl/meta-types/association-type\"]}],\"associations\":null,\"tm-ids\":[\"http://www.isidor.us/unittests/testtm\"]}")
+ (json-fragment-t100
+ "{\"topic\":{\"id\":\"t404\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http://www.budabe.de/\",\"resourceData\":null},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o3\"],\"type\":[\"http://psi.egovpt.org/types/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t100_o4\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.editeur.org/standards/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t228\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/semanticstandard\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t292\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardHasStatus\"]},{\"id\":\"t308\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/description\"]},{\"id\":\"t316\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardValidFromDate\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]},{\"id\":\"t434\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/GeoData\"]},{\"id\":\"t364\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"]},{\"id\":\"t372\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/SubjectRoleType\"]},{\"id\":\"t422\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]},{\"id\":\"t396\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"]},{\"id\":\"t388\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/ServiceRoleType\"]},{\"id\":\"t452\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"id\":\"t380\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/SubjectRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/subject/Semantic+Description\"]}]},{\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#assoc_7\"],\"type\":[\"http://psi.egovpt.org/types/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/ServiceRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/service/Google+Maps\",\"http://maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http://psi.egovpt.org/types/StandardRoleType\"],\"topicRef\":[\"http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tm-ids\":[\"http://www.isidor.us/unittests/testtm\"]}"))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
+ (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
+ (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
+ (json-importer:json-to-elem json-fragment-t64)
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 15))
+ (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+ (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+ (let ((core-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")
+ return tm))
+ (test-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.isidor.us/unittests/testtm")
+ return tm)))
+ (is-true (and core-tm test-tm))
+ (is (= (length (topics core-tm)) 13))
+ (is (= (length (associations core-tm)) 0))
+ (is (= (length (topics test-tm)) 2))
+ (is (= (length (associations test-tm)) 1))
+ (let ((main-topic
+ (loop for topic in (topics test-tm)
+ when (string= (uri (first (psis topic)))
+ "http://psi.egovpt.org/types/serviceUsesStandard")
+ return topic))
+ (sub-topic
+ (loop for topic in (topics test-tm)
+ when (string= (uri (first (psis topic)))
+ "http://www.networkedplanet.com/psi/npcl/meta-types/association-type")
+ return topic)))
+ (is-true (and main-topic sub-topic))
+ (let ((instanceOf-assoc
+ (first (associations test-tm))))
+ (is (string= (uri (first (psis (instance-of instanceOf-assoc))))
+ constants::*type-instance-psi*))
+ (is-false (d:themes instanceOf-assoc))
+ (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
+ "http://www.isidor.us/unittests/testtm"))
+ (is-false (d:item-identifiers instanceOf-assoc))
+ (let ((super-type-role
+ (loop for role in (roles instanceOf-assoc)
+ when (string= (uri (first (psis (instance-of role))))
+ constants:*type-psi*)
+ return role))
+ (sub-type-role
+ (loop for role in (roles instanceOf-assoc)
+ when (string= (uri (first (psis (instance-of role))))
+ constants:*instance-psi*)
+ return role)))
+ (is-true (and super-type-role sub-type-role))
+ (is (string= (uri (first (psis (player super-type-role))))
+ "http://www.networkedplanet.com/psi/npcl/meta-types/association-type"))
+ (is (string= (uri (first (psis (player sub-type-role))))
+ "http://psi.egovpt.org/types/serviceUsesStandard"))))
+ (is-true (= (length (item-identifiers main-topic)) 1))
+ (is-true (= (length (item-identifiers sub-topic)) 1))
+ (is-true (string= (uri (first (item-identifiers main-topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t64"))
+ (is-true (string= (uri (first (item-identifiers sub-topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t7"))
+ (is-true (= (length (names main-topic)) 1))
+ (is-true (string= (charvalue (first (names main-topic)))
+ "service uses standard"))))
+ (json-importer:json-to-elem json-fragment-t100)
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 28)) ;13 new topics
+ (is (= (length (elephant:get-instances-by-class 'AssociationC)) 5)) ;4 new associations
+ (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+ (let ((core-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")
+ return tm))
+ (test-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.isidor.us/unittests/testtm")
+ return tm)))
+ (is-true (and core-tm test-tm))
+ (is (= (length (topics core-tm)) 13))
+ (is (= (length (associations core-tm)) 0))
+ (is (= (length (topics test-tm)) 17))
+ (is (= (length (associations test-tm)) 5))
+ (let ((topics (elephant:get-instances-by-class 'TopicC)))
+ (loop for topic in topics
+ do (let ((psi (uri (first (psis topic)))))
+ (cond
+ ((string= psi "http://psi.egovpt.org/types/semanticstandard") ;t3a
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t3a")))
+ ((string= psi "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t7")))
+ ((string= psi "http://psi.egovpt.org/types/standardHasStatus") ;t51
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t51")))
+ ((string= psi "http://psi.egovpt.org/types/description") ;t53
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t53")))
+ ((string= psi "http://psi.egovpt.org/types/standardValidFromDate") ;t54
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t54")))
+ ((string= psi "http://psi.egovpt.org/types/links") ;t55
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t55")))
+ ((string= psi "http://psi.egovpt.org/types/standardIsAboutSubject") ;t60
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t60")))
+ ((string= psi "http://psi.egovpt.org/types/SubjectRoleType") ;t61
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t61")))
+ ((string= psi "http://psi.egovpt.org/types/StandardRoleType") ;t62
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t62")))
+ ((string= psi "http://psi.egovpt.org/types/ServiceRoleType") ;t63
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t63")))
+ ((string= psi "http://psi.egovpt.org/types/serviceUsesStandard") ;t64
+ (is (= (length (names topic)) 1))
+ (is (string= (charvalue (first (names topic)))
+ "service uses standard"))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t64")))
+ ((string= psi "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata") ;t100
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t100"))
+ (is (= (length (names topic)) 1))
+ (is (string= (charvalue (first (names topic)))
+ "ISO 19115"))
+ (is (= (length (item-identifiers (first (names topic))))))
+ (is (string= (uri (first (item-identifiers (first (names topic)))))
+ "http://psi.egovpt.org/itemIdentifiers#t100_n1"))
+ (is (= (length (variants (first (names topic)))) 2))
+ (let ((variant-1 (first (variants (first (names topic)))))
+ (variant-2 (second (variants (first (names topic))))))
+ (is (= (length (item-identifiers variant-1)) 1))
+ (is (string= (uri (first (item-identifiers variant-1)))
+ "http://psi.egovpt.org/itemIdentifiers#t100_n1_v1"))
+ (is (= (length (item-identifiers variant-2)) 1))
+ (is (string= (uri (first (item-identifiers variant-2)))
+ "http://psi.egovpt.org/itemIdentifiers#t100_n1_v2"))
+ (is (= (length (themes variant-1)) 1))
+ (is (string= (uri (first (psis (first (themes variant-1)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+ (is (= (length (themes variant-2)) 1))
+ (is (string= (uri (first (psis (first (themes variant-2)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))
+ (is (string= (charvalue variant-1)
+ "Geographic Information - Metadata"))
+ (is (string= (datatype variant-1)
+ "http://www.w3.org/2001/XMLSchema#string"))
+ (is (string= (charvalue variant-2)
+ "ISO-19115"))
+ (is (string= (datatype variant-2)
+ "http://www.w3.org/2001/XMLSchema#string")))
+ (is (= (length (occurrences topic)) 4))
+ (let ((occ-1 (first (occurrences topic)))
+ (occ-2 (second (occurrences topic)))
+ (occ-3 (third (occurrences topic)))
+ (occ-4 (fourth (occurrences topic))))
+ (is (= (length (item-identifiers occ-1)) 1))
+ (is (string= (uri (first (item-identifiers occ-1)))
+ "http://psi.egovpt.org/itemIdentifiers#t100_o1"))
+ (is (= (length (item-identifiers occ-2)) 1))
+ (is (string= (uri (first (item-identifiers occ-2)))
+ "http://psi.egovpt.org/itemIdentifiers#t100_o2"))
+ (is (= (length (item-identifiers occ-3)) 1))
+ (is (string= (uri (first (item-identifiers occ-3)))
+ "http://psi.egovpt.org/itemIdentifiers#t100_o3"))
+ (is (= (length (item-identifiers occ-4)) 1))
+ (is (string= (uri (first (item-identifiers occ-4)))
+ "http://psi.egovpt.org/itemIdentifiers#t100_o4"))
+ (is (string= (uri (first (psis (instance-of occ-1))))
+ "http://psi.egovpt.org/types/standardHasStatus"))
+ (is (string= (uri (first (psis (instance-of occ-2))))
+ "http://psi.egovpt.org/types/description"))
+ (is (string= (uri (first (psis (instance-of occ-3))))
+ "http://psi.egovpt.org/types/standardValidFromDate"))
+ (is (string= (uri (first (psis (instance-of occ-4))))
+ "http://psi.egovpt.org/types/links"))
+ (is (string= (datatype occ-1)
+ "http://www.w3.org/2001/XMLSchema#anyURI"))
+ (is (string= (charvalue occ-1)
+ "http://www.budabe.de/"))
+ (is (string= (datatype occ-2)
+ "http://www.w3.org/2001/XMLSchema#string"))
+ (is (string= (charvalue occ-2)
+ "The ISO 19115 standard ..."))
+ (is (string= (datatype occ-3)
+ "http://www.w3.org/2001/XMLSchema#date"))
+ (is (string= (charvalue occ-3)
+ "2003-01-01"))
+ (is (string= (datatype occ-4)
+ "http://www.w3.org/2001/XMLSchema#anyURI"))
+ (is (string= (charvalue occ-4)
+ "http://www.editeur.org/standards/ISO19115.pdf"))))
+ ((string= psi "http://psi.egovpt.org/subject/Semantic+Description") ;t201
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is-false (item-identifiers topic)))
+ ((string= psi "http://psi.egovpt.org/subject/GeoData") ;t203
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is-false (item-identifiers topic)))
+ ((or (string= psi "http://psi.egovpt.org/service/Google+Maps") ;t301a
+ (string= psi "http://maps.google.com"))
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 2))
+ (is (or (string= (uri (first (psis topic)))
+ "http://psi.egovpt.org/service/Google+Maps")
+ (string= (uri (first (psis topic)))
+ "http://maps.google.com")))
+ (is (or (string= (uri (second (psis topic)))
+ "http://psi.egovpt.org/service/Google+Maps")
+ (string= (uri (second (psis topic)))
+ "http://maps.google.com")))
+ (is-false (item-identifiers topic)))
+ (t
+ (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+ (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+ (progn
+ (is (= (length (in-topicmaps topic)) 2))
+ (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")
+ (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")))
+ (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm")
+ (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm"))))
+ (progn
+ (is (= (length (in-topicmaps topic)) 1))
+ (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")))))))));
+ (let ((assoc-7
+ (identified-construct
+ (elephant:get-instance-by-value 'ItemidentifierC 'uri
+ "http://psi.egovpt.org/itemIdentifiers#assoc_7"))))
+ (is (= (length (item-identifiers assoc-7))))
+ (is (string= (uri (first (item-identifiers assoc-7)))
+ "http://psi.egovpt.org/itemIdentifiers#assoc_7"))
+ (is (= (length (roles assoc-7)) 2))
+ (is (string= (uri (first (psis (instance-of assoc-7))))
+ "http://psi.egovpt.org/types/serviceUsesStandard"))
+ (let ((role-1 (first (roles assoc-7)))
+ (role-2 (second (roles assoc-7))))
+ (is (string= (uri (first (psis (instance-of role-1))))
+ "http://psi.egovpt.org/types/ServiceRoleType"))
+ (is (or (string= (uri (first (psis (player role-1))))
+ "http://psi.egovpt.org/service/Google+Maps")
+ (string= (uri (first (psis (player role-1))))
+ "http://maps.google.com")))
+ (is (string= (uri (first (psis (instance-of role-2))))
+ "http://psi.egovpt.org/types/StandardRoleType"))
+ (is (string= (uri (first (psis (player role-2))))
+ "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadata")))))))))
+
+
+(test test-json-importer-merge
+ (let
+ ((dir "data_base"))
+ (with-fixture initialize-destination-db (dir)
+ (elephant:open-store (xml-importer:get-store-spec dir))
+ (xml-importer:init-isidorus)
+ (elephant:open-store (xml-importer:get-store-spec dir)) ; init-isiodurs closes the store
+ (let ((t100-1 "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tm-ids\":[\"http://www.isidor.us/unittests/testtm\"]}")
+ (t100-2 "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tm-ids\":[\"http://www.isidor.us/unittests/testtm\"]}"))
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 13))
+ (is (= (length (elephant:get-instances-by-class 'AssociationC)) 0))
+ (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 1))
+ (json-importer:json-to-elem t100-1)
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
+ (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+ (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+ (let ((core-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")
+ return tm))
+ (test-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.isidor.us/unittests/testtm")
+ return tm)))
+ (is-true (and core-tm test-tm)))
+ (json-importer:json-to-elem t100-2)
+ (is (= (length (elephant:get-instances-by-class 'TopicC)) 17))
+ (is (= (length (elephant:get-instances-by-class 'AssociationC)) 1))
+ (is (= (length (elephant:get-instances-by-class 'TopicMapC)) 2))
+ (let ((core-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")
+ return tm))
+ (test-tm
+ (loop for tm in (elephant:get-instances-by-class 'TopicMapC)
+ when (string= (uri (first (item-identifiers tm)))
+ "http://www.isidor.us/unittests/testtm")
+ return tm)))
+ (is-true (and core-tm test-tm)))
+ (let ((topics (elephant:get-instances-by-class 'TopicC)))
+ (loop for topic in topics
+ do (let ((psi (uri (first (psis topic)))))
+ (cond
+ ((string= psi "http://psi.egovpt.org/types/standard") ;t3
+ (is (= (length (in-topicmaps topic)) 1))
+ (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm"))
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 2))
+ (is (or (string= (uri (first (item-identifiers topic)))
+ "http://www.egovpt.org/itemIdentifiers#t3")
+ (string= (uri (second (item-identifiers topic)))
+ "http://www.egovpt.org/itemIdentifiers#t3")))
+ (is (or (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t3")
+ (string= (uri (second (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t3"))))
+ ((string= psi "http://psi.egovpt.org/types/long-name") ;t50a
+ (is (= (length (in-topicmaps topic)) 1))
+ (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm"))
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 1))
+ (is (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t50a")))
+ ((string= psi "http://psi.egovpt.org/types/links") ;t50
+ (is (= (length (in-topicmaps topic)) 1))
+ (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm"))
+ (is-false (names topic))
+ (is-false (occurrences topic))
+ (is-false (locators topic))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 2))
+ (is (or (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t55")
+ (string= (uri (second (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t55")))
+ (is (or (string= (uri (first (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t55_1")
+ (string= (uri (second (item-identifiers topic)))
+ "http://psi.egovpt.org/itemIdentifiers#t55_1"))))
+ ((string= psi "http://psi.egovpt.org/standard/Common+Lisp") ;t100
+ (is (= (length (in-topicmaps topic)) 1))
+ (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm"))
+ (is (= (length (psis topic)) 1))
+ (is (= (length (item-identifiers topic)) 2))
+ (is (or (string= (uri (first (item-identifiers topic)))
+ "http://www.egovpt.org/itemIdentifiers#t100")
+ (string= (uri (second (item-identifiers topic)))
+ "http://www.egovpt.org/itemIdentifiers#t100")))
+ (is (or (string= (uri (first (item-identifiers topic)))
+ "http://www.egovpt.org/itemIdentifiers#t100_new")
+ (string= (uri (second (item-identifiers topic)))
+ "http://www.egovpt.org/itemIdentifiers#t100_new")))
+ (is (= (length (names topic))))
+ (let ((name (first (names topic))))
+ (is (= (length (item-identifiers name)) 2))
+ (is (or (string= (uri (first (item-identifiers name)))
+ "http://www.egovpt.org/itemIdentifiers#t100_n1")
+ (string= (uri (second (item-identifiers name)))
+ "http://www.egovpt.org/itemIdentifiers#t100_n1")))
+ (is (or (string= (uri (first (item-identifiers name)))
+ "http://www.egovpt.org/itemIdentifiers#t100_n1a")
+ (string= (uri (second (item-identifiers name)))
+ "http://www.egovpt.org/itemIdentifiers#t100_n1a")))
+ (is (string= (charvalue name)
+ "Common Lisp"))
+ (is (= (length (variants name)) 2))
+ (let ((variant-1 (first (variants name)))
+ (variant-2 (second (variants name))))
+ (is (= (length (item-identifiers variant-1)) 1))
+ (is (string= (uri (first (item-identifiers variant-1)))
+ "http://www.egovpt.org/itemIdentifiers#t100_n_v1"))
+ (is (= (length (item-identifiers variant-2)) 1))
+ (is (string= (uri (first (item-identifiers variant-2)))
+ "http://www.egovpt.org/itemIdentifiers#t100_n_v2"))
+ (is (= (length (themes variant-1)) 2))
+ (is (or (string= (uri (first (psis (first (themes variant-1)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+ (string= (uri (first (psis (second (themes variant-1)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")))
+ (is (or (string= (uri (first (psis (first (themes variant-1)))))
+ "http://psi.egovpt.org/types/long-name")
+ (string= (uri (first (psis (second (themes variant-1)))))
+ "http://psi.egovpt.org/types/long-name")))
+ (is (= (length (themes variant-2)) 1))
+ (is (string= (uri (first (psis (first (themes variant-2)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+ (is (string= (datatype variant-1)
+ "http://www.w3.org/2001/XMLSchema#string"))
+ (is (string= (charvalue variant-1)
+ "Common-Lisp"))
+ (is (string= (datatype variant-2)
+ "http://www.w3.org/2001/XMLSchema#string"))
+ (is (string= (charvalue variant-2)
+ "CL"))))
+ (is (= (length (occurrences topic)) 2))
+ (let ((occ-1 (first (occurrences topic)))
+ (occ-2 (second (occurrences topic))))
+ (is (= (length (item-identifiers occ-1)) 1))
+ (is (string= (uri (first (item-identifiers occ-1)))
+ "http://www.egovpt.org/itemIdentifiers#t100_o1"))
+ (is (= (length (item-identifiers occ-2)) 1))
+ (is (string= (uri (first (item-identifiers occ-2)))
+ "http://www.egovpt.org/itemIdentifiers#t100_o2"))
+ (is (string= (uri (first (psis (instance-of occ-1))))
+ "http://psi.egovpt.org/types/links"))
+ (is (string= (uri (first (psis (instance-of occ-2))))
+ "http://psi.egovpt.org/types/links"))
+ (is (string= (datatype occ-1)
+ "http://www.w3.org/2001/XMLSchema#anyURI"))
+ (is (string= (charvalue occ-1)
+ "http://www.common-lisp.net/"))
+ (is (string= (datatype occ-2)
+ "http://www.w3.org/2001/XMLSchema#anyURI"))
+ (is (string= (charvalue occ-2)
+ "http://www.cliki.net/"))))
+ (t
+ (if (or (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")
+ (string= psi "http://www.topicmaps.org/xtm/1.0/core.xtm#display"))
+ (progn
+ (is (= (length (in-topicmaps topic)) 2))
+ (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")
+ (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")))
+ (is (or (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm")
+ (string= (uri (first (item-identifiers (second (in-topicmaps topic)))))
+ "http://www.isidor.us/unittests/testtm"))))
+ (progn
+ (is (= (length (in-topicmaps topic)) 1))
+ (is (string= (uri (first (item-identifiers (first (in-topicmaps topic)))))
+ "http://www.topicmaps.org/xtm/1.0/core.xtm")))))))))
+ (let ((instanceOf-assoc
+ (first (elephant:get-instances-by-class 'AssociationC))))
+ (is (string= (uri (first (psis (instance-of instanceOf-assoc))))
+ constants::*type-instance-psi*))
+ (is-false (d:themes instanceOf-assoc))
+ (is (string= (d:uri (first (d:item-identifiers (first (d:in-topicmaps instanceOf-assoc)))))
+ "http://www.isidor.us/unittests/testtm"))
+ (is-false (d:item-identifiers instanceOf-assoc))
+ (let ((super-type-role
+ (loop for role in (roles instanceOf-assoc)
+ when (string= (uri (first (psis (instance-of role))))
+ constants:*type-psi*)
+ return role))
+ (sub-type-role
+ (loop for role in (roles instanceOf-assoc)
+ when (string= (uri (first (psis (instance-of role))))
+ constants:*instance-psi*)
+ return role)))
+ (is-true (and super-type-role sub-type-role))
+ (is (string= (uri (first (psis (player super-type-role))))
+ "http://psi.egovpt.org/types/standard"))
+ (is (string= (uri (first (psis (player sub-type-role))))
+ "http://psi.egovpt.org/standard/Common+Lisp"))))))))
+
+
+
(defun run-json-tests()
(tear-down-test-db)
(run! 'json-tests))
\ No newline at end of file
Modified: trunk/src/unit_tests/versions_test.lisp
==============================================================================
--- trunk/src/unit_tests/versions_test.lisp (original)
+++ trunk/src/unit_tests/versions_test.lisp Mon Mar 9 18:20:10 2009
@@ -217,28 +217,31 @@
(format t "semantic-standard: ~a~&"
(remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
:test #'string=))
- ;(is-false
- ; (set-exclusive-or
- ; '("http://psi.egovpt.org/types/standard")
- ; (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
- ; :test #'string=)
- ; :test #'string=))
+ (is-false
+ (set-exclusive-or
+ '("http://psi.egovpt.org/types/standard")
+ (remove-duplicates (map 'list #'uri (mapcan #'psis (referenced-topics (first fragments-revision3))))
+ :test #'string=)
+ :test #'string=))
; 0 if we ignore instanceOf associations
(is (= 0 (length (associations (first fragments-revision3)))))
(is (string=
"http://psi.egovpt.org/standard/Common+Lisp"
(uri (first (psis (topic (third fragments-revision3)))))))
- ;(is-false
- ; (set-exclusive-or
- ; '("http://psi.egovpt.org/types/standard"
- ; "http://psi.egovpt.org/types/links")
- ; (remove-duplicates
- ; (map 'list
- ; #'uri
- ; (mapcan #'psis (referenced-topics (third fragments-revision3))))
- ; :test #'string=)
- ; :test #'string=))
+ (is-false
+ (set-exclusive-or
+ '("http://psi.egovpt.org/types/standard"
+ "http://psi.egovpt.org/types/links";)
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"
+ "http://www.topicmaps.org/xtm/1.0/core.xtm#display"
+ "http://psi.egovpt.org/types/long-name")
+ (remove-duplicates
+ (map 'list
+ #'uri
+ (mapcan #'psis (referenced-topics (third fragments-revision3))))
+ :test #'string=)
+ :test #'string=))
;0 if we ignore instanceOf associations
(is (= 0 (length (associations (third fragments-revision3)))))
More information about the Isidorus-cvs
mailing list