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

[isidorus-cvs] r314 - trunk/src/ajax/javascripts
by Lukas Giessmann 07 Sep '10

07 Sep '10

Author: lgiessmann Date: Tue Sep 7 06:50:41 2010 New Revision: 314 Log: The ajax host prefix in constants.js is set automatically --> different mappings works for the same server now; the admin needn't set the host prefix manually Modified: trunk/src/ajax/javascripts/constants.js Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Tue Sep 7 06:50:41 2010 @@ -11,7 +11,7 @@ // --- Some constants fot the http connections via the XMLHttpRequest-Object -var HOST_PREF = "http://localhost:8000/"; /*"192.168.178.23:8000/"; // of the form "http://(.+)/"*/ +var HOST_PREF = getHostPref(); var GET_PREFIX = HOST_PREF + "json/get/"; var GET_STUB_PREFIX = HOST_PREF + "json/topicstubs/"; var TMCL_TYPE_URL = HOST_PREF + "json/tmcl/type/"; @@ -22,9 +22,9 @@ var INSTANCE_PSIS_URL = HOST_PREF + "json/tmcl/instances/"; var OWN_URL = HOST_PREF + "isidorus"; var SUMMARY_URL = HOST_PREF + "json/summary"; - var MARK_AS_DELETED_URL = HOST_PREF + "mark-as-deleted"; +var MARK_AS_DELETED_URL = HOST_PREF + "mark-as-deleted"; var TM_OVERVIEW = HOST_PREF + "json/tmcl/overview/"; -var TIMEOUT = 10000; // const TIMEOUT = 10000 --> "const" doesn't work under IE +var TIMEOUT = 20000; // const TIMEOUT = 10000 --> "const" doesn't work under IE @@ -95,4 +95,20 @@ "removeNameRow" : function(){ return "removeOccurrenceRow"; }, "removeOccurrenceRow" : function(){ return "removeNameRow"; }, "removeTopicRow" : function(){ return "removeTopicRow"; } - }; \ No newline at end of file + }; + + +// --- returns the current host prefix as string, so the user/admin needn't +// --- setting it manually +function getHostPref(){ + var splitter = "/"; + var splitterRate = 3; + var fullUrl = window.location.href; + var urlFragments = fullUrl.split("/"); + var hostPref = ""; + for(var i = 0; i !== splitterRate; ++i){ + hostPref += urlFragments[i]; + hostPref += "/"; + } + return hostPref; +} \ No newline at end of file

1 0

[isidorus-cvs] r313 - branches/new-datamodel/playground
by Lukas Giessmann 02 Sep '10

02 Sep '10

