Author: lgiessmann Date: Thu Dec 16 16:07:40 2010 New Revision: 367 Log: TM-SPARQL: adde the hanlding of || and && operators; added also some unit-tests for these cases Modified: 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/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Thu Dec 16 16:07:40 2010 @@ -15,10 +15,19 @@ "Contains all supported SPARQL-functions") -(defparameter *supported-operators* - (list "!" "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/") - "Contains all supported operators, note some unary operators - are handled as functions, e.g. + and -") +(defparameter *supported-binary-operators* + (list "||" "&&" "=" "!=" "<" "<=" ">" ">=" "+" "-" "*" "/") + "Contains all supported binary operators.") + + +(defparameter *supported-unary-operators* + (list "!" "+" "-") "Contains all supported unary operators") + + +(defun *supported-operators* () + (union *supported-binary-operators* *supported-unary-operators* + :test #'string=)) + (defparameter *supported-brackets* (list "(" ")") @@ -45,25 +54,115 @@ (let* ((result-set-boundings (set-boundings construct query-string)) (filter-string (getf result-set-boundings :filter-string)) (next-query (getf result-set-boundings :next-query)) - (filter-string-unary-ops (set-unary-operators construct filter-string)) + (filter-string-unary-ops + (set-unary-operators construct filter-string)) + (filter-string-or-and-ops + (set-or-and-operators construct filter-string-unary-ops)) )))) ;;TODO: implement - ;; *replace #comment => in set boundings ;; **replace () by (progn ) - ;; **replace ', """, ''' by ''' + ;; **replace ', """, ''' by " ;; **replace !x by (not x) ;; **replace +x by (1+ x) ;; **replace -x by (1- x) - ;; *replace x operator y by (filter-operator x y) - ;; *=, !=, <, >, <=, >=, +, -, *, /, ||, && + ;; **||, && + ;; *=, !=, <, >, <=, >=, +, -, *, / ;; *replace function(x), function(x, y), function(x, y, z) ;; by filter-function(x), (filter-function(x, y), filter-function(x, y, z) - ;; check if all functions that will be invoked are allowed - ;; add a let with all variables that are used: every variable with $ and ? prefix - ;; add a let with (true t) and (false nil) + ;; *check if all functions that will be invoked are allowed + ;; *add a let with all variables that are used: every variable with $ and ? prefix + ;; *add a let with (true t) and (false nil) + ;; *embrace the final result uris in <> => unit-tests ;; *create and store this filter object +(defgeneric set-or-and-operators (construct filter-string) + (:documentation "Transforms the || and && operators in the filter string to + the the lisp or and and functions.") + (:method ((construct SPARQL-Query) (filter-string String)) + (let ((op-pos (search-first (list "||" "&&") filter-string))) + (if (not op-pos) + filter-string + (let* ((op-str (subseq filter-string op-pos (+ 2 op-pos))) + (left-str (subseq filter-string 0 op-pos)) + (right-str (subseq filter-string (+ 2 op-pos))) + (left-scope (find-or-and-left-scope left-str)) + (right-scope (find-or-and-right-scope right-str)) + (modified-str + (concatenate 'string (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" (if (string= op-str "||") "or" "and") " " + "(progn " left-scope ")" "(progn " right-scope ")) " + (subseq right-str (length right-scope))))) + (set-or-and-operators construct modified-str)))))) + + +(defun find-binary-op-string (filter-string idx) + "Returns the operator as string that is placed on the position idx." + (let* ((2-ops + (remove-null (map 'list #'(lambda(op-string) + (when (= (length op-string) 2) + op-string)) + *supported-binary-operators*))) + (operator-str (subseq filter-string idx))) + (if (string-starts-with-one-of operator-str 2-ops) + (subseq operator-str 0 2) + (subseq operator-str 0 1)))) + + +(defun find-or-and-left-scope (left-string) + "Returns the string that is the left part of the binary scope." + (declare (String left-string)) + (let* ((first-bracket + (let ((inner-value (search-first-unclosed-paranthesis left-string))) + (when inner-value + (+ inner-value (1+ (length (name-after-paranthesis + (subseq left-string inner-value)))))))) + (start-idx (if first-bracket + first-bracket + 0))) + (subseq left-string start-idx))) + + +(defun name-after-paranthesis (str) + "Returns the substring that is contained after the paranthesis. + str must start with a ( otherwise the returnvalue is nil." + (declare (String str)) + (let ((result "") + (non-whitespace-found nil)) + (when (string-starts-with str "(") + (let ((cleaned-str (subseq str 1))) + (dotimes (idx (length cleaned-str)) + (let ((current-char (subseq cleaned-str idx (1+ idx)))) + (cond ((string-starts-with-one-of current-char (list "(" ")")) + (setf idx (length cleaned-str))) + ((and non-whitespace-found + (white-space-p current-char)) + (setf idx (length cleaned-str))) + ((white-space-p current-char) + (push-string current-char result)) + (t + (push-string current-char result) + (setf non-whitespace-found t))))) + result)))) + + +(defun find-or-and-right-scope (right-string) + "Returns the string that is the right part of the binary scope." + (declare (String right-string)) + (let* ((first-pos (search-first (list "||" "&&") right-string)) + (first-bracket + (let ((inner-value (search-first-unopened-paranthesis right-string))) + (when inner-value (1+ inner-value)))) + (end-idx (cond ((and first-pos first-bracket) + (min first-pos first-bracket)) + (first-pos first-pos) + (first-bracket first-bracket) + (t (if (= (length right-string) 0) + (1- (length right-string))))))) + (subseq right-string 0 end-idx))) + + (defgeneric set-unary-operators (construct filter-string) (:documentation "Transforms the unary operators !, +, - to (not ), (1+ ) and (1- ). The return value is a modified filter @@ -90,7 +189,7 @@ (if (or (string= string-before "") (string-ends-with string-before "(progn") (string-ends-with-one-of string-before - *supported-operators*)) + (*supported-operators*))) (let ((result (unary-operator-scope filter-string idx))) (push-string (concatenate 'string "(1" current-char " ") result-string) @@ -179,7 +278,7 @@ (declare (String str)) (when (or (string-starts-with str "?") (string-starts-with str "$")) - (let ((found-end (search-first (append (white-space) *supported-operators* + (let ((found-end (search-first (append (white-space) (*supported-operators*) *supported-brackets* (list "?" "$")) (subseq str 1)))) (if found-end @@ -301,7 +400,7 @@ (Integer idx)) (let* ((delimiters (append (list " " (string #\Space) (string #\Tab) (string #\Newline) (string #\cr) "(" ")") - *supported-operators*)) + (*supported-operators*))) (string-before (trim-whitespace-right (subseq query-string 0 idx))) (fragment-before-idx (search-first delimiters string-before :from-end t)) @@ -323,7 +422,7 @@ (> (length fragment-before) (length operator))) (setf fragment-before (string-after fragment-before operator)))) - (append *supported-operators* *supported-brackets*))) + (append (*supported-operators*) *supported-brackets*))) (if fragment-before (progn (when (or (string-starts-with fragment-before "?") Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Thu Dec 16 16:07:40 2010 @@ -12,6 +12,7 @@ (:nicknames :tools) (:export :push-string :when-do + :string-replace :remove-null :full-path :trim-whitespace-left @@ -21,6 +22,7 @@ :string-ends-with :string-ends-with-one-of :string-starts-with-char + :string-starts-with-one-of :string-until :string-after :search-first @@ -30,7 +32,10 @@ :string-after-number :separate-leading-digits :white-space - :escape-string)) + :white-space-p + :escape-string + :search-first-unclosed-paranthesis + :search-first-unopened-paranthesis )) (in-package :base-tools) @@ -63,6 +68,17 @@ nil))) +(defun white-space-p (str) + "Returns t if the passed str contains only white space characters." + (cond ((and (= (length str) 1) + (string-starts-with-one-of str (white-space))) + t) + ((string-starts-with-one-of str (white-space)) + (white-space-p (subseq str 1))) + (t + nil))) + + (defun remove-null (lst) "Removes all null values from the passed list." (remove-if #'null lst)) @@ -118,6 +134,16 @@ (length str-i))))) +(defun string-starts-with-one-of (str prefixes &key (ignore-case nil)) + "Returns t if str ends with one of the string contained in suffixes." + (declare (String str) + (List prefixes) + (Boolean ignore-case)) + (loop for prefix in prefixes + when (string-starts-with str prefix :ignore-case ignore-case) + return t)) + + (defun string-ends-with (str suffix &key (ignore-case nil)) "Checks if string str ends with a given suffix." (declare (String str suffix) @@ -146,6 +172,23 @@ return t)) +(defun string-replace (main-string string-to-replace new-string) + "Replaces every occurrence of string-to-replace by new-string + in main-string." + (declare (String main-string string-to-replace new-string)) + (if (string= string-to-replace new-string) + main-string + (let ((search-idx (search-first (list string-to-replace) main-string))) + (if (not search-idx) + main-string + (let ((modified-string + (concatenate 'string (subseq main-string 0 search-idx) + new-string (subseq main-string + (+ search-idx (length string-to-replace)))))) + (string-replace modified-string string-to-replace new-string)))))) + + + (defun string-starts-with-digit (str) "Checks whether the passed string starts with a digit." (declare (String str)) @@ -153,6 +196,7 @@ when (string-starts-with str (write-to-string item)) return t)) + (defun string-after-number (str) "If str starts with a digit, there is returned the first substring after a character that is a non-digit. @@ -278,4 +322,41 @@ (push-string current-char result)) (t (push-string current-char result))))) - result)) \ No newline at end of file + result)) + + +(defun search-first-unclosed-paranthesis (str) + "Returns the idx of the first ( that is not closed, the search is + started from the end of the string." + (declare (String str)) + (let ((r-str (reverse str)) + (open-brackets 0) + (result-idx nil)) + (dotimes (idx (length r-str)) + (let ((current-char (subseq r-str idx (1+ idx)))) + (cond ((string= current-char ")") + (decf open-brackets)) + ((string= current-char "(") + (incf open-brackets) + (when (> open-brackets 0) + (setf result-idx idx) + (setf idx (length r-str))))))) + (when result-idx + (- (length str) (1+ result-idx))))) + + +(defun search-first-unopened-paranthesis (str) + "Returns the idx of the first paranthesis that is not opened in str." + (declare (String str)) + (let ((closed-brackets 0) + (result-idx nil)) + (dotimes (idx (length str)) + (let ((current-char (subseq str idx (1+ idx)))) + (cond ((string= current-char "(") + (decf closed-brackets)) + ((string= current-char ")") + (incf closed-brackets) + (when (> closed-brackets 0) + (setf result-idx idx) + (setf idx (length str))))))) + result-idx)) \ No newline at end of file Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Thu Dec 16 16:07:40 2010 @@ -9,6 +9,7 @@ (defpackage :sparql-test (:use :cl + :base-tools :it.bese.FiveAM :TM-SPARQL :exceptions @@ -31,7 +32,8 @@ :test-set-result-5 :test-result :test-set-boundings - :test-set-unary-operators)) + :test-set-unary-operators + :test-set-or-and-operators)) (in-package :sparql-test) @@ -1112,6 +1114,26 @@ (is (string= result-4-1 "(not \"a\\\"b\\\"c\") && (progn (1+ 12) = (1- 14))")))) +(test test-set-or-and-operators + "Tests various cases of the function set-unary-operators." + (let* ((dummy-object (make-instance 'TM-SPARQL::SPARQL-Query :query " ")) + (str-1 "isLITERAL(STR(?var))||?var = 12 && true}") + (str-2 "(true != false || !false ) && 12 < 14 || !isLITERAL(?var)}") + (result-1 + (getf (tm-sparql::set-boundings dummy-object str-1) :filter-string)) + (result-1-1 (tm-sparql::set-or-and-operators dummy-object result-1)) + (result-2 + (getf (tm-sparql::set-boundings dummy-object str-2) :filter-string)) + (result-2-1 (tm-sparql::set-or-and-operators dummy-object result-2))) + (is-true result-1) + (is-true result-1-1) + (is-true result-2) + (is-true result-2-1) + (is (string= (string-replace result-1-1 " " "") + "(and(progn(or(prognisLITERAL(STR(?var)))(progn?var=12)))(progntrue))")) + (is (string= (string-replace result-2-1 " " "") + "(or(progn(and(progn(progn(or(progntrue!=false)(progn!false))))(progn12<14)))(progn!isLITERAL(?var)))")))) + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))