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%5C%22%5D,%5C%22subjectLocators%5C... Lisp","variants":[{"itemIdentities":["http://www.egovpt.org/itemIdentifiers#t100_n_v1%5C%22%5D,%5C%22scopes%5C%22:...")

(defvar *t100-2* "{"topic":{"id":"t945","itemIdentities":["http://www.egovpt.org/itemIdentifiers#t100%5C%22,%5C%22http://www.egovpt.org... Lisp","variants":[{"itemIdentities":["http://www.egovpt.org/itemIdentifiers#t100_n_v1%5C%22%5D,%5C%22scopes%5C%22:...") @@ -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")))