[isidorus-cvs] r379 - trunk/src/TM-SPARQL

[Lukas Giessmann]

Author: lgiessmann
Date: Mon Dec 20 13:28:01 2010
New Revision: 379

Log:
TM-SPARQL: fixed a bug when invoking filters => all functions are explicit wrapped in the filter-functions package by using the prefix 'filter-functions::' in the filter stirng.

Modified:
   trunk/src/TM-SPARQL/filter_wrappers.lisp
   trunk/src/TM-SPARQL/sparql.lisp
   trunk/src/TM-SPARQL/sparql_filter.lisp
   trunk/src/TM-SPARQL/sparql_parser.lisp

Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp
==============================================================================
--- trunk/src/TM-SPARQL/filter_wrappers.lisp	(original)
+++ trunk/src/TM-SPARQL/filter_wrappers.lisp	Mon Dec 20 13:28:01 2010
@@ -9,7 +9,8 @@
 
 
 (defpackage :filter-functions
-  (:use :base-tools :constants :tm-sparql))
+  (:use :base-tools :constants :tm-sparql)
+  (:import-from :cl progn handler-case let))
 
 
 (defun filter-functions::not(x)

Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql.lisp	Mon Dec 20 13:28:01 2010
@@ -252,33 +252,50 @@
       (push variable-name (variables construct)))))
 
 
+(defgeneric generate-let-variable-string (construct value)
+  (:documentation "Returns a list if the form (:string <var-string>
+                  :variable-names (<?var-name-as-string>
+                  <$var-name-as-string>)).")
+  (:method ((construct SPARQL-Triple-Elem) value)
+    (when (variable-p construct)
+      (let* ((var-value (write-to-string value))
+	     (var-name (value construct))
+	     (lisp-str
+	      (concatenate 'string "(?" var-name " " var-value ")"
+			   "($" var-name " " var-value ")"))
+	     (vars
+	      (concatenate 'string "?" var-name " $" var-name)))
+	(list :string lisp-str
+	      :variable-names vars)))))
+
+
 (defgeneric invoke-filter (construct filter-string)
   (:documentation "Invokes the passed filter on the construct that
                    represents a sparql result.")
   (:method ((construct SPARQL-Triple) (filter-string String))
     (let ((results nil)) ;a list of the form (:subject x :predicate y :object z)
       (dotimes (row-idx (length (subject-result construct)))
-	(let* ((subj-var
-		(when (variable-p (subject construct))
-		  (concatenate 'string "(" (value (subject construct))
-			       " " (elt (subject-result construct) row-idx) ")")))
-	       (pred-var 
-		(when (variable-p (predicate construct))
-		  (concatenate 'string "(" (value (predicate construct))
-			       " " (elt (predicate-result construct) row-idx) ")")))
-	       (obj-var 
-		(when (variable-p (object construct))
-		  (concatenate 'string "(" (value (object construct))
-			       " " (elt (object-result construct) row-idx) ")")))
-	       (var-let
-		(concatenate 'string "(let ((true t) (false nil) "
-			     subj-var pred-var obj-var ")"))
+	(let* ((subj-elem
+		(generate-let-variable-string
+		 (subject construct) (elt (subject-result construct) row-idx)))
+	       (pred-elem
+		(generate-let-variable-string
+		 (predicate construct) (elt (predicate-result construct) row-idx)))
+	       (obj-elem
+		(generate-let-variable-string
+		 (object construct) (elt (object-result construct) row-idx)))
 	       (expression
-		(concatenate 'string var-let "(cl:handler-case "
-			     filter-string
-			     "(exception:sparql-parser-error (err) "
-			     "(cl:in-package :cl-user) "
-			     "(error err)))")))
+		(concatenate 'string
+			     "(let* ((true t)(false nil)"
+			     (getf subj-elem :string)
+			     (getf pred-elem :string)
+			     (getf obj-elem :string)
+			     "(result " filter-string "))"
+			     "(declare (ignorable true false "
+			     (getf subj-elem :variable-names) " "
+			     (getf pred-elem :variable-names) " "
+			     (getf obj-elem :variable-names) "))"
+			     "result)")))
 	  (when (eval (read-from-string expression))
 	    (push (list :subject (elt (subject-result construct) row-idx)
 			:predicate (elt (predicate-result construct) row-idx)

Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp	Mon Dec 20 13:28:01 2010
@@ -128,20 +128,27 @@
 
 (defgeneric scan-filter-for-deprecated-calls (construct filter-string
 							original-filter)
-  (:documentation "Returns the passed filter-string or throws a
-                   sparql-parser-error of there is an unallowed
-                   function call.")
+  (:documentation "Returns the passed filter-string where all functions
+                   are explicit wrapped in the filter-functions package
+                   or throws a sparql-parser-error of there is an
+                   unallowed function call.")
   (:method ((construct SPARQL-Query) (filter-string String)
 	    (original-filter String))
-    (dotimes (idx (length filter-string) filter-string)
-      (when-do fun-name (return-function-name (subseq filter-string idx))
-	       (unless (string-starts-with-one-of fun-name *supported-functions*)
+    (let ((result ""))
+      (dotimes (idx (length filter-string) result)
+	(let ((fun-name (return-function-name (subseq filter-string idx))))
+	  (cond ((not fun-name)
+		 (push-string (subseq filter-string idx (1+ idx)) result))
+		((string-starts-with-one-of fun-name *allowed-filter-calls*)
+		 (push-string "(filter-functions::" result)
+		 (push-string fun-name result)
+		 (incf idx (length fun-name)))
+		(t
 		 (error 
 		  (make-condition
 		   'exceptions:sparql-parser-error
-		   :message (format nil "Invalid filter: the filter \"~a\" evaluated to \"~a\" which contains the depricated function ~a!"
-				    filter-string original-filter fun-name))))))))
-	       
+		   :message (format nil "Invalid filter: the filter \"~a\" evaluated to \"~a\" which contains the deprecated function ~a!"
+				    filter-string original-filter fun-name))))))))))
 
 
 (defun return-function-name (filter-string)

Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp	(original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp	Mon Dec 20 13:28:01 2010
@@ -117,7 +117,7 @@
 		     trimmed-str (original-query construct)
 		     "FILTER, BASE, or triple. Grouping is currently no implemented.")))
 	    ((string-starts-with trimmed-str "FILTER")
-	     (parse-filter (string-after trimmed-str "FILTER") construct))
+	     (parse-filter construct (string-after trimmed-str "FILTER")))
 	    ((string-starts-with trimmed-str "OPTIONAL")
 	     (error (make-sparql-parser-condition
 		     trimmed-str (original-query construct)