Author: lgiessmann Date: Thu Apr 7 15:19:16 2011 New Revision: 425
Log: TM-SPARQL: fixed a bug in the function in-literal-string-p
Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp trunk/src/TM-SPARQL/sparql.lisp 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/filter_wrappers.lisp ============================================================================== --- trunk/src/TM-SPARQL/filter_wrappers.lisp (original) +++ trunk/src/TM-SPARQL/filter_wrappers.lisp Thu Apr 7 15:19:16 2011 @@ -187,10 +187,11 @@
(defun filter-functions::str(x) - (if (stringp x) - (if (and (base-tools:string-starts-with x "<") - (base-tools:string-ends-with x ">") - (base-tools:absolute-uri-p (subseq x 1 (1- (length x))))) - (subseq x 1 (1- (length x))) - x) - (write-to-string x))) \ No newline at end of file + ;(if (stringp x) ;TODO: remove + ;(if (and (base-tools:string-starts-with x "<") + ;(base-tools:string-ends-with x ">") + ;(base-tools:absolute-uri-p (subseq x 1 (1- (length x))))) + ;(subseq x 1 (1- (length x))) + ;x) + ;(write-to-string x))) + (write-to-string x)) \ No newline at end of file
Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Thu Apr 7 15:19:16 2011 @@ -368,38 +368,6 @@ (elt (getf results :result) idx)))))))))
-;(defun to-lisp-code (variable-values filter) -; "Concatenates all variable names and elements with the filter expression -; in a let statement and returns a string representing the corresponding -; lisp code." -; (declare (List variable-values)) -; (let ((result "") -; (cleanup-str "")) -; (dolist (var-elem variable-values) -; (push-string -; (concat "(defvar ?" (getf var-elem :variable-name) " " -; (write-to-string (getf var-elem :variable-value)) ")") -; result) -; (push-string -; (concat "(defvar $" (getf var-elem :variable-name) " " -; (write-to-string (getf var-elem :variable-value)) ")") -; result)) -; (push-string "(let* ((true t)(false nil)" result) -; (push-string (concat "(result " filter "))") result) -; (push-string "(declare (Ignorable true false " result) -; (push-string "))" result) -; (dolist (var-elem variable-values) -; (push-string (concat "(makunbound '?" (getf var-elem :variable-name) ")") -; cleanup-str) -; (push-string (concat "(makunbound '$" (getf var-elem :variable-name) ")") -; cleanup-str)) -; (push-string "(in-package :cl-user)" cleanup-str) -; (push-string cleanup-str result) -; (push-string "result)" result) -; (concat "(handler-case (progn " result ") (condition () (progn " cleanup-str -; "nil)))"))) - - (defun to-lisp-code (variable-values filter) "Concatenates all variable names and elements with the filter expression in a let statement and returns a string representing the corresponding @@ -1409,22 +1377,24 @@ &key (back-as-string-when-unsupported nil)) "A helper function that casts the passed string value of the literal corresponding to the passed literal-type." - (declare (String literal-value literal-type) + (declare (String literal-value) + (type (or String null) literal-type) (Boolean back-as-string-when-unsupported)) - (cond ((string= literal-type *xml-string*) - literal-value) - ((string= literal-type *xml-boolean*) - (cast-literal-to-boolean literal-value)) - ((string= literal-type *xml-integer*) - (cast-literal-to-integer literal-value)) - ((string= literal-type *xml-double*) - (cast-literal-to-double literal-value)) - ((string= literal-type *xml-decimal*) - (cast-literal-to-decimal literal-value)) - (t ; return the value as a string - (if back-as-string-when-unsupported - literal-value - (concat """"" literal-value """"^^" literal-type))))) + (let ((local-literal-type (if literal-type literal-type *xml-string*))) + (cond ((string= local-literal-type *xml-string*) + literal-value) + ((string= local-literal-type *xml-boolean*) + (cast-literal-to-boolean literal-value)) + ((string= local-literal-type *xml-integer*) + (cast-literal-to-integer literal-value)) + ((string= local-literal-type *xml-double*) + (cast-literal-to-double literal-value)) + ((string= local-literal-type *xml-decimal*) + (cast-literal-to-decimal literal-value)) + (t ; return the value as a string + (if back-as-string-when-unsupported + literal-value + (concat """"" literal-value """"^^" local-literal-type))))))
(defun cast-literal-to-decimal (literal-value)
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Thu Apr 7 15:19:16 2011 @@ -350,12 +350,24 @@ (+ inner-value (1+ (length (name-after-paranthesis (subseq left-string inner-value)))))))) (paranthesis-pair-idx - (let* ((cleaned-str (trim-whitespace-right left-string)) - (bracket-scope (reverse-bracket-scope cleaned-str))) - (when bracket-scope - (- (- (length left-string) - (- (length left-string) (length cleaned-str))) - (length bracket-scope))))) + (let ((value + (let* ((cleaned-str (trim-whitespace-right left-string)) + (bracket-scope (reverse-bracket-scope cleaned-str))) + (when bracket-scope + (- (- (length left-string) + (- (length left-string) (length cleaned-str))) + (length bracket-scope)))))) + (when value ;search a functionname: FUN(...) + (let* ((str-before (subseq left-string 0 value)) + (c-str-before (trim-whitespace-right str-before))) + (if (string-ends-with-one-of c-str-before *supported-functions*) + (loop for fun-name in *supported-functions* + when (string-ends-with c-str-before fun-name) + return (- value + (+ (- (length str-before) + (length c-str-before)) + (length fun-name)))) + value))))) (start-idx (or first-bracket paranthesis-pair-idx 0))) (subseq left-string start-idx)))
Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Thu Apr 7 15:19:16 2011 @@ -352,12 +352,8 @@ (search-first (list """ "'") (subseq main-string 0 first-pos) :from-end from-end)) (next-str - (if from-end - - + (if from-end (subseq main-string 0 literal-start) - - (let* ((sub-str (subseq main-string literal-start)) (literal-result (get-literal sub-str))) (getf literal-result :next-string))))) @@ -441,31 +437,25 @@ (let ((result nil)) (dotimes (idx (length filter-string) result) (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 """) - """)))) + (delimiter (get-literal-quotation current-str))) (when delimiter (let* ((end-pos (let ((result - (search-first (list delimiter) - (subseq current-str (length delimiter))))) - (when result + (find-literal-end (subseq current-str (length delimiter)) + 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)))))))))) + (when quoted-str + (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 t))
Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Thu Apr 7 15:19:16 2011 @@ -1549,7 +1549,7 @@ "BASE http://some.where/psis/poem/ SELECT $subject ?predicate WHERE{ ?subject $predicate <zauberlehrling> . - FILTER (STR(?predicate) = 'http://some.where/base-psis/written%27)%7D") + FILTER (STR(?predicate) = '"http://some.where/base-psis/written"')}") (query-2 "SELECT ?object ?subject WHERE{ http://some.where/psis/author/goethe ?predicate ?object . FILTER (isLITERAL(?object) && @@ -2408,7 +2408,9 @@ FILTER isLITERAL(?obj1) && !isLITERAL(?pred1) && ?obj1 = 'von Goethe' || ?obj1 = 82 FILTER ?pred1 = $pred1 && $obj1 = $obj1 && ?pred1 != ?obj1 FILTER ?obj1 >= 82 || ?obj1 = 'von Goethe' - FILTER BOUND(?obj1) && !BOUND(?obj2) && BOUND(?pred1)" + FILTER BOUND(?obj1) && !BOUND(?obj2) && BOUND(?pred1) + FILTER (DATATYPE(?obj1) = '" *xml-string* "' || DATATYPE(?obj1) = '" *xml-integer* "') && !(DATATYPE(?obj1) = '" *xml-double* "') + FILTER STR(?obj1) = '82' || ?obj1='von Goethe'" "}")) (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) ;(is-true (= (length r-1) 2))