Author: lgiessmann Date: Mon Dec 20 15:47:48 2010 New Revision: 381
Log: TM-SPARQL: fixed the type-handling in FILTERs when there is given something like 'xyz'^^anyType
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 trunk/src/isidorus.asd
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 15:47:48 2010 @@ -13,49 +13,84 @@ (:import-from :cl progn handler-case let))
+(defun filter-functions::normalize-value (value) + "Returns the normalized value, i.e. if a literal + is passed as '12'^^xsd:integer 12 is returned." + (cond ((not (stringp value)) + value) + ((or (base-tools:string-starts-with value "'") + (base-tools:string-starts-with value """)) + (let* ((literal-result (tm-sparql::get-literal value)) + (literal-value + (cond ((or (base-tools:string-starts-with + (getf literal-result :literal) """"") + (base-tools:string-starts-with + (getf literal-result :literal) "'''")) + (subseq (getf literal-result :literal) 3 + (- (length (getf literal-result :literal)) 3))) + (t + (subseq (getf literal-result :literal) 1 + (- (length (getf literal-result :literal)) 1))))) + (given-datatype + (when (base-tools:string-starts-with + (getf literal-result :next-string) "^^") + (subseq (getf literal-result :next-string) 2)))) + (tm-sparql::cast-literal literal-value given-datatype))) + (t + value))) + + (defun filter-functions::not(x) - (not x)) + (not (filter-functions::normalize-value x)))
(defun filter-functions::one+(x) - (1+ x)) + (1+ (filter-functions::normalize-value x)))
(defun filter-functions::one-(x) - (1- x)) + (1- (filter-functions::normalize-value x)))
(defun filter-functions::+(x y) - (+ x y)) + (+ (filter-functions::normalize-value x) + (filter-functions::normalize-value y)))
(defun filter-functions::-(x y) - (- x y)) + (- (filter-functions::normalize-value x) + (filter-functions::normalize-value y)))
(defun filter-functions::*(x y) - (* x y)) + (* (filter-functions::normalize-value x) + (filter-functions::normalize-value y)))
(defun filter-functions::/(x y) - (/ x y)) + (/ (filter-functions::normalize-value x) + (filter-functions::normalize-value y)))
(defun filter-functions::or(x y) - (or x y)) + (or (filter-functions::normalize-value x) + (filter-functions::normalize-value y)))
(defun filter-functions::and(x y) - (and x y)) + (and (filter-functions::normalize-value x) + (filter-functions::normalize-value y)))
(defun filter-functions::=(x y) - (cond ((and (stringp x) (stringp y)) - (string= x y)) - ((and (numberp x)( numberp y)) - (= x y)) - (t - (eql x y)))) + (let ((local-x (filter-functions::normalize-value x)) + (local-y (filter-functions::normalize-value y))) + (cond ((and (stringp local-x) (stringp local-y)) + (string= local-x local-y)) + ((and (numberp local-x)( numberp local-y)) + (= local-x local-y)) + (t + (eql local-x local-y)))))
(defun filter-functions::!=(x y) @@ -64,14 +99,16 @@
(defun filter-functions::<(x y) - (cond ((and (numberp x) (numberp y)) - (< x y)) - ((and (stringp x) (stringp y)) - (string< x y)) - ((and (typep x 'Boolean) (typep y 'Boolean)) - (and (not x) y)) - (t - nil))) + (let ((local-x (filter-functions::normalize-value x)) + (local-y (filter-functions::normalize-value y))) + (cond ((and (numberp local-x) (numberp local-y)) + (< local-x local-y)) + ((and (stringp local-x) (stringp local-y)) + (string< local-x local-y)) + ((and (typep local-x 'Boolean) (typep local-y 'Boolean)) + (and (not local-x) local-y)) + (t + nil))))
(defun filter-functions::>(x y) @@ -92,18 +129,20 @@
(defun filter-functions::regex(str pattern &optional flags) - (declare (Ignorable flags)) - (let* ((case-insensitive (when (find #\i flags) t)) - (multi-line (when (find #\m flags) t)) - (single-line (when (find #\s flags) t)) + (let* ((local-flags (filter-functions::normalize-value flags)) + (case-insensitive (when (find #\i local-flags) t)) + (multi-line (when (find #\m local-flags) t)) + (single-line (when (find #\s local-flags) t)) (local-pattern - (if (find #\x flags) + (if (find #\x local-flags) (base-tools:string-replace (base-tools:string-replace (base-tools:string-replace - (base-tools:string-replace pattern (string #\newline) "") + (base-tools:string-replace + (filter-functions::normalize-value pattern) + (string #\newline) "") (string #\tab) "") (string #\cr) "") " " "") - pattern)) + (filter-functions::normalize-value pattern))) (scanner (ppcre:create-scanner local-pattern :case-insensitive-mode case-insensitive
Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Mon Dec 20 15:47:48 2010 @@ -1010,6 +1010,42 @@ values)))
+(defun cast-literal (literal-value literal-type) + "A helper function that casts the passed string value of the literal + corresponding to the passed literal-type." + (declare (String literal-value literal-type)) + (cond ((string= literal-type *xml-string*) + literal-value) + ((string= literal-type *xml-boolean*) + (when (and (string/= literal-value "false") + (string/= literal-value "true")) + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value literal-type)))) + (if (string= literal-value "false") + nil + t)) + ((string= literal-type *xml-integer*) + (handler-case (parse-integer literal-value) + (condition () + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value literal-type)))))) + ((or (string= literal-type *xml-decimal*) ;;both types are + (string= literal-type *xml-double*)) ;;handled the same way + (let ((value (read-from-string literal-value))) + (unless (numberp value) + (error (make-condition + 'sparql-parser-error + :message (format nil "Could not cast from ~a to ~a" + literal-value literal-type)))) + value)) + (t ; return the value as a string + literal-value))) + + (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) (parser-start construct (original-query construct))
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 15:47:48 2010 @@ -121,10 +121,6 @@ (scan-filter-for-deprecated-calls construct filter-string-functions original-filter-string)) (parse-group construct next-query)))) - ;;TODO: implement - ;; *add ^^datatype to the object-literal-results - ;; *implement to-literal => CharacteristicC => "..."^^datatype => use for tm-sparql - ;; *implement str correctly
(defgeneric scan-filter-for-deprecated-calls (construct 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 15:47:48 2010 @@ -217,42 +217,6 @@ :value (cast-literal l-value l-type)))))
-(defun cast-literal (literal-value literal-type) - "A helper function that casts the passed string value of the literal - corresponding to the passed literal-type." - (declare (String literal-value literal-type)) - (cond ((string= literal-type *xml-string*) - literal-value) - ((string= literal-type *xml-boolean*) - (when (and (string/= literal-value "false") - (string/= literal-value "true")) - (error (make-condition - 'sparql-parser-error - :message (format nil "Could not cast from ~a to ~a" - literal-value literal-type)))) - (if (string= literal-value "false") - nil - t)) - ((string= literal-type *xml-integer*) - (handler-case (parse-integer literal-value) - (condition () - (error (make-condition - 'sparql-parser-error - :message (format nil "Could not cast from ~a to ~a" - literal-value literal-type)))))) - ((or (string= literal-type *xml-decimal*) ;;both types are - (string= literal-type *xml-double*)) ;;handled the same way - (let ((value (read-from-string literal-value))) - (unless (numberp value) - (error (make-condition - 'sparql-parser-error - :message (format nil "Could not cast from ~a to ~a" - literal-value literal-type)))) - value)) - (t ; return the value as a string - literal-value))) - - (defgeneric separate-literal-lang-or-type (construct query-string) (:documentation "A helper function that returns (:next-query string :lang string :type string). Only one of :lang and
Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Mon Dec 20 15:47:48 2010 @@ -41,7 +41,8 @@ :depends-on ("constants" "base-tools")) (:module "TM-SPARQL" :components ((:file "sparql") - (:file "filter_wrappers") + (:file "filter_wrappers" + :depends-on ("sparql")) (:file "sparql_filter" :depends-on ("sparql" "filter_wrappers")) (:file "sparql_parser"