[isidorus-cvs] r229 - in trunk/src: json model rest_interface xml/rdf xml/xtm

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Mar 16 18:24:22 2010
New Revision: 229

Log:
fixed ticket #69 -->  changed the mechanism of the json-reader and -writer, so there can be used with-reader-lock instead of with-writer-lock

Modified:
   trunk/src/json/json_importer.lisp
   trunk/src/model/changes.lisp
   trunk/src/model/datamodel.lisp
   trunk/src/rest_interface/rest-interface.lisp
   trunk/src/rest_interface/set-up-json-interface.lisp
   trunk/src/xml/rdf/importer.lisp
   trunk/src/xml/xtm/setup.lisp

Modified: trunk/src/json/json_importer.lisp
==============================================================================
--- trunk/src/json/json_importer.lisp	(original)
+++ trunk/src/json/json_importer.lisp	Tue Mar 16 18:24:22 2010
@@ -32,13 +32,19 @@
 	    (topicStubs-values (getf fragment-values :topicStubs))
 	    (associations-values (getf fragment-values :associations))
 	    (rev (get-revision))) ; creates a new revision, equal for all elements of the passed fragment
-	(elephant:ensure-transaction (:txn-nosync nil) 
-	  (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
-	    (loop for topicStub-values in (append topicStubs-values (list topic-values))
-	       do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
-	    (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
-	    (loop for association-values in associations-values
-	       do (json-to-association association-values rev :tm xml-importer::tm))))))))
+	(let ((psi-of-topic
+	       (let ((psi-uris (getf topic-values :subjectIdentifiers)))
+		 (when psi-uris
+		   (first psi-uris)))))
+	  (elephant:ensure-transaction (:txn-nosync nil) 
+	    (xml-importer:with-tm (rev xtm-id (first (getf fragment-values :tm-ids)))
+	      (loop for topicStub-values in (append topicStubs-values (list topic-values))
+		 do (json-to-stub topicStub-values rev :tm xml-importer::tm :xtm-id xtm-id))
+	      (json-merge-topic topic-values rev :tm xml-importer::tm :xtm-id xtm-id)
+	      (loop for association-values in associations-values
+		 do (json-to-association association-values rev :tm xml-importer::tm)))
+	    (when psi-of-topic
+	      (create-latest-fragment-of-topic psi-of-topic))))))))
 
 
 (defun json-to-association (json-decoded-list start-revision

Modified: trunk/src/model/changes.lisp
==============================================================================
--- trunk/src/model/changes.lisp	(original)
+++ trunk/src/model/changes.lisp	Tue Mar 16 18:24:22 2010
@@ -277,7 +277,7 @@
 
 
 (defun create-latest-fragment-of-topic (topic-psi)
-  "returns the latest fragment of the passed topic-psi"
+  "Returns the latest fragment of the passed topic-psi"
   (declare (string topic-psi))
   (let ((topic
 	 (get-item-by-psi topic-psi)))
@@ -299,4 +299,18 @@
 			     :revision start-revision
 			     :associations (find-associations-for-topic topic)
 			     :referenced-topics (find-referenced-topics topic)
-			     :topic topic)))))))
\ No newline at end of file
+			     :topic topic)))))))
+
+
+(defun get-latest-fragment-of-topic (topic-psi)
+  "Returns the latest existing fragment of the passed topic-psi."
+  (declare (string topic-psi))
+  (let ((topic
+	 (get-item-by-psi topic-psi)))
+    (when topic
+      (let ((existing-fragments
+	     (elephant:get-instances-by-value 'FragmentC 'topic topic)))
+	(when existing-fragments
+	  (first (sort existing-fragments
+		       #'(lambda(frg-1 frg-2)
+			   (> (revision frg-1) (revision frg-2))))))))))
\ No newline at end of file

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Tue Mar 16 18:24:22 2010
@@ -101,6 +101,7 @@
 	   :variants
 	   :xor
            :create-latest-fragment-of-topic
+	   :get-latest-fragment-of-topic
 	   :reified
 	   :reifier
 	   :add-reifier

