- isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[isidorus-cvs] r17 - in trunk/src: . json rest_interface threading
by Lukas Giessmann 17 Mar '09

17 Mar '09

Author: lgiessmann Date: Tue Mar 17 10:49:55 2009 New Revision: 17 Log: changed the hunchentoot version from 0.15.7 to 1.0.0 and all depending code-fragments using the hunchentoot interface; further the json interface was modified and better structured; the little example of prototype was also modiefied, so you can get all psis of isidorus, you can get all fragments and you can commit fragments+ssh://lgiessmann@common-lisp.net/project/isidorus/svn Modified: trunk/src/isidorus.asd trunk/src/json/json_interface.html trunk/src/rest_interface/publish_feeds.lisp trunk/src/rest_interface/rest-interface.lisp trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/threading/reader-writer.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Mar 17 10:49:55 2009 @@ -121,8 +121,9 @@ (:file "json_importer")

1 0

[isidorus-cvs] r16 - in trunk: docs src/json src/rest_interface src/unit_tests
by Lukas Giessmann 10 Mar '09

10 Mar '09

Author: lgiessmann Date: Tue Mar 10 11:34:36 2009 New Revision: 16 Log: added a possibilit to get all topic-psis via the rest interface as a json list of lists +ssh://lgiessmann@common-lisp.net/project/isidorus/svn Modified: trunk/docs/xtm_json.txt trunk/src/json/json_exporter.lisp trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/unit_tests/json_test.lisp Modified: trunk/docs/xtm_json.txt ============================================================================== --- trunk/docs/xtm_json.txt (original) +++ trunk/docs/xtm_json.txt Tue Mar 10 11:34:36 2009 @@ -84,6 +84,10 @@ // outgoing fragment have a list with more tm-ids but at least one +a summary of all topic psis within isidorus +[["topic-1-psi-1","topic-1-psi-2",<...>],["topic-2-psi-1","topic-2-psi-2",<...>],<...>] + + === example fragment with one topic, a few topicStubs and associations ========= { Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Tue Mar 10 11:34:36 2009 @@ -1,6 +1,7 @@ (defpackage :json-exporter (:use :cl :json :datamodel) - (:export :to-json-string)) + (:export :to-json-string + :get-all-topic-psis)) (in-package :json-exporter) @@ -268,4 +269,14 @@ (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 + (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}"))) + + +(defun get-all-topic-psis() + "returns all topic psis as a json list of the form + [[topic-1-psi-1, topic-1-psi-2],[topic-2-psi-1, topic-2-psi-2],...]" + (encode-json-to-string + (remove-if #'null (map 'list #'(lambda(psi-list) + (when psi-list + (map 'list #'uri psi-list))) + (map 'list #'psis (elephant:get-instances-by-class 'TopicC)))))) \ No newline at end of file Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp (original) +++ trunk/src/rest_interface/set-up-json-interface.lisp Tue Mar 10 11:34:36 2009 @@ -1,21 +1,30 @@ (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") +(defparameter *json-rest-prefix* "/json/psi") ;the prefix to get a fragment by the psis -> localhost:8000/json/psi/<fragment-psi> +(defparameter *json-rest-all-psis* "/json/psis") ;the url to get all topic psis of isidorus -> localhost:8000/json/psis +(defparameter *json-user-interface-url* "/isidorus") ;the url to the user interface -> localhost:8000/isidorus +(defparameter *json-user-interface-file-path* "json/json_interface.html") ;the file path to the HTML file implements the user interface -(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*)) + +(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (rest-all-psis *json-rest-all-psis*) + (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 "/?$"))) + (ui-regex (concatenate 'string ui-url "/?$")) + (all-psis-regex (concatenate 'string rest-all-psis "/?$"))) ;(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 all-psis-regex #'(lambda() + (setf (hunchentoot:content-type) "application/json") ;RFC 4627 + (get-all-topic-psis))) + hunchentoot:*dispatch-table*) + (push (create-regex-dispatcher rest-regex #'(lambda (&optional uri) (assert uri) @@ -30,8 +39,6 @@ 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 @@ -54,59 +61,19 @@ (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 + )))) +;; ((eq http-method :POST) +;; (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) +;; (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*))) \ 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 Tue Mar 10 11:34:36 2009 @@ -14,7 +14,8 @@ :test-get-fragment-values-from-json-list :run-json-tests :test-json-importer - :test-json-importer-merge)) + :test-json-importer-merge + :test-get-all-topic-psis)) (in-package :json-test) @@ -929,7 +930,126 @@ "http://psi.egovpt.org/standard/Common+Lisp")))))))) - +(test test-get-all-topic-psis + (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-psis (json:decode-json-from-string (get-all-topic-psis)))) + (is (= (length json-psis) (length (elephant:get-instances-by-class 'd:TopicC)))) + (loop for topic-psis in json-psis + do (cond + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#topic") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#association") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#subclass") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#display") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/type-instance") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/instance") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/topic-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/service") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/semanticstandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/technicalstandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/subject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/occurrence-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/association-role-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/topicInTaxonomy") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/long-name") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standardHasStatus") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/status/InternationalStandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/description") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standardValidFromDate") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/links") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/topicIsAboutSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/isNarrowerSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/narrowerSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/broaderSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standardIsAboutSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/SubjectRoleType") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/StandardRoleType") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/ServiceRoleType") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/serviceUsesStandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/standard/Topic+Maps+2002") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Web+Services") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Semantic+Description") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Data") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/GeoData") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Legal+Data") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/service/Norwegian+National+Curriculum") + (is (= (length topic-psis) 1))) + ((or (string= (first topic-psis) "http://psi.egovpt.org/service/Google+Maps") + (string= (first topic-psis) "http://maps.google.com") + (is (= (length topic-psis) 2)) + (is (or (string= (second topic-psis) "http://psi.egovpt.org/service/Google+Maps") + (string= (second topic-psis) "http://maps.google.com"))))) + (t + (is-true (format t "found bad topic-psis: ~a" topic-psis))))))))) + + (defun run-json-tests() (tear-down-test-db) - (run! 'json-tests)) \ No newline at end of file + ;(run! 'json-tests)) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list) + ;(it.bese.fiveam:run! 'test-json-importer) ;currently this unittest causes some problems + (it.bese.fiveam:run! 'test-json-importer-merge) + (it.bese.fiveam:run! 'test-to-json-string-associations) + (it.bese.fiveam:run! 'test-to-json-string-fragments) + (it.bese.fiveam:run! 'test-to-json-string-topics) + (it.bese.fiveam:run! 'test-get-all-topic-psis))