Author: lgiessmann Date: Thu Sep 2 09:57:24 2010 New Revision: 313 Log: added some more examples Modified: branches/new-datamodel/playground/threading_debugging.lisp Modified: branches/new-datamodel/playground/threading_debugging.lisp ============================================================================== --- branches/new-datamodel/playground/threading_debugging.lisp (original) +++ branches/new-datamodel/playground/threading_debugging.lisp Thu Sep 2 09:57:24 2010 @@ -1,3 +1,4 @@ +(require :asdf) (asdf:operate 'asdf:load-op :isidorus) (xml-importer:setup-repository "textgrid.xtm" "data_base" :tm-id "http://ztt.fh-worms.de/textgrid.xtm" @@ -18,6 +19,21 @@ (condition (err) (error (format nil "~a" err))))) +(defun return-all-tmcl-instances-test-handler(&optional param) + "similar to hunchentoot's corresponding handler - but without hunchentoot's + variables, e.g. hunchentoot:content-type, ..." + (declare (ignorable param)) + (handler-case (let ((topic-instances + (isidorus-threading:with-reader-lock + (json-tmcl::return-all-tmcl-instances :revision 0)))) + (json:encode-json-to-string + (map 'list #'(lambda(y) + (map 'list #'d:uri y)) + (map 'list #'d:psis topic-instances)))) + (condition (err) (error (format nil "~a" err))))) + + + (defun return-all-topic-psis-test-handler (&optional param) "similar to hunchentoot's corresponding handler - but without hunchentoot's variables, e.g. hunchentoot:content-type, ..." @@ -33,14 +49,16 @@ (defun programm-1 (thread-fun) + "bordeaux-threads" (defvar *thread-1* (bordeaux-threads:make-thread thread-fun)) (defvar *thread-2* (bordeaux-threads:make-thread thread-fun))) (defun programm-2 (thread-fun) + "bordeaux-threads" (let ((thread-1 nil) (thread-2 nil) - (max-iterations 50)) + (max-iterations 150)) (do ((c1 0 (+ c1 0)) (c2 0 (+ c2 0))) ((and (>= c1 max-iterations) (>= c2 max-iterations))) @@ -54,14 +72,35 @@ (format t "c1: ~a c2: ~a~%" c1 c2))))) +(defun programm-3 (thread-fun) + "sb-thread" + (defvar *thread-3* (sb-thread:make-thread thread-fun)) + (defvar *thread-4* (sb-thread:make-thread thread-fun))) +(defun programm-4 (thread-fun) + "sb-thread" + (let ((thread-1 nil) + (thread-2 nil) + (max-iterations 150)) + (do ((c1 0 (+ c1 0)) + (c2 0 (+ c2 0))) + ((and (>= c1 max-iterations) (>= c2 max-iterations))) + (when (or (not thread-1) (not (sb-thread:thread-alive-p thread-1))) + (setf thread-1 (sb-thread:make-thread thread-fun)) + (incf c1) + (format t "c1: ~a c2: ~a~%" c1 c2)) + (when (or (not thread-2) (not (sb-thread:thread-alive-p thread-2))) + (setf thread-2 (sb-thread:make-thread thread-fun)) + (incf c2) + (format t "c1: ~a c2: ~a~%" c1 c2))))) + (defun main() - (programm-2 #'return-all-tmcl-types-test-handler)) + (programm-4 #'return-all-tmcl-types-test-handler)) (main) \ No newline at end of file

1 0

[isidorus-cvs] r312 - branches/new-datamodel/playground
by Lukas Giessmann 01 Sep '10

01 Sep '10

Author: lgiessmann Date: Wed Sep 1 08:09:38 2010 New Revision: 312 Log: added a test file for the threading problem with hunchentoot Added: branches/new-datamodel/playground/threading_debugging.lisp Modified: branches/new-datamodel/playground/isidorus_test.sh Modified: branches/new-datamodel/playground/isidorus_test.sh ============================================================================== --- branches/new-datamodel/playground/isidorus_test.sh (original) +++ branches/new-datamodel/playground/isidorus_test.sh Wed Sep 1 08:09:38 2010 @@ -10,9 +10,9 @@ Nil="false"; doReq1=$T; -doReq2=$Nil; -doReq3=$Nil; -doReq4=$Nil; +doReq2=$T; +doReq3=$T; +doReq4=$T; dir1="req1"; dir2="req2"; @@ -57,25 +57,25 @@ if [ $doReq1 == $T ]; then path1=$log1$counter; result1=$res1$counter; - wget -o $path1".log" -O $result1".res" $req1; + wget -o $path1".log" -O $result1".res" $req1; fi if [ $doReq2 == $T ]; then path2=$log2$counter; result2=$res2$counter; - wget -o $path2".log" -O $result2".res" $req2; + wget -o $path2".log" -O $result2".res" $req2; fi if [ $doReq3 == $T ]; then path3=$log3$counter; result3=$res3$counter; - wget -o $path3".log" -O $result3".res" $req3; + wget -o $path3".log" -O $result3".res" $req3; fi if [ $doReq4 == $T ]; then path4=$log4$counter; result4=$res4$counter; - wget -o $path4".log" -O $result4".res" $req4; + wget -o $path4".log" -O $result4".res" $req4; fi } Added: branches/new-datamodel/playground/threading_debugging.lisp ============================================================================== --- (empty file) +++ branches/new-datamodel/playground/threading_debugging.lisp Wed Sep 1 08:09:38 2010 @@ -0,0 +1,67 @@ +(asdf:operate 'asdf:load-op :isidorus) +(xml-importer:setup-repository "textgrid.xtm" "data_base" + :tm-id "http://ztt.fh-worms.de/textgrid.xtm" + :xtm-id "textgrid.xtm") + + +(defun return-all-tmcl-types-test-handler (&optional param) + "similar to hunchentoot's corresponding handler - but without hunchentoot's + variables, e.g. hunchentoot:content-type, ..." + (declare (ignorable param)) + (handler-case (let ((topic-types + (isidorus-threading:with-reader-lock + (json-tmcl::return-all-tmcl-types :revision 0)))) + (json:encode-json-to-string + (map 'list #'(lambda(y) + (map 'list #'d:uri y)) + (map 'list #'d:psis topic-types)))) + (condition (err) (error (format nil "~a" err))))) + + +(defun return-all-topic-psis-test-handler (&optional param) + "similar to hunchentoot's corresponding handler - but without hunchentoot's + variables, e.g. hunchentoot:content-type, ..." + (declare (ignorable param)) + (handler-case (isidorus-threading:with-reader-lock + (json-exporter::get-all-topic-psis :revision 0)) + (condition (err) (error (format nil "~a" err))))) + + +(defun my-thread-function-1 () + (dotimes (i 100) + (return-all-tmcl-types-test-handler))) + + +(defun programm-1 (thread-fun) + (defvar *thread-1* (bordeaux-threads:make-thread thread-fun)) + (defvar *thread-2* (bordeaux-threads:make-thread thread-fun))) + + +(defun programm-2 (thread-fun) + (let ((thread-1 nil) + (thread-2 nil) + (max-iterations 50)) + (do ((c1 0 (+ c1 0)) + (c2 0 (+ c2 0))) + ((and (>= c1 max-iterations) (>= c2 max-iterations))) + (when (or (not thread-1) (not (bordeaux-threads:thread-alive-p thread-1))) + (setf thread-1 (bordeaux-threads:make-thread thread-fun)) + (incf c1) + (format t "c1: ~a c2: ~a~%" c1 c2)) + (when (or (not thread-2) (not (bordeaux-threads:thread-alive-p thread-2))) + (setf thread-2 (bordeaux-threads:make-thread thread-fun)) + (incf c2) + (format t "c1: ~a c2: ~a~%" c1 c2))))) + + + + + + + + +(defun main() + (programm-2 #'return-all-tmcl-types-test-handler)) + + +(main) \ No newline at end of file

1 0

[isidorus-cvs] r311 - branches/new-datamodel/src/ajax/javascripts trunk/src/ajax/javascripts
by Lukas Giessmann 26 Aug '10

26 Aug '10

Author: lgiessmann Date: Thu Aug 26 17:37:14 2010 New Revision: 311 Log: fixed a problem with the host prefix in the javascript constants file Modified: branches/new-datamodel/src/ajax/javascripts/constants.js trunk/src/ajax/javascripts/constants.js Modified: branches/new-datamodel/src/ajax/javascripts/constants.js ============================================================================== --- branches/new-datamodel/src/ajax/javascripts/constants.js (original) +++ branches/new-datamodel/src/ajax/javascripts/constants.js Thu Aug 26 17:37:14 2010 @@ -21,8 +21,8 @@ var TYPE_PSIS_URL = HOST_PREF + "json/tmcl/types/"; var INSTANCE_PSIS_URL = HOST_PREF + "json/tmcl/instances/"; var OWN_URL = HOST_PREF + "isidorus"; -var SUMMARY_URL = HOST_PREF + "json/summary" -var TM_OVERVIEW = "/json/tmcl/overview/"; +var SUMMARY_URL = HOST_PREF + "json/summary"; +var TM_OVERVIEW = HOST_PREF + "json/tmcl/overview/"; var TIMEOUT = 20000; // const TIMEOUT = 10000 --> "const" doesn't work under IE Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Thu Aug 26 17:37:14 2010 @@ -11,7 +11,7 @@ // --- Some constants fot the http connections via the XMLHttpRequest-Object -var HOST_PREF = /*"http://localhost:8000/";*/ "192.168.178.23:8000/"; // of the form "http://(.+)/" +var HOST_PREF = "http://localhost:8000/"; /*"192.168.178.23:8000/"; // of the form "http://(.+)/"*/ var GET_PREFIX = HOST_PREF + "json/get/"; var GET_STUB_PREFIX = HOST_PREF + "json/topicstubs/"; var TMCL_TYPE_URL = HOST_PREF + "json/tmcl/type/"; @@ -21,9 +21,9 @@ var TYPE_PSIS_URL = HOST_PREF + "json/tmcl/types/"; var INSTANCE_PSIS_URL = HOST_PREF + "json/tmcl/instances/"; var OWN_URL = HOST_PREF + "isidorus"; -var SUMMARY_URL = HOST_PREF + "json/summary" +var SUMMARY_URL = HOST_PREF + "json/summary"; var MARK_AS_DELETED_URL = HOST_PREF + "mark-as-deleted"; -var TM_OVERVIEW = "/json/tmcl/overview/"; +var TM_OVERVIEW = HOST_PREF + "json/tmcl/overview/"; var TIMEOUT = 10000; // const TIMEOUT = 10000 --> "const" doesn't work under IE

1 0

[isidorus-cvs] r310 - branches/new-datamodel/playground
by Lukas Giessmann 21 Jul '10

21 Jul '10

Author: lgiessmann Date: Wed Jul 21 10:39:18 2010 New Revision: 310 Log: new-datamodel: modified the test-script Modified: branches/new-datamodel/playground/isidorus_test.sh Modified: branches/new-datamodel/playground/isidorus_test.sh ============================================================================== --- branches/new-datamodel/playground/isidorus_test.sh (original) +++ branches/new-datamodel/playground/isidorus_test.sh Wed Jul 21 10:39:18 2010 @@ -6,6 +6,14 @@ resDir="results" logDir="logfiles" +T="true"; +Nil="false"; + +doReq1=$T; +doReq2=$Nil; +doReq3=$Nil; +doReq4=$Nil; + dir1="req1"; dir2="req2"; dir3="req3"; @@ -45,32 +53,68 @@ fi fi - path1=$log1$counter; - path2=$log2$counter; - path3=$log3$counter; - path4=$log4$counter; - result1=$res1$counter; - result2=$res2$counter; - result3=$res3$counter; - result4=$res4$counter; - wget -o $path1".log" -O $result1".res" $req1; - wget -o $path2".log" -O $result2".res" $req2; - wget -o $path3".log" -O $result3".res" $req3; - wget -o $path4".log" -O $result4".res" $req4; + + if [ $doReq1 == $T ]; then + path1=$log1$counter; + result1=$res1$counter; + wget -o $path1".log" -O $result1".res" $req1; + fi + + if [ $doReq2 == $T ]; then + path2=$log2$counter; + result2=$res2$counter; + wget -o $path2".log" -O $result2".res" $req2; + fi + + if [ $doReq3 == $T ]; then + path3=$log3$counter; + result3=$res3$counter; + wget -o $path3".log" -O $result3".res" $req3; + fi + + if [ $doReq4 == $T ]; then + path4=$log4$counter; + result4=$res4$counter; + wget -o $path4".log" -O $result4".res" $req4; + fi +} + + +function init { + mkdir $wDir; + cd $wDir; + + if [ $doReq1 == $T ]; then + mkdir -p $logDir"/"$dir1; + mkdir -p $resDir"/"$dir1; + fi + + if [ $doReq2 == $T ]; then + mkdir -p $logDir"/"$dir2; + mkdir -p $resDir"/"$dir2; + fi + + if [ $doReq3 == $T ]; then + mkdir -p $logDir"/"$dir3; + mkdir -p $resDir"/"$dir3; + fi + + if [ $doReq4 == $T ]; then + mkdir -p $logDir"/"$dir4; + mkdir -p $resDir"/"$dir4; + fi +} + + + +function main { + init; + + for i in `seq 1 200000`; do + flow $i; + done } -mkdir $wDir; -cd $wDir; -mkdir -p $logDir"/"$dir1; -mkdir -p $logDir"/"$dir2; -mkdir -p $logDir"/"$dir3; -mkdir -p $logDir"/"$dir4; -mkdir -p $resDir"/"$dir1; -mkdir -p $resDir"/"$dir2; -mkdir -p $resDir"/"$dir3; -mkdir -p $resDir"/"$dir4; -for i in `seq 1 50000`; do - flow $i; -done +main;

1 0

[isidorus-cvs] r309 - branches/new-datamodel/playground
by Lukas Giessmann 21 Jul '10

21 Jul '10

Author: lgiessmann Date: Wed Jul 21 08:24:50 2010 New Revision: 309 Log: new-datamodel: added a simple bash test-script for isidorus Added: branches/new-datamodel/playground/isidorus_test.sh (contents, props changed) Added: branches/new-datamodel/playground/isidorus_test.sh ============================================================================== --- (empty file) +++ branches/new-datamodel/playground/isidorus_test.sh Wed Jul 21 08:24:50 2010 @@ -0,0 +1,76 @@ +#!/bin/bash + +host="http://192.168.0.6:8000"; + +wDir="isidorus_test"; +resDir="results" +logDir="logfiles" + +dir1="req1"; +dir2="req2"; +dir3="req3"; +dir4="req4"; + +req1=$host"/isidorus/json/psis/"; +req2=$host"/isidorus/json/get/http://textgrid.org/serviceregistry/development/webpublish" +req3=$host"/isidorus/json/tmcl/types/" +req4=$host"/isidorus/json/topicstubs/http://textgrid.org/serviceregistry/development/webpublish" + +log1=$logDir"/"$dir1"/iteration_"; +log2=$logDir"/"$dir2"/iteration_"; +log3=$logDir"/"$dir3"/iteration_"; +log4=$logDir"/"$dir4"/iteration_"; + +res1=$resDir"/"$dir1"/iteration_"; +res2=$resDir"/"$dir2"/iteration_"; +res3=$resDir"/"$dir3"/iteration_"; +res4=$resDir"/"$dir4"/iteration_"; + +function flow { + echo "==== iteration: ${1} ===="; + counter=$1; + if [ $1 -lt 10 ]; then + counter="0000"$1; + else + if [ $1 -lt 100 ]; then + counter="000"$1; + else + if [ $1 -lt 1000 ]; then + counter="00"$1; + else + if [ $1 -lt 10000 ]; then + counter="0"$1; + fi + fi + fi + fi + + path1=$log1$counter; + path2=$log2$counter; + path3=$log3$counter; + path4=$log4$counter; + result1=$res1$counter; + result2=$res2$counter; + result3=$res3$counter; + result4=$res4$counter; + wget -o $path1".log" -O $result1".res" $req1; + wget -o $path2".log" -O $result2".res" $req2; + wget -o $path3".log" -O $result3".res" $req3; + wget -o $path4".log" -O $result4".res" $req4; +} + + + +mkdir $wDir; +cd $wDir; +mkdir -p $logDir"/"$dir1; +mkdir -p $logDir"/"$dir2; +mkdir -p $logDir"/"$dir3; +mkdir -p $logDir"/"$dir4; +mkdir -p $resDir"/"$dir1; +mkdir -p $resDir"/"$dir2; +mkdir -p $resDir"/"$dir3; +mkdir -p $resDir"/"$dir4; +for i in `seq 1 50000`; do + flow $i; +done

