[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
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+))))
More information about the Isidorus-cvs
mailing list