Author: lgiessmann Date: Tue Nov 23 11:45:57 2010 New Revision: 349

Log: TM-SPARQL: fixed a recursion bug when parsing SELECT-WHERE-statements

Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.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 Tue Nov 23 11:45:57 2010 @@ -16,20 +16,13 @@

(defvar *empty-label* "_empty_label_symbol")

-(defclass Variable-Container () - ((variables :initarg :variables - :accessor variables ;this value is only for internal purposes - ;purposes and mustn't be reset - :type List - :initform nil - :documentation "A list of the form ((:variable var-name - :value value-object)), that contains tuples - for each variable and its result.")) - (:documentation "This class is used to store all variable in a WHERE{} - statement")) + +;(defclass SPARQL-Triple () +; (()) +; )

-(defclass SPARQL-Query (Variable-Container) +(defclass SPARQL-Query () ((original-query :initarg :query :accessor original-query ;this value is only for internal ;purposes and mustn't be reset @@ -39,6 +32,14 @@ 'missing-argument-error :message "From TM-Query(): original-query must be set")) :documentation "Containst the original received querry as string") + (variables :initarg :variables + :accessor variables ;this value is only for internal purposes + ;purposes and mustn't be reset + :type List + :initform nil + :documentation "A list of the form ((:variable var-name + :value value-object)), that contains tuples + for each selected variable and its result.") (prefixes :initarg :prefixes :accessor prefixes ;this value is only for internal purposes ;purposes and mustn't be reset @@ -97,7 +98,7 @@ If a variable-already exists the existing entry will be overwritten. An entry is of the form (:variable string :value any-type).") - (:method ((construct Variable-Container) (variable-name String) variable-value) + (:method ((construct SPARQL-Query) (variable-name String) variable-value) (let ((existing-tuple (find-if #'(lambda(x) (string= (getf x :variable) variable-name))

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Nov 23 11:45:57 2010 @@ -104,15 +104,16 @@ (unless (string-starts-with trimmed-str "{") (error (make-sparql-parser-condition trimmed-str (original-query construct) "{"))) - (let ((query-tail (parse-group construct (subseq trimmed-str 1) nil nil))) + (let ((query-tail (parse-group construct (subseq trimmed-str 1)))) ;TODO: process query-tail query-tail))))

-(defgeneric parse-group (construct query-string values filters) +(defgeneric parse-group (construct query-string &key last-subject values filters) (:documentation "The entry-point for the parsing of a {} statement.") (:method ((construct SPARQL-Query) (query-string String) - (values List) (filters List)) + &key (last-subject nil) (values nil) (filters nil)) + (declare (List last-subject values filters)) (let ((trimmed-str (cut-comment query-string))) (cond ((string-starts-with trimmed-str "BASE") (parse-base construct (string-after trimmed-str "BASE") @@ -122,7 +123,7 @@ trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "FILTER") - nil) ;TODO: call parse-group with added filter + nil) ;TODO: parse-filter and store it ((string-starts-with trimmed-str "OPTIONAL") (error (make-sparql-parser-condition trimmed-str (original-query construct) @@ -135,10 +136,19 @@ ;TODO: invoke filters with all results (subseq trimmed-str 1)) (t - (let ((result (parse-triple construct trimmed-str values))) - (parse-group construct (getf result :next-query) - (getf result :values) filters))))))) - + ;(let ((result + (parse-triple construct trimmed-str :values values + :filters filters :last-subject last-subject)))))) + + +(defun parse-filter (query-string query-object) + "A helper functions that returns a filter and the next-query string + in the form (:next-query string :filter object)." + ;; !, +, -, *, /, (, ), &&, ||, =, !=, <, >, >=, <=, REGEX(string, pattern) + (declare (String query-string) + (SPARQL-Query query-object)) + ;;TODO: implement + (or query-string query-object))

(defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) @@ -417,15 +427,16 @@ :type 'IRI))))

-(defgeneric parse-triple (construct query-string values &key last-subject) +(defgeneric parse-triple (construct query-string + &key last-subject values filters) (:documentation "Parses a triple within a trippel group and returns a a list of the form (:next-query :values (:subject (:type <'VAR|'IRI> :value string) :predicate (:type <'VAR|'IRI> :value string) :object (:type <'VAR|'IRI|'LITERAL> :value string))).") - (:method ((construct SPARQL-Query) (query-string String) (values List) - &key (last-subject nil)) - (declare (List last-subject)) + (:method ((construct SPARQL-Query) (query-string String) + &key (last-subject nil) (values nil) (filters nil)) + (declare (List last-subject filters values)) (let* ((trimmed-str (cut-comment query-string)) (subject-result (if last-subject ;;is used after a ";" last-subject @@ -444,14 +455,17 @@ :object (getf object-result :value)))))) (let ((tr-str (cut-comment (getf object-result :next-query)))) (cond ((string-starts-with tr-str ";") - (parse-triple construct (subseq tr-str 1) all-values - :last-subject (list :value - (getf subject-result :value)))) + (parse-group + construct (subseq tr-str 1) + :last-subject (list :value (getf subject-result :value)) + :values all-values + :filters filters)) ((string-starts-with tr-str ".") - (parse-triple construct (subseq tr-str 1) all-values)) - ((string-starts-with tr-str "}") ;no other triples follows - (list :next-query tr-str - :values all-values))))))) + (parse-group construct (subseq tr-str 1) :values all-values + :filters filters)) + ((string-starts-with tr-str "}") + (parse-group construct tr-str :values all-values + :filters filters)))))))

(defgeneric parse-variables (construct query-string)

Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue Nov 23 11:45:57 2010 @@ -17,7 +17,9 @@ :sparql-tests :test-prefix-and-base :test-parse-literals - :test-parse-triple-elem)) + :test-parse-triple-elem + :test-parse-group-1 + :test-parse-group-2))

(in-package :sparql-test) @@ -287,7 +289,7 @@ :base "http://base.value/"))) (is-true dummy-object) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") - (let ((result (tm-sparql::parse-triple dummy-object query-1 nil))) + (let ((result (tm-sparql::parse-triple dummy-object query-1))) (is (string= (getf result :next-query) "}")) (is (= (length (getf result :values)) 1)) (is (eql (getf (getf (first (getf result :values)) :subject) :type) @@ -302,7 +304,7 @@ 'TM-SPARQL::VAR)) (is (string= (getf (getf (first (getf result :values)) :object) :value) "object"))) - (let ((result (tm-sparql::parse-triple dummy-object query-2 nil))) + (let ((result (tm-sparql::parse-triple dummy-object query-2))) (is (string= (getf result :next-query) "}")) (is (eql (getf (getf (first (getf result :values)) :subject) :type) 'TM-SPARQL::IRI)) @@ -319,7 +321,7 @@ (is (string= (getf (getf (first (getf result :values)) :object) :literal-type) *xml-double*))) - (let ((result (tm-sparql::parse-triple dummy-object query-3 nil))) + (let ((result (tm-sparql::parse-triple dummy-object query-3))) (is (string= (getf result :next-query) "}")) (is (eql (getf (getf (first (getf result :values)) :subject) :type) 'TM-SPARQL::IRI)) @@ -338,7 +340,7 @@ "en")))))

-(test test-parse-group-2 +(test test-parse-triple-2 "Test various functionality of several functions responsible for parsing the SELECT-WHERE-statement." (let ((query-4 (concatenate 'string "<subject> <predicate> '''true'''^^"