Modified: trunk/src/rest_interface/rest-interface.lisp
==============================================================================
--- trunk/src/rest_interface/rest-interface.lisp	(original)
+++ trunk/src/rest_interface/rest-interface.lisp	Tue Mar 16 18:24:22 2010
@@ -71,14 +71,20 @@
   (setf hunchentoot:*hunchentoot-default-external-format* 
 	(flex:make-external-format :utf-8 :eol-style :lf))
   (setf atom:*base-url* (format nil "http://~a:~a" host-name port))
-  (elephant:open-store  
-   (xml-importer:get-store-spec repository-path))
+  (unless elephant:*store-controller*
+    (elephant:open-store  
+     (xml-importer:get-store-spec repository-path)))
   (load conffile)
   (publish-feed atom:*tm-feed*)
   (set-up-json-interface)
   (setf *server-acceptor* (make-instance 'hunchentoot:acceptor :address host-name :port port))
   (setf hunchentoot:*lisp-errors-log-level* :info)
   (setf hunchentoot:*message-log-pathname* "./hunchentoot-errors.log")
+  (map 'list #'(lambda(top)
+		 (let ((psis-of-top (psis top)))
+		   (when psis-of-top
+		     (create-latest-fragment-of-topic (uri (first psis-of-top))))))
+       (elephant:get-instances-by-class 'd:TopicC))
   (hunchentoot:start *server-acceptor*))
 
 (defun shutdown-tm-engine ()

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	Tue Mar 16 18:24:22 2010
@@ -226,8 +226,8 @@
 	(let ((identifier (string-replace psi "%23" "#")))
 	  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
 	  (let ((fragment
-		 (with-writer-lock
-		   (create-latest-fragment-of-topic identifier))))
+		 (with-reader-lock
+		   (get-latest-fragment-of-topic identifier))))
 	    (if fragment
 		(handler-case (with-reader-lock
 				(to-json-string fragment))
@@ -251,8 +251,8 @@
 	(let ((identifier (string-replace psi "%23" "#")))
 	  (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
 	  (let ((fragment
-		 (with-writer-lock
-		   (create-latest-fragment-of-topic identifier))))
+		 (with-reader-lock
+		   (get-latest-fragment-of-topic identifier))))
 	    (if fragment
 		(handler-case (with-reader-lock
 				(rdf-exporter:to-rdf-string fragment))

Modified: trunk/src/xml/rdf/importer.lisp
==============================================================================
--- trunk/src/xml/rdf/importer.lisp	(original)
+++ trunk/src/xml/rdf/importer.lisp	Tue Mar 16 18:24:22 2010
@@ -20,9 +20,9 @@
   (xml-importer:init-isidorus)
   (init-rdf-module)
   (rdf-importer rdf-xml-path repository-path :tm-id tm-id
-		:document-id document-id)
-  (when elephant:*store-controller*
-    (elephant:close-store)))
+		:document-id document-id))
+;  (when elephant:*store-controller*
+;    (elephant:close-store)))
 
 
 (defun rdf-importer (rdf-xml-path repository-path 
@@ -46,7 +46,7 @@
     (format t "#Objects in the store: Topics: ~a, Associations: ~a~%"
 	    (length (elephant:get-instances-by-class 'TopicC))
 	    (length (elephant:get-instances-by-class 'AssociationC)))
-    (elephant:close-store)
+;    (elephant:close-store)
     (setf *_n-map* nil)))
 
 

Modified: trunk/src/xml/xtm/setup.lisp
==============================================================================
--- trunk/src/xml/xtm/setup.lisp	(original)
+++ trunk/src/xml/xtm/setup.lisp	Tue Mar 16 18:24:22 2010
@@ -50,6 +50,6 @@
     (elephant:open-store  
      (get-store-spec repository-path)))
   (init-isidorus)
-  (import-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id :xtm-format xtm-format)
-  (when elephant:*store-controller*
-    (elephant:close-store)))
\ No newline at end of file
+  (import-xtm xtm-path repository-path :tm-id tm-id :xtm-id xtm-id :xtm-format xtm-format))
+;  (when elephant:*store-controller*
+;    (elephant:close-store)))
\ No newline at end of file