[isidorus-cvs] r333 - in trunk/src: model rest_interface

[Lukas Giessmann]

Author: lgiessmann
Date: Mon Oct 25 12:34:30 2010
New Revision: 333

Log:
fixed ticket #83 -> instead of throwing exceptions when errors occur in the tmcl-information-generation, there is returned an tmcl-info-object with reseted fields; fixed a bug in json-fragment-generation when its type was marked-as-deleted

Modified:
   trunk/src/model/datamodel.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Mon Oct 25 12:34:30 2010
@@ -682,12 +682,13 @@
   (let ((psi-inst
 	 (elephant:get-instance-by-value
 	  'PersistentIdC 'uri topic-psi)))
-    (let ((latest-va
-	   (get-most-recent-versioned-assoc
-	    psi-inst 'identified-construct)))
-      (when (and latest-va (versions latest-va))
-	(identified-construct
-	 psi-inst :revision (start-revision (first (versions latest-va))))))))
+    (when psi-inst
+      (let ((latest-va
+	     (get-most-recent-versioned-assoc
+	      psi-inst 'identified-construct)))
+	(when (and latest-va (versions latest-va))
+	  (identified-construct
+	   psi-inst :revision (start-revision (first (versions latest-va)))))))))
 
 
 (defun get-db-instances-by-class (class-symbol &key (revision *TM-REVISION*))
@@ -2156,10 +2157,12 @@
     #'null
     (map 'list
 	 #'(lambda(x)
-	     (when (loop for psi in (psis (instance-of x :revision revision)
-					  :revision revision)
-		      when (string= (uri psi) constants:*instance-psi*)
-		      return t)
+	     (when (and (parent x :revision revision)
+			(instance-of x :revision revision)
+			(loop for psi in (psis (instance-of x :revision revision)
+					       :revision revision)
+			   when (string= (uri psi) constants:*instance-psi*)
+			   return t))
 	       (loop for role in (roles (parent x :revision revision)
 					:revision revision)
 		  when (not (eq role x))

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 Oct 25 12:34:30 2010
@@ -252,12 +252,9 @@
 				hunchentoot:+http-not-found+)
 			  (setf (hunchentoot:content-type*) "text")
 			  (format nil "Topic \"~a\" not found." psis)))))
-	      (condition (err)
-		(progn
-		  (setf (hunchentoot:return-code*)
-			hunchentoot:+http-internal-server-error+)
-		  (setf (hunchentoot:content-type*) "text")
-		  (format nil "Condition: \"~a\"" err))))))
+	      (condition ()
+		(setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+		"{\"topicConstraints\":{\"exclusiveInstances\":null,\"subjectIdentifierConstraints\":null,\"subjectLocatorConstraints\":null,\"topicNameConstraints\":null,\"topicOccurrenceConstraints\":null,\"abstractConstraint\":false},\"associationsConstraints\":null}"))))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))