1 0

[isidorus-cvs] r308 - in branches/new-datamodel/src: ajax/javascripts rest_interface
by Lukas Giessmann 16 Jul '10

16 Jul '10

Author: lgiessmann Date: Fri Jul 16 05:07:51 2010 New Revision: 308 Log: new-datamodel: adapted the start-tm-engine to the new datamodel, all fragmentsa are created when the engine starts; set the defualt timeout of all ajax-requests to 20 seconds Modified: branches/new-datamodel/src/ajax/javascripts/constants.js branches/new-datamodel/src/rest_interface/rest-interface.lisp branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp Modified: branches/new-datamodel/src/ajax/javascripts/constants.js ============================================================================== --- branches/new-datamodel/src/ajax/javascripts/constants.js (original) +++ branches/new-datamodel/src/ajax/javascripts/constants.js Fri Jul 16 05:07:51 2010 @@ -23,7 +23,7 @@ var OWN_URL = HOST_PREF + "isidorus"; var SUMMARY_URL = HOST_PREF + "json/summary" var TM_OVERVIEW = "/json/tmcl/overview/"; -var TIMEOUT = 10000; // const TIMEOUT = 10000 --> "const" doesn't work under IE +var TIMEOUT = 20000; // const TIMEOUT = 10000 --> "const" doesn't work under IE Modified: branches/new-datamodel/src/rest_interface/rest-interface.lisp ============================================================================== --- branches/new-datamodel/src/rest_interface/rest-interface.lisp (original) +++ branches/new-datamodel/src/rest_interface/rest-interface.lisp Fri Jul 16 05:07:51 2010 @@ -62,7 +62,8 @@ (defvar *server-acceptor* nil) -(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp") (host-name "localhost") (port 8000)) +(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp") + (host-name "localhost") (port 8000)) "Start the Topic Map Engine on a given port, assuming a given hostname. Use the repository under repository-path" (when *server-acceptor* @@ -80,6 +81,11 @@ (setf *server-acceptor* (make-instance 'hunchentoot:acceptor :address host-name :port port)) (setf hunchentoot:*lisp-errors-log-level* :info) (setf hunchentoot:*message-log-pathname* "./hunchentoot-errors.log") + (map 'list #'(lambda(top) + (let ((psis-of-top (psis top))) + (when psis-of-top + (create-latest-fragment-of-topic (uri (first psis-of-top)))))) + (elephant:get-instances-by-class 'd:TopicC)) (hunchentoot:start *server-acceptor*)) (defun shutdown-tm-engine () Modified: branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp (original) +++ branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp Fri Jul 16 05:07:51 2010 @@ -180,8 +180,11 @@ (let ((http-method (hunchentoot:request-method*))) (if (or (eq http-method :POST) (eq http-method :PUT)) - (let ((external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) - (let ((json-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) + (let ((external-format + (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) + (let ((json-data + (hunchentoot:raw-post-data :external-format external-format + :force-text t))) (handler-case (let ((psis (json:decode-json-from-string json-data))) @@ -360,18 +363,22 @@ concatenated of the url-prefix and the relative path of all all files in the passed directory and its subdirectories" (let ((start-position-of-relative-path - (- (length (write-to-string (com.gigamonkeys.pathnames:file-exists-p path-to-files-directory))) 2))) + (- (length (write-to-string (com.gigamonkeys.pathnames:file-exists-p + path-to-files-directory))) 2))) (let ((files-and-urls nil)) - (com.gigamonkeys.pathnames:walk-directory path-to-files-directory - #'(lambda(current-path) - (let ((current-path-string - (write-to-string current-path))) - (let ((last-position-of-current-path - (- (length current-path-string) 1))) - (let ((current-url - (concatenate 'string url-prefix - (subseq current-path-string start-position-of-relative-path last-position-of-current-path)))) - (push (list :path current-path :url current-url) files-and-urls)))))) + (com.gigamonkeys.pathnames:walk-directory + path-to-files-directory + #'(lambda(current-path) + (let ((current-path-string + (write-to-string current-path))) + (let ((last-position-of-current-path + (- (length current-path-string) 1))) + (let ((current-url + (concatenate + 'string url-prefix + (subseq current-path-string start-position-of-relative-path + last-position-of-current-path)))) + (push (list :path current-path :url current-url) files-and-urls)))))) files-and-urls)))

1 0

[isidorus-cvs] r307 - branches/new-datamodel/src/json
by Lukas Giessmann 02 Jul '10

02 Jul '10

