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)