[isidorus-cvs] r883 - in branches/gdl-frontend/src: json/JTM model rest_interface

lgiessmann at common-lisp.net lgiessmann at common-lisp.net
Tue Sep 13 09:28:14 UTC 2011

Author: lgiessmann
Date: Tue Sep 13 02:28:13 2011
New Revision: 883

jtm-importer + gdl-interface: added a boolean variable to the jtm-importer, so a fragment of each topic that is contained in the received jtm-fragment can be created automiticaly


Modified: branches/gdl-frontend/src/json/JTM/jtm_importer.lisp
--- branches/gdl-frontend/src/json/JTM/jtm_importer.lisp	Tue Sep 13 02:07:39 2011	(r882)
+++ branches/gdl-frontend/src/json/JTM/jtm_importer.lisp	Tue Sep 13 02:28:13 2011	(r883)
@@ -29,7 +29,8 @@
 (defun import-construct-from-jtm-string (jtm-string &key
 					 (revision *TM-REVISION*)
-					 (jtm-format :1.1) tm-id)
+					 (jtm-format :1.1) tm-id
+					 (create-fragments nil))
   "Imports the passed jtm-string.
    Note tm-id needs not to be declared, but if the imported construct
    is a topicmap and it has no item-identifiers defined, a JTM-error
@@ -37,15 +38,18 @@
   (declare (String jtm-string)
 	   (type (or Null String) tm-id)
 	   (Integer revision)
-	   (Keyword jtm-format))
+	   (Keyword jtm-format)
+	   (Boolean create-fragments))
   (let* ((jtm-list (json:decode-json-from-string jtm-string)))
-     jtm-list :revision revision :jtm-format jtm-format :tm-id tm-id)))
+     jtm-list :revision revision :jtm-format jtm-format
+     :tm-id tm-id :create-fragments create-fragments)))
 (defun import-construct-from-jtm-decoded-list (jtm-list &key
-						(revision *TM-REVISION*)
-						(jtm-format :1.1) tm-id)
+					       (revision *TM-REVISION*)
+					       (jtm-format :1.1) tm-id
+					       (create-fragments nil))
   "Imports the passed jtm-decoded-list.
    Note tm-id needs not to be declared, but if the imported construct
    is a topicmap and it has no item-identifiers defined, a JTM-error
@@ -53,7 +57,8 @@
   (declare (List jtm-list)
 	   (Integer revision)
 	   (Keyword jtm-format)
-	   (type (or Null String) tm-id))
+	   (type (or Null String) tm-id)
+	   (Boolean create-fragments))
   (let* ((version (get-item :VERSION jtm-list))
 	 (item_type (get-item :ITEM--TYPE jtm-list))
 	 (prefixes (make-prefix-list-from-jtm-list (get-item :PREFIXES jtm-list)))
@@ -72,12 +77,13 @@
 	       (string= item_type item_type-topicmap))
 	    jtm-list tm-id :revision revision :prefixes prefixes
-	    :instance-of-p format-1.1-p))					   
+	    :instance-of-p format-1.1-p :create-fragments create-fragments))
 	  ((string= item_type item_type-topic)
 	   (import-topic-stub-from-jtm-list jtm-list nil :revision revision
 					    :prefixes prefixes)
 	   (merge-topic-from-jtm-list jtm-list :instance-of-p format-1.1-p
-				      :revision revision :prefixes prefixes))
+				      :revision revision :prefixes prefixes
+				      :create-fragment create-fragments))
 	  ((string= item_type item_type-name)
 	   (import-name-from-jtm-list jtm-list nil :revision revision
 				      :prefixes prefixes))
