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/%5C" xmlns:xlink="http://www.w3.org/1999/xlink%5C%22/%3E"))))

-(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+-+Metadat...")) + (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%5C%22%5D,%5C%22subjectLocators%5C... 19115","variants":[{"itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100_n1_v1%5C%22%5D,%5C%22scopes%5C%22... Information - Metadata"}},{"itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100_n1_v2%5C%22%5D,%5C%22scopes%5C%22... ISO 19115 standard ..."}},{"itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100_o3%5C%22%5D,%5C%22type%5C%22:%5B%..."" (topicid (elt (referenced-topics frag-t100) 0)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t3a%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 1)) "","itemIdentities":null,"subjectLocators":null,"subjectIdentifiers":["http://www.topicmaps.org/xtm/1.0/core.xtm#display%5C%22%5D%7D,%7B%5C%22id%5C..."" (topicid (elt (referenced-topics frag-t100) 2)) "","itemIdentities":null,"subjectLocators":null,"subjectIdentifiers":["http://www.topicmaps.org/xtm/1.0/core.xtm#sort%5C%22%5D%7D,%7B%5C%22id%5C%22..."" (topicid (elt (referenced-topics frag-t100) 3)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t51%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 4)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t53%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 5)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t54%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 6)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t55%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 7)) "","itemIdentities":null,"subjectLocators":null,"subjectIdentifiers":["http://psi.egovpt.org/subject/GeoData%5C%22%5D%7D,%7B%5C%22id%5C%22:%5C"" (topicid (elt (referenced-topics frag-t100) 8)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t60%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 9)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t61%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 10)) "","itemIdentities":null,"subjectLocators":null,"subjectIdentifiers":["http://psi.egovpt.org/subject/Semantic+Description%5C%22%5D%7D,%7B%5C%22id%5..."" (topicid (elt (referenced-topics frag-t100) 11)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t64%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 12)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t63%5C%22%5D,%5C%22subjectLocators%5C%..."" (topicid (elt (referenced-topics frag-t100) 13)) "","itemIdentities":null,"subjectLocators":null,"subjectIdentifiers":["http://psi.egovpt.org/service/Google+Maps%5C%22,%5C%22http://maps.google.com..."" (topicid (elt (referenced-topics frag-t100) 14)) "","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t62%5C%22%5D,%5C%22subjectLocators%5C%...")) + (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%5C%22%5D,%5C%22instanceOfs%5..."))) + (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-...")) + (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%5C%22%5D,%5C%22subjectLocators%5C%... uses standard","variants":null}],"occurrences":null},"topicStubs":[{"id":"t260","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t7%5C%22%5D,%5C%22subjectLocators%5C%2...") + (json-fragment-t100 + "{"topic":{"id":"t404","itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100%5C%22%5D,%5C%22subjectLocators%5C... 19115","variants":[{"itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100_n1_v1%5C%22%5D,%5C%22scopes%5C%22... Information - Metadata"}},{"itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100_n1_v2%5C%22%5D,%5C%22scopes%5C%22... ISO 19115 standard ..."}},{"itemIdentities":["http://psi.egovpt.org/itemIdentifiers#t100_o3%5C%22%5D,%5C%22type%5C%22:%5B%...")) + (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+-+Metadat...") ;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+-+Metadat..."))))))))) + + +(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%5C%22%5D,%5C%22subjectLocators%5C... Lisp","variants":[{"itemIdentities":["http://www.egovpt.org/itemIdentifiers#t100_n_v1%5C%22%5D,%5C%22scopes%5C%22:...") + (t100-2 "{"topic":{"id":"t945","itemIdentities":["http://www.egovpt.org/itemIdentifiers#t100%5C%22,%5C%22http://www.egovpt.org... Lisp","variants":[{"itemIdentities":["http://www.egovpt.org/itemIdentifiers#t100_n_v1%5C%22%5D,%5C%22scopes%5C%22:...")) + (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)))))