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

Lukas Giessmann lgiessmann at common-lisp.net
Tue Apr 5 09:31:40 UTC 2011


Author: lgiessmann
Date: Tue Apr  5 05:31:40 2011
New Revision: 413

Log:
changed the behavior of the handling of paranthesis and quotations in filters and the behavior of hanlding SPARQL comments

Modified:
   trunk/src/TM-SPARQL/sparql.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.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql.lisp	Tue Apr  5 05:31:40 2011
@@ -377,6 +377,9 @@
   (:documentation "Processes all filters by calling invoke-filter.")
   (:method ((construct SPARQL-Query))
     (dolist (filter (filters construct))
+
+      (format t ">>>~a<<<~%" filter) ;TODO: remove
+
       (let* ((filter-variable-names
 	      (get-variables-from-filter-string filter))
 	     (filter-variable-values nil)

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Tue Apr  5 05:31:40 2011
@@ -38,7 +38,10 @@
     (if (string-starts-with trimmed-str "#")
         (let ((next-query (string-after trimmed-str (string #\newline))))
 	  (if next-query
-	      next-query
+	      (let ((cleaned-next-query (cut-comment next-query)))
+		(if (string= next-query cleaned-next-query)
+		    next-query
+		    (cut-comment next-query)))
 	      ""))
 	trimmed-str)))
 

Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp	(original)
+++ trunk/src/base-tools/base-tools.lisp	Tue Apr  5 05:31:40 2011
@@ -437,25 +437,35 @@
 	   (Integer pos))
   (let ((result nil))
     (dotimes (idx (length filter-string) result)
-      (let ((current-char (subseq filter-string idx (1+ idx))))
-	(cond ((or (string= current-char "'")
-		   (string= current-char "\""))
-	       (let* ((l-result (get-literal (subseq filter-string idx)))
-		      (next-idx
-		       (when l-result
-			 (- (length filter-string)
-			    (length (getf l-result :next-string))))))
-		 (when (and next-idx (< pos next-idx))
-		   (setf result t)
-		   (setf idx (length filter-string)))
-		 (when (<= pos idx)
-		   (setf idx (length filter-string)))))
-	      (t
-	       (when (<= pos idx)
-		 (setf idx (length filter-string)))))))))
+      (let* ((current-str (subseq filter-string idx))
+	     (delimiter (cond ((string-starts-with current-str "'''")
+			       "'''")
+			      ((string-starts-with current-str "'")
+			       "'")
+			      ((string-starts-with current-str "\"\"\"")
+			       "\"\"\"")
+			      ((string-starts-with current-str "\"")
+			       "\""))))
+	(when delimiter
+	  (let* ((end-pos
+		  (let ((result
+			 (search-first (list delimiter) 
+				       (subseq current-str (length delimiter)))))
+		    (when result
+		      (+ (length delimiter) result))))
+		 (quoted-str (when end-pos
+			       (subseq current-str (length delimiter) end-pos)))
+		 (start-pos idx))
+	    (incf idx (+ (* 2 (length delimiter)) (length quoted-str)))
+	    (if (and (>= pos start-pos)
+		     (<= pos (+ start-pos end-pos)))
+		(progn
+		  (setf result t)
+		  (setf idx (length filter-string)))
+		(incf idx (+ (* 2 (length delimiter)) (length quoted-str))))))))))
 
 
-(defun search-first-unclosed-paranthesis (str &key ignore-literals)
+(defun search-first-unclosed-paranthesis (str &key (ignore-literals t))
   "Returns the idx of the first ( that is not closed, the search is
    started from the end of the string.
    If ignore-literals is set to t all paranthesis that are within
@@ -467,12 +477,14 @@
     (do ((idx (1- (length str)))) ((< idx 0))
       (let ((current-char (subseq str idx (1+ idx))))
 	(cond ((string= current-char ")")
-	       (when (or ignore-literals
-			 (not (in-literal-string-p str idx)))
+	       (when (or (not ignore-literals)
+			 (and ignore-literals
+			      (not (in-literal-string-p str idx))))
 		 (decf open-brackets)))
 	      ((string= current-char "(")
-	       (when (or ignore-literals
-			 (not (in-literal-string-p str idx)))
+	       (when (or (not ignore-literals)
+			 (and ignore-literals
+			      (not (in-literal-string-p str idx))))
 		 (incf open-brackets)
 		 (when (> open-brackets 0)
 		   (setf result-idx idx)
@@ -481,7 +493,7 @@
     result-idx))
 
 
-(defun search-first-unopened-paranthesis (str &key ignore-literals)
+(defun search-first-unopened-paranthesis (str &key (ignore-literals t))
   "Returns the idx of the first paranthesis that is not opened in str.
    If ignore-literals is set to t all mparanthesis that are within
    \", \"\"\", ' and ''' are ignored."
@@ -492,13 +504,15 @@
     (dotimes (idx (length str))
       (let ((current-char (subseq str idx (1+ idx))))
 	(cond ((string= current-char "(")
-	       (when (or ignore-literals
-			 (not (in-literal-string-p str idx)))
+	       (when (or (not ignore-literals)
+			 (and ignore-literals
+			      (not (in-literal-string-p str idx))))
 		 (decf closed-brackets)
 		 (setf result-idx nil)))
 	      ((string= current-char ")")
-	       (when (or ignore-literals
-			 (not (in-literal-string-p str idx)))
+	       (when (or (not ignore-literals)
+			 (and ignore-literals
+			      (not (in-literal-string-p str idx))))
 		 (incf closed-brackets)
 		 (when (> closed-brackets 0)
 		   (setf result-idx idx)

Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp	(original)
+++ trunk/src/unit_tests/sparql_test.lisp	Tue Apr  5 05:31:40 2011
@@ -2339,6 +2339,52 @@
 	   r-1))))
 
 
+(test test-all-14
+  "Tests the entire module with the file sparql_test.xtm"
+  (with-fixture with-tm-filled-db ("data_base" *sparql_test.xtm*)
+    (tm-sparql:init-tm-sparql)
+    (let* ((q-1 (concat
+		 "SELECT * WHERE {
+                   <http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
+                    FILTER ?obj1 = 'von Goethe' || ?obj1 = '82'
+                   #FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
+		   #FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
+                   #FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
+		   #FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
+                 "
+}"))
+	   (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
+
+
+
+      ;;TODO: use all stored literal datatype information if existent and
+      ;;      cast the values to the actual objects
+      ;;      or
+      ;;      write all string values to the results in a quoted form,
+      ;;      it is also needed to escapte quotes in the actual string value
+      ;;      the filter is called with read-from-string, so a "12" will evaluate
+      ;;      to 12 and "\"abc\"" to "abc
+
+      (map 'list #'(lambda(triple)
+		     (format t "~a - ~a - ~a~%"
+			     (tm-sparql::subject-result triple)
+			     (tm-sparql::predicate-result triple)
+			     (tm-sparql::object-result triple)))
+	   (tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
+
+
+
+      (is-true (= (length r-1) 2))
+      (map 'list #'(lambda(item)
+		     (cond
+		       ((string= (getf item :variable) "pred1")
+			nil)
+		       ((string= (getf item :variable) "obj1")
+			nil)))
+	   r-1)
+      (format t "~a~%" r-1))))
+
+
 
 ;TODO: test complex filters
 




More information about the Isidorus-cvs mailing list