[isidorus-cvs] r918 - branches/gdl-frontend/src/rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Mon Sep 19 01:06:33 2011
New Revision: 918

Log:
gdl-backend: added the tm-sparql interface to the gdl-interface

Modified:
   branches/gdl-frontend/src/rest_interface/rest-interface.lisp
   branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp

Modified: branches/gdl-frontend/src/rest_interface/rest-interface.lisp
==============================================================================
--- branches/gdl-frontend/src/rest_interface/rest-interface.lisp	Mon Sep 19 00:29:32 2011	(r917)
+++ branches/gdl-frontend/src/rest_interface/rest-interface.lisp	Mon Sep 19 01:06:33 2011	(r918)
@@ -59,7 +59,8 @@
 	   :*gdl-host-address*
 	   :*gdl-base-path*
 	   :*gdl-host-file*
-	   :*gdl-tm-id*))
+	   :*gdl-tm-id*
+	   :*gdl-sparql*))
 
 
 (in-package :rest-interface)

Modified: branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp
==============================================================================
--- branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Mon Sep 19 00:29:32 2011	(r917)
+++ branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Mon Sep 19 01:06:33 2011	(r918)
@@ -17,12 +17,14 @@
 (defparameter *gdl-base-path* "anaToMia/hosted_files/")
 (defparameter *gdl-host-file* (concat *gdl-base-path* "GDL_Widgets.html"))
 (defparameter *gdl-tm-id* "http://textgrid.org/serviceregistry/gdl-frontend/gdl-tm")
+(defparameter *gdl-sparql* "/gdl/tm-sparql/?$")
 
 
 (defun set-up-gdl-interface (&key (get-fragment *gdl-get-fragment*)
 			     (get-schema *gdl-get-schema*)
 			     (commit-fragment *gdl-commit-fragment*)
 			     (delete-fragment *gdl-delete-fragment*)
+			     (gdl-sparql *gdl-sparql*)
 			     (base-path *gdl-base-path*)
 			     (host-address *gdl-host-address*)
 			     (host-file *gdl-host-file*))
@@ -56,6 +58,10 @@
 
   (push
    (create-regex-dispatcher delete-fragment #'delete-handler)
+   hunchentoot:*dispatch-table*)
+
+  (push
+   (create-regex-dispatcher gdl-sparql #'gdl-tm-sparql)
    hunchentoot:*dispatch-table*))
 
 
@@ -212,4 +218,19 @@
 		  (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
 		  (setf (hunchentoot:content-type*) "text")
 		  (format nil "Topic \"~a\" not found" psi)))))
-	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
\ No newline at end of file
+	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
+
+
+(defun gdl-tm-sparql (&optional param)
+  "Returns a JSON object representing a SPARQL response."
+  (declare (Ignorable param))
+  (if (eql (hunchentoot:request-method*) :POST)
+      (let ((external-format (flexi-streams:make-external-format
+			      :UTF-8 :eol-style :LF)))
+	(let ((sparql-request (hunchentoot:raw-post-data
+			       :external-format external-format
+			       :force-text t)))
+	  (export-construct-as-isidorus-json-string
+	   (make-instance 'SPARQL-Query :query sparql-request
+			  :revision 0))))
+      (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)))
\ No newline at end of file