1 0

[isidorus-cvs] r15 - in trunk: docs src src/json src/model src/rest_interface src/unit_tests
by Lukas Giessmann 09 Mar '09

09 Mar '09

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

1 0

[isidorus-cvs] r14 - trunk/src/rest_interface
by Christoph Ludwig 01 Feb '09

01 Feb '09

Author: cludwig Date: Sun Feb 1 23:22:25 2009 New Revision: 14 Log: fix the computation of the most recent already imported snapshot Modified: trunk/src/rest_interface/read.lisp Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Sun Feb 1 23:22:25 2009 @@ -101,7 +101,7 @@ (let* ((feed (read-snapshots-feed snapshot-feed-url)) (all-entries (slot-value feed 'atom:entries)) - (most-recent-imported-entry all-entries)) + (most-recent-imported-entry (most-recent-entry all-entries))) (if most-recent-imported-entry most-recent-imported-entry (let*

1 0

[isidorus-cvs] r13 - trunk/src/rest_interface
by Christoph Ludwig 01 Feb '09

01 Feb '09

Author: cludwig Date: Sun Feb 1 21:48:06 2009 New Revision: 13 Log: check if we already imported any snapshot Modified: trunk/src/rest_interface/read.lisp Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Sun Feb 1 21:48:06 2009 @@ -83,39 +83,48 @@ (t (string-max (rest string-list) max)))) -(defun import-snapshots-feed (snapshot-feed-url &key tm-id) - ;this finds the most recent snapshot and imports that. It returns the entry - ;corresponding to that snapshot +(defun most-recent-entry (entry-list) + (let + ((most-recent-update (string-max (mapcar #'atom:updated entry-list)))) + (find most-recent-update entry-list :key #'updated :test #'string=))) + +(defun most-recent-imported-snapshot (all-snapshot-entries) + (let + ((all-imported-entries + (remove-if-not #'xtm-id-p all-snapshot-entries :key #'atom:id))) + (most-recent-entry all-imported-entries))) - (let +(defun import-snapshots-feed (snapshot-feed-url &key tm-id) + "checks if we already imported any of this feed's snapshots. If not, +finds the most recent snapshot and imports that. It returns the entry +corresponding to the snapshot imported (now or previously)." + (let* ((feed (read-snapshots-feed snapshot-feed-url)) - (revision (get-revision))) - (let* - ((most-recent-update (string-max (mapcar #'atom:updated (slot-value feed 'atom:entries)))) - (entry - (find - most-recent-update - (slot-value feed 'atom:entries) :key #'updated :test #'string=)) - (xtm-id (id entry))) - ;;that *should* be the algorithm... - ;; If a client has a local topic map that contains topic map - ;; data from more than one server and wants to fetch and update - ;; the latest full topic map from ONE source then it MUST do the - ;; following. Apply the delete topic algorithm from below, but - ;; apply it to the entire topic map. Then proceed in terms of 'A - ;; Clean Start', by fetching the topic map and merging it in - ;; (1b, 1.4.3.2) - (unless (xtm-id-p xtm-id) - (importer-xtm1.0 - (dom:document-element - (cxml:parse-rod (read-url (link entry)) (cxml-dom:make-dom-builder))) - :tm-id tm-id - :xtm-id xtm-id :revision revision)) - entry))) + (all-entries (slot-value feed 'atom:entries)) + (most-recent-imported-entry all-entries)) + (if most-recent-imported-entry + most-recent-imported-entry + (let* + ((entry (most-recent-entry all-entries)) + (snapshot-dom + (dom:document-element + (cxml:parse-rod (read-url (link entry)) (cxml-dom:make-dom-builder)))) + (xtm-id (id entry)) + (revision (get-revision))) + ;;that *should* be the algorithm... + ;; If a client has a local topic map that contains topic map + ;; data from more than one server and wants to fetch and update + ;; the latest full topic map from ONE source then it MUST do the + ;; following. Apply the delete topic algorithm from below, but + ;; apply it to the entire topic map. Then proceed in terms of 'A + ;; Clean Start', by fetching the topic map and merging it in + ;; (1b, 1.4.3.2) + (importer-xtm1.0 snapshot-dom :tm-id tm-id :xtm-id xtm-id :revision revision) + entry)))) (defun import-tm-feed (feed-url &optional (processed-feed-urls nil)) - "takes the feed url of a collection feed, imports the first snapshot if -necessary and then applies all fragments to it" + "takes the feed url of a collection feed, processes the dependencies, +imports the first snapshot if necessary and then applies all fragments to it" ;the implementation may be a bit brutal, but relies only on ;guaranteed rel-attributes on the links (let* @@ -146,7 +155,8 @@ (format t "Recursively processing feed ~a~&" dependent-feed-url) (import-tm-feed dependent-feed-url (append processed-feed-urls feed-url))))) - + ;; import a snapshot (if necessary) and the process all fragments more + ;; recent than the snapshot (let ((imported-snapshot-entry (import-snapshots-feed

1 0

[isidorus-cvs] r12 - in trunk/src: . model unit_tests xml
by Marc Wilhelm Kuster 01 Feb '09

01 Feb '09

Author: mkuster Date: Sun Feb 1 21:44:18 2009 New Revision: 12 Log: instanceOf associations are now also filtered by TM Added: trunk/src/unit_tests/multiple_tms_ont.xtm trunk/src/unit_tests/multiple_tms_worms.xtm Modified: trunk/src/isidorus.asd trunk/src/model/datamodel.lisp trunk/src/xml/exporter.lisp trunk/src/xml/exporter_xtm1.0.lisp trunk/src/xml/exporter_xtm2.0.lisp Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Sun Feb 1 21:44:18 2009 @@ -35,7 +35,8 @@ :depends-on ("importer_xtm2.0" "importer_xtm1.0")) (:file "exporter_xtm1.0") - (:file "exporter_xtm2.0") + (:file "exporter_xtm2.0" + :depends-on ("exporter_xtm1.0")) (:file "exporter" :depends-on ("exporter_xtm1.0" "exporter_xtm2.0"))) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Sun Feb 1 21:44:18 2009 @@ -948,6 +948,10 @@ (: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*))) + (defmethod initialize-instance :around ((instance TopicC) &key (psis nil) (locators nil)) "implement the pseudo-initargs :topic-ids, :persistent-ids, and :subject-locators" (declare (list psis)) @@ -1135,19 +1139,29 @@ (:documentation "Test for the existence of PSIs") (:method ((top TopicC)) (slot-predicate top 'psis))) -(defgeneric list-instanceOf (topic) - (:method ((topic TopicC)))) - -(defmethod list-instanceOf ((topic TopicC)) - (remove-if #'null - (map 'list #'(lambda(x) - (when (loop for psi in (psis (instance-of x)) - when (string= (uri psi) "http://psi.topicmaps.org/iso13250/model/instance") - return t) - (loop for role in (roles (parent x)) - when (not (eq role x)) - return (player role)))) - (player-in-roles topic)))) +(defgeneric list-instanceOf (topic &key tm) + (:documentation "Generate a list of all topics that this topic is an + instance of, optionally filtered by a topic map")) + +(defmethod list-instanceOf ((topic TopicC) &key (tm nil)) + (remove-if + #'null + (map 'list #'(lambda(x) + (when (loop for psi in (psis (instance-of x)) + when (string= (uri psi) "http://psi.topicmaps.org/iso13250/model/instance") + return t) + (loop for role in (roles (parent x)) + when (not (eq role x)) + return (player role)))) + (if tm + (remove-if-not + (lambda (role) + (format t "player: ~a" (player role)) + (format t "parent: ~a" (parent role)) + (format t "topic: ~a~&" topic) + (in-topicmap tm (parent role))) + (player-in-roles topic)) + (player-in-roles topic))))) (defun string-starts-with (str prefix) "Checks if string str starts with a given prefix" Added: trunk/src/unit_tests/multiple_tms_ont.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/multiple_tms_ont.xtm Sun Feb 1 21:44:18 2009 @@ -0,0 +1,57 @@ +<?xml version="1.0" encoding="utf-8"?> +<topicMap xmlns="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink"> + <topic id="t1"> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/types/topic-type"/> + </subjectIdentity> + </topic> + + <topic id="a1"> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/types/association-type"/> + </subjectIdentity> + </topic> + + <topic id="r1"> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/types/role-type"/> + </subjectIdentity> + </topic> + + <topic id="t2"> + <instanceOf> + <topicRef xlink:href="#t1"/> + </instanceOf> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t2"/> + </subjectIdentity> + </topic> + + <topic id="t3"> + <instanceOf> + <topicRef xlink:href="#t1"/> + </instanceOf> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t3"/> + </subjectIdentity> + </topic> + + <association> + <instanceOf> + <topicRef xlink:href="#a2"/> + </instanceOf> + <member> + <roleSpec> + <topicRef xlink:href="#r1"/> + </roleSpec> + <topicRef xlink:href="#t2"/> + </member> + <member> + <roleSpec> + <topicRef xlink:href="#r1"/> + </roleSpec> + <topicRef xlink:href="#t3"/> + </member> + </association> +</topicMap> \ No newline at end of file Added: trunk/src/unit_tests/multiple_tms_worms.xtm ============================================================================== --- (empty file) +++ trunk/src/unit_tests/multiple_tms_worms.xtm Sun Feb 1 21:44:18 2009 @@ -0,0 +1,16 @@ +<?xml version="1.0" encoding="utf-8"?> +<topicMap xmlns="http://www.topicmaps.org/xtm/1.0/" + xmlns:xlink="http://www.w3.org/1999/xlink"> + + <topic id="t2"> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t2"/> + </subjectIdentity> + </topic> + + <topic id="t3"> + <subjectIdentity> + <subjectIndicatorRef xlink:href="http://www.egovpt.org/instances/topic-t3"/> + </subjectIdentity> + </topic> +</topicMap> \ No newline at end of file Modified: trunk/src/xml/exporter.lisp ============================================================================== --- trunk/src/xml/exporter.lisp (original) +++ trunk/src/xml/exporter.lisp Sun Feb 1 21:44:18 2009 @@ -1,9 +1,9 @@ (in-package :exporter) -(defun instanceofs-to-elem (ios) - (when ios - (map 'list (lambda (io) (cxml:with-element "t:instanceOf" (ref-to-elem io))) ios))) +;; (defun instanceofs-to-elem (ios) +;; (when ios +;; (map 'list (lambda (io) (cxml:with-element "t:instanceOf" (ref-to-elem io))) ios))) (defun list-extern-associations () @@ -39,15 +39,18 @@ ,@body)))) (defmacro export-to-elem (tm to-elem) - `(map 'list ,to-elem + `(setf *export-tm* ,tm) + `(format t "*export-tm*: ~a" *export-tm*) + `(map 'list + ,to-elem (remove-if #'null (map 'list #'(lambda(top) (d:find-item-by-revision top revision)) (if ,tm - (union - (d:topics ,tm) (d:associations ,tm)) + (union + (d:topics ,tm) (d:associations ,tm)) (union (elephant:get-instances-by-class 'd:TopicC) (list-extern-associations))))))) @@ -60,6 +63,7 @@ ((tm (when tm-id (get-item-by-item-identifier tm-id :revision revision)))) + (setf *export-tm* tm) (with-revision revision (with-open-file (stream xtm-path :direction :output) (cxml:with-xml-output (cxml:make-character-stream-sink stream :canonical nil) Modified: trunk/src/xml/exporter_xtm1.0.lisp ============================================================================== --- trunk/src/xml/exporter_xtm1.0.lisp (original) +++ trunk/src/xml/exporter_xtm1.0.lisp Sun Feb 1 21:44:18 2009 @@ -13,6 +13,8 @@ (in-package :exporter) +(defparameter *export-tm* nil "TopicMap which is exported (nil if all is to be exported") + (defgeneric to-elem-xtm1.0 (instance) (:documentation "converts the Topic Maps construct instance to an XTM 1.0 element")) @@ -115,8 +117,8 @@ (baseName | occurrence)* }" (cxml:with-element "t:topic" (cxml:attribute "id" (topicid topic)) - (when (list-instanceOf topic) - (map 'list #'to-instanceOf-elem-xtm1.0 (list-instanceOf topic))) + (when (list-instanceOf topic :tm *export-tm*) + (map 'list #'to-instanceOf-elem-xtm1.0 (list-instanceOf topic :tm *export-tm*))) (when (or (psis topic) (locators topic)) (to-subjectIdentity-elem-xtm1.0 (psis topic) (first (locators topic)))) (when (names topic) Modified: trunk/src/xml/exporter_xtm2.0.lisp ============================================================================== --- trunk/src/xml/exporter_xtm2.0.lisp (original) +++ trunk/src/xml/exporter_xtm2.0.lisp Sun Feb 1 21:44:18 2009 @@ -118,9 +118,9 @@ (map 'list #'to-elem (item-identifiers topic)) (map 'list #'to-elem (locators topic)) (map 'list #'to-elem (psis topic)) - (when (list-instanceOf topic) + (when (list-instanceOf topic :tm *export-tm*) (cxml:with-element "t:instanceOf" - (loop for item in (list-instanceOf topic) + (loop for item in (list-instanceOf topic :tm *export-tm*) do (cxml:with-element "t:topicRef" (cxml:attribute "href" (concatenate 'string "#" (topicid item))))))) (map 'list #'to-elem (names topic))

1 0

[isidorus-cvs] r11 - in trunk/src: model rest_interface
by Marc Wilhelm Kuster 31 Jan '09

31 Jan '09

Author: mkuster Date: Sat Jan 31 23:34:41 2009 New Revision: 11 Log: reading the snapshots feed for the ontology repaired Modified: trunk/src/model/changes.lisp trunk/src/model/datamodel.lisp trunk/src/rest_interface/read.lisp Modified: trunk/src/model/changes.lisp ============================================================================== --- trunk/src/model/changes.lisp (original) +++ trunk/src/model/changes.lisp Sat Jan 31 23:34:41 2009 @@ -241,7 +241,7 @@ (some (lambda (ii) (string-starts-with (uri ii) source-locator)) (item-identifiers construct)) (let ((ii-uri (format nil "~a/~d" source-locator (internal-id construct)))) - (make-instance 'ItemIdentifierC :uri ii-uri :identified-construct construct)))) + (make-instance 'ItemIdentifierC :uri ii-uri :identified-construct construct :start-revision revision)))) (defmethod add-source-locator ((top TopicC) &key source-locator revision) ;topics already have the source locator in (at least) one PSI, so we Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Sat Jan 31 23:34:41 2009 @@ -263,7 +263,7 @@ (defmethod add-to-version-history ((construct TopicMapConstructC) &key - (start-revision (error "Must be present") ) + (start-revision (error "Start revision must be present") ) (end-revision 0)) "Adds relevant information to a construct's version info" (let @@ -470,7 +470,7 @@ (string= (uri identifier1) (uri identifier2))) (defmethod initialize-instance :around ((identifier PointerC) &key - (start-revision (error "Must be present") ) + (start-revision (error "Start revision must be present") ) (end-revision 0)) (call-next-method) (add-to-version-history identifier Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Sat Jan 31 23:34:41 2009 @@ -44,7 +44,7 @@ (read-url snapshot-feed-url))) (parse-snapshots-feed snapshot-feed))) -(defun import-fragments-feed (tm-id fragment-feed-url imported-snapshot-entry) +(defun import-fragments-feed (fragment-feed-url imported-snapshot-entry &key tm-id) ;a bit of a borderline case if that should be here or in the ;importer. Since it deals with the network interface, I think it ;makes sense to have it here, though @@ -83,7 +83,7 @@ (t (string-max (rest string-list) max)))) -(defun import-snapshots-feed (tm-id snapshot-feed-url) +(defun import-snapshots-feed (snapshot-feed-url &key tm-id) ;this finds the most recent snapshot and imports that. It returns the entry ;corresponding to that snapshot @@ -150,13 +150,12 @@ (let ((imported-snapshot-entry (import-snapshots-feed - feed-url - (get-attribute snapshot-feed-link-elem "href")))) + (get-attribute snapshot-feed-link-elem "href") + :tm-id feed-url))) (assert imported-snapshot-entry) (import-fragments-feed - feed-url (get-attribute fragment-feed-link-elem "href") - imported-snapshot-entry)))) + imported-snapshot-entry :tm-id feed-url)))) \ No newline at end of file

