Author: lgiessmann Date: Sat Dec 4 08:59:08 2010 New Revision: 358 Log: TM-SPARQL: added a method called "result"=>SPARQL-Query, so invoking it produces a result of the entier query; fixed a style warning in the RESTful-itnerface Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Sat Dec 4 08:59:08 2010 @@ -9,10 +9,8 @@ (defpackage :TM-SPARQL (:use :cl :datamodel :base-tools :exceptions :constants) - (:export :SPARQL-Query)) - -;;TODO: -;; *handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html + (:export :SPARQL-Query + :result)) (in-package :TM-SPARQL) @@ -161,6 +159,21 @@ (:documentation "This class represents the entire request.")) +(defmethod variables ((construct SPARQL-Triple-Elem)) + "Returns all variable names that are contained in the passed element." + (remove-duplicates + (remove-null + (loop for triple in (select-group construct) + collect (remove-null + (list (when (variable-p (subject construct)) + (value (subject construct))) + (when (variable-p (predicate construct)) + (value (predicate construct))) + (when (variable-p (object construct)) + (value (object construct))))))) + :test #'string=)) + + (defgeneric add-triple (construct triple) (:documentation "Adds a triple object to the select-group list.") (:method ((construct SPARQL-Query) (triple SPARQL-Triple)) @@ -742,6 +755,162 @@ assocs))))) + +(defgeneric result (construct) + (:documentation "Returns the result of the entire query.") + (:method ((construct SPARQL-Query)) + (let ((result-lists (make-result-lists construct))) + (reduce-results construct result-lists) + (let* ((response-variables (variables construct)) + (cleaned-results (make-result-lists construct))) + (map 'list #'(lambda(response-variable) + (variable-intersection response-variable + cleaned-results)) + response-variables))))) + + +(defgeneric make-result-lists (construct) + (:documentation "Returns a list of the form ((:variable 'var-name' + :result (<any-object>)).") + (:method ((construct SPARQL-Query)) + (remove-null + (loop for triple in (select-group construct) + collect (remove-null + (list + (when (variable-p (subject construct)) + (list :variable (value (subject construct)) + :result (subject-result construct))) + (when (variable-p (predicate construct)) + (list :variable (value (predicate construct)) + :result (predicate-result construct))) + (when (variable-p (object construct)) + (list :variable (value (object construct)) + :result (object-result construct))))))))) + + +(defgeneric all-variables (result-lists) + (:documentation "Returns a list of all variables that are contained in + the passed result-lists.") + (:method ((result-lists List)) + (remove-duplicates + (map 'list #'(lambda(entry) + (getf entry :variable)) + result-lists) + :test #'string=))) + + +(defgeneric variable-intersection (variable-name result-lists) + (:documentation "Returns a list with all results of the passed variable + that are contained in the result-lists. All results is + an intersection of all paratial results.") + (:method ((variable-name String) (result-lists List)) + (let* ((all-values (results-for-variable variable-name result-lists)) + (list-1 (when (>= (length all-values) 1) + (first all-values))) + (list-2 (if (> (length all-values) 2) + (second all-values) + list-1)) + (more-lists (rest (rest all-values)))) + (recursive-intersection list-1 list-2 more-lists)))) + + +(defun recursive-intersection (list-1 list-2 &rest more-lists) + "Returns an intersection of al the passed lists." + (declare (List list-1 list-2)) + (let ((current-result + (intersection list-1 list-2 + :test #'(lambda(val-1 val-2) + (if (and (stringp val-1) (stringp val-2)) + (string= val-1 val-2) + (eql val-1 val-2)))))) + (if (= (length more-lists) 0) + current-result + (apply #'recursive-intersection current-result + (first more-lists) (rest more-lists))))) + + +(defgeneric reduce-results(construct result-lists) + (:documentation "Reduces the select-group of the passed construct by processing + all triples with the intersection-results.") + (:method ((construct SPARQL-Query) (result-lists List)) + (map 'list #'(lambda(triple) + (reduce-triple triple result-lists)) + (select-group construct)))) + + +(defgeneric reduce-triple(construct result-lists) + (:documentation "Reduces the results of a triple by using only the + intersection values.") + (:method ((construct SPARQL-Triple-Elem) (result-lists List)) + (let* ((triple-variables (variables construct)) + (intersections + (map 'list #'(lambda(var) + (list :variable var + :result (variable-intersection + var result-lists))) + triple-variables))) + (map 'list #'(lambda(entry) + (delete-rows construct (getf entry :variable) + (getf entry :result))) + intersections)))) + + +(defgeneric delete-rows (construct variable-name dont-touch-values) + (:documentation "Checks all results of the passed variable of the given + construct and deletes every result with the corresponding + row that is not contained in the dont-touch-values.") + (:method ((construct SPARQL-Triple-Elem) (variable-name String) + (dont-touch-values List)) + (let ((var-elem + (cond ((and (variable-p (subject construct)) + (string= (value (subject construct)) variable-name)) + (subject-result construct)) + ((and (variable-p (predicate construct)) + (string= (value (predicate construct)) variable-name)) + (predicate-result construct)) + ((and (variable-p (object construct)) + (string= (value (object construct)) variable-name)) + (object-result construct))))) + (if (not var-elem) + construct + (let* ((rows-to-hold + (remove-null + (map 'list #'(lambda(val) + (if (stringp val) + (position val var-elem :test #'string=) + (position val var-elem))) + var-elem))) + (new-result-list + (dolist (row-idx rows-to-hold) + (list :subject (elt (subject-result construct) row-idx) + :predicate (elt (predicate-result construct) row-idx) + :object (elt (object-result construct) row-idx))))) + (setf (subject-result construct) + (map 'list #'(lambda(entry) + (getf entry :subject)) new-result-list)) + (setf (predicate-result construct) + (map 'list #'(lambda(entry) + (getf entry :predicate)) new-result-list)) + (setf (object-result construct) + (map 'list #'(lambda(entry) + (getf entry :object)) new-result-list))))))) + + +(defgeneric results-for-variable (variable-name result-lists) + (:documentation "Returns a list with result-lists for the passed variable.") + (:method ((variable-name String) (result-lists List)) + (let* ((cleaned-result-lists + (remove-if-not #'(lambda(entry) + (string= (getf entry :variable) + variable-name)) + result-lists)) + (values + (map 'list #'(lambda(entry) + (getf entry :result)) + cleaned-result-lists))) + values))) + + (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) (parser-start construct (original-query construct)) 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 08:59:08 2010 @@ -428,8 +428,10 @@ (if result (progn (when (typep result 'd:TopicC) - (delete (elephant::oid result) *type-table*) - (delete (elephant::oid result) *instance-table*)) + (append ;;the append function is used only for suppress + ;;style warnings of unused delete return values + (delete (elephant::oid result) *type-table*) + (delete (elephant::oid result) *instance-table*))) (format nil "")) ;operation succeeded (progn (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sat Dec 4 08:59:08 2010 @@ -19,6 +19,7 @@ (:export :run-sparql-tests :sparql-tests :test-prefix-and-base + :test-variable-names :test-parse-literals :test-parse-triple-elem :test-parse-group-1 @@ -180,61 +181,61 @@ (query-9 (concatenate 'string "\"13e4\"^^" *xml-boolean* " .")) (dummy-object (make-instance 'SPARQL-Query :query ""))) (is-true dummy-object) - (let ((result (tm-sparql::parse-literal-elem query-1 dummy-object))) - (is (string= (getf result :next-query) ".")) - (is (string= (tm-sparql::value (getf result :value)) + (let ((res (tm-sparql::parse-literal-elem query-1 dummy-object))) + (is (string= (getf res :next-query) ".")) + (is (string= (tm-sparql::value (getf res :value)) "literal-value")) - (is (string= (tm-sparql::literal-lang (getf result :value)) + (is (string= (tm-sparql::literal-lang (getf res :value)) "de")) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-string*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) - (let ((result (tm-sparql::parse-literal-elem query-2 dummy-object))) - (is (string= (getf result :next-query) ".")) - (is (eql (tm-sparql::value (getf result :value)) t)) - (is-false (tm-sparql::literal-lang (getf result :value))) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) + (let ((res (tm-sparql::parse-literal-elem query-2 dummy-object))) + (is (string= (getf res :next-query) ".")) + (is (eql (tm-sparql::value (getf res :value)) t)) + (is-false (tm-sparql::literal-lang (getf res :value))) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-boolean*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) - (let ((result (tm-sparql::parse-literal-elem query-3 dummy-object))) - (is (string= (getf result :next-query) "}")) - (is (eql (tm-sparql::value (getf result :value)) nil)) - (is-false (tm-sparql::literal-lang (getf result :value))) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) + (let ((res (tm-sparql::parse-literal-elem query-3 dummy-object))) + (is (string= (getf res :next-query) "}")) + (is (eql (tm-sparql::value (getf res :value)) nil)) + (is-false (tm-sparql::literal-lang (getf res :value))) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-boolean*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) - (let ((result (tm-sparql::parse-literal-elem query-4 dummy-object))) - (is (string= (getf result :next-query) (string #\tab))) - (is (= (tm-sparql::value (getf result :value)) 1234.43e10)) - (is-false (tm-sparql::literal-lang (getf result :value))) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) + (let ((res (tm-sparql::parse-literal-elem query-4 dummy-object))) + (is (string= (getf res :next-query) (string #\tab))) + (is (= (tm-sparql::value (getf res :value)) 1234.43e10)) + (is-false (tm-sparql::literal-lang (getf res :value))) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-double*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) - (let ((result (tm-sparql::parse-literal-elem query-5 dummy-object))) - (is (string= (getf result :next-query) ";")) - (is (eql (tm-sparql::value (getf result :value)) t)) - (is-false (tm-sparql::literal-lang (getf result :value))) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) + (let ((res (tm-sparql::parse-literal-elem query-5 dummy-object))) + (is (string= (getf res :next-query) ";")) + (is (eql (tm-sparql::value (getf res :value)) t)) + (is-false (tm-sparql::literal-lang (getf res :value))) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-boolean*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) - (let ((result (tm-sparql::parse-literal-elem query-6 dummy-object))) - (is (string= (getf result :next-query) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) + (let ((res (tm-sparql::parse-literal-elem query-6 dummy-object))) + (is (string= (getf res :next-query) (concatenate 'string "." (string #\newline)))) - (is (eql (tm-sparql::value (getf result :value)) 123.4)) - (is-false (tm-sparql::literal-lang (getf result :value))) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (eql (tm-sparql::value (getf res :value)) 123.4)) + (is-false (tm-sparql::literal-lang (getf res :value))) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-double*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) - (let ((result (tm-sparql::parse-literal-elem query-7 dummy-object))) - (is (string= (getf result :next-query) ".")) - (is (string= (tm-sparql::value (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) + (let ((res (tm-sparql::parse-literal-elem query-7 dummy-object))) + (is (string= (getf res :next-query) ".")) + (is (string= (tm-sparql::value (getf res :value)) "Just a test literal with some \\\"quoted\\\" words!")) - (is (string= (tm-sparql::literal-lang (getf result :value)) "en")) - (is (string= (tm-sparql::literal-datatype (getf result :value)) + (is (string= (tm-sparql::literal-lang (getf res :value)) "en")) + (is (string= (tm-sparql::literal-datatype (getf res :value)) *xml-string*)) - (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) (signals sparql-parser-error (tm-sparql::parse-literal-elem query-8 dummy-object)) (signals sparql-parser-error @@ -256,38 +257,38 @@ (var 'TM-SPARQL::VARIABLE) (iri 'TM-SPARQL::IRI)) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value") - (let ((result (tm-sparql::parse-triple-elem query-1 dummy-object))) - (is (string= (getf result :next-query) ".")) - (is (string= (tm-sparql::value (getf result :value)) "var1")) - (is (eql (tm-sparql::elem-type (getf result :value)) var))) - (let ((result (tm-sparql::parse-triple-elem query-2 dummy-object))) - (is (string= (getf result :next-query) ";")) - (is (string= (tm-sparql::value (getf result :value)) "var2")) - (is (eql (tm-sparql::elem-type (getf result :value)) var))) - (let ((result (tm-sparql::parse-triple-elem query-3 dummy-object))) - (is (string= (getf result :next-query) "}")) - (is (string= (tm-sparql::value (getf result :value)) "var3")) - (is (eql (tm-sparql::elem-type (getf result :value)) var))) - (let ((result (tm-sparql::parse-triple-elem query-4 dummy-object))) - (is (string= (getf result :next-query) ".")) - (is (string= (tm-sparql::value (getf result :value)) + (let ((res (tm-sparql::parse-triple-elem query-1 dummy-object))) + (is (string= (getf res :next-query) ".")) + (is (string= (tm-sparql::value (getf res :value)) "var1")) + (is (eql (tm-sparql::elem-type (getf res :value)) var))) + (let ((res (tm-sparql::parse-triple-elem query-2 dummy-object))) + (is (string= (getf res :next-query) ";")) + (is (string= (tm-sparql::value (getf res :value)) "var2")) + (is (eql (tm-sparql::elem-type (getf res :value)) var))) + (let ((res (tm-sparql::parse-triple-elem query-3 dummy-object))) + (is (string= (getf res :next-query) "}")) + (is (string= (tm-sparql::value (getf res :value)) "var3")) + (is (eql (tm-sparql::elem-type (getf res :value)) var))) + (let ((res (tm-sparql::parse-triple-elem query-4 dummy-object))) + (is (string= (getf res :next-query) ".")) + (is (string= (tm-sparql::value (getf res :value)) "http://full.url")) - (is (eql (tm-sparql::elem-type (getf result :value)) iri))) - (let ((result (tm-sparql::parse-triple-elem query-5 dummy-object))) - (is (string= (getf result :next-query) "}")) - (is (string= (tm-sparql::value (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) iri))) + (let ((res (tm-sparql::parse-triple-elem query-5 dummy-object))) + (is (string= (getf res :next-query) "}")) + (is (string= (tm-sparql::value (getf res :value)) "http://base.value/url-suffix")) - (is (eql (tm-sparql::elem-type (getf result :value)) iri))) - (let ((result (tm-sparql::parse-triple-elem query-6 dummy-object))) - (is (string= (getf result :next-query) ".")) - (is (string= (tm-sparql::value (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) iri))) + (let ((res (tm-sparql::parse-triple-elem query-6 dummy-object))) + (is (string= (getf res :next-query) ".")) + (is (string= (tm-sparql::value (getf res :value)) "http://prefix.value/suffix")) - (is (eql (tm-sparql::elem-type (getf result :value)) iri))) - (let ((result (tm-sparql::parse-triple-elem query-7 dummy-object))) - (is (string= (getf result :next-query) "}")) - (is (string= (tm-sparql::value (getf result :value)) + (is (eql (tm-sparql::elem-type (getf res :value)) iri))) + (let ((res (tm-sparql::parse-triple-elem query-7 dummy-object))) + (is (string= (getf res :next-query) "}")) + (is (string= (tm-sparql::value (getf res :value)) "http://prefix.value/suffix")) - (is (eql (tm-sparql::elem-type (getf result :value)) iri))) + (is (eql (tm-sparql::elem-type (getf res :value)) iri))) (signals sparql-parser-error (tm-sparql::parse-triple-elem query-8 dummy-object))))