@@ -111,13 +117,14 @@
 (defun import-topic-map-from-jtm-list (jtm-list tm-id &key (revision *TM-REVISION*)
-				       prefixes (instance-of-p t))
+				       prefixes (instance-of-p t)
+				       (create-fragments nil))
   "Creates and returns a topic map corresponding to the tm-id or a given
    item-identifier in the jtm-list and returns the tm construct after all
    topics and associations contained in the jtm-list has been created."
   (declare (List jtm-list prefixes)
 	   (Integer revision)
-	   (Boolean instance-of-p))
+	   (Boolean instance-of-p create-fragments))
   (let* ((iis (let ((value (append (import-identifiers-from-jtm-strings
 				    (get-item :ITEM--IDENTIFIERS jtm-list)
 				    :prefixes prefixes)
@@ -134,8 +141,9 @@
 			     :item-identifiers iis)))
     (import-topic-stubs-from-jtm-lists j-tops (list tm) :revision revision
 				       :prefixes prefixes)
-    (merge-topics-from-jtm-lists j-tops (list tm) :instance-of-p instance-of-p
-				 :revision revision :prefixes prefixes)
+    (merge-topics-from-jtm-lists j-tops :instance-of-p instance-of-p
+				 :revision revision :prefixes prefixes
+				 :create-fragments create-fragments)
     (import-associations-from-jtm-lists j-assocs (list tm) :revision revision
 					:prefixes prefixes)
@@ -339,21 +347,24 @@
-(defun merge-topics-from-jtm-lists (jtm-lists parents &key (instance-of-p t)
-				    (revision *TM-REVISION*) prefixes)
+(defun merge-topics-from-jtm-lists (jtm-lists &key (instance-of-p t)
+				    (revision *TM-REVISION*) prefixes
+				    (create-fragments nil))
   "Creates and returns a list of topics."
-  (declare (List jtm-lists parents prefixes)
-	   (Boolean instance-of-p)
+  (declare (List jtm-lists prefixes)
+	   (Boolean instance-of-p create-fragments)
 	   (Integer revision))
   (map 'list #'(lambda(jtm-list)
 		  jtm-list :revision revision :prefixes prefixes
-		  :instance-of-p instance-of-p))
+		  :instance-of-p instance-of-p
+		  :create-fragment create-fragments))
 (defun merge-topic-from-jtm-list(jtm-list &key (instance-of-p t)
-				  (revision *TM-REVISION*) prefixes)
+				  (revision *TM-REVISION*) prefixes
+				 (create-fragment nil))
   "Creates and returns a topic object from the passed jtm
    list generated by json:decode-json-from-string.
    Note that the merged topics are not added explicitly to the parent
@@ -362,7 +373,8 @@
    to their topic map elements."
   (declare (List jtm-list prefixes)
 	   (Boolean instance-of-p)
-	   (Integer revision))
+	   (Integer revision)
+	   (Boolean create-fragment))
   (let* ((ids (append (get-item :ITEM--IDENTIFIERS jtm-list)
 		      (get-item :SUBJECT--IDENTIFIERS jtm-list)
 		      (get-item :SUBJECT--LOCATORS jtm-list)))
@@ -396,6 +408,8 @@
     (dolist (occ top-occs)
       (add-occurrence top occ :revision revision))
     (format t "t")
+    (when create-fragment
+      (create-latest-fragment-of-topic top))

Modified: branches/gdl-frontend/src/model/changes.lisp
--- branches/gdl-frontend/src/model/changes.lisp	Tue Sep 13 02:07:39 2011	(r882)
+++ branches/gdl-frontend/src/model/changes.lisp	Tue Sep 13 02:28:13 2011	(r883)
@@ -412,10 +412,12 @@
         (find-associations top :revision revision)))
-(defun create-latest-fragment-of-topic (topic-psi)
+(defun create-latest-fragment-of-topic (topic-or-psi)
   "Returns the latest fragment of the passed topic-psi"
-  (declare (string topic-psi))
-  (let ((topic (get-latest-topic-by-psi topic-psi)))
+  (declare (type (or String TopicC) topic-or-psi))
+  (let ((topic (if (stringp topic-or-psi)
+		   (get-latest-topic-by-psi topic-or-psi)
+		   topic-or-psi)))
     (when topic
       (let ((start-revision

Modified: branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp
--- branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Tue Sep 13 02:07:39 2011	(r882)
+++ branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Tue Sep 13 02:28:13 2011	(r883)
@@ -143,7 +143,8 @@
 					    :force-text t)))
-	       json-data :revision (get-revision) :tm-id *gdl-tm-id*))))
+	       json-data :revision (get-revision) :tm-id *gdl-tm-id*
+	       :create-fragments t))))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))

More information about the Isidorus-cvs mailing list