1 0

[isidorus-cvs] r10 - in trunk/src: atom rest_interface
by Marc Wilhelm Kuster 31 Jan '09

31 Jan '09

Author: mkuster Date: Sat Jan 31 22:52:57 2009 New Revision: 10 Log: version parses the snapshots and fragments feeds Modified: trunk/src/atom/atom.lisp trunk/src/rest_interface/read.lisp Modified: trunk/src/atom/atom.lisp ============================================================================== --- trunk/src/atom/atom.lisp (original) +++ trunk/src/atom/atom.lisp Sat Jan 31 22:52:57 2009 @@ -129,9 +129,7 @@ (:documentation "Register an entry for a given feed")) (defmethod register-entry ((feed feed) (entry entry)) - (format t "feed: ~s; entry: ~s" feed entry) - (push entry (slot-value feed 'entries)) - (format t "entries of ~s: ~s" feed (slot-value feed 'entries))) + (push entry (slot-value feed 'entries))) (defgeneric register-subfeed (feed subfeed) (:documentation "Register a subfeed for a given feed")) Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Sat Jan 31 22:52:57 2009 @@ -44,14 +44,14 @@ (read-url snapshot-feed-url))) (parse-snapshots-feed snapshot-feed))) -(defun import-fragments-feed (fragment-feed-url imported-snapshot-entry) +(defun import-fragments-feed (tm-id fragment-feed-url imported-snapshot-entry) ;a bit of a borderline case if that should be here or in the ;importer. Since it deals with the network interface, I think it ;makes sense to have it here, though (let ((feed (read-fragments-feed fragment-feed-url)) (revision (d:get-revision))) - (loop for entry in (atom:entries feed) do + (loop for entry in (slot-value feed 'atom:entries) do (let ((top (d:get-item-by-psi (psi entry) :revision revision)) (xtm-id (atom:id entry)) @@ -61,11 +61,11 @@ (unless (or (xtm-id-p xtm-id) (string> (atom:updated entry) (atom:updated imported-snapshot-entry))) (when top (mark-as-deleted top :source-locator source-locator :revision revision)) - (format t "Fragment feed: ~a~&" (link entry)) + ;(format t "Fragment feed: ~a~&" (link entry)) (importer-xtm1.0 (dom:document-element (cxml:parse-rod (read-url (link entry)) (cxml-dom:make-dom-builder))) - :xtm-id xtm-id :revision revision) + :tm-id tm-id :xtm-id xtm-id :revision revision) ;the consequence of the algorithm is to add the source ;locator + a suitable internal id as an identifier to all ;characteristics and associations that don't already have @@ -83,20 +83,19 @@ (t (string-max (rest string-list) max)))) -(defun import-snapshots-feed (snapshot-feed-url) +(defun import-snapshots-feed (tm-id snapshot-feed-url) ;this finds the most recent snapshot and imports that. It returns the entry ;corresponding to that snapshot (let ((feed (read-snapshots-feed snapshot-feed-url)) (revision (get-revision))) - (format t "~s" (string-max (mapcar #'atom:updated (atom:entries feed)))) (let* - ((most-recent-update (string-max (mapcar #'atom:updated (atom:entries feed)))) + ((most-recent-update (string-max (mapcar #'atom:updated (slot-value feed 'atom:entries)))) (entry (find most-recent-update - (atom:entries feed) :key #'updated :test #'string=)) + (slot-value feed 'atom:entries) :key #'updated :test #'string=)) (xtm-id (id entry))) ;;that *should* be the algorithm... ;; If a client has a local topic map that contains topic map @@ -110,6 +109,7 @@ (importer-xtm1.0 (dom:document-element (cxml:parse-rod (read-url (link entry)) (cxml-dom:make-dom-builder))) + :tm-id tm-id :xtm-id xtm-id :revision revision)) entry))) @@ -143,15 +143,18 @@ ((dependent-feed-url (xpath-fn-string dependency-elem))) (unless (find dependent-feed-url processed-feed-urls) + (format t "Recursively processing feed ~a~&" dependent-feed-url) (import-tm-feed dependent-feed-url (append processed-feed-urls feed-url))))) (let ((imported-snapshot-entry (import-snapshots-feed + feed-url (get-attribute snapshot-feed-link-elem "href")))) (assert imported-snapshot-entry) (import-fragments-feed + feed-url (get-attribute fragment-feed-link-elem "href") imported-snapshot-entry))))

1 0

[isidorus-cvs] r9 - in trunk/src: atom model rest_interface
by Christoph Ludwig 31 Jan '09

31 Jan '09

Author: cludwig Date: Sat Jan 31 22:14:17 2009 New Revision: 9 Log: intermediate stage; need to create feed clients for import Modified: trunk/src/atom/atom.lisp trunk/src/atom/read.lisp trunk/src/model/changes.lisp trunk/src/rest_interface/read.lisp Modified: trunk/src/atom/atom.lisp ============================================================================== --- trunk/src/atom/atom.lisp (original) +++ trunk/src/atom/atom.lisp Sat Jan 31 22:14:17 2009 @@ -129,7 +129,9 @@ (:documentation "Register an entry for a given feed")) (defmethod register-entry ((feed feed) (entry entry)) - (push entry (entries feed))) + (format t "feed: ~s; entry: ~s" feed entry) + (push entry (slot-value feed 'entries)) + (format t "entries of ~s: ~s" feed (slot-value feed 'entries))) (defgeneric register-subfeed (feed subfeed) (:documentation "Register a subfeed for a given feed")) Modified: trunk/src/atom/read.lisp ============================================================================== --- trunk/src/atom/read.lisp (original) +++ trunk/src/atom/read.lisp Sat Jan 31 22:14:17 2009 @@ -1,15 +1,15 @@ (in-package :atom) -(defmacro parse-feed ((fragment-feed-string) &body make-entry) +(defmacro parse-feed ((feed-string feed-type) &body make-entry) "a convenience macro that captures key parsing elements for feeds. As body it takes the action to be performed on each entry in the feed (usually a register-entry statement)" `(let* ((feed-dom (dom:document-element - (cxml:parse-rod ,fragment-feed-string (cxml-dom:make-dom-builder)))) + (cxml:parse-rod ,feed-string (cxml-dom:make-dom-builder)))) (feed - (make-instance 'fragments-feed + (make-instance ,feed-type :id (xpath-fn-string (xpath-single-child-elem-by-qname feed-dom @@ -36,7 +36,7 @@ (defun parse-fragments-feed (fragment-feed-string) - (parse-feed (fragment-feed-string) + (parse-feed (fragment-feed-string 'fragments-feed) (register-entry feed (make-instance 'fragment-entry @@ -51,7 +51,7 @@ (xpath-single-child-elem-by-qname entry-elem *egovpt-ns* "TopicSI")))))) (defun parse-snapshots-feed (fragment-feed-string) - (parse-feed (fragment-feed-string) + (parse-feed (fragment-feed-string 'snapshots-feed) (register-entry feed (make-instance 'snapshot-entry Modified: trunk/src/model/changes.lisp ============================================================================== --- trunk/src/model/changes.lisp (original) +++ trunk/src/model/changes.lisp Sat Jan 31 22:14:17 2009 @@ -18,7 +18,7 @@ engine for this Topic Map" (let* ((tm (get-item-by-item-identifier tm-id :revision 0)) - (tops-and-assocs (union (topics tm) (associations tm))) + (tops-and-assocs (when tm (union (topics tm) (associations tm)))) (revision-set nil)) ;(format t "tops-and-assocs: ~a~&" (mapcan #'versions tops-and-assocs)) (dolist (vi (mapcan #'versions tops-and-assocs)) Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Sat Jan 31 22:14:17 2009 @@ -90,10 +90,12 @@ (let ((feed (read-snapshots-feed snapshot-feed-url)) (revision (get-revision))) + (format t "~s" (string-max (mapcar #'atom:updated (atom:entries feed)))) (let* - ((entry + ((most-recent-update (string-max (mapcar #'atom:updated (atom:entries feed)))) + (entry (find - (string-max (mapcar #'atom:updated (atom:entries feed))) + most-recent-update (atom:entries feed) :key #'updated :test #'string=)) (xtm-id (id entry))) ;;that *should* be the algorithm...

1 0

[isidorus-cvs] r8 - in trunk/src: atom rest_interface
by Christoph Ludwig 31 Jan '09

31 Jan '09

Author: cludwig Date: Sat Jan 31 20:15:50 2009 New Revision: 8 Log: fix import via atom feeds; make use of dependency and updated fields Modified: trunk/src/atom/atom.lisp trunk/src/rest_interface/read.lisp Modified: trunk/src/atom/atom.lisp ============================================================================== --- trunk/src/atom/atom.lisp (original) +++ trunk/src/atom/atom.lisp Sat Jan 31 20:15:50 2009 @@ -19,6 +19,7 @@ :subfeeds :tm-id :tm-id-p + :updated :*base-url* :*tm-feed*)) Modified: trunk/src/rest_interface/read.lisp ============================================================================== --- trunk/src/rest_interface/read.lisp (original) +++ trunk/src/rest_interface/read.lisp Sat Jan 31 20:15:50 2009 @@ -44,7 +44,7 @@ (read-url snapshot-feed-url))) (parse-snapshots-feed snapshot-feed))) -(defun import-fragments-feed (fragment-feed-url) +(defun import-fragments-feed (fragment-feed-url imported-snapshot-entry) ;a bit of a borderline case if that should be here or in the ;importer. Since it deals with the network interface, I think it ;makes sense to have it here, though @@ -56,8 +56,9 @@ ((top (d:get-item-by-psi (psi entry) :revision revision)) (xtm-id (atom:id entry)) (source-locator (source-locator-prefix feed))) - ;check if xtm-id has already been imported. If so, don't do it again - (unless (xtm-id-p xtm-id) + ;check if xtm-id has already been imported or if the entry is older + ;than the snapshot feed. If so, don't do it again + (unless (or (xtm-id-p xtm-id) (string> (atom:updated entry) (atom:updated imported-snapshot-entry))) (when top (mark-as-deleted top :source-locator source-locator :revision revision)) (format t "Fragment feed: ~a~&" (link entry)) @@ -73,20 +74,27 @@ (d:get-item-by-psi (psi entry) :revision revision) ;works even if the topic is only created during import :source-locator source-locator :revision revision)))))) +(defun string-max (string-list &optional (max nil)) + (cond + ((null string-list) + max) + ((string> (first string-list) max) + (string-max (rest string-list) (first string-list))) + (t + (string-max (rest string-list) max)))) + (defun import-snapshots-feed (snapshot-feed-url) - ;this would have to find the oldest (?) snapshot and import that. It - ;subsequently applies all fragments against it + ;this finds the most recent snapshot and imports that. It returns the entry + ;corresponding to that snapshot - ;sets source locator (let ((feed (read-snapshots-feed snapshot-feed-url)) (revision (get-revision))) - ;TODO: we lie for now and claim that the first entry always - ;represents the oldest snapshot we lie in addition in that we - ;import the snapshotfeed outright, not looking at the source - ;locator (let* - ((entry (first (entries feed))) + ((entry + (find + (string-max (mapcar #'atom:updated (atom:entries feed))) + (atom:entries feed) :key #'updated :test #'string=)) (xtm-id (id entry))) ;;that *should* be the algorithm... ;; If a client has a local topic map that contains topic map @@ -100,11 +108,12 @@ (importer-xtm1.0 (dom:document-element (cxml:parse-rod (read-url (link entry)) (cxml-dom:make-dom-builder))) - :xtm-id xtm-id :revision revision))))) + :xtm-id xtm-id :revision revision)) + entry))) -(defun import-tm-feed (feed-url) - "takes the feed url, imports the first snapshot if necessary and -then applies all fragments to it" +(defun import-tm-feed (feed-url &optional (processed-feed-urls nil)) + "takes the feed url of a collection feed, imports the first snapshot if +necessary and then applies all fragments to it" ;the implementation may be a bit brutal, but relies only on ;guaranteed rel-attributes on the links (let* @@ -123,10 +132,26 @@ (find-if (lambda(elem) (string= (get-attribute elem "rel") "http://www.egovpt.org/sdshare/fragmentsfeed")) link-elems))) - (import-snapshots-feed - (get-attribute snapshot-feed-link-elem "href")) - (import-fragments-feed - (get-attribute fragment-feed-link-elem "href")))) + + ;;Process dependencies + (dolist (dependency-elem + (xpath-select-location-path feed-dom + '((*egovpt-ns* "dependency")))) + (let ;;prevent circular dependencies + ((dependent-feed-url + (xpath-fn-string dependency-elem))) + (unless (find dependent-feed-url processed-feed-urls) + (import-tm-feed dependent-feed-url (append processed-feed-urls feed-url))))) + + + (let + ((imported-snapshot-entry + (import-snapshots-feed + (get-attribute snapshot-feed-link-elem "href")))) + (assert imported-snapshot-entry) + (import-fragments-feed + (get-attribute fragment-feed-link-elem "href") + imported-snapshot-entry)))) \ No newline at end of file

1 0