[isidorus-cvs] r897 - branches/gdl-frontend/src/json/JTM

lgiessmann at common-lisp.net lgiessmann at common-lisp.net
Wed Sep 14 10:35:09 UTC 2011


Author: lgiessmann
Date: Wed Sep 14 03:35:08 2011
New Revision: 897

Log:
jtm-importer: fixed a bug when importing occurrence and variant datatype that are represetned as curies

Modified:
   branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp
   branches/gdl-frontend/src/json/JTM/jtm_importer.lisp

Modified: branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp
==============================================================================
--- branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp	Wed Sep 14 02:25:05 2011	(r896)
+++ branches/gdl-frontend/src/json/JTM/jtm_delete_interface.lisp	Wed Sep 14 03:35:08 2011	(r897)
@@ -233,7 +233,15 @@
 	    (when curies
 	      (jtm::compute-uri-from-jtm-identifier (first curies) prefs))))
 	 (value (jtm::get-item :VALUE jtm-decoded-list))
-	 (datatype (jtm::get-item :DATATYPE jtm-decoded-list))
+	 (datatype
+	  (let ((curie (jtm::get-item :DATATYPE jtm-decoded-list)))
+	    (cond ((null curie)
+		   constants:*xml-string*)
+		  ((and (tools:string-starts-with curie "[")
+			(tools:string-ends-with curie "]"))
+		   (jtm::compute-uri-from-jtm-identifier curie prefs))
+		  (t
+		   curie))))
 	 (type
 	  (let ((curie (jtm::get-item :TYPE jtm-decoded-list)))
 	    (when curie
@@ -260,6 +268,8 @@
 		 (reifier
 		  (reified-construct reifier :revision revision))
 		 (parent
+		  (format t "parent: ~a, charvalue: ~a, datatype: ~a, type: ~a, scope: ~a~%"
+			  parent value datatype type scope)
 		  (let ((found-occs
 			 (tools:remove-null
 			  (map 'list (lambda(occ)
@@ -274,8 +284,8 @@
 		 (t
 		  (error "when deleting an occurrence, there must be an item-identifier, reifier or parent set!")))))
       (when occ-to-delete
-	(delete-occurrence (parent occ-to-delete :revision revision)
-		     occ-to-delete :revision revision)
+	;(delete-occurrence (parent occ-to-delete :revision revision)
+	;occ-to-delete :revision revision)
 	occ-to-delete))))
 
 

Modified: branches/gdl-frontend/src/json/JTM/jtm_importer.lisp
==============================================================================
--- branches/gdl-frontend/src/json/JTM/jtm_importer.lisp	Wed Sep 14 02:25:05 2011	(r896)
+++ branches/gdl-frontend/src/json/JTM/jtm_importer.lisp	Wed Sep 14 03:35:08 2011	(r897)
@@ -469,7 +469,15 @@
   (let* ((iis (import-identifiers-from-jtm-strings
 	       (get-item :ITEM--IDENTIFIERS jtm-list)
 	       :prefixes prefixes))
-	 (datatype (get-item :DATATYPE jtm-list))
+	 (datatype
+	  (let ((curie (jtm::get-item :DATATYPE jtm-list)))
+	    (cond ((null curie)
+		   constants:*xml-string*)
+		  ((and (tools:string-starts-with curie "[")
+			(tools:string-ends-with curie "]"))
+		   (jtm::compute-uri-from-jtm-identifier curie prefixes))
+		  (t
+		   curie))))
 	 (scope (get-item :SCOPE jtm-list))
 	 (type (get-item :TYPE jtm-list))
 	 (value (get-item :VALUE jtm-list))
@@ -487,7 +495,7 @@
       (error (make-condition 'JTM-error :message (format nil "From import-occurrence-from-jtm-list(): the JTM occurrence ~a must have a type set in its members." jtm-list))))
     (make-construct 'OccurrenceC :start-revision revision
 		    :item-identifiers iis
-		    :datatype (if datatype datatype *xml-string*)
+		    :datatype datatype
 		    :charvalue value
 		    :themes (get-items-from-jtm-references
 			     scope :revision revision :prefixes prefixes)
@@ -522,7 +530,15 @@
   (let* ((iis (import-identifiers-from-jtm-strings
 	       (get-item :ITEM--IDENTIFIERS jtm-list)
 	       :prefixes prefixes))
-	 (datatype (get-item :DATATYPE jtm-list))
+	 (datatype 
+	  (let ((curie (jtm::get-item :DATATYPE jtm-list)))
+	    (cond ((null curie)
+		   constants:*xml-string*)
+		  ((and (tools:string-starts-with curie "[")
+			(tools:string-ends-with curie "]"))
+		   (jtm::compute-uri-from-jtm-identifier curie prefixes))
+		  (t
+		   curie))))
 	 (value (get-item :VALUE jtm-list))
 	 (reifier (get-item :REIFIER jtm-list))
 	 (parent-references (get-item :PARENT jtm-list))




More information about the Isidorus-cvs mailing list