[isidorus-cvs] r332 - in trunk/src: . json rest_interface unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Sun Oct 24 16:43:48 UTC 2010
Author: lgiessmann
Date: Sun Oct 24 12:43:48 2010
New Revision: 332
Log:
fixed tifcket #81 -> fixed some bugs with the mark-as-deleted-handler of the UI when some topictypes are deleted and tmcl information is generated; adaption of the datamodel-unit-tests of TopicMapC with the equality of TopicMapC; fixed ticket #78 -> added a json unit-test that tests lage xml-contents in topic-occurrences that are serialized and deserialized to and from json; fixed ticket #80 -> added a RESTful handler that returns the latest used revision of the storage
Added:
trunk/src/unit_tests/poems_light.xtm.txt
- copied unchanged from r328, /trunk/src/unit_tests/poems_light.xtm
Modified:
trunk/src/isidorus.asd
trunk/src/json/json_tmcl.lisp
trunk/src/rest_interface/set-up-json-interface.lisp
trunk/src/unit_tests/datamodel_test.lisp
trunk/src/unit_tests/json_test.lisp
trunk/src/unit_tests/unittests-constants.lisp
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Sun Oct 24 12:43:48 2010
@@ -113,6 +113,7 @@
(:static-file "poems.rdf")
(:static-file "poems_light.rdf")
(:static-file "poems_light.xtm")
+ (:static-file "poems_light.xtm.txt")
(:static-file "poems_light_tm_ii.xtm")
(:static-file "poems_light_tm_ii_merge.xtm")
(:static-file "poems_light_tm_reification_xtm1.0.xtm")
Modified: trunk/src/json/json_tmcl.lisp
==============================================================================
--- trunk/src/json/json_tmcl.lisp (original)
+++ trunk/src/json/json_tmcl.lisp Sun Oct 24 12:43:48 2010
@@ -111,9 +111,11 @@
(concatenate 'string "\"rolePlayerConstraints\":" value)))
(otherrole-constraints
(let ((value
- (get-otherrole-constraints
- (getf constraint-topics :otherrole-constraints)
- :revision revision)))
+ (handler-case
+ (get-otherrole-constraints
+ (getf constraint-topics :otherrole-constraints)
+ :revision revision)
+ (condition () "null"))))
(concatenate 'string "\"otherRoleConstraints\":" value))))
(let ((json-string
(concatenate 'string "{" associationtype "," associationrole-constraints
@@ -154,7 +156,8 @@
:revision revision)))
(loop for role in (player-in-roles constraint-topic
:revision revision)
- when (and (eq constraint-role
+ when (and (parent role :revision revision)
+ (eq constraint-role
(instance-of role :revision revision))
(eq applies-to (instance-of
(parent role :revision revision)
@@ -697,6 +700,7 @@
when (and (eq constraint-role
(instance-of role
:revision revision))
+ (parent role :revision revision)
(eq applies-to (instance-of
(parent role :revision revision)
:revision revision)))
@@ -1655,6 +1659,7 @@
(instance-of role :revision revision))
(eq othertopictype-role
(instance-of role :revision revision)))
+ (parent role :revision revision)
(eq applies-to
(instance-of (parent role :revision revision)
:revision revision)))
@@ -1679,6 +1684,7 @@
:revision revision)
when (and (eq constraint-role
(instance-of c-role :revision revision))
+ (parent c-role :revision revision)
(eq applies-to
(instance-of (parent c-role
:revision revision)
Modified: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- trunk/src/rest_interface/set-up-json-interface.lisp (original)
+++ trunk/src/rest_interface/set-up-json-interface.lisp Sun Oct 24 12:43:48 2010
@@ -53,6 +53,8 @@
(defparameter *ajax-javascript-url-prefix* "/javascripts")
;the url suffix that calls the mark-as-deleted handler
(defparameter *mark-as-deleted-url* "/mark-as-deleted")
+;the get url to request the latest revision of the storage
+(defparameter *latest-revision-url* "/json/latest-revision/?$")
(defun set-up-json-interface (&key (json-get-prefix *json-get-prefix*)
@@ -72,7 +74,8 @@
(ajax-user-interface-css-directory-path *ajax-user-interface-css-directory-path*)
(ajax-javascripts-directory-path *ajax-javascript-directory-path*)
(ajax-javascripts-url-prefix *ajax-javascript-url-prefix*)
- (mark-as-deleted-url *mark-as-deleted-url*))
+ (mark-as-deleted-url *mark-as-deleted-url*)
+ (latest-revision-url *latest-revision-url*))
"registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
and also registers a file-hanlder to the html-user-interface"
@@ -148,6 +151,9 @@
hunchentoot:*dispatch-table*)
(push
(create-regex-dispatcher mark-as-deleted-url #'mark-as-deleted-handler)
+ hunchentoot:*dispatch-table*)
+ (push
+ (create-regex-dispatcher latest-revision-url #'return-latest-revision)
hunchentoot:*dispatch-table*))
;; =============================================================================
@@ -431,6 +437,25 @@
(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
+(defun return-latest-revision ()
+ "Returns an integer that represents the latest revision that
+ is used in the storage."
+ (handler-case
+ (if (eql (hunchentoot:request-method*) :GET)
+ (let ((sorted-revisions
+ (with-reader-lock (sort (d:get-all-revisions) #'>))))
+ (when sorted-revisions
+ (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+ (format nil "~a" (first sorted-revisions))))
+ (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))
+ (condition (err)
+ (progn
+ (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+ (setf (hunchentoot:content-type*) "text")
+ (format nil "Condition: \"~a\"" err)))))
+
+
+
;; =============================================================================
;; --- some helper functions ---------------------------------------------------
;; =============================================================================
Modified: trunk/src/unit_tests/datamodel_test.lisp
==============================================================================
--- trunk/src/unit_tests/datamodel_test.lisp (original)
+++ trunk/src/unit_tests/datamodel_test.lisp Sun Oct 24 12:43:48 2010
@@ -1950,7 +1950,9 @@
(is-false (d::equivalent-construct tm-1 :item-identifiers (list ii-2)))
(is-false (d::equivalent-construct tm-1 :reifier reifier-2))
(is-false (d::strictly-equivalent-constructs tm-1 tm-1))
- (is-false (d::strictly-equivalent-constructs tm-1 tm-2))))))
+ ;in our definition TopicMapC-constructs are always equal, since
+ ;item-identifiers and reifiers are not used for TMDM equlity
+ (is-true (d::strictly-equivalent-constructs tm-1 tm-2))))))
(test test-class-p ()
Modified: trunk/src/unit_tests/json_test.lisp
==============================================================================
--- trunk/src/unit_tests/json_test.lisp (original)
+++ trunk/src/unit_tests/json_test.lisp Sun Oct 24 12:43:48 2010
@@ -8,7 +8,7 @@
;;+-----------------------------------------------------------------------------
(defpackage :json-test
- (:use
+ (:use
:common-lisp
:xml-importer
:json-exporter
@@ -46,7 +46,8 @@
:test-delete-from-json-occurrence
:test-delete-from-json-variant
:test-delete-from-json-association
- :test-delete-from-json-role))
+ :test-delete-from-json-role
+ :test-occurrence-xml-content))
(in-package :json-test)
@@ -58,6 +59,13 @@
(in-suite json-tests)
+(defun read-file (strm)
+ "Reads a file from the beginning to the end."
+ (if (= (cl-user::stream-file-position strm) (file-length strm))
+ ""
+ (format nil "~a~%~a" (read-line strm) (read-file strm))))
+
+
(defvar *t100-1* "{\"topic\":{\"id\":\"t970\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\",\"http://www.egovpt.org/itemIdentifiers#t100_n1a\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o1\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.common-lisp.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\",\"http://psi.egovpt.org/itemIdentifiers#t55_1\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
(defvar *t100-2* "{\"topic\":{\"id\":\"t945\",\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100\",\"http://www.egovpt.org/itemIdentifiers#t100_new\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/standard/Common+Lisp\"],\"instanceOfs\":[[\"http://psi.egovpt.org/types/standard\"]],\"names\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"Common Lisp\",\"variants\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v1\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"],[\"http://psi.egovpt.org/types/long-name\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"Common-Lisp\"}},{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_n_v2\"],\"scopes\":[[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http://www.w3.org/2001/XMLSchema#string\",\"value\":\"CL\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http://www.egovpt.org/itemIdentifiers#t100_o2\"],\"type\":[\"http://psi.egovpt.org/types/links\"],\"scopes\":null,\"resourceRef\":\"http://www.cliki.net/\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"t220\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t3\",\"http://www.egovpt.org/itemIdentifiers#t3\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/standard\"]},{\"id\":\"t68\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#sort\"]},{\"id\":\"t284\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/long-name\"]},{\"id\":\"t74\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://www.topicmaps.org/xtm/1.0/core.xtm#display\"]},{\"id\":\"t324\",\"itemIdentities\":[\"http://psi.egovpt.org/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http://psi.egovpt.org/types/links\"]}],\"associations\":null,\"tmIds\":[\"http://www.isidor.us/unittests/testtm\"]}")
@@ -2141,7 +2149,42 @@
(is-false (mark-as-deleted-from-json j-req-3))
(is (= (length (roles assoc-1)) 2))
(is (= (length (roles assoc-2)) 2)))))))))
-
+
+
+(test test-occurrence-xml-content
+ "Tests the handling of long xml-contents in occurrences when serialized
+ and deserialised to and from json."
+ (with-fixture with-empty-db ("data_base")
+ (elephant:open-store (xml-importer:get-store-spec "data_base"))
+ (let ((xml-data
+ (with-open-file
+ (stream unittests-constants::*poems_light.xtm.txt*
+ :direction :input)
+ (read-file stream)))
+ (rev-1 100))
+ (let* ((occ-type (make-construct 'd:TopicC
+ :start-revision rev-1
+ :psis (list (make-construct 'd:PersistentIdC
+ :start-revision rev-1
+ :uri "occ-type"))))
+ (top (make-construct 'd:TopicC
+ :start-revision rev-1
+ :psis (list (make-construct 'd:PersistentIdC
+ :uri "test-topic"
+ :start-revision rev-1))
+ :occurrences
+ (list (make-construct 'd:OccurrenceC
+ :start-revision rev-1
+ :instance-of occ-type
+ :charvalue xml-data)))))
+ (is-true (occurrences top))
+ (is (string= (d:charvalue (first (occurrences top))) xml-data))
+ (let ((json-string
+ (to-json-string (first (occurrences top)))))
+ (is (string= (cdr (third (fifth (json:decode-json-from-string
+ json-string))))
+ xml-data)))))))
+
@@ -2173,4 +2216,5 @@
(it.bese.fiveam:run! 'test-delete-from-json-occurrence)
(it.bese.fiveam:run! 'test-delete-from-json-variant)
(it.bese.fiveam:run! 'test-delete-from-json-association)
- (it.bese.fiveam:run! 'test-delete-from-json-role))
\ No newline at end of file
+ (it.bese.fiveam:run! 'test-delete-from-json-role)
+ (it.bese.fiveam:run! 'test-occurrence-xml-content))
\ No newline at end of file
Modified: trunk/src/unit_tests/unittests-constants.lisp
==============================================================================
--- trunk/src/unit_tests/unittests-constants.lisp (original)
+++ trunk/src/unit_tests/unittests-constants.lisp Sun Oct 24 12:43:48 2010
@@ -31,6 +31,7 @@
:*atom-conf.lisp*
:*poems_light.rdf*
:*poems_light.xtm*
+ :*poems_light.xtm.txt*
:*full_mapping.rdf*
:*reification_xtm1.0.xtm*
:*reification_xtm2.0.xtm*
@@ -107,6 +108,10 @@
(asdf:component-pathname
(asdf:find-component *unit-tests-component* "poems_light.xtm")))
+(defparameter *poems_light.xtm.txt*
+ (asdf:component-pathname
+ (asdf:find-component *unit-tests-component* "poems_light.xtm.txt")))
+
(defparameter *full_mapping.rdf*
(asdf:component-pathname
(asdf:find-component *unit-tests-component* "full_mapping.rdf")))
More information about the Isidorus-cvs
mailing list