Author: lgiessmann Date: Sat Dec 4 16:05:05 2010 New Revision: 360 Log: fixed ticket #87 => added a JSON-handler for SPARQL-requests; fixed a bug in base-tools:trim-whitespace => #\cr is also added as a whitespace character Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/base-tools/base-tools.lisp trunk/src/isidorus.asd trunk/src/json/json_exporter.lisp trunk/src/rest_interface/rest-interface.lisp trunk/src/rest_interface/set-up-json-interface.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Sat Dec 4 16:05:05 2010 @@ -759,9 +759,9 @@ (let ((result-lists (make-result-lists construct))) (reduce-results construct result-lists) (let* ((response-variables - (if (*-p construct) - (all-variables construct) - (variables construct))) + (reverse (if (*-p construct) + (all-variables construct) + (variables construct)))) (cleaned-results (make-result-lists construct))) (map 'list #'(lambda(response-variable) (list :variable response-variable Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sat Dec 4 16:05:05 2010 @@ -76,7 +76,8 @@ (t (error (make-sparql-parser-condition trimmed-query-string (original-query construct) - "SELECT, PREFIX or BASE"))))))) + (format nil "SELECT, PREFIX or BASE, but found: ~a..." + (subseq trimmed-query-string 0 10))))))))) (defgeneric parse-select (construct query-string) Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Sat Dec 4 16:05:05 2010 @@ -70,19 +70,19 @@ (defun trim-whitespace-left (value) "Uses string-left-trim with a predefined character-list." (declare (String value)) - (string-left-trim '(#\Space #\Tab #\Newline) value)) + (string-left-trim '(#\Space #\Tab #\Newline #\cr) value)) (defun trim-whitespace-right (value) "Uses string-right-trim with a predefined character-list." (declare (String value)) - (string-right-trim '(#\Space #\Tab #\Newline) value)) + (string-right-trim '(#\Space #\Tab #\Newline #\cr) value)) (defun trim-whitespace (value) "Uses string-trim with a predefined character-list." (declare (String value)) - (string-trim '(#\Space #\Tab #\Newline) value)) + (string-trim '(#\Space #\Tab #\Newline #\cr) value)) (defun string-starts-with (str prefix &key (ignore-case nil)) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Sat Dec 4 16:05:05 2010 @@ -104,6 +104,7 @@ :depends-on ("model" "atom" "xml" + "TM-SPARQL" "json" "threading")) (:module "unit_tests" @@ -194,7 +195,8 @@ (:file "json_delete_interface" :depends-on ("json_importer"))) :depends-on ("model" - "xml")) + "xml" + "TM-SPARQL")) (:module "ajax" :components ((:static-file "isidorus.html") (:module "javascripts" Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Sat Dec 4 16:05:05 2010 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :json-exporter - (:use :cl :json :datamodel) + (:use :cl :json :datamodel :TM-SPARQL :base-tools) (:export :to-json-string :get-all-topic-psis :to-json-string-summary @@ -475,4 +475,25 @@ (to-json-string-summary topic :revision revision) ",")))) (subseq inner-string 0 (- (length inner-string) 1))))) (concatenate 'string "[" json-string "]")) - "null")) \ No newline at end of file + "null")) + + +;; ============================================================================= +;; --- json data sparql-results ------------------------------------------------ +;; ============================================================================= + +(defmethod to-json-string ((construct SPARQL-Query) &key xtm-id revision) + "Returns a JSON string that represents the object query result." + (declare (Ignorable revision xtm-id)) + (let ((query-result (result construct))) + (if (not query-result) + "null" + (let ((j-str "{")) + (loop for entry in query-result + do (push-string + (concatenate + 'string + (json:encode-json-to-string (getf entry :variable)) ":" + (json:encode-json-to-string (getf entry :result)) ",") + j-str)) + (concatenate 'string (subseq j-str 0 (- (length j-str) 1)) "}"))))) \ No newline at end of file Modified: trunk/src/rest_interface/rest-interface.lisp ============================================================================== --- trunk/src/rest_interface/rest-interface.lisp (original) +++ trunk/src/rest_interface/rest-interface.lisp Sat Dec 4 16:05:05 2010 @@ -12,6 +12,8 @@ (:use :cl :hunchentoot :cxml :constants + :exceptions + :TM-SPARQL :atom :datamodel :exporter @@ -44,7 +46,8 @@ :*ajax-user-interface-file-path* :*ajax-javascript-directory-path* :*ajax-javascript-url-prefix* - :*xtm-commit-prefix*)) + :*xtm-commit-prefix* + :*sparql-url*)) (in-package :rest-interface) 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 Sat Dec 4 16:05:05 2010 @@ -59,6 +59,8 @@ (defparameter *mark-as-deleted-url* "/mark-as-deleted") ;the get url to request the latest revision of the storage (defparameter *latest-revision-url* "/json/latest-revision/?$") +;the ulr to invoke a SPARQL query +(defparameter *sparql-url* "/json/tm-sparql/?$") (defun set-up-json-interface (&key (json-get-prefix *json-get-prefix*) @@ -80,7 +82,8 @@ (ajax-javascripts-url-prefix *ajax-javascript-url-prefix*) (mark-as-deleted-url *mark-as-deleted-url*) (latest-revision-url *latest-revision-url*) - (xtm-commit-prefix *xtm-commit-prefix*)) + (xtm-commit-prefix *xtm-commit-prefix*) + (sparql-url *sparql-url*)) "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" @@ -162,6 +165,9 @@ hunchentoot:*dispatch-table*) (push (create-regex-dispatcher latest-revision-url #'return-latest-revision) + hunchentoot:*dispatch-table*) + (push + (create-regex-dispatcher sparql-url #'return-tm-sparql) hunchentoot:*dispatch-table*)) ;; ============================================================================= @@ -485,6 +491,28 @@ (setf (hunchentoot:content-type*) "text") (format nil "Condition: \"~a\"" err))))) + +(defun return-tm-sparql (&optional param) + "Returns a JSON object representing a SPARQL response." + (declare (Ignorable param)) + (handler-case + (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))) + (to-json-string (make-instance 'SPARQL-Query :query sparql-request + :revision 0)))) + (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+)) + (condition (err) + (progn + (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+) + (setf (hunchentoot:content-type*) "text") + (if (typep err 'SPARQL-Parser-Error) + (format nil "SPARQL-Parser-Error: \"~a\"" (exceptions::message err)) + (format nil "Condition: \"~a\"" err)))))) + ;; ============================================================================= ;; --- some helper functions --------------------------------------------------- ;; =============================================================================