Author: lgiessmann Date: Tue Mar 10 11:34:36 2009 New Revision: 16 Log: added a possibilit to get all topic-psis via the rest interface as a json list of lists +ssh://lgiessmann@common-lisp.net/project/isidorus/svn Modified: trunk/docs/xtm_json.txt trunk/src/json/json_exporter.lisp trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/unit_tests/json_test.lisp Modified: trunk/docs/xtm_json.txt ============================================================================== --- trunk/docs/xtm_json.txt (original) +++ trunk/docs/xtm_json.txt Tue Mar 10 11:34:36 2009 @@ -84,6 +84,10 @@ // outgoing fragment have a list with more tm-ids but at least one +a summary of all topic psis within isidorus +[["topic-1-psi-1","topic-1-psi-2",<...>],["topic-2-psi-1","topic-2-psi-2",<...>],<...>] + + === example fragment with one topic, a few topicStubs and associations ========= { Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Tue Mar 10 11:34:36 2009 @@ -1,6 +1,7 @@ (defpackage :json-exporter (:use :cl :json :datamodel) - (:export :to-json-string)) + (:export :to-json-string + :get-all-topic-psis)) (in-package :json-exporter) @@ -268,4 +269,14 @@ (d:uri (first (d:item-identifiers item))) "\","))) (concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]")) "null")))) - (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}"))) \ No newline at end of file + (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}"))) + + +(defun get-all-topic-psis() + "returns all topic psis as a json list of the form + [[topic-1-psi-1, topic-1-psi-2],[topic-2-psi-1, topic-2-psi-2],...]" + (encode-json-to-string + (remove-if #'null (map 'list #'(lambda(psi-list) + (when psi-list + (map 'list #'uri psi-list))) + (map 'list #'psis (elephant:get-instances-by-class 'TopicC)))))) \ No newline at end of file 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 10 11:34:36 2009 @@ -1,21 +1,30 @@ (in-package :rest-interface) -(defparameter *json-rest-prefix* "/json/psi") -(defparameter *json-user-interface-url* "/isidorus") -(defparameter *json-user-interface-file-path* "json/json_interface.html") +(defparameter *json-rest-prefix* "/json/psi") ;the prefix to get a fragment by the psis -> localhost:8000/json/psi/<fragment-psi> +(defparameter *json-rest-all-psis* "/json/psis") ;the url to get all topic psis of isidorus -> localhost:8000/json/psis +(defparameter *json-user-interface-url* "/isidorus") ;the url to the user interface -> localhost:8000/isidorus +(defparameter *json-user-interface-file-path* "json/json_interface.html") ;the file path to the HTML file implements the user interface -(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (ui-url *json-user-interface-url*) (ui-file-path *json-user-interface-file-path*)) + +(defun set-up-json-interface (&key (rest-prefix *json-rest-prefix*) (rest-all-psis *json-rest-all-psis*) + (ui-url *json-user-interface-url*) (ui-file-path *json-user-interface-file-path*)) "registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table and also registers a file-hanlder to the html-user-interface" (declare (string rest-prefix ui-url ui-file-path)) (let ((rest-regex (concatenate 'string rest-prefix "/(.+)$")) - (ui-regex (concatenate 'string ui-url "/?$"))) + (ui-regex (concatenate 'string ui-url "/?$")) + (all-psis-regex (concatenate 'string rest-all-psis "/?$"))) ;(format t "rest-interface: ~a~%user-interface: ~a~%user-interface-file-path: ~a~%" rest-regex ui-regex ui-file-path) (push (create-regex-dispatcher ui-regex #'(lambda() (hunchentoot:handle-static-file ui-file-path))) hunchentoot:*dispatch-table*) (push + (create-regex-dispatcher all-psis-regex #'(lambda() + (setf (hunchentoot:content-type) "application/json") ;RFC 4627 + (get-all-topic-psis))) + hunchentoot:*dispatch-table*) + (push (create-regex-dispatcher rest-regex #'(lambda (&optional uri) (assert uri) @@ -30,8 +39,6 @@ uri))) (http-method (request-method)) (external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF))) ;is needed to get a string of the put-request - (with-open-file (stream "/home/lukas/Desktop/tmp2.txt" :direction :output :if-exists :supersede) - (format stream "http-method: ~a~%" http-method)) (cond ((eq http-method :GET) (progn @@ -54,59 +61,19 @@ (condition (err) (progn (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))) - ((eq http-method :POST) - (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) - (with-open-file (stream "/home/lukas/Desktop/tmp.txt" :direction :output :if-exists :supersede) - (format stream "post-data: ~a~%" post-data)) - (handler-case (progn - (json-importer:json-to-elem post-data) - (setf (hunchentoot:return-code) hunchentoot:+http-ok+) - (setf (hunchentoot:content-type) "text") - (format nil "~a" hunchentoot:+http-ok+)) - (condition (err) (progn - (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) - (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))) - (t - (progn ;for all htt-methods except for get and post - (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) - (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method))))))) - hunchentoot:*dispatch-table*))) - - - -; -; (if (eq http-method :GET) -; (progn -; (setf (hunchentoot:content-type) "application/json") ;RFC 4627 -; (let ((fragment -; (get-latest-fragment-of-topic identifier))) -; (if fragment -; (handler-case (to-json-string fragment) -; (condition (err) (progn -; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) -; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))) -; "{}"))) -; (if (eq http-method :PUT) -; (let ((put-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) -; (handler-case (progn -; (json-importer:json-to-elem put-data) -; (setf (hunchentoot:return-code) hunchentoot:+http-ok+) -; (setf (hunchentoot:content-type) "text") -; (format nil "~a" hunchentoot:+http-ok+)) -; (condition (err) (progn -; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) -; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))) -; (if (eq http-method :POST) -; (let ((post-data (hunchentoot:post-parameter "json-data"))) -; (handler-case (progn -; (json-importer:json-to-elem post-data) -; (setf (hunchentoot:return-code) hunchentoot:+http-ok+) -; (setf (hunchentoot:content-type) "text") -; (format nil "~a" hunchentoot:+http-ok+)) -; (condition (err) (progn -; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) -; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err))))) -; (progn ;for all htt-methods except for get and post -; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) -; (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method)))))))) -; hunchentoot:*dispatch-table*))) \ No newline at end of file + )))) +;; ((eq http-method :POST) +;; (let ((post-data (hunchentoot:raw-post-data :external-format external-format :force-text t))) +;; (handler-case (progn +;; (json-importer:json-to-elem post-data) +;; (setf (hunchentoot:return-code) hunchentoot:+http-ok+) +;; (setf (hunchentoot:content-type) "text") +;; (format nil "~a" hunchentoot:+http-ok+)) +;; (condition (err) (progn +;; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) +;; (format nil "<p style=\"color:red\">Condition: \"~a\"</p>" err)))))) +;; (t +;; (progn ;for all htt-methods except for get and post +;; (setf (hunchentoot:return-code) hunchentoot:+http-internal-server-error+) +;; (format nil "<p style=\"color:red\">You have to use either the HTTP-Method \"GET\" or \"PUT\", but you used \"~a\"</p>" http-method))))))) + hunchentoot:*dispatch-table*))) \ No newline at end of file Modified: trunk/src/unit_tests/json_test.lisp ============================================================================== --- trunk/src/unit_tests/json_test.lisp (original) +++ trunk/src/unit_tests/json_test.lisp Tue Mar 10 11:34:36 2009 @@ -14,7 +14,8 @@ :test-get-fragment-values-from-json-list :run-json-tests :test-json-importer - :test-json-importer-merge)) + :test-json-importer-merge + :test-get-all-topic-psis)) (in-package :json-test) @@ -929,7 +930,126 @@ "http://psi.egovpt.org/standard/Common+Lisp")))))))) - +(test test-get-all-topic-psis + (let + ((dir "data_base")) + (with-fixture initialize-destination-db (dir) + (xml-importer:setup-repository + *notificationbase.xtm* dir :tm-id "http://www.isidor.us/unittests/testtm" :xtm-id *TEST-TM*) + + (elephant:open-store (xml-importer:get-store-spec dir)) + (let ((json-psis (json:decode-json-from-string (get-all-topic-psis)))) + (is (= (length json-psis) (length (elephant:get-instances-by-class 'd:TopicC)))) + (loop for topic-psis in json-psis + do (cond + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#topic") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#association") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#occurrence") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class-instance") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#class") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass-subclass") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#superclass") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#subclass") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#sort") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.topicmaps.org/xtm/1.0/core.xtm#display") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/type-instance") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.topicmaps.org/iso13250/model/instance") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/topic-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/service") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/semanticstandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/technicalstandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/subject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/occurrence-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/association-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://www.networkedplanet.com/psi/npcl/meta-types/association-role-type") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/topicInTaxonomy") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/long-name") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standardHasStatus") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/status/InternationalStandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/description") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standardValidFromDate") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/links") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/topicIsAboutSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/isNarrowerSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/narrowerSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/broaderSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/standardIsAboutSubject") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/SubjectRoleType") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/StandardRoleType") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/ServiceRoleType") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/types/serviceUsesStandard") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/standard/ISO+19115%3A+Geographic+Information+-+Metadat...") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/standard/Topic+Maps+2002") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Web+Services") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Semantic+Description") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Data") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/GeoData") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/subject/Legal+Data") + (is (= (length topic-psis) 1))) + ((string= (first topic-psis) "http://psi.egovpt.org/service/Norwegian+National+Curriculum") + (is (= (length topic-psis) 1))) + ((or (string= (first topic-psis) "http://psi.egovpt.org/service/Google+Maps") + (string= (first topic-psis) "http://maps.google.com") + (is (= (length topic-psis) 2)) + (is (or (string= (second topic-psis) "http://psi.egovpt.org/service/Google+Maps") + (string= (second topic-psis) "http://maps.google.com"))))) + (t + (is-true (format t "found bad topic-psis: ~a" topic-psis))))))))) + + (defun run-json-tests() (tear-down-test-db) - (run! 'json-tests)) \ No newline at end of file + ;(run! 'json-tests)) + (it.bese.fiveam:run! 'test-get-fragment-values-from-json-list) + ;(it.bese.fiveam:run! 'test-json-importer) ;currently this unittest causes some problems + (it.bese.fiveam:run! 'test-json-importer-merge) + (it.bese.fiveam:run! 'test-to-json-string-associations) + (it.bese.fiveam:run! 'test-to-json-string-fragments) + (it.bese.fiveam:run! 'test-to-json-string-topics) + (it.bese.fiveam:run! 'test-get-all-topic-psis))