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