[isidorus-cvs] r362 - in trunk/src: TM-SPARQL base-tools unit_tests

Lukas Giessmann lgiessmann at common-lisp.net
Tue Dec 14 21:07:50 UTC 2010


Author: lgiessmann
Date: Tue Dec 14 16:07:50 2010
New Revision: 362

Log:
TM-SPARQL: added some functions that separate a single filter-statement, handle bracketing, and handle unsupported functions

Modified:
   trunk/src/TM-SPARQL/sparql_filter.lisp
   trunk/src/TM-SPARQL/sparql_parser.lisp
   trunk/src/base-tools/base-tools.lisp
   trunk/src/unit_tests/sparql_test.lisp

Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp	Tue Dec 14 16:07:50 2010
@@ -9,14 +9,42 @@
 
 (in-package :TM-SPARQL)
 
-(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)."
-  (declare (String query-string)
-	   (SPARQL-Query query-object))
+
+(defparameter *supported-functions*
+  (list "BOUND" "isLITERAL" "STR" "DATATYPE" "REGEX")
+  "Contains all supported SPARQL-functions")
+
+
+(defparameter *supported-operators*
+  (list "!" "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/")
+  "Contains all supported operators, note some unary operators
+   are handled as functions, e.g. + and -")
+
+
+(defun make-sparql-parser-condition(rest-of-query entire-query expected)
+  "Creates a spqrql-parser-error object."
+  (declare (String rest-of-query entire-query expected))
+  (let ((message
+	 (format nil "The query:~%\"~a\"~%~%has a bad token at position ~a => ~a.~%Expected: ~a"
+		 entire-query (- (length entire-query)
+				 (length rest-of-query))
+		 (subseq entire-query (- (length entire-query)
+					 (length rest-of-query)))
+		 expected)))
+    (make-condition 'sparql-parser-error :message message)))
+
+
+(defgeneric parse-filter (construct query-string)
+  (:documentation "A helper functions that returns a filter and the next-query
+                   string in the form (:next-query string :filter object).")
+  (:method ((construct SPARQL-Query) (query-string String))
+    (let* ((result-set-boundings (set-boundings construct query-string))
+	   (filter-string (getf result-set-boundings :filter-string))
+	   (next-query (getf result-set-boundings :next-query))
+	   ))))
   ;;TODO: implement
-  ;; *replace () by (progn )
-  ;; *replace ', """, ''' by "
+  ;; **replace () by (progn )
+  ;; **replace ', """, ''' by '''
   ;; *replace !x by (not x)
   ;; *replace +x by (1+ x)
   ;; *replace -x by (1- x)
@@ -25,7 +53,147 @@
   ;; *replace function(x), function(x, y), function(x, y, z)
   ;;   by filter-function(x), (filter-function(x, y), filter-function(x, y, z)
   ;; *create and store this filter object
-  )
+
+
+(defgeneric set-boundings (construct query-string)
+  (:documentation "Returns a list of the form (:next-query <string>
+                   :filter-string <string>). next-query is a string containing
+                   the query after the filter and filter is a string
+                   containing the actual filter. Additionally all free
+                   '(' are transformed into '(progn' and all ', ''', \"\"\"
+                   are transformed into \".")
+  (:method ((construct SPARQL-Query) (query-string String))
+    (let ((filter-string "")
+	  (open-brackets 0)
+	  (result nil))
+      (dotimes (idx (length query-string))
+	(let ((current-char (subseq query-string idx (1+ idx))))
+	  (cond ((string= "(" current-char)
+		 (setf open-brackets (1+ open-brackets))
+		 (if (progn-p query-string idx)
+		     (push-string "(progn " filter-string)
+		     (push-string current-char filter-string)))
+		((string= ")" current-char)
+		 (setf open-brackets (1- open-brackets))
+		 (when (< open-brackets 0)
+		   (make-sparql-parser-condition
+		    (subseq query-string idx)
+		    (original-query construct)
+		    "an opening bracket \"(\" is missing for the current closing one"))
+		 (push-string current-char filter-string))
+		((or (string= "'" current-char)
+		     (string= "\"" current-char))
+		 (let ((result (get-literal (subseq query-string idx))))
+		   (unless result
+		     (make-sparql-parser-condition
+		      (subseq query-string idx)
+		      (original-query construct)
+		      "a closing character for the given literal"))
+		   (setf idx (- (1- (length query-string))
+				(length (getf result :next-query))))
+		   (push-string (getf result :literal) filter-string)))
+		((string= "#" current-char)
+		 (let ((comment-string
+			(string-until (subseq query-string idx)
+				      (string #\newline))))
+		   (setf idx (+ idx (length comment-string)))))
+		((and (string= current-char (string #\newline))
+		      (= 0 open-brackets))
+		 (setf result
+		       (list :next-query (subseq query-string idx)
+			     :filter-string filter-string))
+		 (setf idx (1- (length query-string))))
+		((string= current-char "}")
+		 (when (/= open-brackets 0)
+		   (make-sparql-parser-condition
+		    (subseq query-string idx)
+		    (original-query construct)
+		    "a valid filter, but the filter is not complete"))
+		 (setf result
+		       (list :next-query (subseq query-string idx)
+			     :filter-string filter-string)))
+		(t
+		 (push-string current-char filter-string)))))
+      result)))
+
+
+(defun progn-p(query-string idx)
+  "Returns t if the ( at position idx in the filter string
+  represents a (progn) block."
+  (declare (String query-string)
+	   (Integer idx))
+  (let* ((delimiters (append (list " " (string #\Space) (string #\Tab)
+				   (string #\Newline) (string #\cr) "(" ")")
+			     *supported-operators*))
+	 (string-before (trim-whitespace-right (subseq query-string 0 idx)))
+	 (fragment-before-idx
+	  (search-first delimiters string-before :from-end t))
+	 (fragment-before
+	  (if (and (not fragment-before-idx)
+		   (and (> (length string-before) 0)
+			(not (find string-before *supported-functions*
+				   :test #'string=))))
+	      (error (make-condition
+		      'SPARQL-PARSER-ERROR
+		      :message (format nil "Invalid filter: \"~a\"~%"
+				       query-string)))
+	      (when fragment-before-idx
+		(let ((inner-value
+		       (subseq string-before fragment-before-idx)))
+		  (if (and (> (length inner-value) 1)
+			   (string-starts-with inner-value "("))
+		      (subseq inner-value 1)
+		      inner-value))))))
+    (if fragment-before
+	(progn
+	  (when (or (string-starts-with fragment-before "?")
+		    (string-starts-with fragment-before "$"))
+	    (error
+	     (make-condition
+	      'SPARQL-PARSER-ERROR
+	      :message (format nil "Invalid filter: found \"~a\" but expected ~a"
+			       fragment-before *supported-functions*))))
+	  (when (not (find fragment-before (append *supported-functions*
+						   delimiters)
+			   :test #'string=))
+	    (error
+	     (make-condition
+	      'SPARQL-PARSER-ERROR
+	      :message
+	      (format nil "Invalid character: ~a, expected characters: ~a"
+		      fragment-before (append *supported-functions* delimiters)))))
+	  (if (find fragment-before *supported-functions* :test #'string=)
+	      nil
+	      t))
+	(if (find string-before *supported-functions* :test #'string=)
+	    nil
+	    t))))
+
+
+(defun get-literal (query-string)
+  "Returns a list of the form (:next-query <string> :literal <string>
+   where next-query is the query after the found literal and literal
+   is the literal string."
+  (declare (String query-string))
+  (cond ((or (string-starts-with query-string "\"\"\"")
+	     (string-starts-with query-string "'''"))
+	 (let ((literal-end
+		(find-literal-end (subseq query-string 3) (subseq query-string 0 3))))
+	   (when literal-end
+	     (list :next-query (subseq query-string (+ 3 literal-end))
+		   :literal (concatenate 'string "'''"
+					 (subseq query-string 3 literal-end)
+					 "'''")))))
+	((or (string-starts-with query-string "\"")
+	     (string-starts-with query-string "'"))
+	 (let ((literal-end
+		(find-literal-end (subseq query-string 1)(subseq query-string 0 1))))
+	   (when literal-end
+	     (list :next-query (subseq query-string (+ 1 literal-end))
+		   :literal (concatenate 'string "'''"
+					 (subseq query-string 1 literal-end)
+					 "'''")))))))
+
 
 (defun find-literal-end (query-string delimiter &optional (overall-pos 0))
   "Returns the end of the literal corresponding to the passed delimiter

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Tue Dec 14 16:07:50 2010
@@ -9,19 +9,6 @@
 
 (in-package :TM-SPARQL)
 
-(defun make-sparql-parser-condition(rest-of-query entire-query expected)
-  "Creates a spqrql-parser-error object."
-  (declare (String rest-of-query entire-query expected))
-  (let ((message
-	 (format nil "The query:~%\"~a\"~%~%has a bad token at position ~a => ~a.~%Expected: ~a"
-		 entire-query (- (length entire-query)
-				 (length rest-of-query))
-		 (subseq entire-query (- (length entire-query)
-					 (length rest-of-query)))
-		 expected)))
-    (make-condition 'sparql-parser-error :message message)))
-
-
 (defun parse-closed-value(query-string query-object &key (open "<") (close ">"))
   "A helper function that checks the value of a statement within
    two brackets, i.e. <prefix-value>. A list of the

Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp	(original)
+++ trunk/src/base-tools/base-tools.lisp	Tue Dec 14 16:07:50 2010
@@ -150,16 +150,20 @@
 	nil)))
 
 
-(defun search-first (search-strings main-string)
+(defun search-first (search-strings main-string &key from-end)
   "Returns the position of one of the search-strings. The returned position
    is the one closest to 0. If no search-string is found, nil is returned."
   (declare (String main-string)
-	   (List search-strings))
+	   (List search-strings)
+	   (Boolean from-end))
   (let ((positions
-	 (remove-null (map 'list #'(lambda(search-str)
-				     (search search-str main-string))
-			   search-strings))))
-    (let ((sorted-positions (sort positions #'<)))
+	 (remove-null
+	  (map 'list #'(lambda(search-str)
+			 (search search-str main-string :from-end from-end))
+	       search-strings))))
+    (let ((sorted-positions (if from-end
+				(sort positions #'>)
+				(sort positions #'<))))
       (when sorted-positions
 	(first sorted-positions)))))
 

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Tue Dec 14 16:07:50 2010
@@ -29,7 +29,8 @@
 	   :test-set-result-3
 	   :test-set-result-4
 	   :test-set-result-5
-	   :test-result))
+	   :test-result
+	   :test-set-boundings))
 
 
 (in-package :sparql-test)
@@ -1038,6 +1039,29 @@
 		      (getf (first (result q-obj-2)) :result) :test #'string=)))))))))
 
 
+(test test-set-boundings
+  "Tests various cases of the function set-boundings"
+  (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query "  "))
+	 (str-1 "BOUND((  (?var)  )) || (isLITERAL($var) && ?var = 'abc')}")
+	 (result-1 (tm-sparql::set-boundings dummy-object str-1))
+	 (str-2
+	  "(REGEX(?var1, '''''', ?var3) || (?var1 > ?var3 && (STR( ?var) = \"abc\")))}")
+	 (result-2 (tm-sparql::set-boundings dummy-object str-2))
+	 (str-3
+	  "DATATYPE(?var3) || +?var1 = -?var2
+           ?var1 ?var2 ?var3}")
+	 (result-3 (tm-sparql::set-boundings dummy-object str-3)))
+    (is-true result-1)
+    (is-true result-2)
+    (is (string= (getf result-1 :filter-string)
+		 "BOUND((progn   (progn ?var)  )) || (progn isLITERAL($var) && ?var = '''abc''')"))
+    (is (string= (getf result-1 :next-query) "}"))
+    (is (string= (getf result-2 :filter-string)
+		 "(progn REGEX(?var1, '''''', ?var3) || (progn ?var1 > ?var3 && (progn STR( ?var) = '''abc''')))"))
+    (is (string= (getf result-2 :next-query) "}"))
+    (is (string= (getf result-3 :filter-string)
+		 "DATATYPE(?var3) || +?var1 = -?var2"))
+    (is (string= (getf result-3 :next-query) (subseq str-3 34)))))
 
 
 (defun run-sparql-tests ()




More information about the Isidorus-cvs mailing list