[isidorus-cvs] r644 - in trunk/src: json/isidorus-json rest_interface
lgiessmann at common-lisp.net
lgiessmann at common-lisp.net
Tue Jul 19 08:28:05 UTC 2011
Author: lgiessmann
Date: Tue Jul 19 01:28:04 2011
New Revision: 644
Log:
trunk: fixed some handler that return a storage snapshot => mark-as-deleted topics are not shown yet
Modified:
trunk/src/json/isidorus-json/json_exporter.lisp
trunk/src/json/isidorus-json/json_tmcl.lisp
trunk/src/rest_interface/set-up-json-interface.lisp
Modified: trunk/src/json/isidorus-json/json_exporter.lisp
==============================================================================
--- trunk/src/json/isidorus-json/json_exporter.lisp Tue Jul 19 01:01:12 2011 (r643)
+++ trunk/src/json/isidorus-json/json_exporter.lisp Tue Jul 19 01:28:04 2011 (r644)
@@ -395,7 +395,12 @@
#'(lambda(psi-list)
(when psi-list
(map 'list #'uri psi-list)))
- (map 'list #'psis (get-all-topics revision))))))
+ (map 'list #'psis
+ (remove-null
+ (map 'list #'(lambda(top)
+ (when (find-item-by-revision top revision)
+ top))
+ (get-all-topics revision))))))))
(defun to-json-string-summary (topic &key (revision *TM-REVISION*))
Modified: trunk/src/json/isidorus-json/json_tmcl.lisp
==============================================================================
--- trunk/src/json/isidorus-json/json_tmcl.lisp Tue Jul 19 01:01:12 2011 (r643)
+++ trunk/src/json/isidorus-json/json_tmcl.lisp Tue Jul 19 01:28:04 2011 (r644)
@@ -1715,7 +1715,8 @@
(error "From make-tree-view(): The topictype-constraint \"~a\" exists but the topictype \"~a\" is missing!"
*topictype-constraint-psi*
*topictype-psi*))
- (list (make-nodes topictype t t :revision revision)))
+ (let ((lst (remove-null (make-nodes topictype t t :revision revision))))
+ (if lst (list lst) nil)))
(let ((tree-roots
(get-all-tree-roots :revision revision)))
(let ((tree-list
@@ -1733,8 +1734,8 @@
(valid-instance-p root nil nil revision)
t)
(Condition () nil))))
- (make-nodes root l-is-type l-is-instance
- :revision revision)))))
+ (remove-null (make-nodes root l-is-type l-is-instance
+ :revision revision))))))
tree-list)))))
@@ -1794,74 +1795,76 @@
:subtypes <nodes>)."
(declare (TopicC topic-instance)
(type (or integer null) revision))
- (let ((topictype (get-item-by-psi *topictype-psi* :revision revision))
- (topictype-constraint (is-type-constrained :revision revision)))
- (let ((isas-of-this
- (map
- 'list
- #'(lambda(z)
- (let ((l-is-type
- (handler-case
- (progn
- (topictype-p z topictype topictype-constraint
- nil revision)
- t)
- (Condition () nil)))
- (l-is-instance
- (handler-case (progn
- (valid-instance-p z nil nil revision)
- t)
- (Condition () nil))))
- (list :topic z :is-type l-is-type :is-instance l-is-instance)))
- (remove-duplicates
- (remove-if #'null
- (remove-if
- #'(lambda(x) (when (eql topic-instance x)
- t))
- (get-direct-instances-of-topic topic-instance
- :revision revision))))))
- (akos-of-this
- (map 'list
- #'(lambda(z)
- (let ((l-is-type
- (handler-case
- (progn
- (topictype-p z topictype topictype-constraint
- nil revision)
- t)
- (Condition () nil)))
- (l-is-instance
- (handler-case (progn
- (valid-instance-p z nil nil revision)
- t)
- (Condition () nil))))
- (list :topic z :is-type l-is-type :is-instance l-is-instance)))
- (remove-duplicates
- (remove-if
- #'null
- (remove-if #'(lambda(x) (when (eql topic-instance x)
- t))
- (get-direct-subtypes-of-topic topic-instance
- :revision revision)))))))
- (let ((cleaned-isas ;;all constraint topics are removed
- (clean-topic-entries isas-of-this :revision revision))
- (cleaned-akos ;;all constraint topics are removed
- (clean-topic-entries akos-of-this :revision revision)))
- (list :topic topic-instance
- :is-type is-type
- :is-instance is-instance
- :instances (map 'list #'(lambda(x)
- (make-nodes (getf x :topic)
- (getf x :is-type)
- (getf x :is-instance)
- :revision revision))
- cleaned-isas)
- :subtypes (map 'list #'(lambda(x)
- (make-nodes (getf x :topic)
- (getf x :is-type)
- (getf x :is-instance)
- :revision revision))
- cleaned-akos))))))
+ (when (find-item-by-revision topic-instance revision)
+ (let ((topictype (get-item-by-psi *topictype-psi* :revision revision))
+ (topictype-constraint (is-type-constrained :revision revision)))
+ (let ((isas-of-this
+ (map
+ 'list
+ #'(lambda(z)
+ (let ((l-is-type
+ (handler-case
+ (progn
+ (topictype-p z topictype topictype-constraint
+ nil revision)
+ t)
+ (Condition () nil)))
+ (l-is-instance
+ (handler-case (progn
+ (valid-instance-p z nil nil revision)
+ t)
+ (Condition () nil))))
+ (list :topic z :is-type l-is-type :is-instance l-is-instance)))
+ (remove-duplicates
+ (remove-null
+ (remove-if
+ #'(lambda(x) (when (eql topic-instance x)
+ t))
+ (get-direct-instances-of-topic topic-instance
+ :revision revision))))))
+ (akos-of-this
+ (map 'list
+ #'(lambda(z)
+ (let ((l-is-type
+ (handler-case
+ (progn
+ (topictype-p z topictype topictype-constraint
+ nil revision)
+ t)
+ (Condition () nil)))
+ (l-is-instance
+ (handler-case (progn
+ (valid-instance-p z nil nil revision)
+ t)
+ (Condition () nil))))
+ (list :topic z :is-type l-is-type :is-instance l-is-instance)))
+ (remove-duplicates
+ (remove-null
+ (remove-if #'(lambda(x) (when (eql topic-instance x)
+ t))
+ (get-direct-subtypes-of-topic topic-instance
+ :revision revision)))))))
+ (let ((cleaned-isas ;;all constraint topics are removed
+ (clean-topic-entries isas-of-this :revision revision))
+ (cleaned-akos ;;all constraint topics are removed
+ (clean-topic-entries akos-of-this :revision revision)))
+ (list :topic topic-instance
+ :is-type is-type
+ :is-instance is-instance
+ :instances (remove-null
+ (map 'list #'(lambda(x)
+ (make-nodes (getf x :topic)
+ (getf x :is-type)
+ (getf x :is-instance)
+ :revision revision))
+ cleaned-isas))
+ :subtypes (remove-null
+ (map 'list #'(lambda(x)
+ (make-nodes (getf x :topic)
+ (getf x :is-type)
+ (getf x :is-instance)
+ :revision revision))
+ cleaned-akos))))))))
(defun clean-topic-entries(isas-or-akos &key (revision *TM-REVISION*))
Modified: trunk/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- trunk/src/rest_interface/set-up-json-interface.lisp Tue Jul 19 01:01:12 2011 (r643)
+++ trunk/src/rest_interface/set-up-json-interface.lisp Tue Jul 19 01:28:04 2011 (r644)
@@ -177,7 +177,7 @@
"Returns all topic-psi that are valid types -> so they have to be valid to the
topictype-constraint (if it exists) and the can't be abstract."
(declare (ignorable param))
- (handler-case (let ((topic-types
+ (handler-case (let ((topic-types
(with-reader-lock
(map 'list #'(lambda (oid)
(elephant::controller-recreate-instance
@@ -290,7 +290,9 @@
(defun return-json-fragment(&optional psi)
- "returns the json-fragmen belonging to the psi passed by the parameter psi"
+ "returns the json-fragmen belonging to the psi passed by the parameter psi.
+ If the topic is marked as deleted the corresponding fragment is treated
+ as non-existent and an HTTP 404 is set."
(assert psi)
(let ((http-method (hunchentoot:request-method*)))
(if (eq http-method :GET)
@@ -299,7 +301,8 @@
(let ((fragment
(with-reader-lock
(get-latest-fragment-of-topic identifier))))
- (if fragment
+ (if (and fragment
+ (find-item-by-revision (topic fragment) 0))
(handler-case (with-reader-lock
(export-construct-as-isidorus-json-string
fragment :revision 0))
@@ -325,7 +328,8 @@
(let ((fragment
(with-reader-lock
(get-latest-fragment-of-topic identifier))))
- (if fragment
+ (if (and fragment
+ (find-item-by-revision (topic fragment) 0))
(handler-case (with-reader-lock
(rdf-exporter:to-rdf-string fragment))
(condition (err)
@@ -372,8 +376,13 @@
(handler-case (parse-integer (hunchentoot:get-parameter "end"))
(condition () nil))))
(handler-case (with-reader-lock
- (let ((topics
- (elephant:get-instances-by-class 'd:TopicC)))
+ (let ((topics
+ (remove-null
+ (map 'list
+ #'(lambda(top)
+ (when (find-item-by-revision top 0)
+ top))
+ (elephant:get-instances-by-class 'd:TopicC)))))
(let ((end
(cond
((not end-idx)
More information about the Isidorus-cvs
mailing list