isidorus-cvs
Threads by month
- ----- 2025 -----
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- 1037 discussions
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
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
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
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
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
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
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
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
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

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