Author: lgiessmann Date: Fri Jul 2 12:44:02 2010 New Revision: 307 Log: new-datamodel: adapted some functions of the rest-interface to the new datamodel, so it is possible to read fragments Modified: branches/new-datamodel/src/json/json_tmcl.lisp branches/new-datamodel/src/json/json_tmcl_validation.lisp Modified: branches/new-datamodel/src/json/json_tmcl.lisp ============================================================================== --- branches/new-datamodel/src/json/json_tmcl.lisp (original) +++ branches/new-datamodel/src/json/json_tmcl.lisp Fri Jul 2 12:44:02 2010 @@ -1757,7 +1757,8 @@ (let ((l-is-type (handler-case (progn - (topictype-p root topictype topictype-constraint) + (topictype-p root topictype topictype-constraint + nil revision) t) (Condition () nil))) (l-is-instance Modified: branches/new-datamodel/src/json/json_tmcl_validation.lisp ============================================================================== --- branches/new-datamodel/src/json/json_tmcl_validation.lisp (original) +++ branches/new-datamodel/src/json/json_tmcl_validation.lisp Fri Jul 2 12:44:02 2010 @@ -95,9 +95,8 @@ topictype or it is an instanceOf of the topictype or it is a subtype of the topictype. TMDM 7.2 + TMDM 7.3" (declare (type (or integer null) revision) - (TopicC topictype) - (list checked-topics) - (type (or TopicC null) topictype-constraint topictype)) + (type (or TopicC null) topictype topic-instance) + (list checked-topics)) (let ((current-checked-topics (append checked-topics (list topic-instance))) (akos-of-this (get-direct-supertypes-of-topic topic-instance :revision revision)) @@ -308,10 +307,6 @@ // ... The return value is a named list of the form (:subtypes (<topic> <...>) :checked-topics (<topic> <...>)" - (declare (type (or integer null) revision) - (list checked-topics) - (TopicC topic-instance) - (type (or TopicC null) topictype topictype-constraint)) (let ((current-checked-topics (append checked-topics (list topic-instance)))) (handler-case (topictype-p topic-instance topictype topictype-constraint nil revision) @@ -350,11 +345,9 @@ (revision *TM-REVISION*)) "Returns the topic-instance, all subtypes found by the function list-subtypes and all direct instances for the found subtypes." - (declare (type (or integer null) revision) - (TopicC topic-instance) - (type (or TopicC null) topictype topictype-constraint)) (let ((all-subtypes-of-this - (getf (list-subtypes topic-instance topictype topictype-constraint revision) + (getf (list-subtypes topic-instance topictype topictype-constraint + nil nil revision) :subtypes)) (type (get-item-by-psi *type-psi* :revision revision)) (instance (get-item-by-psi *instance-psi* :revision revision))

1 0

[isidorus-cvs] r306 - in branches/new-datamodel/src: json model unit_tests xml/xtm
by Lukas Giessmann 27 Jun '10

27 Jun '10

Author: lgiessmann Date: Sun Jun 27 07:30:32 2010 New Revision: 306 Log: new-datamodel: fixed bugs in get-latest-topic-by-psi, find-all-associations-for-topic, find-associations-for-topic, changed-p, with-tm; adapted the json-unit-tests to the new datamodel Modified: branches/new-datamodel/src/json/json_exporter.lisp branches/new-datamodel/src/json/json_importer.lisp branches/new-datamodel/src/model/changes.lisp branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp branches/new-datamodel/src/unit_tests/importer_test.lisp branches/new-datamodel/src/unit_tests/json_test.lisp branches/new-datamodel/src/xml/xtm/importer.lisp branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp branches/new-datamodel/src/xml/xtm/setup.lisp Modified: branches/new-datamodel/src/json/json_exporter.lisp ============================================================================== --- branches/new-datamodel/src/json/json_exporter.lisp (original) +++ branches/new-datamodel/src/json/json_exporter.lisp Sun Jun 27 07:30:32 2010 @@ -86,7 +86,8 @@ 'string "\"type\":" (if (instance-of parent-elem :revision revision) (json:encode-json-to-string - (map 'list #'uri (psis (instance-of parent-elem :revision revision)))) + (map 'list #'uri (psis (instance-of parent-elem :revision revision) + :revision revision))) "null"))) @@ -194,7 +195,7 @@ (let ((id (concatenate 'string "\"id\":" - (json:encode-json-to-string (topic-id instance :revision revision)))) + (json:encode-json-to-string (topic-id instance revision)))) (itemIdentity (concatenate 'string "\"itemIdentities\":" @@ -218,7 +219,7 @@ (name (concatenate 'string "\"names\":" - (if (names instance) + (if (names instance :revision revision) (let ((j-names "[")) (loop for item in (names instance :revision revision) do (setf j-names @@ -231,7 +232,7 @@ (occurrence (concatenate 'string "\"occurrences\":" - (if (occurrences instance) + (if (occurrences instance :revision revision) (let ((j-occurrences "[")) (loop for item in (occurrences instance :revision revision) do (setf j-occurrences @@ -258,7 +259,7 @@ (let ((id (concatenate 'string "\"id\":" - (json:encode-json-to-string (topic-id topic :revision revision)))) + (json:encode-json-to-string (topic-id topic revision)))) (itemIdentity (concatenate 'string "\"itemIdentities\":" @@ -423,7 +424,7 @@ (declare (TopicC topic) (type (or integer null) revision)) (let ((id - (concatenate 'string "\"id\":\"" (topic-id topic :revision revision) "\"")) + (concatenate 'string "\"id\":\"" (topic-id topic revision) "\"")) (itemIdentity (concatenate 'string "\"itemIdentities\":" Modified: branches/new-datamodel/src/json/json_importer.lisp ============================================================================== --- branches/new-datamodel/src/json/json_importer.lisp (original) +++ branches/new-datamodel/src/json/json_importer.lisp Sun Jun 27 07:30:32 2010 @@ -31,13 +31,16 @@ (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 + (rev (get-revision)) ; creates a new revision, equal for all elements of the passed fragment + (tm-ids (getf fragment-values :tm-ids))) + (unless tm-ids + (error "From json-to-elem(): tm-ids must be set")) (let ((psi-of-topic (let ((psi-uris (getf topic-values :subjectIdentifiers))) (when psi-uris (first psi-uris))))) (elephant:ensure-transaction (:txn-nosync nil) - (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids))) + (xml-importer:with-tm (rev xtm-id (first tm-ids)) (loop for topicStub-values in (append topicStubs-values (list topic-values)) do (json-to-stub topicStub-values rev :tm xml-importer::tm @@ -72,12 +75,12 @@ (declare (TopicMapC tm)) (setf roles (xml-importer::set-standard-role-types roles start-revision)) (add-to-tm tm - (make-construct 'AssociationC - :start-revision start-revision - :item-identifiers item-identifiers - :instance-of instance-of - :themes themes - :roles roles))))) + (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) @@ -157,9 +160,11 @@ (make-identifier 'SubjectLocatorC uri start-revision)) (getf json-decoded-list :subjectLocators))) (topic-ids - (make-construct 'TopicIdentificationC - :uri (getf json-decoded-list :id) - :xtm-id xtm-id))) + (when (getf json-decoded-list :id) + (list + (make-construct 'TopicIdentificationC + :uri (getf json-decoded-list :id) + :xtm-id xtm-id))))) ;; 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 Modified: branches/new-datamodel/src/model/changes.lisp ============================================================================== --- branches/new-datamodel/src/model/changes.lisp (original) +++ branches/new-datamodel/src/model/changes.lisp Sun Jun 27 07:30:32 2010 @@ -28,35 +28,35 @@ ((tm (get-item-by-item-identifier tm-id :revision 0)) (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)) - ;(format t "(start-revision vi): ~a~&" (start-revision vi)) (pushnew (start-revision vi) revision-set)) (sort revision-set #'<))) -(defun find-all-associations-for-topic (top &key (revision *TM-REVISION*)) - "Finds all associations for a topic." - (remove-duplicates - (map 'list #'(lambda(role) - (parent role :revision revision)) - (player-in-roles top :revision revision)))) - - -(defun find-associations-for-topic (top &key (revision *TM-REVISION*)) - "Finds all associations of this topic except type-instance-associations." - (let - ((type-instance-topic - (d:identified-construct - (elephant:get-instance-by-value 'PersistentIdC - 'uri - constants:*type-instance-psi*)))) - (remove-if - #'(lambda(assoc) - (when (eql (instance-of assoc :revision revision) - type-instance-topic) - t)) - (find-all-associations-for-topic top :revision revision)))) +(defgeneric find-all-associations (instance &key revision) + (:documentation "Finds all associations for a topic.") + (:method ((instance TopicC) &key (revision *TM-REVISION*)) + (declare (type (or integer null) revision)) + (remove-duplicates + (map 'list #'(lambda(role) + (parent role :revision revision)) + (player-in-roles instance :revision revision))))) + + +(defgeneric find-associations (instance &key revision) + (:documentation "Finds all associations of this topic except + type-instance-associations.") + (:method ((instance TopicC) &key (revision *TM-REVISION*)) + (declare (type (or integer null) revision)) + (let ((type-instance-topic + (d:identified-construct + (elephant:get-instance-by-value + 'PersistentIdC 'uri *type-instance-psi*)))) + (remove-if + #'(lambda(assoc) + (eql (instance-of assoc :revision revision) + type-instance-topic)) + (find-all-associations instance :revision revision))))) (defgeneric find-referenced-topics (construct &key revision) @@ -127,7 +127,7 @@ (occurrences top :revision revision)) (mapcan #'(lambda(assoc) (find-referenced-topics assoc :revision revision)) - (find-associations-for-topic top :revision revision)))))) + (find-associations top :revision revision)))))) (defgeneric changed-p (construct revision) @@ -154,16 +154,17 @@ ((first-player-in-associations (remove-if-not (lambda (association) - (eq (player (first (roles association))) + (eq (player (first (roles association :revision revision)) + :revision revision) topic)) - (find-associations-for-topic topic))) + (find-associations topic :revision revision))) (all-constructs (union - (get-all-identifiers-of-construct topic) + (get-all-identifiers-of-construct topic :revision revision) (union - (names topic) + (names topic :revision revision) (union - (occurrences topic) + (occurrences topic :revision revision) first-player-in-associations))))) (some (lambda (construct) @@ -216,15 +217,20 @@ cached-fragments (remove nil - (map 'list - (lambda (top) - (when (changed-p top revision) - (make-instance 'FragmentC - :revision revision - :associations (find-associations-for-topic top :revision revision) ;TODO: this quite probably introduces code duplication with query: Check! - :referenced-topics (find-referenced-topics top :revision revision) - :topic top))) - (get-all-topics revision)))))) + (map + 'list + (lambda (top) + (when (changed-p top revision) + (make-instance 'FragmentC + :revision revision + :associations (find-associations + top :revision revision) + ;TODO: this quite probably introduces + ;code duplication with query: Check! + :referenced-topics (find-referenced-topics + top :revision revision) + :topic top))) + (get-all-topics revision)))))) (defun get-fragment (unique-id) "get a fragment by its unique id" @@ -256,12 +262,18 @@ ;topics already have the source locator in (at least) one PSI, so we ;do not need to add an extra item identifier to them. However, we ;need to do that for all their characteristics + associations - (mapc (lambda (name) (add-source-locator name :revision revision :source-locator source-locator)) + (mapc (lambda (name) + (add-source-locator name :revision revision + :source-locator source-locator)) (names top :revision revision)) - (mapc (lambda (occ) (add-source-locator occ :revision revision :source-locator source-locator)) + (mapc (lambda (occ) + (add-source-locator occ :revision revision + :source-locator source-locator)) (occurrences top :revision revision)) - (mapc (lambda (ass) (add-source-locator ass :revision revision :source-locator source-locator)) - (find-associations-for-topic top :revision revision))) + (mapc (lambda (ass) + (add-source-locator ass :revision revision + :source-locator source-locator)) + (find-associations top :revision revision))) (defun create-latest-fragment-of-topic (topic-psi) @@ -284,8 +296,10 @@ existing-fragment (make-instance 'FragmentC :revision start-revision - :associations (find-associations-for-topic topic) - :referenced-topics (find-referenced-topics topic) + :associations (find-associations + topic :revision start-revision) + :referenced-topics (find-referenced-topics + topic :revision start-revision) :topic topic))))))) Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Sun Jun 27 07:30:32 2010 @@ -685,9 +685,9 @@ (let ((latest-va (get-most-recent-versioned-assoc psi-inst 'identified-construct))) - (when latest-va + (when (and latest-va (versions latest-va)) (identified-construct - psi-inst :revision (start-revision latest-va)))))) + psi-inst :revision (start-revision (first (versions latest-va)))))))) (defun get-db-instances-by-class (class-symbol &key (revision *TM-REVISION*)) @@ -1500,7 +1500,7 @@ (occurrences top :revision 0)) (mapc (lambda (ass) (mark-as-deleted ass :revision revision :source-locator source-locator)) - (find-all-associations-for-topic top :revision 0)) + (find-all-associations top :revision 0)) (call-next-method))) Modified: branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/exporter_xtm1.0_test.lisp Sun Jun 27 07:30:32 2010 @@ -1118,27 +1118,28 @@ (test test-fragments-xtm1.0-versions (with-fixture merge-test-db () (handler-case (delete-file *out-xtm1.0-file*)(error () )) ;deletes file - if exist - - (let ((new-t100 (loop for item in (elephant:get-instances-by-class 'PersistentIdC) - when (string= (uri item) new-t100-psi) - return (identified-construct item)))) - + (let ((new-t100 + (loop for item in (elephant:get-instances-by-class 'd:PersistentIdC) + when (string= (uri item) new-t100-psi) + return (identified-construct item)))) (d:get-fragments fixtures::revision3) - (let ((fragment (loop for item in (elephant:get-instances-by-class 'FragmentC) + (let ((fragment (loop for item in (elephant:get-instances-by-class 'd:FragmentC) when (eq (topic item) new-t100) return item))) - (with-open-file (stream *out-xtm1.0-file* :direction :output) (write-string (export-xtm-fragment fragment :xtm-format '1.0) stream)))) - (let ((document (dom:document-element (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) + (let ((document + (dom:document-element + (cxml:parse-file *out-xtm1.0-file* (cxml-dom:make-dom-builder))))) (check-document-structure document 6 0 :ns-uri *xtm1.0-ns*) (loop for topic across (xpath-child-elems-by-qname document *xtm1.0-ns* "topic") do (loop for subjectIndicatorRef across (xpath-child-elems-by-qname (xpath-single-child-elem-by-qname topic *xtm1.0-ns* "subjectIdentity") *xtm1.0-ns* "subjectIndicatorRef") - do (let ((href (dom:get-attribute-ns subjectIndicatorRef *xtm1.0-xlink* "href"))) + do (let ((href (dom:get-attribute-ns subjectIndicatorRef + *xtm1.0-xlink* "href"))) (cond ((string= href core-sort-psi) (check-topic-id topic)) Modified: branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/exporter_xtm2.0_test.lisp Sun Jun 27 07:30:32 2010 @@ -70,7 +70,8 @@ (error () )) ;do nothing (handler-case (delete-file *out-xtm1.0-file*) (error () )) ;do nothing - (setup-repository *sample_objects_2_0.xtm* "data_base" :xtm-id "test-tm")) + (setup-repository *sample_objects_2_0.xtm* "data_base" :xtm-id "test-tm" + :tm-id "http://isidorus.org/test-tm")) ;(elephant:open-store (get-store-spec "data_base"))) Modified: branches/new-datamodel/src/unit_tests/importer_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/importer_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/importer_test.lisp Sun Jun 27 07:30:32 2010 @@ -328,7 +328,7 @@ (test test-error-detection "Test for the detection of common errors such as dangling -references, duplicate PSIs or item identifiers" + references, duplicate PSIs or item identifiers" (declare (optimize (debug 3))) (with-fixture bare-test-db() (signals missing-reference-error @@ -521,7 +521,8 @@ ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xml-importer:setup-repository - *notificationbase.xtm* dir :xtm-id *TEST-TM*) + *notificationbase.xtm* dir :xtm-id *TEST-TM* + :tm-id "http://isidorus.org/test-tm") (setf *TM-REVISION* 0) (elephant:open-store (xml-importer:get-store-spec dir)) (let ((variants (elephant:get-instances-by-class 'VariantC))) @@ -600,7 +601,8 @@ (let ((dir "data_base")) (with-fixture initialize-destination-db (dir) (xml-importer:setup-repository - *sample_objects.xtm* dir :xtm-id *TEST-TM* :xtm-format '1.0) + *sample_objects.xtm* dir :xtm-id *TEST-TM* :xtm-format '1.0 + :tm-id "http://isidorus.org/test-tm") ;(elephant:open-store (xml-importer:get-store-spec dir)) (is (= (length (elephant:get-instances-by-class 'VariantC)) 5)) (let ((t-2526 (get-item-by-id "t-2526"))) Modified: branches/new-datamodel/src/unit_tests/json_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/json_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/json_test.lisp Sun Jun 27 07:30:32 2010 @@ -59,97 +59,112 @@ (test test-to-json-string-topics - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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*) - + :xtm-id *TEST-TM*) + (elephant:open-store (xml-importer:get-store-spec dir)) - (let ((t50a (get-item-by-id "t50a"))) - (let ((t50a-string (to-json-string t50a)) + (let ((t50a (get-item-by-id "t50a" :xtm-id *TEST-TM* :revision rev-0))) + (let ((t50a-string (to-json-string t50a :revision 0)) (json-string (concatenate 'string "{\"id\":\"" (topic-id t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) (is (string= t50a-string json-string))) - (let ((t8 (get-item-by-id "t8"))) - (let ((t8-string (to-json-string t8)) + (let ((t8 (get-item-by-id "t8" :revision rev-0 :xtm-id *TEST-TM*))) + (let ((t8-string (to-json-string t8 :revision rev-0 :xtm-id *TEST-TM*)) (json-string (concatenate 'string "{\"id\":\"" (topic-id t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) (is (string= t8-string json-string)))) - (let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm"))) - (let ((t-topic-string (to-json-string t-topic)) + (let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm" :revision rev-0))) + (let ((t-topic-string (to-json-string t-topic :xtm-id "core.xtm" + :revision rev-0)) (json-string (concatenate 'string "{\"id\":\"" (topic-id t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) (is (string= t-topic-string json-string)))) - (let ((t301 (get-item-by-id "t301"))) - (let ((t301-string (to-json-string t301)) + (let ((t301 (get-item-by-id "t301" :xtm-id *TEST-TM* :revision rev-0))) + (let ((t301-string (to-json-string t301 :xtm-id *TEST-TM* :revision rev-0)) (json-string (concatenate 'string "{\"id\":\"" (topic-id t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}"))) (is (string= t301-string json-string)))) - (let ((t100 (get-item-by-id "t100"))) - (let ((t100-string (to-json-string t100)) + (let ((t100 (get-item-by-id "t100" :revision rev-0 :xtm-id *TEST-TM*))) + (let ((t100-string (to-json-string t100 :revision rev-0 :xtm-id *TEST-TM*)) (json-string (concatenate 'string "{\"id\":\"" (topic-id t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}"))) (is (string= t100-string json-string)))))))) (test test-to-json-string-associations - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 ((t57 (get-item-by-id "t57")) - (t59 (get-item-by-id "t59")) - (t202 (get-item-by-id "t202")) - (t58 (get-item-by-id "t58")) - (t203 (get-item-by-id "t203")) - (t64 (get-item-by-id "t64")) - (t62 (get-item-by-id "t62"))) + (let ((t57 (get-item-by-id "t57" :revision rev-0 :xtm-id *TEST-TM*)) + (t59 (get-item-by-id "t59" :revision rev-0 :xtm-id *TEST-TM*)) + (t202 (get-item-by-id "t202" :revision rev-0 :xtm-id *TEST-TM*)) + (t58 (get-item-by-id "t58" :revision rev-0 :xtm-id *TEST-TM*)) + (t203 (get-item-by-id "t203" :revision rev-0 :xtm-id *TEST-TM*)) + (t64 (get-item-by-id "t64" :revision rev-0 :xtm-id *TEST-TM*)) + (t62 (get-item-by-id "t62" :revision rev-0 :xtm-id *TEST-TM*))) (let ((association-1 - (loop for association in (elephant:get-instances-by-class 'AssociationC) - when (and (eq t57 (instance-of association)) - (eq t59 (instance-of (first (roles association)))) - (eq t202 (player (first (roles association)))) - (eq t58 (instance-of (second (roles association)))) - (eq t203 (player (second (roles association))))) + (loop for association in + (elephant:get-instances-by-class 'AssociationC) + when (and (eq t57 (instance-of association :revision rev-0)) + (eq t59 (instance-of + (first (roles association :revision rev-0)) + :revision rev-0)) + (eq t202 (player + (first (roles association :revision rev-0)) + :revision rev-0)) + (eq t58 (instance-of + (second (roles association :revision rev-0)) + :revision rev-0)) + (eq t203 (player + (second (roles association :revision rev-0)) + :revision rev-0))) return association)) (association-7 (identified-construct - (elephant:get-instance-by-value 'ItemIdentifierC 'uri - "http://psi.egovpt.org/itemIdentifiers#assoc_7")))) - (let ((association-1-string (to-json-string association-1)) + (elephant:get-instance-by-value + 'ItemIdentifierC 'uri + "http://psi.egovpt.org/itemIdentifiers#assoc_7") + :revision rev-0))) + (let ((association-1-string + (to-json-string association-1 :revision rev-0 :xtm-id *TEST-TM*)) (json-string (concatenate 'string "{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/broaderSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Data\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/narrowerSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]}"))) (is (string= association-1-string json-string))) - (let ((association-7-string (to-json-string association-7)) + (let ((association-7-string + (to-json-string association-7 :revision rev-0 :xtm-id *TEST-TM*)) (json-string (concatenate 'string "{\"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\"]}]}"))) (is (string= association-7-string json-string))) - (elephant:remove-association association-7 'roles (first (roles association-7))) - (elephant:remove-association association-7 'roles (first (roles association-7))) - (elephant:remove-association association-7 'instance-of t64) - (elephant:add-association association-7 'themes t64) - (elephant:add-association association-7 'themes t62) - (let ((association-7-string (to-json-string association-7)) + (let ((rev-1 (get-revision))) + (delete-role association-7 (first (roles association-7 :revision 0)) + :revision rev-1) + (delete-role association-7 (first (roles association-7 :revision 0)) + :revision rev-1) + (delete-type association-7 (instance-of association-7 :revision 0) + :revision rev-1) + (add-theme association-7 t62 :revision rev-1) + (add-theme association-7 t64 :revision rev-1)) + (let ((association-7-string + (to-json-string association-7 :revision rev-0 :xtm-id *TEST-TM*)) (json-string (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]],\"roles\":null}"))) (is (string= association-7-string json-string)))))))) (test test-to-json-string-fragments - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…")) @@ -159,31 +174,36 @@ (concatenate 'string "{\"topic\":{\"id\":\"" (d:topic-id (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}")) (frag-topic-string (concatenate 'string "{\"topic\":{\"id\":\"" (topic-id (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,\"tmIds\":[\"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)))))))) + (is (string= + frag-t100-string + (to-json-string frag-t100 :xtm-id *TEST-TM* :revision rev-0))) + (is (string= + frag-topic-string + (to-json-string frag-topic :xtm-id *TEST-TM* :revision rev-0)))))))) (test test-get-fragment-values-from-json-list-general - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) - (to-json-string fragment-obj)))) + (to-json-string fragment-obj :revision rev-0 :xtm-id *TEST-TM*)))) (let ((fragment-list (json-importer::get-fragment-values-from-json-list (json:decode-json-from-string json-fragment)))) (let ((topic (getf fragment-list :topic))) (is (string= (getf topic :ID) (d:topic-id - (d:identified-construct (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri - "http://psi.egovpt.org/standard/Topic+Maps+2002"))))) + (d:identified-construct + (elephant:get-instance-by-value + 'd:PersistentIdC 'd:uri + "http://psi.egovpt.org/standard/Topic+Maps+2002") + :revision rev-0)))) (is-false (getf topic :itemIdentities)) (is-false (getf topic :subjectLocators)) (is (= (length (getf topic :subjectIdentifiers)) 1)) @@ -196,18 +216,16 @@ (test test-get-fragment-values-from-json-list-names - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) - (to-json-string fragment-obj)))) + (to-json-string fragment-obj :revision rev-0 :xtm-id *TEST-TM*)))) (let ((fragment-list (json-importer::get-fragment-values-from-json-list (json:decode-json-from-string json-fragment)))) @@ -263,18 +281,16 @@ (test test-get-fragment-values-from-json-list-occurrences - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) - (to-json-string fragment-obj)))) + (to-json-string fragment-obj :revision rev-0 :xtm-id *TEST-TM*)))) (let ((fragment-list (json-importer::get-fragment-values-from-json-list (json:decode-json-from-string json-fragment)))) @@ -326,18 +342,16 @@ (test test-get-fragment-values-from-json-list-topicStubs - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) - (to-json-string fragment-obj)))) + (to-json-string fragment-obj :revision rev-0 :xtm-id *TEST-TM*)))) (let ((fragment-list (json-importer::get-fragment-values-from-json-list (json:decode-json-from-string json-fragment)))) @@ -359,33 +373,41 @@ (is-false subjectLocators) (is (string= (d:topic-id topic) id)) (cond - ((string= subjectIdentifier "http://psi.egovpt.org/types/semanticstandard") + ((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") + ((string= subjectIdentifier + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") (is-false itemIdentities)) - ((string= subjectIdentifier "http://psi.egovpt.org/types/long-name") + ((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") + ((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") + ((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") + ((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") + ((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") + ((string= subjectIdentifier + "http://psi.egovpt.org/types/standardIsAboutSubject") (is (= (length itemIdentities) 1)) (is (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t60"))) @@ -393,23 +415,29 @@ (is (= (length itemIdentities) 1)) (is (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t61"))) - ((string= subjectIdentifier "http://psi.egovpt.org/subject/Semantic+Description") + ((string= subjectIdentifier + "http://psi.egovpt.org/subject/Semantic+Description") (is-false itemIdentities)) - ((string= subjectIdentifier "http://psi.egovpt.org/types/serviceUsesStandard") + ((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") + ((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") + ((string= subjectIdentifier + "http://psi.egovpt.org/service/Norwegian+National+Curriculum") (is-false itemIdentities)) - ((string= subjectIdentifier "http://psi.egovpt.org/types/StandardRoleType") + ((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") + ((string= subjectIdentifier + "http://psi.egovpt.org/status/InternationalStandard") (is (= (length itemIdentities) 1)) (is (string= (first itemIdentities) "http://psi.egovpt.org/itemIdentifiers#t52"))) @@ -419,18 +447,16 @@ (test test-get-fragment-values-from-json-list-associations - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (create-latest-fragment-of-topic "http://psi.egovpt.org/standard/Topic+Maps+2002"))) - (to-json-string fragment-obj)))) + (to-json-string fragment-obj :revision rev-0 :xtm-id *TEST-TM*)))) (let ((fragment-list (json-importer::get-fragment-values-from-json-list (json:decode-json-from-string json-fragment)))) @@ -491,12 +517,10 @@ (test test-json-importer-general-1 - (let - ((dir "data_base")) + (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 (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)) @@ -522,12 +546,10 @@ (test test-json-importer-general-2 - (let - ((dir "data_base")) + (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 (json-importer:json-to-elem *t64*) (let ((test-tm (loop for tm in (elephant:get-instances-by-class 'TopicMapC) @@ -580,16 +602,14 @@ (test test-json-importer-general-3 - (let - ((dir "data_base")) + (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 (json-importer:json-to-elem *t64*) (json-importer:json-to-elem *t100-3*) - (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 'd:TopicC)) 28)) ;13 new topics + (is (= (length (elephant:get-instances-by-class 'd: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) @@ -609,162 +629,195 @@ (test test-json-importer-topics-1 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (json-importer:json-to-elem *t64*) (json-importer:json-to-elem *t100-3*) (let ((topics (elephant:get-instances-by-class 'TopicC))) (loop for topic in topics - do (let ((psi (uri (first (psis topic))))) + do (let ((psi (uri (first (psis topic :revision rev-0))))) (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))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= (uri (first (item-identifiers topic :revision rev-0))) "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))) + ((string= psi + "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") ;t7 + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= (uri (first (item-identifiers topic :revision rev-0))) "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))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= (uri (first (item-identifiers topic :revision rev-0))) "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))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= (uri (first (item-identifiers topic :revision rev-0))) "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")))))))))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t54")))))))))) (test test-json-importer-topics-2 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (json-importer:json-to-elem *t64*) (json-importer:json-to-elem *t100-3*) (let ((topics (elephant:get-instances-by-class 'TopicC))) (loop for topic in topics - do (let ((psi (uri (first (psis topic))))) + do (let ((psi (uri (first (psis topic :revision rev-0))))) (cond ((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"))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "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"))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "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"))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t61"))) + ((string= psi + "http://psi.egovpt.org/types/StandardRoleType") ;t62 + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "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))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t63"))) + ((string= psi + "http://psi.egovpt.org/types/serviceUsesStandard") ;t64 + (is (= (length (names topic :revision rev-0)) 1)) + (is (string= (charvalue (first (names topic :revision rev-0))) "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")))))))))) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t64")))))))))) (test test-json-importer-topics-3 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (json-importer:json-to-elem *t64*) (json-importer:json-to-elem *t100-3*) (let ((topics (elephant:get-instances-by-class 'TopicC))) (loop for topic in topics - do (let ((psi (uri (first (psis topic))))) + do (let ((psi (uri (first (psis topic :revision rev-0))))) (cond ((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))) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100")) + (is (= (length (names topic :revision rev-0)) 1)) + (is (string= (charvalue (first (names topic :revision rev-0))) "ISO 19115")) - (is (= (length (item-identifiers (first (names topic)))))) - (is (string= (uri (first (item-identifiers (first (names topic))))) + (is (= (length (item-identifiers + (first (names topic :revision rev-0)) + :revision rev-0)))) + (is (string= (uri (first + (item-identifiers + (first (names topic :revision rev-0)) + :revision rev-0))) "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 (= (length (variants + (first (names topic :revision rev-0)) + :revision rev-0)) 2)) + (let ((variant-1 (first + (variants + (first (names topic :revision rev-0)) + :revision rev-0))) + (variant-2 (second + (variants + (first (names topic :revision rev-0)) + :revision rev-0)))) + (is (= (length + (item-identifiers variant-1 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers variant-1 + :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100_n1_v1")) + (is (= (length + (item-identifiers variant-2 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers + variant-2 :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100_n1_v2")) + (is (= (length (themes variant-1 :revision rev-0)) 1)) + (is (string= + (uri (first (psis (first (themes variant-1 + :revision rev-0))))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#display")) + (is (= (length (themes variant-2 :revision rev-0)) 1)) + (is (string= + (uri (first + (psis (first (themes variant-2 + :revision rev-0)) + :revision rev-0))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort")) (is (string= (charvalue variant-1) "Geographic Information - Metadata")) (is (string= (datatype variant-1) @@ -773,31 +826,39 @@ "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 (= (length (occurrences topic :revision rev-0)) 4)) + (let ((occ-1 (first (occurrences topic :revision rev-0))) + (occ-2 (second (occurrences topic :revision rev-0))) + (occ-3 (third (occurrences topic :revision rev-0))) + (occ-4 (fourth (occurrences topic :revision rev-0)))) + (is (= (length (item-identifiers occ-1 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers occ-1 :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100_o1")) + (is (= (length (item-identifiers occ-2 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers occ-2 :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100_o2")) + (is (= (length (item-identifiers occ-3 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers occ-3 :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100_o3")) + (is (= (length (item-identifiers occ-4 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers occ-4 :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t100_o4")) + (is (string= + (uri (first (psis (instance-of occ-1 :revision rev-0)))) + "http://psi.egovpt.org/types/standardHasStatus")) + (is (string= + (uri (first (psis (instance-of occ-2 :revision rev-0)))) + "http://psi.egovpt.org/types/description")) + (is (string= + (uri (first (psis (instance-of occ-3 :revision rev-0)))) + "http://psi.egovpt.org/types/standardValidFromDate")) + (is (string= + (uri (first (psis (instance-of occ-4 :revision rev-0)))) + "http://psi.egovpt.org/types/links")) (is (string= (datatype occ-1) "http://www.w3.org/2001/XMLSchema#anyURI")) (is (string= (charvalue occ-1) @@ -817,86 +878,94 @@ (test test-json-importer-topics-4 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (json-importer:json-to-elem *t64*) (json-importer:json-to-elem *t100-3*) (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/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))) + do (let ((psi (uri (first (psis topic :revision rev-0))))) + (cond ((string= + psi + "http://psi.egovpt.org/subject/Semantic+Description") ;t201 + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is-false (item-identifiers topic :revision rev-0))) ((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 + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is-false (item-identifiers topic :revision rev-0))) + ((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))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 2)) + (is (or (string= (uri (first (psis topic :revision rev-0))) "http://psi.egovpt.org/service/Google+Maps") - (string= (uri (first (psis topic))) + (string= (uri (first (psis topic :revision rev-0))) "http://maps.google.com"))) - (is (or (string= (uri (second (psis topic))) + (is (or (string= (uri (second (psis topic :revision rev-0))) "http://psi.egovpt.org/service/Google+Maps") - (string= (uri (second (psis topic))) + (string= (uri (second (psis topic :revision rev-0))) "http://maps.google.com"))) - (is-false (item-identifiers topic)))))))))) + (is-false (item-identifiers topic :revision rev-0)))))))))) (test test-json-importer-associations - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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 (json-importer:json-to-elem *t64*) (json-importer:json-to-elem *t100-3*) (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))) + (elephant:get-instance-by-value + 'ItemidentifierC 'uri + "http://psi.egovpt.org/itemIdentifiers#assoc_7") + :revision rev-0))) + (is (= (length (item-identifiers assoc-7 :revision rev-0)))) + (is (string= (uri (first (item-identifiers assoc-7 :revision rev-0))) "http://psi.egovpt.org/itemIdentifiers#assoc_7")) - (is (= (length (roles assoc-7)) 2)) - (is (string= (uri (first (psis (instance-of assoc-7)))) + (is (= (length (roles assoc-7 :revision rev-0)) 2)) + (is (string= (uri (first (psis (instance-of assoc-7 :revision rev-0) + :revision rev-0))) "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)))) + (let ((role-1 (first (roles assoc-7 :revision rev-0))) + (role-2 (second (roles assoc-7 :revision rev-0)))) + (is (string= (uri (first (psis (instance-of role-1 :revision rev-0) + :revision rev-0))) "http://psi.egovpt.org/types/ServiceRoleType")) - (is (or (string= (uri (first (psis (player role-1)))) + (is (or (string= (uri (first (psis (player role-1 :revision rev-0) + :revision rev-0))) "http://psi.egovpt.org/service/Google+Maps") - (string= (uri (first (psis (player role-1)))) + (string= (uri (first (psis (player role-1 :revision rev-0) + :revision rev-0))) "http://maps.google.com"))) - (is (string= (uri (first (psis (instance-of role-2)))) + (is (string= (uri (first (psis (instance-of role-2 :revision rev-0) + :revision rev-0))) "http://psi.egovpt.org/types/StandardRoleType")) - (is (string= (uri (first (psis (player role-2)))) + (is (string= (uri (first (psis (player role-2 :revision rev-0) + :revision rev-0))) "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metada…"))))))) (test test-json-importer-merge-1 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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-isidorus closes the store (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)) @@ -906,12 +975,12 @@ (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))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "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))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "http://www.isidor.us/unittests/testtm") return tm))) (is-true (and core-tm test-tm))) @@ -921,141 +990,194 @@ (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))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "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))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "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))))) + do (let ((psi (uri (first (psis topic :revision rev-0))))) (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")))) + (is (= (length (in-topicmaps topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.isidor.us/unittests/testtm")) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 2)) + (is (or (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t3") + (string= + (uri (second (item-identifiers topic :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t3"))) + (is (or (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t3") + (string= + (uri (second (item-identifiers topic :revision rev-0))) + "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))))) + (is (= (length (in-topicmaps topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) "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))) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 1)) + (is (string= (uri (first (item-identifiers topic :revision rev-0))) "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"))))))))))) + (is (= (length (in-topicmaps topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.isidor.us/unittests/testtm")) + (is-false (names topic :revision rev-0)) + (is-false (occurrences topic :revision rev-0)) + (is-false (locators topic :revision rev-0)) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 2)) + (is (or (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t55") + (string= + (uri (second (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t55"))) + (is (or (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t55_1") + (string= + (uri (second (item-identifiers topic :revision rev-0))) + "http://psi.egovpt.org/itemIdentifiers#t55_1"))))))))))) (test test-json-importer-merge-2 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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-isidorus closes the store (json-importer:json-to-elem *t100-1*) (let ((core-tm (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "http://www.topicmaps.org/xtm/1.0/core.xtm") - return tm)) + return tm)) (test-tm (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "http://www.isidor.us/unittests/testtm") return tm))) (is-true (and core-tm test-tm))) (json-importer:json-to-elem *t100-2*) (let ((topics (elephant:get-instances-by-class 'TopicC))) (loop for topic in topics - do (let ((psi (uri (first (psis topic))))) + do (let ((psi (uri (first (psis topic :revision rev-0))))) (cond - ((string= psi "http://psi.egovpt.org/types/standard") t) ;was already checked - ((string= psi "http://psi.egovpt.org/types/long-name") t) ;was already checked - ((string= psi "http://psi.egovpt.org/types/links") t) ;was already checked + ((string= psi "http://psi.egovpt.org/types/standard") + t) ;was already checked + ((string= psi "http://psi.egovpt.org/types/long-name") + t) ;was already checked + ((string= psi "http://psi.egovpt.org/types/links") + t) ;was already checked ((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 (= (length (in-topicmaps topic :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.isidor.us/unittests/testtm")) + (is (= (length (psis topic :revision rev-0)) 1)) + (is (= (length (item-identifiers topic :revision rev-0)) 2)) + (is (or (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100") + (string= + (uri (second (item-identifiers topic :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100"))) + (is (or (string= + (uri (first (item-identifiers topic :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_new") + (string= + (uri (second (item-identifiers topic :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_new"))) + (is (= (length (names topic :revision rev-0)))) + (let ((name (first (names topic :revision rev-0)))) + (is (= (length (item-identifiers name :revision rev-0)) 2)) + (is (or (string= + (uri (first (item-identifiers name :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_n1") + (string= + (uri (second (item-identifiers name :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_n1"))) + (is (or (string= + (uri (first (item-identifiers name :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_n1a") + (string= + (uri (second (item-identifiers name :revision rev-0))) + "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 (= (length (variants name :revision rev-0)) 2)) + (let ((variant-1 (first (variants name :revision rev-0))) + (variant-2 (second (variants name :revision rev-0)))) + (is (= (length (item-identifiers variant-1 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers variant-1 :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_n_v1")) + (is (= (length (item-identifiers variant-2 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers variant-2 :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_n_v2")) + (is (= (length (themes variant-1 :revision rev-0)) 2)) + (is (or (string= + (uri + (first + (psis + (first (themes variant-1 :revision rev-0)) + :revision rev-0))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") + (string= + (uri + (first + (psis (second (themes variant-1 :revision rev-0)) + :revision rev-0))) + "http://www.topicmaps.org/xtm/1.0/core.xtm#sort"))) + (is (or (string= + (uri + (first + (psis (first (themes variant-1 :revision rev-0)) + :revision rev-0))) + "http://psi.egovpt.org/types/long-name") + (string= + (uri + (first + (psis (second (themes variant-1 :revision rev-0)) + :revision rev-0))) + "http://psi.egovpt.org/types/long-name"))) + (is (= (length (themes variant-2 :revision rev-0)) 1)) + (is (string= + (uri + (first + (psis (first (themes variant-2 :revision rev-0)) + :revision rev-0))) + "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) @@ -1064,19 +1186,25 @@ "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 (= (length (occurrences topic :revision rev-0)) 2)) + (let ((occ-1 (first (occurrences topic :revision rev-0))) + (occ-2 (second (occurrences topic :revision rev-0)))) + (is (= (length (item-identifiers occ-1 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers occ-1 :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_o1")) + (is (= (length (item-identifiers occ-2 :revision rev-0)) 1)) + (is (string= + (uri (first (item-identifiers occ-2 :revision rev-0))) + "http://www.egovpt.org/itemIdentifiers#t100_o2")) + (is (string= + (uri (first (psis (instance-of occ-1 :revision rev-0) + :revision rev-0))) + "http://psi.egovpt.org/types/links")) + (is (string= + (uri (first (psis (instance-of occ-2 :revision rev-0) + :revision rev-0))) + "http://psi.egovpt.org/types/links")) (is (string= (datatype occ-1) "http://www.w3.org/2001/XMLSchema#anyURI")) (is (string= (charvalue occ-1) @@ -1086,178 +1214,276 @@ (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")) + (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")))) + (is (= (length (in-topicmaps topic :revision rev-0)) 2)) + (is (or (string= + (uri + (first + (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.topicmaps.org/xtm/1.0/core.xtm") + (string= + (uri + (first + (item-identifiers + (second (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.topicmaps.org/xtm/1.0/core.xtm"))) + (is (or (string= + (uri + (first + (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.isidor.us/unittests/testtm") + (string= + (uri + (first + (item-identifiers + (second (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "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")))))))))))) + (is (= (length (in-topicmaps topic :revision rev-0)) 1)) + (is (string= + (uri + (first + (item-identifiers + (first (in-topicmaps topic :revision rev-0)) + :revision rev-0))) + "http://www.topicmaps.org/xtm/1.0/core.xtm")))))))))))) (test test-json-importer-merge-3 - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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-isidorus closes the store (json-importer:json-to-elem *t100-1*) (let ((core-tm (loop for tm in (elephant:get-instances-by-class 'TopicMapC) - when (string= (uri (first (item-identifiers tm))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "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))) + when (string= (uri (first (item-identifiers tm :revision rev-0))) "http://www.isidor.us/unittests/testtm") return tm))) (is-true (and core-tm test-tm))) (json-importer:json-to-elem *t100-2*) (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)) + (is (string= + (uri (first (psis (instance-of instanceOf-assoc :revision rev-0) + :revision rev-0))) + constants::*type-instance-psi*)) + (is-false (d:themes instanceOf-assoc :revision rev-0)) + (is (string= + (d:uri + (first + (d:item-identifiers + (first (d:in-topicmaps instanceOf-assoc :revision rev-0)) + :revision rev-0))) + "http://www.isidor.us/unittests/testtm")) + (is-false (d:item-identifiers instanceOf-assoc :revision rev-0)) (let ((super-type-role - (loop for role in (roles instanceOf-assoc) - when (string= (uri (first (psis (instance-of role)))) - constants:*type-psi*) + (loop for role in (roles instanceOf-assoc :revision rev-0) + when (string= + (uri (first (psis (instance-of role :revision rev-0) + :revision rev-0))) + constants:*type-psi*) return role)) (sub-type-role - (loop for role in (roles instanceOf-assoc) - when (string= (uri (first (psis (instance-of role)))) + (loop for role in (roles instanceOf-assoc :revision rev-0) + when (string= (uri (first (psis (instance-of role :revision rev-0) + :revision rev-0))) constants:*instance-psi*) return role))) (is-true (and super-type-role sub-type-role)) - (is (string= (uri (first (psis (player super-type-role)))) + (is (string= (uri (first (psis (player super-type-role :revision rev-0) + :revision rev-0))) "http://psi.egovpt.org/types/standard")) - (is (string= (uri (first (psis (player sub-type-role)))) + (is (string= (uri (first (psis (player sub-type-role :revision rev-0) + :revision rev-0))) "http://psi.egovpt.org/standard/Common+Lisp"))))))) (test test-get-all-topic-psis - (let - ((dir "data_base")) + (let ((dir "data_base") + (rev-0 0)) (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)))) + *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" + :xtm-id *TEST-TM*) + (let ((json-psis + (json:decode-json-from-string (get-all-topic-psis :revision rev-0)))) + (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") + ((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") + ((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") + ((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") + ((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") + ((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#supertype-subtype") + ((string= + (first topic-psis) + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype-subtype") (is (= (length topic-psis) 1))) - ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype") + ((string= (first topic-psis) + "http://www.topicmaps.org/xtm/1.0/core.xtm#supertype") (is (= (length topic-psis) 1))) - ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype") + ((string= (first topic-psis) + "http://www.topicmaps.org/xtm/1.0/core.xtm#subtype") (is (= (length topic-psis) 1))) - ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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…") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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") + ((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")) + ((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")))) + (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))))))))) Modified: branches/new-datamodel/src/xml/xtm/importer.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/importer.lisp (original) +++ branches/new-datamodel/src/xml/xtm/importer.lisp Sun Jun 27 07:30:32 2010 @@ -104,24 +104,22 @@ when (string= xtm-id (xtm-id item)) return (uri item)))) + (defmacro with-tm ((revision xtm-id tm-id) &body body) "creates a topic map object called tm and puts it into the local scope" - `(let - ((ii (make-instance 'ItemIdentifierC - :uri ,tm-id - :start-revision ,revision))) - ;(add-to-version-history ii :start-revision ,revision) - (let - ((tm - (make-construct 'TopicMapC - :start-revision ,revision - :xtm-id ,xtm-id - :item-identifiers (list ii)))) + `(let ((ii (make-construct 'ItemIdentifierC + :uri ,tm-id + :start-revision ,revision))) + (let ((tm + (make-construct 'TopicMapC + :start-revision ,revision + :xtm-id ,xtm-id + :item-identifiers (list ii)))) (declare (ItemIdentifierC ii)) (declare (TopicMapC tm)) - ,@body))) - + + (defun init-isidorus (&optional (revision (get-revision))) "Initiatlize the database with the stubs of the core topics + PSIs defined in the XTM 1.0 spec. This includes a topic that represents the Modified: branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp (original) +++ branches/new-datamodel/src/xml/xtm/importer_xtm2.0.lisp Sun Jun 27 07:30:32 2010 @@ -356,8 +356,8 @@ (declare (integer start-revision)) (declare (TopicMapC tm)) (elephant:ensure-transaction (:txn-nosync t) - (let - ((item-identifiers + (let + ((item-identifiers (make-identifiers 'ItemIdentifierC assoc-elem "itemIdentity" start-revision)) (instance-of (from-type-elem Modified: branches/new-datamodel/src/xml/xtm/setup.lisp ============================================================================== --- branches/new-datamodel/src/xml/xtm/setup.lisp (original) +++ branches/new-datamodel/src/xml/xtm/setup.lisp Sun Jun 27 07:30:32 2010 @@ -22,9 +22,9 @@ importer for the XTM version. Does *not* close the store afterwards" (declare ((or pathname string) xtm-path)) (declare ((or pathname string) repository-path)) - (let - ((xtm-dom (dom:document-element (cxml:parse-file - (truename xtm-path) (cxml-dom:make-dom-builder))))) + (let ((xtm-dom (dom:document-element + (cxml:parse-file + (truename xtm-path) (cxml-dom:make-dom-builder))))) (unless elephant:*store-controller* (elephant:open-store (get-store-spec repository-path))) @@ -40,7 +40,7 @@ (defun setup-repository (xtm-path repository-path &key - tm-id + (tm-id (error "you must provide a stable identifier (PSI-style) for this TM")) (xtm-id (get-uuid)) (xtm-format '2.0)) "Initializes a repository and imports a XTM file into it"

1 0

[isidorus-cvs] r305 - in branches/new-datamodel/src: model unit_tests
by Lukas Giessmann 24 Jun '10

24 Jun '10

Author: lgiessmann Date: Thu Jun 24 12:40:10 2010 New Revision: 305 Log: new-datamodel: fixed a bug in the datamodel's test Modified: branches/new-datamodel/src/model/changes.lisp branches/new-datamodel/src/model/datamodel.lisp branches/new-datamodel/src/unit_tests/datamodel_test.lisp Modified: branches/new-datamodel/src/model/changes.lisp ============================================================================== --- branches/new-datamodel/src/model/changes.lisp (original) +++ branches/new-datamodel/src/model/changes.lisp Thu Jun 24 12:40:10 2010 @@ -11,12 +11,11 @@ (defun get-all-revisions () "Returns an ordered set of the start dates of all revisions in the engine" - ;TODO: this is a very inefficient implementation... it would equally - ;be possible to have a separate object that stored all such - ;revisions and only make the search from the latest version that's - ;stored their - (let - ((revision-set)) + ;TODO: this is a very inefficient implementation... it would equally + ;be possible to have a separate object that stored all such + ;revisions and only make the search from the latest version that's + ;stored their + (let ((revision-set)) (dolist (vi (elephant:get-instances-by-class 'VersionInfoC)) (pushnew (start-revision vi) revision-set)) (sort revision-set #'<))) Modified: branches/new-datamodel/src/model/datamodel.lisp ============================================================================== --- branches/new-datamodel/src/model/datamodel.lisp (original) +++ branches/new-datamodel/src/model/datamodel.lisp Thu Jun 24 12:40:10 2010 @@ -2067,7 +2067,10 @@ (identified-construct (first possible-top-ids) :revision revision)) (unless (= (length possible-top-ids) 1) - (error (make-duplicate-identifier-condition (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1" possible-top-ids topic-id xtm-id) topic-id))) + (error (make-duplicate-identifier-condition + (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1" + possible-top-ids topic-id xtm-id) + topic-id))) (identified-construct (first possible-top-ids) :revision revision) ;no revision need not to be chaecked, since the revision Modified: branches/new-datamodel/src/unit_tests/datamodel_test.lisp ============================================================================== --- branches/new-datamodel/src/unit_tests/datamodel_test.lisp (original) +++ branches/new-datamodel/src/unit_tests/datamodel_test.lisp Thu Jun 24 12:40:10 2010 @@ -483,11 +483,11 @@ (get-item-by-id (concatenate 'string "t" (write-to-string (elephant::oid top-3))) - :revision rev-0))) + :revision rev-0 :xtm-id nil))) (is-false (get-item-by-id (concatenate 'string "t" (write-to-string (elephant::oid top-3))) - :revision rev-1))))) + :revision rev-1 :xtm-id nil))))) (test test-get-item-by-item-identifier ()

1 0