[isidorus-cvs] r276 - in trunk/src: . json

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Apr 13 08:06:00 2010
New Revision: 276

Log:
json: added the functionality to deleted topics and associations to the json/RESTful-interface

Modified:
   trunk/src/isidorus.asd
   trunk/src/json/json_tmcl.lisp

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Tue Apr 13 08:06:00 2010
@@ -162,7 +162,7 @@
 					    :depends-on ("json_tmcl_constants" "json_exporter" ))
 				     (:file "json_tmcl_constants")
 				     (:file "json_tmcl"
-					    :depends-on ("json_tmcl_validation")))
+					    :depends-on ("json_tmcl_validation" "json_importer")))
 	                :depends-on ("model"
 				     "xml"))
 	       (:module "ajax"

Modified: trunk/src/json/json_tmcl.lisp
==============================================================================
--- trunk/src/json/json_tmcl.lisp	(original)
+++ trunk/src/json/json_tmcl.lisp	Tue Apr 13 08:06:00 2010
@@ -15,8 +15,9 @@
 ;; =============================================================================
 ; a test string ...
 (defvar cl-user::*js-1*
-  "{\"type\":\"Topic\",
-    \"topics\":[\"http://textgrid.org/isidorus/tmcl/service\"],
+  "{\"type\":\"Association\",
+    \"topics\":[\"http://textgrid.org/isidorus/tmcl/service\",
+                \"http://textgrid.org/isidorus/tmcl/parameter\"],
     \"associations\":[{\"itemIdentities\":null,
                       \"type\":[\"http://psi.topicmaps.org/tmcl/applies-to\"],
                       \"scopes\":null,
@@ -24,7 +25,7 @@
                                   \"type\":[\"http://psi.topicmaps.org/tmcl/constraint-role\"],
                                   \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/exc\"]},
                                  {\"itemIdentities\":null,
-                                  \"type\":[\"http://psi.topicmaps.org/tmcl/topictype-role\"],
+                                  \"type\":[\"http://psi.topicmaps.org/tmcl/topic-type-role\"],
                                   \"topicRef\":[\"http://textgrid.org/isidorus/tmcl/service\"]}]}],
     \"parent-topic\":[\"http://textgrid.org/isidorus/my-service/my-service\"],
     \"parent-name\":{\"itemIdentities\":null,
@@ -85,9 +86,109 @@
 ;                          role>
 ; \"roles\": <a list of roles in the specified json format>}
   (let ((values (json:decode-json-from-string json-data)))
-    values
-    ))
+    (let ((type nil)
+	  (topics nil)
+	  (associations nil)
+	  (parent-topic nil)
+	  (parent-name nil)
+	  (names nil)
+	  (variants nil)
+	  (occurrences nil)
+	  (parent-association nil)
+	  (roles nil)
+	  (rev (get-revision)))
+      (loop for entry in values
+	 when (consp entry)
+	 do (let ((st (car entry))
+		  (nd (cdr entry)))
+	      (cond ((eql st :type) (setf type nd))
+		    ((eql st :topics) (setf topics nd))
+		    ((eql st :associations) (setf associations nd))
+		    ((eql st :parent-topic) (setf parent-topic nd))
+		    ((eql st :parent-name) (setf parent-name nd))
+		    ((eql st :names) (setf names nd))
+		    ((eql st :variants) (setf variants nd))
+		    ((eql st :occurrences) (setf occurrences nd))
+		    ((eql st :parent-association) (setf parent-association nd))
+		    ((eql st :roles) (setf roles nd)))))
+      (cond ((string= type "Topic")
+	     (delete-topics-from-json topics rev))
+	    ((string= type "Association")
+	     (delete-associations-from-json associations rev))
+	    ((string= type "Occurrence")
+	     nil)
+	    ((string= type "Name")
+	     nil)
+	    ((string= type "Variant")
+	     nil)
+	    ((string= type "Role")
+	     nil)
+	    (t
+	     (error "From mark-as-deleted-from-json(): the type ~a is not defined"
+		    type))))))
+
+
 
+(defun find-association-from-json (json-plist)
+  (declare (list json-plist))
+  (let ((type-assocs
+	 (elephant:get-instances-by-value
+	  'd:AssociationC 'd:instance-of
+	  (d:get-item-by-psi (first (getf json-plist :type)))))
+	(scopes nil)
+	(err "From find-association-from-json(): "))
+    (loop for scope-entry in (getf json-plist :scopes)
+       do (let ((top (d:get-item-by-psi (first scope-entry))))
+	    (unless top
+	      (error "~a ~a not found"
+		     err (first scope-entry)))
+	    (pushnew top scopes)))
+    (let ((scope-assocs
+	   (loop for assoc in type-assocs
+	      when (not (set-exclusive-or scopes (themes assoc)))
+	      collect assoc)))
+      (loop for assoc in scope-assocs
+	 when (let ((found-roles
+		     (loop for j-role in (getf json-plist :roles)
+			when (let ((j-player (when (getf j-role :topicRef)
+					       (d:get-item-by-psi (first (getf j-role :topicRef)))))
+				   (j-type (when (getf j-role :type)
+					     (d:get-item-by-psi (first (getf j-role :type))))))
+			       (find-if #'(lambda(role)
+					    (and (eql (instance-of role) j-type)
+						 (eql (player role) j-player)))
+					(roles assoc)))
+			collect j-role)))
+		(= (length (roles assoc)) (length (getf json-plist :roles))
+		   (length found-roles)))
+	 return assoc))))
+
+
+(defun delete-associations-from-json (associations revision)
+  (declare (list associations) (integer revision))
+  (dolist (j-assoc associations)
+    (let ((plist (json-importer::get-association-values-from-json-list j-assoc))
+	  (err "From delete-association-from-json(): "))
+      (let ((assoc (find-association-from-json plist)))
+	(unless assoc
+	  (error "~a ~a not found" err plist))
+	(mark-as-deleted assoc :revision revision)))))
+  
+
+(defun delete-topics-from-json (topics revision)
+  (declare (list topics) (integer revision))
+  (let ((psis nil))
+    (dolist (uri topics)
+      (let ((psi (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri uri)))
+	(unless psi
+	  (error "From delete-topic-from-json(): PSI ~a not found" uri))
+	(pushnew psi psis)))
+    (let ((tops
+	   (remove-duplicates
+	    (map 'list #'d:identified-construct psis))))
+      (dolist (top tops)
+	(let ((psi (uri (first (psis top)))))
+	  (mark-as-deleted top :source-locator psi :revision revision))))))
 
 
 ;; =============================================================================