Author: lgiessmann Date: Sun Dec 19 16:00:02 2010 New Revision: 376
Log: TM-SPARQL: implemented all wrapper functions for filters in a separate package
Added: trunk/src/TM-SPARQL/filter_wrappers.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_filter.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/base-tools/base-tools.lisp trunk/src/isidorus.asd
Added: trunk/src/TM-SPARQL/filter_wrappers.lisp ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/filter_wrappers.lisp Sun Dec 19 16:00:02 2010 @@ -0,0 +1,146 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff +;;+ +;;+ Isidorus is freely distributable under the LLGPL license. +;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and +;;+ trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- + + +(defpackage :filter-functions + (:use :base-tools :constants :tm-sparql)) + + +(defun filter-functions::not(x) + (not x)) + + +(defun filter-functions::one+(x) + (1+ x)) + + +(defun filter-functions::one-(x) + (1- x)) + + +(defun filter-functions::+(x y) + (+ x y)) + + +(defun filter-functions::-(x y) + (- x y)) + + +(defun filter-functions::*(x y) + (* x y)) + + +(defun filter-functions::/(x y) + (/ x y)) + + +(defun filter-functions::or(x y) + (or x y)) + + +(defun filter-functions::and(x y) + (and x 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)))) + + +(defun filter-functions::!=(x y) + (filter-functions::not + (filter-functions::= x y))) + + +(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))) + + +(defun filter-functions::>(x y) + (filter-functions::not + (filter-functions::< x y))) + + +(defun filter-functions::<=(x y) + (filter-functions::or + (filter-functions::< x y) + (filter-functions::= x y))) + + +(defun filter-functions::>=(x y) + (filter-functions::or + (filter-functions::> x y) + (filter-functions::= x y))) + + +(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)) + (local-pattern + (if (find #\x flags) + (base-tools:string-replace + (base-tools:string-replace + (base-tools:string-replace + (base-tools:string-replace pattern (string #\newline) "") + (string #\tab) "") (string #\cr) "") " " "") + pattern)) + (scanner + (ppcre:create-scanner local-pattern + :case-insensitive-mode case-insensitive + :multi-line-mode multi-line + :single-line-mode single-line))) + (ppcre:scan scanner str))) + + +(defun filter-functions::bound(x) + (boundp x)) + + +(defun filter-functions::isLITERAL(x) + (or (numberp x) + (not (and (base-tools:string-starts-with x "<") + (base-tools:string-ends-with x ">") + (base-tools:absolute-uri-p x))))) + + +(defun filter-functions::datatype(x) + (let ((type-suffix + (when (and (stringp x) + (or (base-tools:string-starts-with x "'") + (base-tools:string-starts-with x """))) + (let* ((result (base-tools:get-literal x)) + (literal-datatype + (when (base-tools:string-starts-with + (getf result :next-string) "^^") + (subseq (getf result :next-string) 2)))) + literal-datatype)))) + (cond (type-suffix type-suffix) + ((integerp x) constants::*xml-integer*) + ((floatp x) constants::*xml-decimal*) + ((numberp x) constants::*xml-double*) + ((stringp x) constants::*xml-string*) + (t (type-of x))))) + + +(defun filter-functions::str(x) + ;TODO: implement + ) \ 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 Sun Dec 19 16:00:02 2010 @@ -132,8 +132,8 @@ ;purposes and mustn't be reset :type List :initform nil - :documentation "A list of the form that contains the variable - names as string.") + :documentation "A list of that contains the variable + names as strings.") (prefixes :initarg :prefixes :accessor prefixes ;this value is only for internal purposes ;purposes and mustn't be reset @@ -154,15 +154,31 @@ :type List :initform nil :documentation "Contains a SPARQL-Group that represents - the entire inner select-where statement.")) + the entire inner select-where statement.") + (filters :initarg filters + :accessor filters ;this value is only for internal purposes + ;purposes and mustn't be reset + :type List ;a list of strings + :initform nil + :documentation "Contains strings, each string represents a filter + that was transformed to lisp code and can be evoked + on each triple in the list select-group.")) (:documentation "This class represents the entire request."))
(defgeneric *-p (construct) (:documentation "Returns t if the user selected all variables with *.") (:method ((construct SPARQL-Query)) - (and (= (length (variables construct)) 1) - (string= (first (variables construct)) "*")))) + (loop for var in (variables construct) + when (string= var "*") + return t))) + + +(defgeneric add-filter (construct filter) + (:documentation "Pushes the filter string to the corresponding list in + the construct.") + (:method ((construct SPARQL-Query) (filter String)) + (push filter (filters construct))))
(defmethod variables ((construct SPARQL-Triple)) @@ -236,6 +252,38 @@ (push variable-name (variables construct)))))
+(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)) + (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 + (if (or subj-var pred-var obj-var) + (concatenate 'string "(let (" subj-var pred-var obj-var ")") + "(let ()")) + (expression (concatenate 'string var-let filter-string ")"))) + + )) + ;TODO: implement + ;; *implement a method "invoke-filter(SPARQL-Triple filter-string)" so + ;; that the variables are automatically contained in a let afterwards + ;; the eval function can be called this method should also have a let + ;; with (true t) and (false nil) + )) + + (defgeneric set-results (construct &key revision) (:documentation "Calculates the result of a triple and set all the values in the passed object.") @@ -766,18 +814,16 @@ (defgeneric result (construct) (:documentation "Returns the result of the entire query.") (:method ((construct SPARQL-Query)) - (let ((result-lists (make-result-lists construct))) - (reduce-results construct result-lists) - (let* ((response-variables - (reverse (if (*-p construct) - (all-variables construct) - (variables construct)))) - (cleaned-results (make-result-lists construct))) - (map 'list #'(lambda(response-variable) - (list :variable response-variable - :result (variable-intersection response-variable - cleaned-results))) - response-variables))))) + (let* ((response-variables + (reverse (if (*-p construct) + (all-variables construct) + (variables construct)))) + (cleaned-results (make-result-lists construct))) + (map 'list #'(lambda(response-variable) + (list :variable response-variable + :result (variable-intersection response-variable + cleaned-results))) + response-variables))))
(defgeneric make-result-lists (construct) @@ -939,4 +985,10 @@ (parser-start construct (original-query construct)) (dolist (triple (select-group construct)) (set-results triple :revision (revision construct))) + ;; filters all entries that are not important for the result + ;; => an intersection is invoked + (reduce-results construct (make-result-lists construct)) + (dolist (triple (select-group construct)) + (dolist (filter (filters construct)) + (invoke-filter triple filter))) construct) \ No newline at end of file
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Sun Dec 19 16:00:02 2010 @@ -117,18 +117,17 @@ (set-compare-operators construct filter-string-arithmetic-ops)) (filter-string-functions (set-functions construct filter-string-compare-ops))) - (list :next-query next-query - :filter-string (scan-filter-for-deprecated-calls - construct filter-string-functions original-filter-string))))) + (add-filter construct + (scan-filter-for-deprecated-calls + construct filter-string-functions original-filter-string)) + (parse-group construct next-query)))) ;;TODO: implement ;; *implement wrapper functions, also for the operators - ;; it would be nice of the self defined operator functions would be in a + ;; it would be nice when the self defined operator functions would be in a ;; separate packet, e.g. filter-functions, so =, ... would couse no ;; collisions - ;; *create and store this filter object => store the created string and implement - ;; a method "invoke-filter(SPARQL-Triple filter-string)" so that the variables - ;; are automatically contained in a letafterwards the eval function can be called - ;; this method should also have a let with (true t) and (false nil) + ;; *add ^^datatype to the object-literal-results + ;; *implement to-literal => CharacteristicC => "..."^^datatype => use for tm-sparql
(defgeneric scan-filter-for-deprecated-calls (construct filter-string @@ -677,10 +676,8 @@ (push-string current-char result-string)))) ((or (string= current-char "'") (string= current-char """)) - (let* ((sub-str (subseq filter-string idx)) - (quotation (get-literal-quotation sub-str)) - (literal - (get-literal (subseq filter-string idx) :quotation quotation))) + (let ((literal + (get-literal (subseq filter-string idx)))) (if literal (progn (setf idx (- (1- (length filter-string)) @@ -710,7 +707,7 @@ (list :next-query (string-after cleaned-str result) :scope result))) ((string-starts-with cleaned-str """) - (let ((result (get-literal cleaned-str))) + (let ((result (get-literal cleaned-str :quotation """))) (list :next-query (getf result :next-string) :scope (getf result :literal)))) ((string-starts-with-digit cleaned-str) @@ -807,10 +804,7 @@ (let ((current-char (subseq str idx (1+ idx)))) (cond ((or (string= "'" current-char) (string= """ current-char)) - (let* ((sub-str (subseq str idx)) - (quotation (get-literal-quotation sub-str)) - (literal - (get-literal (subseq str idx) :quotation quotation))) + (let ((literal (get-literal (subseq str idx)))) (if literal (progn (setf idx (- (1- (length str)) @@ -861,7 +855,8 @@ (push-string current-char filter-string)) ((or (string= "'" current-char) (string= """ current-char)) - (let ((result (get-literal (subseq query-string idx)))) + (let ((result + (get-literal (subseq query-string idx) :quotation """))) (unless result (error (make-sparql-parser-condition (subseq query-string idx)
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sun Dec 19 16:00:02 2010 @@ -95,7 +95,9 @@ (error (make-sparql-parser-condition trimmed-str (original-query construct) "{"))) (let ((query-tail (parse-group construct (subseq trimmed-str 1)))) - ;TODO: process query-tail + (when (> (length (trim-whitespace query-tail)) 0) + (make-sparql-parser-condition + query-tail (original-query construct) "end of query, solution sequences and modifiers are not supported")) query-tail))))
@@ -125,7 +127,6 @@ trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "}") ;ending of this group - ;TODO: invoke filters with all results on construct in initialize :after (subseq trimmed-str 1)) (t (parse-triple construct trimmed-str :last-subject last-subject)))))) @@ -249,9 +250,7 @@ literal-value literal-type)))) value)) (t ; return the value as a string - (if (stringp literal-value) - literal-value - (write-to-string literal-value))))) + literal-value)))
(defgeneric separate-literal-lang-or-type (construct query-string)
Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Sun Dec 19 16:00:02 2010 @@ -294,49 +294,37 @@ """)))
-(defun get-literal (query-string &key (quotation """)) +(defun get-literal (query-string &key (quotation nil)) "Returns a list of the form (:next-string <string> :literal <string> where next-query is the query after the found literal and literal is the literal string." (declare (String query-string) - (String quotation)) - (cond ((or (string-starts-with query-string """"") - (string-starts-with query-string "'''")) - (let ((literal-end - (find-literal-end (subseq query-string 3) (subseq query-string 0 3)))) - (when literal-end - (list :next-string (subseq query-string (+ 3 literal-end)) - :literal (concatenate 'string quotation - (subseq query-string 3 literal-end) - quotation))))) - ((or (string-starts-with query-string """) - (string-starts-with query-string "'")) - (let ((literal-end - (find-literal-end (subseq query-string 1) - (subseq query-string 0 1)))) - (when literal-end - (let ((literal - (escape-string (subseq query-string 1 literal-end) """))) - (list :next-string (subseq query-string (+ 1 literal-end)) - :literal (concatenate 'string quotation literal - quotation)))))))) - - -;(defun search-first-ignore-literals (search-strings main-string) -; (declare (String main-string) -; (List search-strings)) -; (let ((first-pos (search-first search-strings main-string))) -; (when first-pos -; (if (not (in-literal-string-p main-string first-pos)) -; first-pos -; (let* ((literal-start (search-first (list """ "'") main-string)) -; (sub-str (subseq main-string literal-start)) -; (literal-result (get-literal sub-str)) -; (next-str (getf literal-result :next-string))) -; (let ((next-pos -; (search-first-ignore-literals search-strings next-str))) -; (when next-pos -; (+ (- (length main-string) (length next-str)) next-pos)))))))) + (type (or Null String) quotation)) + (let ((local-quotation quotation)) + (cond ((or (string-starts-with query-string """"") + (string-starts-with query-string "'''")) + (unless local-quotation + (setf local-quotation (subseq query-string 0 3))) + (let ((literal-end + (find-literal-end (subseq query-string 3) (subseq query-string 0 3)))) + (when literal-end + (list :next-string (subseq query-string (+ 3 literal-end)) + :literal (concatenate 'string quotation + (subseq query-string 3 literal-end) + quotation))))) + ((or (string-starts-with query-string """) + (string-starts-with query-string "'")) + (unless local-quotation + (setf local-quotation (subseq query-string 0 1))) + (let ((literal-end + (find-literal-end (subseq query-string 1) + (subseq query-string 0 1)))) + (when literal-end + (let ((literal + (escape-string (subseq query-string 1 literal-end) """))) + (list :next-string (subseq query-string (+ 1 literal-end)) + :literal (concatenate 'string local-quotation literal + local-quotation)))))))))
(defun search-first-ignore-literals (search-strings main-string &key from-end)
Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Sun Dec 19 16:00:02 2010 @@ -1,4 +1,3 @@ -;;-*- mode: lisp -*- ;;+----------------------------------------------------------------------------- ;;+ Isidorus ;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff @@ -42,8 +41,9 @@ :depends-on ("constants" "base-tools")) (:module "TM-SPARQL" :components ((:file "sparql") + (:file "filter_wrappers") (:file "sparql_filter" - :depends-on ("sparql")) + :depends-on ("sparql" "filter_wrappers")) (:file "sparql_parser" :depends-on ("sparql" "sparql_filter"))) :depends-on ("constants" "base-tools" "model"))