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

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Dec 16 08:23:10 2010
New Revision: 366

Log:
TM-SPARQL: fixed a problem in all filter statements that uses """, ' or ''' and do not escape inner " in literals

Modified:
   trunk/src/TM-SPARQL/sparql_filter.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	Thu Dec 16 08:23:10 2010
@@ -58,7 +58,9 @@
   ;;   *=, !=, <, >, <=, >=, +, -, *, /, ||, &&
   ;; *replace function(x), function(x, y), function(x, y, z)
   ;;   by filter-function(x), (filter-function(x, y), filter-function(x, y, z)
-  ;; check if all functions that will e invoked are allowed
+  ;; check if all functions that will be invoked are allowed
+  ;; add a let with all variables that are used: every variable with $ and ? prefix
+  ;; add a let with (true t) and (false nil)
   ;; *create and store this filter object
 
 
@@ -121,7 +123,7 @@
 	   (let ((result (get-filter-variable cleaned-str)))
 	     (list :next-query (string-after cleaned-str result)
 		   :scope result)))
-	  ((string-starts-with cleaned-str "'''")
+	  ((string-starts-with cleaned-str "\"")
 	   (let ((result (get-literal cleaned-str)))
 	     (list :next-query (getf result :next-query)
 		   :scope (getf result :literal))))
@@ -348,7 +350,7 @@
 	    t))))
 
 
-(defun get-literal (query-string &key (quotation "'''"))
+(defun get-literal (query-string &key (quotation "\""))
   "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."
@@ -366,12 +368,14 @@
 	((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))))
+		(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 quotation
-					 (subseq query-string 1 literal-end)
-					 quotation)))))))
+	     (let ((literal
+		    (escape-string (subseq query-string 1 literal-end) "\"")))
+	       (list :next-query (subseq query-string (+ 1 literal-end))
+		     :literal (concatenate 'string quotation literal
+					   quotation))))))))
 
 
 (defun find-literal-end (query-string delimiter &optional (overall-pos 0))

Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp	(original)
+++ trunk/src/base-tools/base-tools.lisp	Thu Dec 16 08:23:10 2010
@@ -29,7 +29,8 @@
 	   :string-starts-with-digit
 	   :string-after-number
 	   :separate-leading-digits
-	   :white-space))
+	   :white-space
+	   :escape-string))
 
 (in-package :base-tools)
 
@@ -260,4 +261,21 @@
 	   (position #\: uri)))
       (declare (string uri))
       (and position-of-colon (> position-of-colon 0)
-	   (not (find #\/ (subseq uri 0 position-of-colon)))))))
\ No newline at end of file
+	   (not (find #\/ (subseq uri 0 position-of-colon)))))))
+
+
+(defun escape-string (str char-to-escape)
+  "Escapes every occurrence of char-to-escape in str, if it is
+   not escaped."
+  (declare (String str char-to-escape))
+  (let ((result ""))
+    (dotimes (idx (length str))
+      (let ((current-char (subseq str idx (1+ idx)))
+	    (previous-char (if (= idx 0) "" (subseq str (1- idx) idx))))
+	(cond ((and (string= current-char char-to-escape)
+		    (string/= previous-char "\\"))
+	       (push-string "\\" result)
+	       (push-string current-char result))
+	      (t
+	       (push-string current-char result)))))
+    result))
\ No newline at end of file

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Thu Dec 16 08:23:10 2010
@@ -1059,10 +1059,10 @@
     (is-true result-1)
     (is-true result-2)
     (is (string= (getf result-1 :filter-string)
-		 "BOUND((progn   (progn ?var)  )) || (progn isLITERAL($var) && ?var = '''abc''')"))
+		 "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''')))"))
+		 "(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"))
@@ -1081,7 +1081,7 @@
 	 (str-1 "BOUND(?var1)||(!(+(-(?var1))))}")
 	 (str-2 "!BOUND(?var1) = false}")
 	 (str-3 "+?var1=-$var2}")
-	 (str-4 "!'abc' && (+12 = - 14)}")
+	 (str-4 "!'a\"b\"c' && (+12 = - 14)}")
 	 (result-1
 	  (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string))
 	 (result-1-1 (tm-sparql::set-unary-operators dummy-object result-1))
@@ -1109,7 +1109,7 @@
 	 "BOUND(?var1)||(progn (not (progn (1+ (progn (1- (progn ?var1)))))))"))
     (is (string= result-2-1 "(not BOUND(?var1)) = false"))
     (is (string= result-3-1 "(1+ ?var1)=(1- $var2)"))
-    (is (string= result-4-1 "(not '''abc''') && (progn (1+ 12) = (1- 14))"))))
+    (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (1+ 12) = (1- 14))"))))