[isidorus-cvs] r77 - in trunk/src: json rest_interface

[Lukas Giessmann]

Author: lgiessmann
Date: Mon Jun 29 05:11:38 2009
New Revision: 77

Log:
json-server: fixed a bug with tmcl-type-validation when there is no topictype or no topictype-constraint or if they isn't either a topictype nor a topictype-constraint

Modified:
   trunk/src/json/json_tmcl.lisp
   trunk/src/json/json_tmcl_validation.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp

Modified: trunk/src/json/json_tmcl.lisp
==============================================================================
--- trunk/src/json/json_tmcl.lisp	(original)
+++ trunk/src/json/json_tmcl.lisp	Mon Jun 29 05:11:38 2009
@@ -35,7 +35,7 @@
 	     (let ((value
 		    (get-constraints-of-topic topics :treat-as treat-as)))
 	       (concatenate 'string "\"topicConstraints\":" value))))
-	(let ((available-associations ;what's with association which have only a associationrole-constraints?
+	(let ((available-associations
 	       (remove-duplicates
 		(loop for topic in topics
 		   append (get-available-associations-of-topic topic :treat-as treat-as)))))

Modified: trunk/src/json/json_tmcl_validation.lisp
==============================================================================
--- trunk/src/json/json_tmcl_validation.lisp	(original)
+++ trunk/src/json/json_tmcl_validation.lisp	Mon Jun 29 05:11:38 2009
@@ -287,7 +287,7 @@
 	(local-akos-checked))
 
     (when (not topictype-constraint)
-      (return-from valid-instance-p topic-instance))
+      (return-from valid-instance-p (list topic-instance)))
 
     (when (and topictype-constraint
 	       (not topictype))

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	Mon Jun 29 05:11:38 2009
@@ -169,8 +169,8 @@
 	(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)))
-			    (let ((tmcl 
+				 (json:decode-json-from-string json-data)))			    
+			    (let ((tmcl
 				   (json-tmcl:get-constraints-of-fragment psis :treat-as treat-as)))
 			      (if tmcl
 				  (progn