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")))