Author: lgiessmann Date: Wed Apr 6 11:02:36 2011 New Revision: 419 Log: TM-SPARQL: sparql filters now support constants of the form 'string-value'^^datatype and 'string'@lang 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 Wed Apr 6 11:02:36 2011 @@ -177,7 +177,7 @@ (cond (type-suffix type-suffix) ((integerp x) constants::*xml-integer*) ((floatp x) constants::*xml-decimal*) - ((numberp x) constants::*xml-double*) + ((typep x 'double-float) constants::*xml-double*) ((stringp x) constants::*xml-string*) (t (type-of x))))) Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Wed Apr 6 11:02:36 2011 @@ -426,20 +426,17 @@ (cast-variable-values construct filter-variable-values)) (dolist (filter (filters construct)) (dolist (var-elem filter-variable-values) - - ;(format t "~a~%==>~a~%~%" (to-lisp-code var-elem filter) - ;(eval (read-from-string (to-lisp-code var-elem filter)))) ;TODO: remove + + ;(format t "~%~%>>~a<<~%~%" (to-lisp-code var-elem filter)); TODO: remove (when (eval (read-from-string (to-lisp-code var-elem filter))) (map 'list #'(lambda(list-elem) (push list-elem true-values)) var-elem)))) - ;(format t "tv: -->~a<--~%" true-values) ;TODO: remove (let ((values-to-remove (return-false-values filter-variable-values (remove-duplicates true-values :test #'variable-list=)))) - ;(format t "vr: -->~a<--~%" values-to-remove) ;TODO: remove (dolist (to-del values-to-remove) (delete-rows-by-value construct (getf to-del :variable-name) (getf to-del :variable-value)))))) Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Wed Apr 6 11:02:36 2011 @@ -106,8 +106,10 @@ (original-filter-string (subseq query-string 0 (- (length query-string) (length next-query)))) + (filter-string-casted-constants + (cast-literal-constants construct filter-string)) (filter-string-unary-ops - (set-unary-operators construct filter-string)) + (set-unary-operators construct filter-string-casted-constants)) (filter-string-or-and-ops (set-or-and-operators construct filter-string-unary-ops original-filter-string)) @@ -119,10 +121,57 @@ (set-functions construct filter-string-compare-ops))) (add-filter construct (scan-filter-for-deprecated-calls - construct filter-string-functions original-filter-string)) + construct filter-string-functions filter-string)) (parse-group construct next-query)))) +(defgeneric cast-literal-constants (construct filter-string) + (:documentation "Casts all constants of the form 'string-value'^^datatype to an + object of the specified type. If the specified type is not + supported the return value is the string-value without a + type specifier.") + (:method ((construct SPARQL-Query) (filter-string String)) + (let ((first-pos (search-first (list "'" "\"") filter-string))) + (if (not first-pos) + filter-string + (let* ((delimiters + (append (white-space) *supported-brackets* (list "}"))) + (result (get-literal (subseq filter-string first-pos))) + (literal-value (getf result :literal)) + (next-string (getf result :next-string)) + (lang + (when (string-starts-with next-string "@") + (let ((end-pos (search-first delimiters next-string))) + (when end-pos + (subseq next-string 0 end-pos))))) + (type + (when (string-starts-with next-string "^^") + (let ((end-pos + (let ((pos (search-first delimiters next-string))) + (if pos + pos + (length next-string))))) + (when end-pos + (subseq next-string 2 end-pos))))) + (modified-literal-value + (if type + (if (> (length literal-value) 0) + (string-trim (list (elt literal-value 0)) literal-value) + literal-value) + literal-value))) + (concat (subseq filter-string 0 first-pos) + (if type + (write-to-string + (cast-literal modified-literal-value type + :back-as-string-when-unsupported t)) + modified-literal-value) + (cast-literal-constants + construct + (subseq next-string (cond (lang (length lang)) + (type (+ 2 (length type))) + (t 0)))))))))) + + (defgeneric scan-filter-for-deprecated-calls (construct filter-string original-filter) (:documentation "Returns the passed filter-string where all functions @@ -695,7 +744,7 @@ (declare (String filter-string) (Integer idx)) (let* ((string-after (subseq filter-string (1+ idx))) - (cleaned-str (cut-comment string-after))) + (cleaned-str (trim-whitespace-left string-after))) (cond ((string-starts-with cleaned-str "(") (let ((result (bracket-scope cleaned-str))) (list :next-query (string-after cleaned-str result) @@ -741,14 +790,14 @@ that is the scope of the function, i.e. the function name and all its variable including the closing )." (declare (String str)) - (let* ((cleaned-str (cut-comment str)) + (let* ((cleaned-str (trim-whitespace-left str)) (after-fun (remove-null (map 'list #'(lambda(fun) (when (string-starts-with cleaned-str fun) (string-after str fun))) *supported-functions*))) (fun-suffix (when after-fun - (cut-comment (first after-fun))))) + (trim-whitespace-left (first after-fun))))) (when fun-suffix (let* ((args (bracket-scope fun-suffix)) (fun-name (string-until cleaned-str args))) @@ -864,11 +913,6 @@ (setf idx (- (1- (length query-string)) (length (getf result :next-string)))) (push-string (getf result :literal) filter-string))) - ((string= "#" current-char) - (let ((comment-string - (string-until (subseq query-string idx) - (string #\newline)))) - (setf idx (+ idx (length comment-string))))) ((and (string= current-char (string #\newline)) (= 0 open-brackets)) (setf result Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Wed Apr 6 11:02:36 2011 @@ -280,7 +280,7 @@ "Returns the end of the literal corresponding to the passed delimiter string. The query-string must start after the opening literal delimiter. The return value is an int that represents the start index of closing - delimiter. delimiter must be either \", ', or '''. + delimiter. delimiter must be either \", ', \"\"\", or '''. If the returns value is nil, there is no closing delimiter." (declare (String query-string delimiter) (Integer overall-pos)) @@ -297,7 +297,7 @@ (defun get-literal-quotation (str) "Returns ', ''', \" or \"\"\" when the string starts with a literal delimiter." (cond ((string-starts-with str "'''") - "'") + "'''") ((string-starts-with str "\"\"\"") "\"\"\"") ((string-starts-with str "'") Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Wed Apr 6 11:02:36 2011 @@ -1546,9 +1546,9 @@ (with-revision 0 (let* ((query-1 "BASE <http://some.where/psis/poem/> - SELECT $subject ?predicate WHERE{ - ?subject $predicate <zauberlehrling> . - FILTER (STR(?predicate) = 'http://some.where/base-psis/written')}") + SELECT $subject ?predicate WHERE{ + ?subject $predicate <zauberlehrling> . + 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) && @@ -2364,8 +2364,8 @@ (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'^^" *xml-integer* " + #FILTER ?obj1 = 'von Goethe' || ?obj1 = 82 + FILTER ?obj1 = 'von Goethe'^^" *xml-string* " || ?obj1 = '82'^^" *xml-integer* " #FILTER (?obj1 = 'von Goethe' || 82 = ?obj1) #FILTER (?obj1 = 'von Goethe') || (82 = ?obj1) #FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))" @@ -2373,17 +2373,6 @@ }")) (r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))) - - ;(map 'list #'(lambda(triple) - ;(format t "~a - ~a - ~a[~a]~%" - ;(tm-sparql::subject-result triple) - ;(tm-sparql::predicate-result triple) - ;(tm-sparql::object-result triple) - ;(tm-sparql::object-datatype 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 @@ -2395,7 +2384,6 @@ (format t "~a~%" r-1)))) -;TODO: cast literal-values when called in filters ;TODO: test complex filters (defun run-sparql-tests ()