Author: lgiessmann Date: Sun Dec 19 10:18:30 2010 New Revision: 375
Log: TM-SPARQL: added the scanning of function in sparql-filters that are not allowed, so not authorized calls, e.g. of drop-instance or another lisp functions are detected and therefore not evaluated; changed the form of the return values of sparql-triples, now an uri is embraced in <> => adapt the corresponding unit-tests.
Modified: 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/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Sun Dec 19 10:18:30 2010 @@ -256,6 +256,14 @@ results)))))
+(defun embrace-uri(uri-string) + "Returns '<'uri-string'>' if uri-string is not a string uri-string + is returned as result." + (if (typep uri-string 'String) + (concatenate 'string "<" uri-string ">") + uri-string)) + + (defgeneric filter-by-given-object (construct &key revision) (:documentation "Returns a list representing a triple that is the result of a given object.") @@ -319,8 +327,8 @@ (pred (when-do top (instance-of char :revision revision) (any-id top :revision revision)))) (when (and subj pred) - (list :subject subj - :predicate pred + (list :subject (embrace-uri subj) + :predicate (embrace-uri pred) :object (charvalue char) :literal-datatyp literal-datatype)))) ;;elephant returns names, occurences, and variants if any string @@ -355,9 +363,9 @@ (when-do plr (player orole :revision revision) (any-id plr :revision revision)))) (when (and obj-uri pred-uri subj-uri) - (list :subject subj-uri - :predicate pred-uri - :object obj-uri)))) + (list :subject (embrace-uri subj-uri) + :predicate (embrace-uri pred-uri) + :object (embrace-uri obj-uri))))) roles-by-oplayer)))))
@@ -421,9 +429,9 @@ (when-do plr (player orole :revision revision) (any-id plr :revision revision)))) (when (and subj-uri pred-uri obj-uri) - (list :subject subj-uri - :predicate pred-uri - :object obj-uri)))) + (list :subject (embrace-uri subj-uri) + :predicate (embrace-uri pred-uri) + :object (embrace-uri obj-uri))))) roles-by-player))))))
@@ -469,8 +477,8 @@ (when-do top (instance-of name :revision revision) (any-id top :revision revision)))) (when (and subj pred) - (list :subject subj - :predicate pred + (list :subject (embrace-uri subj) + :predicate (embrace-uri pred) :object (charvalue name) :literal-datatype *xml-string*)))) names-by-literal)))))) @@ -509,8 +517,8 @@ (when-do top (instance-of occ :revision revision) (any-id top :revision revision)))) (when (and subj pred) - (list :subject subj - :predicate pred + (list :subject (embrace-uri subj) + :predicate (embrace-uri pred) :object (charvalue occ) :literal-datatype (datatype occ))))) all-occs)))))) @@ -641,15 +649,17 @@ #'(lambda(occ) (filter-occ-by-value occ literal-value literal-datatype)) occs-by-type))) - (subj-uri (any-id construct :revision revision))) + (subj-uri (when-do top-uri (any-id construct :revision revision) + top-uri))) (remove-null (map 'list #'(lambda(occ) (let ((pred-uri - (when-do type-top (instance-of occ :revision revision) + (when-do type-top + (instance-of occ :revision revision) (any-id type-top :revision revision)))) (when pred-uri - (list :subject subj-uri - :predicate pred-uri + (list :subject (embrace-uri subj-uri) + :predicate (embrace-uri pred-uri) :object (charvalue occ) :literal-datatype (datatype occ))))) all-occs))))) @@ -681,8 +691,8 @@ (when-do type-top (instance-of name :revision revision) (any-id type-top :revision revision)))) (when pred-uri - (list :subject subj-uri - :predicate pred-uri + (list :subject (embrace-uri subj-uri) + :predicate (embrace-uri pred-uri) :object (charvalue name) :literal-datatype *xml-string*)))) all-names))))) @@ -747,9 +757,9 @@ :revision revision) (any-id player-top :revision revision))))) (when (and pred-uri obj-uri) - (list :subject subj-uri - :predicate pred-uri - :object obj-uri))))) + (list :subject (embrace-uri subj-uri) + :predicate (embrace-uri pred-uri) + :object (embrace-uri obj-uri)))))) assocs)))))
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 10:18:30 2010 @@ -24,7 +24,9 @@
(defparameter *supported-compare-operators* - (list "!=" "<=" ">=" "=" "<" ">") ;not the order is important! + (list "!=" "<=" ">=" "=" "<" ">") ;note the order is important! + ;the operators with length = 2 + ;must be listed first "Contains all supported binary operators.")
@@ -36,6 +38,12 @@ (list "!" "+" "-") "Contains all supported unary operators")
+(defparameter *allowed-filter-calls* + (append (list "one+" "one-" "progn" "or" "and" "not" "/=" "=" + ">" ">=" "<" "<=" "+" "-" "*" "/") + *supported-functions*)) + + (defun *2-compare-operators* () (remove-null (map 'list #'(lambda(op) @@ -88,37 +96,75 @@
(defgeneric parse-filter (construct query-string) (:documentation "A helper functions that returns a filter and the next-query - string in the form (:next-query string :filter object).") + string in the form (:next-query string + :filter-string object).") (:method ((construct SPARQL-Query) (query-string String)) ;note the order of the invacations is important! (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)) + (original-filter-string + (subseq query-string 0 (- (length query-string) + (length next-query)))) (filter-string-unary-ops (set-unary-operators construct filter-string)) (filter-string-or-and-ops (set-or-and-operators construct filter-string-unary-ops - filter-string-unary-ops)) + original-filter-string)) (filter-string-arithmetic-ops (set-arithmetic-operators construct filter-string-or-and-ops)) (filter-string-compare-ops (set-compare-operators construct filter-string-arithmetic-ops)) (filter-string-functions (set-functions construct filter-string-compare-ops))) - filter-string-functions))) + (list :next-query next-query + :filter-string (scan-filter-for-deprecated-calls + construct filter-string-functions original-filter-string))))) ;;TODO: implement - ;; *check if all functions that will be invoked are allowed ;; *implement wrapper functions, also for the operators ;; it would be nice of the self defined operator functions would be in a ;; separate packet, e.g. filter-functions, so =, ... would couse no ;; collisions - ;; *embrace the final results uris in <> => unit-tests ;; *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)
+(defgeneric scan-filter-for-deprecated-calls (construct filter-string + original-filter) + (:documentation "Returns the passed filter-string or throws a + sparql-parser-error of there is an unallowed + function call.") + (:method ((construct SPARQL-Query) (filter-string String) + (original-filter String)) + (dotimes (idx (length filter-string) filter-string) + (when-do fun-name (return-function-name (subseq filter-string idx)) + (unless (string-starts-with-one-of fun-name *supported-functions*) + (error + (make-condition + 'exceptions:sparql-parser-error + :message (format nil "Invalid filter: the filter "~a" evaluated to "~a" which contains the depricated function ~a!" + filter-string original-filter fun-name)))))))) + + + +(defun return-function-name (filter-string) + "If the string starts with ( there is returned the function name + that is placed directly after the (." + (declare (String filter-string)) + (when (string-starts-with filter-string "(") + (let ((local-str (trim-whitespace-left (subseq filter-string 1))) + (whitespaces (map 'list #'string (white-space))) + (result "")) + (dotimes (idx (length local-str) result) + (let ((current-char (subseq local-str idx (1+ idx)))) + (if (string-starts-with-one-of + current-char (append whitespaces *supported-brackets*)) + (setf idx (length local-str)) + (push-string current-char result))))))) + + (defgeneric set-functions (construct filter-string) (:documentation "Transforms all supported functions of the form function(x, y) to (function x y).") @@ -695,7 +741,7 @@
(defun function-scope (str) - "If str starts with a supported function it there is given the entire substr + "If str starts with a supported function there is given the entire substr that is the scope of the function, i.e. the function name and all its variable including the closing )." (declare (String str))
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 10:18:30 2010 @@ -510,14 +510,18 @@ result-idx))
-(defun return-if-starts-with (str to-be-matched &key from-end ignore-case) +(defun return-if-starts-with (str to-be-matched &key from-end ignore-case + ignore-leading-whitespace) "Returns the string that is contained in to-be-matched and that is the start of the string str." (declare (String str) (List to-be-matched) - (Boolean from-end ignore-case)) - (loop for try in to-be-matched - when (if from-end - (string-ends-with str try :ignore-case ignore-case) - (string-starts-with str try :ignore-case ignore-case)) - return try)) \ No newline at end of file + (Boolean from-end ignore-case ignore-leading-whitespace)) + (let ((cleaned-str (if ignore-leading-whitespace + (trim-whitespace-left str) + str))) + (loop for try in to-be-matched + when (if from-end + (string-ends-with cleaned-str try :ignore-case ignore-case) + (string-starts-with cleaned-str try :ignore-case ignore-case)) + return try))) \ 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 Sun Dec 19 10:18:30 2010 @@ -457,24 +457,24 @@ (first (tm-sparql::select-group q-obj-2))))) (obj-2 (second (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2)))))) - (cond ((or (string= subj-1 "http://some.where/psis/author/goethe") - (string= subj-1 "http://some.where/psis/persons/goethe")) - (is (string= pred-1 "http://some.where/base-psis/written")) - (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling") - (string= obj-1 "http://some.where/psis/der_zauberlehrling"))) - (is (string= subj-2 "http://some.where/base-psis/poem")) - (is (string= pred-2 "http://psi.topicmaps.org/iso13250/model/instance")) - (is (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling") - (string= obj-2 "http://some.where/psis/der_zauberlehrling")))) - ((string= subj-1 "http://some.where/base-psis/poem") - (is (string= pred-2 "http://some.where/base-psis/written")) - (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling") - (string= obj-1 "http://some.where/psis/der_zauberlehrling"))) - (is (or (string= subj-2 "http://some.where/psis/author/goethe") - (string= subj-2 "http://some.where/psis/persons/goethe"))) - (is (string= pred-1 "http://psi.topicmaps.org/iso13250/model/type")) - (is (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling") - (string= obj-2 "http://some.where/psis/der_zauberlehrling")))) + (cond ((or (string= subj-1 "http://some.where/psis/author/goethe") + (string= subj-1 "http://some.where/psis/persons/goethe")) + (is (string= pred-1 "http://some.where/base-psis/written")) + (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling") + (string= obj-1 "http://some.where/psis/der_zauberlehrling"))) + (is (string= subj-2 "http://some.where/base-psis/poem")) + (is (string= pred-2 "http://psi.topicmaps.org/iso13250/model/instance")) + (is (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling") + (string= obj-2 "http://some.where/psis/der_zauberlehrling")))) + ((string= subj-1 "http://some.where/base-psis/poem") + (is (string= pred-2 "http://some.where/base-psis/written")) + (is (or (string= obj-1 "http://some.where/psis/poem/zauberlehrling") + (string= obj-1 "http://some.where/psis/der_zauberlehrling"))) + (is (or (string= subj-2 "http://some.where/psis/author/goethe") + (string= subj-2 "http://some.where/psis/persons/goethe"))) + (is (string= pred-1 "http://psi.topicmaps.org/iso13250/model/type")) + (is (or (string= obj-2 "http://some.where/psis/poem/zauberlehrling") + (string= obj-2 "http://some.where/psis/der_zauberlehrling")))) (t (is-true nil)))) (is (= (length (tm-sparql::subject-result @@ -485,13 +485,13 @@ (first (tm-sparql::select-group q-obj-3)))) 1)) (is (or (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/psis/author/goethe") + "http://some.where/psis/author/goethe") (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/psis/persons/goethe"))) + "http://some.where/psis/persons/goethe"))) (is (string= (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/base-psis/first-name")) + "http://some.where/base-psis/first-name")) (is (string= (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-3)))) "Johann Wolfgang")))))) @@ -547,27 +547,27 @@ (first (tm-sparql::select-group q-obj-1))))) (o-4 (fourth (tm-sparql::object-result (first (tm-sparql::select-group q-obj-1)))))) - (is (string= p-1 "http://some.where/base-psis/written")) - (is (string= p-2 "http://some.where/base-psis/written")) - (is (string= p-3 "http://some.where/base-psis/written")) - (is (string= p-4 "http://some.where/base-psis/written")) + (is (string= p-1 "http://some.where/base-psis/written")) + (is (string= p-2 "http://some.where/base-psis/written")) + (is (string= p-3 "http://some.where/base-psis/written")) + (is (string= p-4 "http://some.where/base-psis/written")) (is (or (not (set-exclusive-or - (list "http://some.where/psis/author/eichendorff" - "http://some.where/psis/author/schiller" - "http://some.where/psis/author/goethe") + (list "http://some.where/psis/author/eichendorff" + "http://some.where/psis/author/schiller" + "http://some.where/psis/author/goethe") (list s-1 s-2 s-3 s-4) :test #'string=)) (not (set-exclusive-or - (list "http://some.where/psis/author/eichendorff" - "http://some.where/psis/author/schiller" - "http://some.where/psis/persons/goethe") + (list "http://some.where/psis/author/eichendorff" + "http://some.where/psis/author/schiller" + "http://some.where/psis/persons/goethe") (list s-1 s-2 s-3 s-4) :test #'string=)))) (is-false (set-exclusive-or - (list "http://some.where/psis/poem/mondnacht" - "http://some.where/psis/poem/resignation" - "http://some.where/psis/poem/erlkoenig" - "http://some.where/psis/poem/zauberlehrling") + (list "http://some.where/psis/poem/mondnacht" + "http://some.where/psis/poem/resignation" + "http://some.where/psis/poem/erlkoenig" + "http://some.where/psis/poem/zauberlehrling") (list o-1 o-2 o-3 o-4) :test #'string=))) (is-true q-obj-2) @@ -595,47 +595,47 @@ (first (tm-sparql::select-group q-obj-2))))) (o-3 (third (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2)))))) - (string= p-1 "http://some.where/base-psis/first-name") - (string= p-2 "http://some.where/base-psis/first-name") - (string= p-3 "http://some.where/base-psis/first-name") + (string= p-1 "http://some.where/base-psis/first-name") + (string= p-2 "http://some.where/base-psis/first-name") + (string= p-3 "http://some.where/base-psis/first-name") (cond ((string= o-1 "Johann Christoph Friedrich") - (is (string= s-1 "http://some.where/psis/author/schiller")) + (is (string= s-1 "http://some.where/psis/author/schiller")) (cond ((string= o-2 "Johann Wolfgang") - (is (or (string= s-2 "http://some.where/psis/author/goethe") - (string= s-2 "http://some.where/psis/persons/goethe"))) - (is (string= s-3 "http://some.where/psis/author/eichendorff")) + (is (or (string= s-2 "http://some.where/psis/author/goethe") + (string= s-2 "http://some.where/psis/persons/goethe"))) + (is (string= s-3 "http://some.where/psis/author/eichendorff")) (is (string= o-3 "Joseph Karl Benedikt"))) ((string= o-2 "Joseph Karl Benedikt") - (is (string= s-2 "http://some.where/psis/author/eichendorff")) - (is (or (string= s-3 "http://some.where/psis/author/goethe") - (string= s-3 "http://some.where/psis/persons/goethe"))) + (is (string= s-2 "http://some.where/psis/author/eichendorff")) + (is (or (string= s-3 "http://some.where/psis/author/goethe") + (string= s-3 "http://some.where/psis/persons/goethe"))) (is (string= o-3 "Johann Wolfgang"))) (t (is-true nil)))) ((string= o-1 "Johann Wolfgang") - (is (or (string= s-1 "http://some.where/psis/author/goethe") - (string= s-1 "http://some.where/psis/persons/goethe"))) + (is (or (string= s-1 "http://some.where/psis/author/goethe") + (string= s-1 "http://some.where/psis/persons/goethe"))) (cond ((string= o-2 "Johann Christoph Friedrich") - (is (string= s-2 "http://some.where/psis/author/schiller")) - (is (string= s-3 "http://some.where/psis/author/eichendorff")) + (is (string= s-2 "http://some.where/psis/author/schiller")) + (is (string= s-3 "http://some.where/psis/author/eichendorff")) (is (string= o-3 "Joseph Karl Benedikt"))) ((string= o-2 "Joseph Karl Benedikt") - (is (string= s-2 "http://some.where/psis/author/eichendorff")) - (is (string= s-3 "http://some.where/psis/author/schiller")) + (is (string= s-2 "http://some.where/psis/author/eichendorff")) + (is (string= s-3 "http://some.where/psis/author/schiller")) (is (string= o-3 "Johann Christoph Friedrich"))) (t (is-true nil)))) ((string= o-1 "Joseph Karl Benedikt") - (is (string= s-1 "http://some.where/psis/author/eichendorff")) + (is (string= s-1 "http://some.where/psis/author/eichendorff")) (cond ((string= o-2 "Johann Wolfgang") - (is (or (string= s-2 "http://some.where/psis/author/goethe") - (string= s-2 "http://some.where/psis/persons/goethe"))) - (is (string= s-3 "http://some.where/psis/author/schiller")) + (is (or (string= s-2 "http://some.where/psis/author/goethe") + (string= s-2 "http://some.where/psis/persons/goethe"))) + (is (string= s-3 "http://some.where/psis/author/schiller")) (is (string= o-3 "Johann Christoph Friedrich"))) ((string= o-2 "Johann Christoph Friedrich") - (is (string= s-2 "http://some.where/psis/author/schiller")) - (is (or (string= s-3 "http://some.where/psis/author/goethe") - (string= s-3 "http://some.where/psis/persons/goethe"))) + (is (string= s-2 "http://some.where/psis/author/schiller")) + (is (or (string= s-3 "http://some.where/psis/author/goethe") + (string= s-3 "http://some.where/psis/persons/goethe"))) (is (string= o-3 "Johann Wolfgang"))) (t (is-true nil)))) @@ -651,16 +651,16 @@ (first (tm-sparql::select-group q-obj-3)))) 1)) (is (or (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/psis/author/goethe") + "http://some.where/psis/author/goethe") (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/psis/persons/goethe"))) + "http://some.where/psis/persons/goethe"))) (is (string= (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/base-psis/written")) + "http://some.where/base-psis/written")) (is (string= (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-3)))) - "http://some.where/psis/poem/zauberlehrling")))))) + "http://some.where/psis/poem/zauberlehrling"))))))
(test test-set-result-3 @@ -700,25 +700,25 @@ (first (tm-sparql::select-group q-obj-3)))) 0)) (is (or (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1)))) - "http://some.where/psis/author/goethe") + "http://some.where/psis/author/goethe") (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1)))) - "http://some.where/psis/persons/goethe"))) + "http://some.where/psis/persons/goethe"))) (is (string= (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-1)))) - "http://some.where/base-psis/author-info")) + "http://some.where/base-psis/author-info")) (is (string= (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-1)))) "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe")) (is (string= (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-4)))) - "http://some.where/psis/author/schiller")) + "http://some.where/psis/author/schiller")) (is (string= (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-4)))) - "http://some.where/base-psis/written")) + "http://some.where/base-psis/written")) (is (string= (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-4)))) - "http://some.where/psis/poem/resignation")))))) + "http://some.where/psis/poem/resignation"))))))
(test test-set-result-4 @@ -749,91 +749,91 @@ (is (= (length (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3)))) 1)) (is-true (or (null (set-exclusive-or - (list "http://some.where/psis/author/goethe") + (list "http://some.where/psis/author/goethe") (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1))) :test #'string=)) (null (set-exclusive-or - (list "http://some.where/psis/persons/goethe") + (list "http://some.where/psis/persons/goethe") (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1))) :test #'string=)))) (let ((predicates (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-1))))) - (is (= (count "http://some.where/base-psis/written" predicates + (is (= (count "http://some.where/base-psis/written" predicates :test #'string=) 2)) - (is (= (count "http://some.where/base-psis/place" predicates + (is (= (count "http://some.where/base-psis/place" predicates :test #'string=) 1)) - (is (= (count "http://some.where/base-psis/first-name" predicates + (is (= (count "http://some.where/base-psis/first-name" predicates :test #'string=) 1)) - (is (= (count "http://some.where/base-psis/last-name" predicates + (is (= (count "http://some.where/base-psis/last-name" predicates :test #'string=) 1)) - (is (= (count "http://some.where/base-psis/author-info" predicates + (is (= (count "http://some.where/base-psis/author-info" predicates :test #'string=) 1)) - (is (= (count "http://psi.topicmaps.org/iso13250/model/type" predicates + (is (= (count "http://psi.topicmaps.org/iso13250/model/type" predicates :test #'string=) 1))) (let ((objects (tm-sparql::object-result (first (tm-sparql::select-group q-obj-1))))) - (is (= (count "http://some.where/psis/poem/erlkoenig" objects + (is (= (count "http://some.where/psis/poem/erlkoenig" objects :test #'string=) 1)) - (is (or (= (count "http://some.where/psis/poem/der_zauberlehrling" + (is (or (= (count "http://some.where/psis/poem/der_zauberlehrling" objects :test #'string=) 1) - (= (count "http://some.where/psis/poem/zauberlehrling" objects + (= (count "http://some.where/psis/poem/zauberlehrling" objects :test #'string=) 1))) - (is (or (= (count "http://some.where/base-psis/author" objects + (is (or (= (count "http://some.where/base-psis/author" objects :test #'string=) 1) - (= (count "http://some.where/base-psis/author-psi" objects + (= (count "http://some.where/base-psis/author-psi" objects :test #'string=) 1))) (is (= (count "http://de.wikipedia.org/wiki/Johann_Wolfgang_von_Goethe" objects :test #'string=) 1)) (is (= (count "von Goethe" objects :test #'string=) 1)) (is (= (count "Johann Wolfgang" objects :test #'string=) 1)) - (is (= (count "http://some.where/psis/region/frankfurt_am_main" + (is (= (count "http://some.where/psis/region/frankfurt_am_main" objects :test #'string=) 1))) (is-true (or (null (set-exclusive-or - (list "http://some.where/psis/poem/der_zauberlehrling") + (list "http://some.where/psis/poem/der_zauberlehrling") (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-2))) :test #'string=)) (null (set-exclusive-or - (list "http://some.where/psis/poem/zauberlehrling") + (list "http://some.where/psis/poem/zauberlehrling") (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-2))) :test #'string=)))) (let ((predicates (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-2))))) - (is (= (count "http://some.where/base-psis/writer" predicates + (is (= (count "http://some.where/base-psis/writer" predicates :test #'string=) 1)) - (is (= (count "http://some.where/base-psis/title" predicates + (is (= (count "http://some.where/base-psis/title" predicates :test #'string=) 1)) - (is (= (count "http://some.where/base-psis/poem-content" predicates + (is (= (count "http://some.where/base-psis/poem-content" predicates :test #'string=) 1)) - (is (= (count "http://psi.topicmaps.org/iso13250/model/type" predicates + (is (= (count "http://psi.topicmaps.org/iso13250/model/type" predicates :test #'string=) 1))) (let ((objects (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))) - (is (or (= (count "http://some.where/psis/author/goethe" objects + (is (or (= (count "http://some.where/psis/author/goethe" objects :test #'string=) 1) - (= (count "http://some.where/psis/persons/goethe" objects + (= (count "http://some.where/psis/persons/goethe" objects :test #'string=) 1))) (is (= (count "Der Zauberlehrling" objects :test #'string=) 1)) - (is (= (count "http://some.where/base-psis/poem" + (is (= (count "http://some.where/base-psis/poem" objects :test #'string=) 1)) ;do not check the entire poem content => too long ) - (is (or (string= "http://some.where/psis/author/goethe" + (is (or (string= "http://some.where/psis/author/goethe" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3))))) - (string= "http://some.where/psis/persons/goethe" + (string= "http://some.where/psis/persons/goethe" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-3))))))) - (is (string= "http://some.where/base-psis/written" + (is (string= "http://some.where/base-psis/written" (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-3)))))) - (is (or (string= "http://some.where/psis/poem/der_zauberlehrling" + (is (or (string= "http://some.where/psis/poem/der_zauberlehrling" (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-3))))) - (string= "http://some.where/psis/poem/zauberlehrling" + (string= "http://some.where/psis/poem/zauberlehrling" (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-3)))))))))))
@@ -868,52 +868,52 @@ (first (tm-sparql::select-group q-obj-3)))) 0)) (is (= (length (tm-sparql::subject-result (second (tm-sparql::select-group q-obj-3)))) 1)) - (is (or (string= "http://some.where/psis/author/goethe" + (is (or (string= "http://some.where/psis/author/goethe" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1))))) - (string= "http://some.where/psis/persons/goethe" + (string= "http://some.where/psis/persons/goethe" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-1))))))) - (is (string= "http://some.where/base-psis/first-name" + (is (string= "http://some.where/base-psis/first-name" (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-1)))))) (is (string= "Johann Wolfgang" (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-1)))))) - (is (or (string= "http://some.where/psis/author/goethe" + (is (or (string= "http://some.where/psis/author/goethe" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-2))))) - (string= "http://some.where/psis/persons/goethe" + (string= "http://some.where/psis/persons/goethe" (first (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-2))))))) - (is (string= "http://some.where/base-psis/written" + (is (string= "http://some.where/base-psis/written" (first (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-2)))))) - (is (or (string= "http://some.where/psis/poem/zauberlehrling" + (is (or (string= "http://some.where/psis/poem/zauberlehrling" (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))) - (string= "http://some.where/psis/poem/der_zauberlehrling" + (string= "http://some.where/psis/poem/der_zauberlehrling" (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))) - (string= "http://some.where/psis/poem/erlkoenig" + (string= "http://some.where/psis/poem/erlkoenig" (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))))) - (is (or (string= "http://some.where/psis/author/goethe" + (is (or (string= "http://some.where/psis/author/goethe" (second (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-2))))) - (string= "http://some.where/psis/persons/goethe" + (string= "http://some.where/psis/persons/goethe" (second (tm-sparql::subject-result (first (tm-sparql::select-group q-obj-2))))))) - (is (string= "http://some.where/base-psis/written" + (is (string= "http://some.where/base-psis/written" (second (tm-sparql::predicate-result (first (tm-sparql::select-group q-obj-2)))))) - (is (or (string= "http://some.where/psis/poem/zauberlehrling" + (is (or (string= "http://some.where/psis/poem/zauberlehrling" (second (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))) - (string= "http://some.where/psis/poem/der_zauberlehrling" + (string= "http://some.where/psis/poem/der_zauberlehrling" (second (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))) - (string= "http://some.where/psis/poem/erlkoenig" + (string= "http://some.where/psis/poem/erlkoenig" (second (tm-sparql::object-result (first (tm-sparql::select-group q-obj-2))))))) (is-false (first (tm-sparql::subject-result @@ -922,13 +922,13 @@ (first (tm-sparql::select-group q-obj-3))))) (is-false (first (tm-sparql::object-result (first (tm-sparql::select-group q-obj-3))))) - (is (or (string= "http://some.where/psis/author/goethe" + (is (or (string= "http://some.where/psis/author/goethe" (first (tm-sparql::subject-result (second (tm-sparql::select-group q-obj-3))))) - (string= "http://some.where/psis/persons/goethe" + (string= "http://some.where/psis/persons/goethe" (first (tm-sparql::subject-result (second (tm-sparql::select-group q-obj-3))))))) - (is (string= "http://some.where/base-psis/last-name" + (is (string= "http://some.where/base-psis/last-name" (first (tm-sparql::predicate-result (second (tm-sparql::select-group q-obj-3)))))) (is (string= "von Goethe" @@ -965,22 +965,22 @@ (progn (is (= (length (getf (first (result q-obj-1)) :result)) 1)) (is (or (string= (first (getf (first (result q-obj-1)) :result)) - "http://some.where/psis/author/goethe") + "http://some.where/psis/author/goethe") (string= (first (getf (first (result q-obj-1)) :result)) - "http://some.where/psis/persons/goethe"))) + "http://some.where/psis/persons/goethe"))) (is (= (length (getf (second (result q-obj-1)) :result)) 1)) (is (string= (first (getf (second (result q-obj-1)) :result)) - "http://some.where/psis/poem/erlkoenig")) - (is (string= (getf (second (result q-obj-1)) :variable) "poems"))) + "http://some.where/psis/poem/erlkoenig")) + (is (string= (getf (second (result q-obj-1)) :variable) "<poems"))) (progn (is (= (length (getf (second (result q-obj-1)) :result)) 1)) (is (or (string= (first (getf (second (result q-obj-1)) :result)) - "http://some.where/psis/author/goethe") + "http://some.where/psis/author/goethe") (string= (first (getf (second (result q-obj-1)) :result)) - "http://some.where/psis/persons/goethe"))) + "http://some.where/psis/persons/goethe"))) (is (= (length (getf (first (result q-obj-1)) :result)) 1)) (is (string= (first (getf (first (result q-obj-1)) :result)) - "http://some.where/psis/poem/erlkoenig")) + "http://some.where/psis/poem/erlkoenig")) (is (string= (getf (first (result q-obj-1)) :variable) "poems")))) (is (= (length (result q-obj-2)) 2)) (if (string= (getf (first (result q-obj-2)) :variable) "titles") @@ -1000,19 +1000,19 @@ (getf (first (result q-obj-2)) :result) :test #'string=)) (string= (getf (second (result q-obj-2)) :variable) "poems") (is-true - (find "http://some.where/psis/poem/mondnacht" + (find "http://some.where/psis/poem/mondnacht" (getf (second (result q-obj-2)) :result) :test #'string=)) (is-true - (find "http://some.where/psis/poem/resignation" + (find "http://some.where/psis/poem/resignation" (getf (second (result q-obj-2)) :result) :test #'string=)) (is-true - (find "http://some.where/psis/poem/erlkoenig" + (find "http://some.where/psis/poem/erlkoenig" (getf (second (result q-obj-2)) :result) :test #'string=)) (is-true (or - (find "http://some.where/psis/poem/zauberlehrling" + (find "http://some.where/psis/poem/zauberlehrling" (getf (second (result q-obj-2)) :result) :test #'string=) - (find "http://some.where/psis/poem/der_zauberlehrling" + (find "http://some.where/psis/poem/der_zauberlehrling" (getf (second (result q-obj-2)) :result) :test #'string=)))) (progn (is (= (length (getf (second (result q-obj-2)) :result)) 4)) @@ -1030,19 +1030,19 @@ (getf (second (result q-obj-2)) :result) :test #'string=)) (string= (getf (first (result q-obj-2)) :variable) "poems") (is-true - (find "http://some.where/psis/poem/mondnacht" + (find "http://some.where/psis/poem/mondnacht" (getf (first (result q-obj-2)) :result) :test #'string=)) (is-true - (find "http://some.where/psis/poem/resignation" + (find "http://some.where/psis/poem/resignation" (getf (first (result q-obj-2)) :result) :test #'string=)) (is-true - (find "http://some.where/psis/poem/erlkoenig" + (find "http://some.where/psis/poem/erlkoenig" (getf (first (result q-obj-2)) :result) :test #'string=)) (is-true (or - (find "http://some.where/psis/poem/zauberlehrling" + (find "http://some.where/psis/poem/zauberlehrling" (getf (first (result q-obj-2)) :result) :test #'string=) - (find "http://some.where/psis/poem/der_zauberlehrling" + (find "http://some.where/psis/poem/der_zauberlehrling" (getf (first (result q-obj-2)) :result) :test #'string=)))))))))
-
Lukas Giessmann