[isidorus-cvs] r16 - in trunk: docs src/json src/rest_interface src/unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Mar 10 11:34:37 UTC 2009
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+-+Metadata")
+ (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))
More information about the Isidorus-cvs
mailing list