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)