Author: lgiessmann Date: Tue Sep 13 02:28:13 2011 New Revision: 883 Log: 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/model/changes.lisp branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp 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))) (import-construct-from-jtm-decoded-list - 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)) (import-topic-map-from-jtm-list 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) tm)) @@ -339,21 +347,24 @@ assoc))) -(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) (merge-topic-from-jtm-list jtm-list :revision revision :prefixes prefixes - :instance-of-p instance-of-p)) + :instance-of-p instance-of-p + :create-fragment create-fragments)) jtm-lists)) (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)) 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 (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))) (with-writer-lock (jtm-importer:import-construct-from-jtm-string - 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+))))