November 2010 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r356 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 28 Nov '10

28 Nov '10

Author: lgiessmann Date: Sun Nov 28 14:47:27 2010 New Revision: 356 Log: TM-SPARQL: added some unit-tests for processing single triples in a SELECT-WHERE statement => fixed some bugs in the SPARQL-queries Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/unit_tests/poems.xtm 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 Nov 28 14:47:27 2010 @@ -114,7 +114,13 @@ (defclass SPARQL-Query () - ((original-query :initarg :query + ((revision :initarg :revision + :accessor revision + :type Integer + :initform 0 + :documentation "Represents the revision in which all the queries + are processed in the DB.") + (original-query :initarg :query :accessor original-query ;this value is only for internal ;purposes and mustn't be reset :type String @@ -230,9 +236,9 @@ (filter-by-given-predicate construct :revision revision) (filter-by-given-object construct :revision revision)))) (map 'list #'(lambda(result) - (push (getf result :subject) (subject construct)) - (push (getf result :predicate) (predicate construct)) - (push (getf result :object) (object construct))) + (push (getf result :subject) (subject-result construct)) + (push (getf result :predicate) (predicate-result construct)) + (push (getf result :object) (object-result construct))) ;;literal-datatype is not used and is not returned, since ;;the values are returned as object of their specific type, e.g. ;;integer, boolean, string, ... @@ -244,7 +250,9 @@ of a given object.") (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) (declare (Integer revision)) - (unless (variable-p (object construct)) + (when (and (not (variable-p (object construct))) + (variable-p (predicate construct)) + (variable-p (subject construct))) (cond ((literal-p (object construct)) (filter-by-characteristic-value (value (object construct)) (literal-datatype (object construct)) @@ -304,7 +312,12 @@ :predicate pred :object (charvalue char) :literal-datatyp literal-datatype)))) - chars)))) + ;;elephant returns names, occurences, and variants if any string + ;;value matches, so all duplicates have to be removed, additionaly + ;;variants have to be remove completely + (remove-if #'(lambda(obj) + (typep obj 'VariantC)) + (remove-duplicates chars)))))) (defgeneric filter-by-otherplayer (construct &key revision) @@ -328,7 +341,7 @@ (when-do type (instance-of role :revision revision) (any-id type :revision revision))) (subj-uri - (when-do plr (instance-of orole :revision revision) + (when-do plr (player orole :revision revision) (any-id plr :revision revision)))) (when (and obj-uri pred-uri subj-uri) (list :subject subj-uri @@ -364,16 +377,18 @@ (when (or (variable-p (object construct)) (iri-p (object construct))) (let* ((roles-by-type - (map 'list #'(lambda(typed-construct) - (when (typep typed-construct 'RoleC) - typed-construct)) - (used-as-type construct :revision revision))) + (remove-null + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'RoleC) + typed-construct)) + (used-as-type (value (predicate construct)) :revision revision)))) (roles-by-player (if (iri-p (object construct)) (remove-null (map 'list #'(lambda(role) - (when (eql (instance-of role :revision revision) - (value (object construct))))) + (when (eql (player role :revision revision) + (value (object construct))) + role)) roles-by-type)) roles-by-type)) (pred-uri (any-id (value (predicate construct)) :revision revision))) @@ -415,7 +430,7 @@ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) (declare (Integer revision)) (when (and (not (iri-p (object construct))) - (or (not (literal-datatype construct)) + (or (not (literal-datatype (object construct))) (string= (literal-datatype construct) *xml-string*))) (let* ((names-by-type (remove-null @@ -426,12 +441,13 @@ :revision revision)))) (names-by-literal (if (variable-p (object construct)) + names-by-type (remove-null (map 'list #'(lambda(name) - (string= (charvalue name) - (value (object construct)))) - names-by-type)) - names-by-type))) + (when (string= (charvalue name) + (value (object construct))) + name)) + names-by-type))))) (remove-null (map 'list #'(lambda(name) @@ -713,4 +729,6 @@ (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) (parser-start construct (original-query construct)) + (dolist (triple (select-group construct)) + (set-results triple :revision (revision construct))) construct) \ No newline at end of file Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sun Nov 28 14:47:27 2010 @@ -208,11 +208,12 @@ ((string-starts-with-digit trimmed-str) (parse-literal-number-value trimmed-str query-object))))) (list :next-query (getf value-type-lang-query :next-query) - :value (make-instance 'SPARQL-Triple-Elem - :elem-type 'LITERAL - :value (getf value-type-lang-query :value) - :literal-lang (getf value-type-lang-query :lang) - :literal-type (getf value-type-lang-query :type))))) + :value (make-instance + 'SPARQL-Triple-Elem + :elem-type 'LITERAL + :value (getf value-type-lang-query :value) + :literal-lang (getf value-type-lang-query :lang) + :literal-datatype (getf value-type-lang-query :type))))) (defun parse-literal-string-value (query-string query-object) Modified: trunk/src/unit_tests/poems.xtm ============================================================================== --- trunk/src/unit_tests/poems.xtm (original) +++ trunk/src/unit_tests/poems.xtm Sun Nov 28 14:47:27 2010 @@ -1,16 +1,16 @@ <?xml version="1.0" encoding="UTF-8"?> <tm:topicMap version="2.0" xmlns:tm="http://www.topicmaps.org/xtm/"> -  -  -  -  -  -  -  -  -  -  -  +  +  +  +  +  +  +  +  +  +  +     Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Nov 28 14:47:27 2010 @@ -12,6 +12,9 @@ :it.bese.FiveAM :TM-SPARQL :exceptions + :unittests-constants + :fixtures + :d :constants) (:export :run-sparql-tests :sparql-tests @@ -19,7 +22,9 @@ :test-parse-literals :test-parse-triple-elem :test-parse-group-1 - :test-parse-group-2)) + :test-parse-group-2 + :test-set-result-1 + :test-set-result-2)) (in-package :sparql-test) @@ -408,5 +413,254 @@ (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))))) +(test test-set-result-1 + (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) + (with-revision 0 + (let* ((query-1 "BASE <http://some.where/> + SELECT ?subject ?predicate ?object WHERE { + ?subject ?predicate ?object }") + (query-2 "BASE <http://some.where/psis/poem/> + SELECT $subject ?predicate WHERE{ + ?subject $predicate <zauberlehrling> }") + (query-3 "SELECT ?predicate ?subject WHERE + {?subject ?predicate \"Johann Wolfgang\" }") + (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)) + (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2)) + (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3))) + (is-true q-obj-1) + (is (= (length (tm-sparql::select-group q-obj-1)) 1)) + (is-true q-obj-2) + (is (= (length (tm-sparql::select-group q-obj-2)) 1)) + (is-true q-obj-3) + (is (= (length (tm-sparql::select-group q-obj-3)) 1)) + (is-false (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1)))) + (is-false (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1)))) + (is-false (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1)))) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2)))) 2)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2)))) 2)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2)))) 2)) + (let ((subj-1 (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (subj-2 (second (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (pred-1 (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (pred-2 (second (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (obj-1 (first (tm-sparql::object-result + (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")))) + (t + (is-true nil)))) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::object-result + (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") + (string= (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) + "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")) + (is (string= (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-3)))) + "Johann Wolfgang")))))) + + +(test test-set-result-2 + (with-fixture with-tm-filled-db ("data_base" *poems.xtm*) + (with-revision 0 + (let* ((query-1 "PREFIX pref:<http://some.where/base-psis/> + SELECT $subject $object WHERE { + ?subject pref:written ?object }") + (query-2 "BASE <http://some.where/base-psis/> + SELECT $subject $object WHERE { + ?subject <first-name> ?object }") + (query-3 "BASE <http://some.where/psis/> + SELECT ?subject WHERE{ + ?subject <http://some.where/base-psis/written> + <poem/zauberlehrling>}") + (q-obj-1 (make-instance 'TM-SPARQL:SPARQL-Query :query query-1)) + (q-obj-2 (make-instance 'TM-SPARQL:SPARQL-Query :query query-2)) + (q-obj-3 (make-instance 'TM-SPARQL:SPARQL-Query :query query-3))) + (is-true q-obj-1) + (is (= (length (tm-sparql::select-group q-obj-1)) 1)) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1)))) 4)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1)))) 4)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1)))) 4)) + (let* ((s-1 (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (s-2 (second (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (s-3 (third (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (s-4 (fourth (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-1))))) + (p-1 (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (p-2 (second (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (p-3 (third (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (p-4 (fourth (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-1))))) + (o-1 (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1))))) + (o-2 (second (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-1))))) + (o-3 (third (tm-sparql::object-result + (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 (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 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 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 o-1 o-2 o-3 o-4) + :test #'string=))) + (is-true q-obj-2) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2)))) 3)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2)))) 3)) + (is (= (length (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2)))) 3)) + (let* ((s-1 (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (s-2 (second (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (s-3 (third (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-2))))) + (p-1 (first (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (p-2 (second (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (p-3 (third (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-2))))) + (o-1 (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-2))))) + (o-2 (second (tm-sparql::object-result + (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") + (cond ((string= o-1 "Johann Christoph Friedrich") + (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 (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= 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"))) + (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= 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= 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")) + (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 (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= o-3 "Johann Wolfgang"))) + (t + (is-true nil)))) + (t + (is-true nil)))) + (is-true q-obj-3) + (is (= (length (tm-sparql::select-group q-obj-3)) 1)) + (is (= (length (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::predicate-result + (first (tm-sparql::select-group q-obj-3)))) 1)) + (is (= (length (tm-sparql::object-result + (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") + (string= (first (tm-sparql::subject-result + (first (tm-sparql::select-group q-obj-3)))) + "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")) + (is (string= (first (tm-sparql::object-result + (first (tm-sparql::select-group q-obj-3)))) + "http://some.where/psis/poem/zauberlehrling")))))) + + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0

[isidorus-cvs] r355 - in trunk/src: TM-SPARQL model
by Lukas Giessmann 27 Nov '10

27 Nov '10

Author: lgiessmann Date: Sat Nov 27 11:40:38 2010 New Revision: 355 Log: TM-SPARQL: fixed ticket #86 => requests without FILTERs can be processed Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/model/datamodel.lisp trunk/src/model/trivial-queries.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Sat Nov 27 11:40:38 2010 @@ -11,10 +11,33 @@ (:use :cl :datamodel :base-tools :exceptions :constants) (:export :SPARQL-Query)) +;;TODO: +;; *handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html (in-package :TM-SPARQL) -(defvar *empty-label* "_empty_label_symbol") +(defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels") + +(defvar *equal-operators* nil "A Table taht contains tuples of + classes and equality operators.") + +(defun init-*equal-operators* () + (setf *equal-operators* + (list (list :class 'Boolean :operator #'eql) + (list :class 'String :operator #'string=) + (list :class 'Number :operator #'=)))) + + +(init-*equal-operators*) + + +(defun get-equal-operator (value) + (let ((entry + (find-if #'(lambda(entry) + (typep value (getf entry :class))) + *equal-operators*))) + (when entry + (getf entry :operator)))) (defclass SPARQL-Triple-Elem() @@ -37,11 +60,12 @@ :initform nil :type String :documentation "Contains the @lang attribute of a literal") - (literal-type :initarg :literal-type - :accessor literal-type - :type String - :initform nil - :documentation "Contains the datatype of the literal, e.g. xml:string")) + (literal-datatype :initarg :literal-datatype + :accessor literal-datatype + :type String + :initform nil + :documentation "Contains the datatype of the literal, + e.g. xml:string")) (:documentation "Represents one element of an RDF-triple.")) @@ -195,36 +219,495 @@ (variables construct)))))) - - -;;TODO: -;; -;; find-triples (subject predicate object) -;; * var var var => return the entire graph (all subjects) -;; * var var object -;; * var predicate var -;; * var predicate object -;; * subject var var -;; * subject var object -;; * subject predicate var -;; * subject predicate object => return subject predicate object if true otherweise nil -;; handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html - -(defgeneric set-result (construct) +(defgeneric set-results (construct &key revision) (:documentation "Calculates the result of a triple and set all the values in the passed object.") + (:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*)) + (declare (Integer revision)) + (set-tm-constructs construct :revision revision) + (when (not (iri-not-found-p construct)) ;there is only a result if all IRIs were found + (let ((results (or (filter-by-given-subject construct :revision revision) + (filter-by-given-predicate construct :revision revision) + (filter-by-given-object construct :revision revision)))) + (map 'list #'(lambda(result) + (push (getf result :subject) (subject construct)) + (push (getf result :predicate) (predicate construct)) + (push (getf result :object) (object construct))) + ;;literal-datatype is not used and is not returned, since + ;;the values are returned as object of their specific type, e.g. + ;;integer, boolean, string, ... + results))))) + + +(defgeneric filter-by-given-object (construct &key revision) + (:documentation "Returns a list representing a triple that is the result + of a given object.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (unless (variable-p (object construct)) + (cond ((literal-p (object construct)) + (filter-by-characteristic-value (value (object construct)) + (literal-datatype (object construct)) + :revision revision)) + ((iri-p (object construct)) + (filter-by-otherplayer (value (object construct)) + :revision revision)))))) + + +(defun filter-by-characteristic-value (literal-value literal-datatype + &key (revision *TM-REVISION*)) + "Returns a triple where the passed value is a charvalue in a occurrence + or name. The subject is the owner topic and the predicate is the + characteristic's type." + (declare (Integer revision) + (String literal-value literal-datatype)) + (let ((chars + (cond ((string= literal-datatype *xml-string*) + (remove-if #'(lambda(elem) + (string/= (charvalue elem) literal-value)) + (append + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue literal-value) + (elephant:get-instances-by-value + 'NameC 'charvalue literal-value)))) + ((and (string= literal-datatype *xml-boolean*) + (eql literal-value t)) + (remove-if #'(lambda(elem) + (string/= (charvalue elem) "true")) + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue "true"))) + ((and (string= literal-datatype *xml-boolean*) + (eql literal-value nil)) + (remove-if #'(lambda(elem) + (string/= (charvalue elem) "false")) + (elephant:get-instances-by-value + 'OccurrenceC 'charvalue "false"))) + ((or (string= literal-datatype *xml-double*) + (string= literal-datatype *xml-decimal*) + (string= literal-datatype *xml-integer*)) + (let ((occs + (remove-if #'(lambda(occ) + (string/= (datatype occ) literal-datatype)) + (elephant:get-instances-by-value + 'OccurrenceC 'datatype literal-datatype)))) + (remove-if #'(lambda(occ) + (not (literal= (charvalue occ) literal-value))) + occs)))))) + (remove-null + (map 'list #'(lambda(char) + (let ((subj (when-do top (parent char :revision revision) + (any-id top :revision revision))) + (pred (when-do top (instance-of char :revision revision) + (any-id top :revision revision)))) + (when (and subj pred) + (list :subject subj + :predicate pred + :object (charvalue char) + :literal-datatyp literal-datatype)))) + chars)))) + + +(defgeneric filter-by-otherplayer (construct &key revision) + (:documentation "Returns triples where the passed player is the object, + the other player is the subject and the type of the passed + player's role is the predicate.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (let ((roles-by-oplayer (player-in-roles construct :revision revision)) + (obj-uri (any-id construct :revision revision))) + (remove-null + (map 'list + #'(lambda(role) + (let* ((orole + (when-do assoc (parent role :revision revision) + (when (= (length (roles assoc :revision revision)) + 2) + (find-if #'(lambda(r) (not (eql r role))) + (roles assoc :revision revision))))) + (pred-uri + (when-do type (instance-of role :revision revision) + (any-id type :revision revision))) + (subj-uri + (when-do plr (instance-of 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)))) + roles-by-oplayer))))) + + +(defgeneric filter-by-given-predicate (construct &key revision) + (:documentation "Returns all topics that owns a characteristic of the + given type or an associaiton with an otherrole of the + given type. The result is a plist representing a triple.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (and (variable-p (subject construct)) + (iri-p (predicate construct))) + (cond ((variable-p (object construct)) + (append (filter-by-otherroletype construct :revision revision) + (filter-by-characteristictype construct :revision revision))) + ((literal-p (object construct)) + (filter-by-characteristictype construct :revision revision)) + ((iri-p (object construct)) + (filter-by-otherroletype construct :revision revision)))))) + + +(defgeneric filter-by-otherroletype (construct &key revision) + (:documentation "Returns triple where the passed predicate is a + type of a role. The returned subject is the otherplayer, + the predicate is the passed predicate, the object is + the player of the role of the passed type.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (or (variable-p (object construct)) + (iri-p (object construct))) + (let* ((roles-by-type + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'RoleC) + typed-construct)) + (used-as-type construct :revision revision))) + (roles-by-player + (if (iri-p (object construct)) + (remove-null + (map 'list #'(lambda(role) + (when (eql (instance-of role :revision revision) + (value (object construct))))) + roles-by-type)) + roles-by-type)) + (pred-uri (any-id (value (predicate construct)) :revision revision))) + (remove-null + (map 'list + #'(lambda(role) + (let* ((obj-uri + (when-do plr-top (player role :revision revision) + (any-id plr-top :revision revision))) + (assoc (parent role :revision revision)) + (orole (when (and assoc + (= (length + (roles assoc :revision revision)) + 2)) + (find-if #'(lambda(r) + (not (eql r role))) + (roles assoc :revision revision)))) + (subj-uri + (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)))) + roles-by-player)))))) + + +(defgeneric filter-by-characteristictype (construct &key revision) + (:documentation "Returns the results of filter-by-nametype and + filter-by-occurrencetype.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (append (filter-by-nametype construct :revision revision) + (filter-by-occurrencetype construct :revision revision)))) + + +(defgeneric filter-by-nametype (construct &key revision) + (:documentation "Returns all names that corresponds to the given parameters.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (and (not (iri-p (object construct))) + (or (not (literal-datatype construct)) + (string= (literal-datatype construct) *xml-string*))) + (let* ((names-by-type + (remove-null + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'NameC) + typed-construct)) + (used-as-type (value (predicate construct)) + :revision revision)))) + (names-by-literal + (if (variable-p (object construct)) + (remove-null + (map 'list #'(lambda(name) + (string= (charvalue name) + (value (object construct)))) + names-by-type)) + names-by-type))) + (remove-null + (map 'list + #'(lambda(name) + (let ((subj + (when-do top (parent name :revision revision) + (any-id top :revision revision))) + (pred + (when-do top (instance-of name :revision revision) + (any-id top :revision revision)))) + (when (and subj pred) + (list :subject subj + :predicate pred + :object (charvalue name) + :literal-datatype *xml-string*)))) + names-by-literal)))))) + + +(defgeneric filter-by-occurrencetype (construct &key revision) + (:documentation "Returns all occurrence that corresponds to the + given parameters.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (unless (iri-p (object construct)) + (let* ((occs-by-type + (remove-null + (map 'list #'(lambda(typed-construct) + (when (typep typed-construct 'OccurrenceC) + typed-construct)) + (used-as-type (value (predicate construct)) + :revision revision)))) + (all-occs + (let ((literal-value (if (variable-p (object construct)) + nil + (value (object construct)))) + (literal-datatype (literal-datatype (object construct)))) + (remove-null + (map 'list #'(lambda(occ) + (filter-occ-by-value occ literal-value + literal-datatype)) + occs-by-type))))) + (remove-null + (map 'list + #'(lambda(occ) + (let ((subj + (when-do top (parent occ :revision revision) + (any-id top :revision revision))) + (pred + (when-do top (instance-of occ :revision revision) + (any-id top :revision revision)))) + (when (and subj pred) + (list :subject subj + :predicate pred + :object (charvalue occ) + :literal-datatype (datatype occ))))) + all-occs)))))) + + +(defgeneric filter-by-given-subject (construct &key revision) + (:documentation "Calls filter-characteristics and filter associations + for the topic that is set as a subject of the passed triple.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (iri-p (subject construct)) + (let* ((subj (value (subject construct))) + (pred (when (iri-p (predicate construct)) + (value (predicate construct))))) + (cond ((variable-p (object construct)) + (append (filter-characteristics + subj pred nil nil :revision revision) + (filter-associations + subj pred nil :revision revision))) + ((literal-p (object construct)) + (filter-characteristics + subj pred (value (subject construct)) + (literal-datatype (object construct)) :revision revision)) + ((iri-p (object construct)) + (filter-associations subj pred (value (object construct)) + :revision revision))))))) + + +(defgeneric literal-p (construct) + (:documentation "Returns t if the passed construct has an elem-type + set to 'LITERAL.") + (:method ((construct SPARQL-Triple-Elem)) + (eql (elem-type construct) 'LITERAL))) + + +(defgeneric iri-p (construct) + (:documentation "Returns t if the passed construct has an elem-type + set to 'IRI.") + (:method ((construct SPARQL-Triple-Elem)) + (eql (elem-type construct) 'IRI))) + + +(defgeneric variable-p (construct) + (:documentation "Returns t if the passed construct has an elem-type + set to 'VARIABLE.") + (:method ((construct SPARQL-Triple-Elem)) + (eql (elem-type construct) 'VARIABLE))) + + +(defgeneric iri-not-found-p (construct) + (:documentation "Must be called after a call of set-tm-constructs. + It returns t if a TM-construct was not found for a + given IRI, so the result value of a query is nil.") (:method ((construct SPARQL-Triple)) - ;;TODO: implement - construct)) - - -(defgeneric find-subject-var-var (construct) - (:documentation "Finds a triple corresponding to the subject and sets - both variables.") - (:method ((construct SPARQL-Triple)) - - )) - + (or (iri-not-found-p (subject construct)) + (iri-not-found-p (predicate construct)) + (iri-not-found-p (object construct))))) + + +(defmethod iri-not-found-p ((construct SPARQL-Triple-Elem)) + (and (eql (elem-type construct) 'IRI) + (not (value construct)))) + + +(defgeneric set-tm-constructs (construct &key revision) + (:documentation "Calls the method set-tm-construct for every element + in a SPARQL-Triple object.") + (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*)) + (when-do subj (subject construct) + (set-tm-construct subj :revision revision)) + (when-do pred (predicate construct) + (set-tm-construct pred :revision revision)) + (when-do obj (object construct) (set-tm-construct obj :revision revision)))) + + +(defgeneric set-tm-construct (construct &key revision) + (:documentation "Replaces the IRI in the given object by the corresponding + TM-construct.") + (:method ((construct SPARQL-Triple-Elem) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when (eql (elem-type construct) 'IRI) + (setf (value construct) + (get-item-by-any-id (value construct) :revision revision))))) + + +(defun literal= (value-1 value-2) + "Returns t if both arguments are equal. The equality function is searched in + the table *equal-operators*." + (when (or (and (numberp value-1) (numberp value-2)) + (typep value-1 (type-of value-2)) + (typep value-2 (type-of value-1))) + (let ((operator (get-equal-operator value-1))) + (funcall operator value-1 value-2)))) + + +(defun filter-occ-by-value (occurrence literal-value literal-datatype) + "A helper that compares the occurrence's charvalue with the passed + literal value." + (declare (OccurrenceC occurrence) + (type (or Null String) literal-value literal-datatype)) + (when (or (not literal-datatype) + (string= (datatype occurrence) literal-datatype)) + (if (not literal-value) + occurrence + (handler-case + (let ((occ-value (cast-literal (charvalue occurrence) + (datatype occurrence)))) + (when (literal= occ-value literal-value) + occurrence)) + (condition () nil))))) + + +(defgeneric filter-occurrences(construct type-top literal-value + literal-datatype &key revision) + (:documentation "Returns a list representing a triple.") + (:method ((construct TopicC) type-top literal-value literal-datatype + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null String) literal-value literal-datatype) + (type (or Null TopicC) type-top)) + (let* ((occs-by-type + (occurrences-by-type construct type-top :revision revision)) + (all-occs + (remove-null + (map 'list + #'(lambda(occ) + (filter-occ-by-value occ literal-value literal-datatype)) + occs-by-type))) + (subj-uri (any-id construct :revision revision))) + (remove-null + (map 'list #'(lambda(occ) + (let ((pred-uri + (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 + :object (charvalue occ) + :literal-datatype (datatype occ))))) + all-occs))))) + + +(defgeneric filter-names(construct type-top literal-value + &key revision) + (:documentation "Returns a list representing a triple.") + (:method ((construct TopicC) type-top literal-value + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null String) literal-value) + (type (or Null TopicC) type-top)) + (let* ((by-type + (names-by-type construct type-top :revision revision)) + (by-literal (if literal-value + (names-by-value + construct #'(lambda(name) + (string= name literal-value)) + :revision revision) + (names construct :revision revision))) + (all-names (intersection by-type by-literal)) + (subj-uri (any-id construct :revision revision))) + (remove-null + (map 'list #'(lambda(name) + (let ((pred-uri + (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 + :object (charvalue name) + :literal-datatype *xml-string*)))) + all-names))))) + + +(defgeneric filter-characteristics (construct type-top literal-value + literal-datatype &key revision) + (:documentation "Returns a list representing a triple.") + (:method ((construct TopicC) type-top literal-value literal-datatype + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null String) literal-value literal-datatype) + (type (or Null TopicC) type-top)) + (let ((occs (filter-occurrences construct type-top literal-value + literal-datatype :revision revision)) + (names (if (or (not literal-datatype) + (string= literal-datatype *xml-string*)) + (filter-names construct type-top literal-value + :revision revision) + nil))) + (append occs names)))) + + +(defgeneric filter-associations(construct type-top player-top + &key revision) + (:documentation "Returns a list of the form (:type <uri> :value <uri>). + type-identifier is the type of the otherrole and + player-identifier if the otherplayer.") + (:method ((construct TopicC) type-top player-top + &key (revision *TM-REVISION*)) + (declare (Integer revision) + (type (or Null TopicC) type-top player-top)) + (let ((assocs + (associations-of construct nil nil type-top player-top + :revision revision))) + (remove-null ;only assocs with two roles can match! + (map 'list + #'(lambda(assoc) + (when (= (length (roles assoc :revision revision)) 2) + (let* ((other-role + (find-if #'(lambda(role) + (not (eql construct + (player role :revision revision)))) + (roles assoc :revision revision))) + (pred-uri + (when-do type-top (instance-of other-role + :revision revision) + (any-id type-top :revision revision))) + (obj-uri + (when-do player-top (player other-role + :revision revision) + (any-id player-top :revision revision)))) + (when (and pred-uri obj-uri) + (list :type pred-uri + :value obj-uri))))) + assocs))))) (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Sat Nov 27 11:40:38 2010 @@ -92,7 +92,10 @@ next-query (original-query construct) "WHERE"))) (let* ((triples (string-after next-query "WHERE")) (query-tail (parse-where construct triples))) - (or query-tail) ;TODO: process tail-of query, e.g. order by, ... + (when (> (length query-tail) 0) + (error (make-sparql-parser-condition + query-tail (original-query construct) + "The end of the query. Solution sequence modifiers are not supported yet."))) construct)))) @@ -147,7 +150,7 @@ (declare (String query-string) (SPARQL-Query query-object)) ;;TODO: implement - (or query-string query-object)) + ) (defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) @@ -264,8 +267,12 @@ 'sparql-parser-error :message (format nil "Could not cast from ~a to ~a" literal-value literal-type)))) - value)))) - + value)) + (t + (error (make-condition + 'sparql-error + :message (format nil "The type \"~a\" is not supported." + literal-type)))))) (defun separate-literal-lang-or-type (query-string query-object) "A helper function that returns (:next-query string :lang string Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Sat Nov 27 11:40:38 2010 @@ -43,6 +43,7 @@ :FragmentC ;;methods, functions and macros + :get-all-identifiers-of-construct :xtm-id :uri :identified-construct @@ -108,6 +109,8 @@ :get-item-by-item-identifier :get-item-by-locator :get-item-by-content + :get-item-by-any-id + :any-id :string-integer-p :with-revision :get-latest-fragment-of-topic @@ -170,6 +173,7 @@ :invoke-on :names-by-type :occurrences-by-type + :occurrences-by-datatype :characteristics-by-type :occurrences-by-value :names-by-value @@ -1028,6 +1032,11 @@ the TM.")) +(defgeneric any-id (construct &key revision) + (:documentation "Returns any uri of the constructs identifier, except + TopicIdentificationC. The order is: PSIs, SL, II.")) + + ;;; generic functions/accessors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; VersionInfocC @@ -1838,6 +1847,28 @@ (item-identifiers construct :revision revision))) +(defun get-item-by-any-id (id-uri &key (revision d:*TM-REVISION*)) + "Returns a topic or REfifiableConstruct corresponding to the given uri." + (declare (String id-uri) + (Integer revision)) + (or (d:get-item-by-psi id-uri :revision revision) + (get-item-by-item-identifier id-uri :revision revision) + (get-item-by-locator id-uri :revision revision))) + + +(defmethod any-id ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (let ((psi (when-do psis (psis construct :revision revision) + (uri (first psis))))) + (if psi + psi + (let ((sl (when-do sls (locators construct :revision revision) + (uri (first sls))))) + (if sl + sl + (call-next-method)))))) + + (defgeneric names (construct &key revision) (:documentation "Returns the NameC-objects that correspond with the passed construct and the passed version.") @@ -3159,7 +3190,6 @@ construct 'reifier :start-revision revision))) (when assocs ;assocs must be nil or a list with exactly one item (reifier-topic (first assocs)))))) -1 (defgeneric add-item-identifier (construct item-identifier &key revision) @@ -3229,6 +3259,12 @@ construct))) +(defmethod any-id ((construct ReifiableConstructC) &key (revision *TM-REVISION*)) + (declare (Integer revision)) + (when-do iis (item-identifiers construct :revision revision) + (uri (first iis)))) + + (defgeneric add-reifier (construct reifier-topic &key revision) (:documentation "Adds the passed reifier-topic as reifier of the construct. If the construct is already reified by the given topic Modified: trunk/src/model/trivial-queries.lisp ============================================================================== --- trunk/src/model/trivial-queries.lisp (original) +++ trunk/src/model/trivial-queries.lisp Sat Nov 27 11:40:38 2010 @@ -321,6 +321,20 @@ (occurrences-by-value construct filter :revision revision)))) +(defgeneric occurrences-by-datatype (construct datatype &key revision) + (:documentation "Returns all occurrences of the specified datatype.") + (:method ((construct TopicC) datatype &key (revision *TM-REVISION*)) + (declare (type (or Null String) datatype) + (Integer revision)) + (if datatype + (remove-null + (map 'list #'(lambda(occ) + (when (string= (datatype occ) datatype) + occ)) + (occurrences construct :revision revision))) + (occurrences construct :revision revision)))) + + (defgeneric isa (construct type &key revision) (:documentation "Returns all types if the passed construct is of the specified type.")

1 0

[isidorus-cvs] r354 - in trunk/src: ajax/javascripts rest_interface
by Lukas Giessmann 26 Nov '10

26 Nov '10

Author: lgiessmann Date: Fri Nov 26 11:55:18 2010 New Revision: 354 Log: REST-interface: splitted the webserver into a webserver for the UI => RDF/XTM/JSON-handlers and into an atom-webserver Modified: trunk/src/ajax/javascripts/datamodel.js trunk/src/rest_interface/rest-interface.lisp Modified: trunk/src/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Fri Nov 26 11:55:18 2010 @@ -4414,7 +4414,6 @@ } commitDeletedObject(delMessage, function(xhr){ - alert("Objected deleted"); if(type === "Topic"){ $(CLASSES.subPage()).update(); setNaviClasses($(PAGES.home)); @@ -4428,7 +4427,6 @@ else { if(type === "Occurrence"){ objectToDelete.__value__.setValue(""); - objectToDelete.disable(); } else { objectToDelete.__value__.__frames__[0].__content__.setValue(""); @@ -4436,13 +4434,14 @@ objectToDelete.__variants__ = new VariantContainerC(null, objectToDelete); vars.append(objectToDelete.__variants__.getFrame()); vars.remove(); - objectToDelete.disable(); } + objectToDelete.disable(); var ii = objectToDelete.__itemIdentity__; objectToDelete.__itemIdentity__ = new ItemIdentityC(null, objectToDelete); ii.append(objectToDelete.__itemIdentity__.getFrame()); ii.remove(); } } + alert("Objected deleted"); }); } \ No newline at end of file Modified: trunk/src/rest_interface/rest-interface.lisp ============================================================================== --- trunk/src/rest_interface/rest-interface.lisp (original) +++ trunk/src/rest_interface/rest-interface.lisp Fri Nov 26 11:55:18 2010 @@ -25,8 +25,10 @@ :import-tm-feed :read-url :read-fragment-feed - :start-tm-engine - :shutdown-tm-engine + :start-json-engine + :start-atom-engine + :shutdown-json-engine + :shutdown-atom-engine :*json-get-prefix* :*get-rdf-prefix* :*json-commit-url* @@ -61,15 +63,47 @@ (apply page-function (coerce matched-registers 'list)))))))) -(defvar *server-acceptor* nil) +(defvar *json-server-acceptor* nil) +(defvar *atom-server-acceptor* nil) -(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp") - (host-name "localhost") (port 8000)) - "Start the Topic Map Engine on a given port, assuming a given - hostname. Use the repository under repository-path" - (when *server-acceptor* - (error "Ther server is already running")) +(defun start-json-engine (repository-path &key + (host-name "localhost") (port 8000)) + "Start the Topic Maps Engine on a given port, assuming a given + hostname. Use the repository under repository-path. + This function starts only the json/xtm/rdf handlers for the UI, + The atom interface has to be started separately." + (when *json-server-acceptor* + (error "The json-server is already running")) + (setf hunchentoot:*show-lisp-errors-p* t) ;for now + (setf hunchentoot:*hunchentoot-default-external-format* + (flex:make-external-format :utf-8 :eol-style :lf)) + (unless elephant:*store-controller* + (elephant:open-store + (xml-importer:get-store-spec repository-path))) + (set-up-json-interface) + (setf *json-server-acceptor* + (make-instance 'hunchentoot:acceptor :address host-name :port port)) + (setf hunchentoot:*lisp-errors-log-level* :info) + (setf hunchentoot:*message-log-pathname* "./json-hunchentoot-errors.log") + (hunchentoot:start *json-server-acceptor*)) + + +(defun shutdown-json-engine () + "Shut down the Topic Map Engine, only the json part." + (hunchentoot:stop *json-server-acceptor*) + (setf *json-server-acceptor* nil) + (elephant:close-store)) + + +(defun start-atom-engine (repository-path &key (conf-file "atom/conf.lisp") + (host-name "localhost") (port 8001)) + "Start the Topic Maps Engine on a given port, assuming a given + hostname. Use the repository under repository-path. + This function starts only the atom interface. + The json/xtm/rdf interface has to be started separately." + (when *atom-server-acceptor* + (error "The atom-server is already running")) (setf hunchentoot:*show-lisp-errors-p* t) ;for now (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf)) @@ -77,16 +111,17 @@ (unless elephant:*store-controller* (elephant:open-store (xml-importer:get-store-spec repository-path))) - (load conffile) + (load conf-file) (publish-feed atom:*tm-feed*) - (set-up-json-interface) - (setf *server-acceptor* (make-instance 'hunchentoot:acceptor :address host-name :port port)) + (setf *atom-server-acceptor* + (make-instance 'hunchentoot:acceptor :address host-name :port port)) (setf hunchentoot:*lisp-errors-log-level* :info) - (setf hunchentoot:*message-log-pathname* "./hunchentoot-errors.log") - (hunchentoot:start *server-acceptor*)) + (setf hunchentoot:*message-log-pathname* "./atom-hunchentoot-errors.log") + (hunchentoot:start *atom-server-acceptor*)) + -(defun shutdown-tm-engine () - "Shut down the Topic Map Engine" - (hunchentoot:stop *server-acceptor*) - (setf *server-acceptor* nil) +(defun shutdown-atom-engine () + "Shut down the Topic Map Engine, only the atom part." + (hunchentoot:stop *atom-server-acceptor*) + (setf *atom-server-acceptor* nil) (elephant:close-store)) \ No newline at end of file

1 0

[isidorus-cvs] r353 - in trunk/src: json model
by Lukas Giessmann 26 Nov '10

26 Nov '10

Author: lgiessmann Date: Fri Nov 26 10:46:50 2010 New Revision: 353 Log: datamodel: fixed ticket #97 => all classes are finalized manually after they are defined Modified: trunk/src/json/json_exporter.lisp trunk/src/model/datamodel.lisp Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Fri Nov 26 10:46:50 2010 @@ -382,18 +382,12 @@ (tm-ids (concatenate 'string "\"tmIds\":" - (if (in-topicmaps (topic instance)) - (let ((j-tm-ids "[")) - (loop for item in (in-topicmaps (topic instance)) - do (setf j-tm-ids - (concatenate - 'string j-tm-ids - (json:encode-json-to-string - (d:uri (first (d:item-identifiers item - :revision revision)))) - ","))) - (concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]")) - "null")))) + (let ((uris + (loop for tm in (in-topicmaps (topic instance)) + collect (map 'list #'d:uri + (item-identifiers tm :revision revision))))) + (concatenate 'string (json:encode-json-to-string + (remove-if #'null uris))))))) (concatenate 'string "{" main-topic "," topicStubs "," associations "," tm-ids "}"))) Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Fri Nov 26 10:46:50 2010 @@ -280,11 +280,6 @@ (:documentation "An abstract base class for all pointers.")) -(defpclass IdentifierC(PointerC) - () - (:documentation "An abstract base class for all TM-Identifiers.")) - - (defpclass TopicIdentificationC(PointerC) ((xtm-id :initarg :xtm-id :accessor xtm-id @@ -298,6 +293,11 @@ representing one of them.")) +(defpclass IdentifierC(PointerC) + () + (:documentation "An abstract base class for all TM-Identifiers.")) + + (defpclass SubjectLocatorC(IdentifierC) () (:index t) @@ -3159,6 +3159,7 @@ construct 'reifier :start-revision revision))) (when assocs ;assocs must be nil or a list with exactly one item (reifier-topic (first assocs)))))) +1 (defgeneric add-item-identifier (construct item-identifier &key revision) @@ -4417,4 +4418,21 @@ possible-characteristics)))) (when equivalent-construct (merge-constructs (first equivalent-construct) new-characteristic - :revision revision)))))) \ No newline at end of file + :revision revision)))))) + + +;; fixes a bug in elephant, where sb-mop:finalize-inheritance is called too late +(let ((classes + (map 'list #'find-class + (list 'TopicMapConstructC 'PointerC 'IdentifierC 'PersistentIdC + 'ItemIdentifierC 'SubjectLocatorC 'TopicIdentificationC + 'ReifiableConstructC 'TopicC 'TopicMapC 'AssociationC + 'RoleC 'CharacteristicC 'ScopableC 'TypableC 'NameC + 'OccurrenceC 'VariantC 'DatatypableC 'VersionedConstructC + 'VersionedAssociationC 'PointerAssociationC 'ItemIdAssociationC + 'TopicIdAssociationC 'PersistentIdAssociationC + 'SubjectLocatorAssociationC 'ReifierAssociationC + 'CharacteristicAssociationC 'OccurrenceAssociationC + 'NameAssociationC 'VariantAssociationC 'RoleAssociationC + 'ScopeAssociationC 'TypeAssociationC 'PlayerAssociationC)))) + (map 'list #'sb-mop:finalize-inheritance classes)) \ No newline at end of file

1 0

[isidorus-cvs] r352 - in trunk/src: ajax/javascripts rest_interface
by Lukas Giessmann 26 Nov '10

26 Nov '10

Author: lgiessmann Date: Fri Nov 26 06:02:28 2010 New Revision: 352 Log: Isidorus-UI: fixed ticket #95 => deleted objects are not only deleted in the backend, but also in the frontend, so a recommit of the data contains in the UI does not recreate the removed object Modified: trunk/src/ajax/javascripts/datamodel.js trunk/src/rest_interface/set-up-json-interface.lisp Modified: trunk/src/ajax/javascripts/datamodel.js ============================================================================== --- trunk/src/ajax/javascripts/datamodel.js (original) +++ trunk/src/ajax/javascripts/datamodel.js Fri Nov 26 06:02:28 2010 @@ -4421,18 +4421,22 @@ makePage(PAGES.home, ""); } else if (type === "Occurrence" || type === "Name"){ - if(objectToDelete.__owner__.__frames__.length > objectToDelete.__max__ - && objectToDelete.__owner__.__frames__.length > 1){ + if(objectToDelete.__owner__.__frames__.length >= 1 && + objectToDelete.__owner__.__frames__.length > objectToDelete.__min__){ objectToDelete.remove(); } else { - if(type === "Occurrence"){ objectToDelete.__value__.setValue(""); } + if(type === "Occurrence"){ + objectToDelete.__value__.setValue(""); + objectToDelete.disable(); + } else { objectToDelete.__value__.__frames__[0].__content__.setValue(""); var vars = objectToDelete.__variants__; objectToDelete.__variants__ = new VariantContainerC(null, objectToDelete); vars.append(objectToDelete.__variants__.getFrame()); vars.remove(); + objectToDelete.disable(); } var ii = objectToDelete.__itemIdentity__; objectToDelete.__itemIdentity__ = new ItemIdentityC(null, objectToDelete); Modified: trunk/src/rest_interface/set-up-json-interface.lisp ============================================================================== --- trunk/src/rest_interface/set-up-json-interface.lisp (original) +++ trunk/src/rest_interface/set-up-json-interface.lisp Fri Nov 26 06:02:28 2010 @@ -10,9 +10,10 @@ (in-package :rest-interface) ;caching tables -(defparameter *type-table* nil) -(defparameter *instance-table* nil) - +(defparameter *type-table* nil "Cointains integer==OIDs that represent a topic + instance of a vylid type-topic") +(defparameter *instance-table* nil "Cointains integer==OIDs that represent a topic + instance of a valid instance-topic") ;the prefix to get a fragment by the psi -> localhost:8000/json/get/<fragment-psi> (defparameter *json-get-prefix* "/json/get/(.+)$")

1 0

[isidorus-cvs] r351 - in trunk/src: . TM-SPARQL ajax/javascripts
by Lukas Giessmann 26 Nov '10

26 Nov '10

Author: lgiessmann Date: Fri Nov 26 05:09:20 2010 New Revision: 351 Log: Isidorus-UI: fixed ticket #96 => set the timeout to 30 seconds to avoid time-out errors; removed the setting of the exteranl-default-format in isidorus.asd, since it should be set explcitly by the end user Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/ajax/javascripts/constants.js trunk/src/constants.lisp trunk/src/isidorus.asd Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Fri Nov 26 05:09:20 2010 @@ -54,6 +54,11 @@ 'missing-argument-error :message "From SPARQL-Triple(): subject must be set")) :documentation "Represents the subject of an RDF-triple.") + (subject-result :initarg :subject-result + :accessor subject-result + :type T + :initform nil + :documentation "Contains the result of the subject triple elem.") (predicate :initarg :predicate :accessor predicate :type SPARQL-Triple-Elem @@ -62,6 +67,12 @@ 'missing-argument-error :message "From SPARQL-Triple(): predicate must be set")) :documentation "Represents the predicate of an RDF-triple.") + (predicate-result :initarg :predicate-result + :accessor predicate-result + :type T + :initform nil + :documentation "Contains the result of the predicate + triple elem.") (object :initarg :object :accessor object :type SPARQL-Triple-Elem @@ -69,7 +80,12 @@ (make-condition 'missing-argument-error :message "From SPARQL-Triple-(): object must be set")) - :documentation "Represents the subject of an RDF-triple.")) + :documentation "Represents the subject of an RDF-triple.") + (object-result :initarg :object-result + :accessor object-result + :type T + :initform nil + :documentation "Contains the result of the object triple elem.")) (:documentation "Represents an entire RDF-triple.")) @@ -179,6 +195,38 @@ (variables construct)))))) + + +;;TODO: +;; +;; find-triples (subject predicate object) +;; * var var var => return the entire graph (all subjects) +;; * var var object +;; * var predicate var +;; * var predicate object +;; * subject var var +;; * subject var object +;; * subject predicate var +;; * subject predicate object => return subject predicate object if true otherweise nil +;; handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html + +(defgeneric set-result (construct) + (:documentation "Calculates the result of a triple and set all the values in + the passed object.") + (:method ((construct SPARQL-Triple)) + ;;TODO: implement + construct)) + + +(defgeneric find-subject-var-var (construct) + (:documentation "Finds a triple corresponding to the subject and sets + both variables.") + (:method ((construct SPARQL-Triple)) + + )) + + + (defmethod initialize-instance :after ((construct SPARQL-Query) &rest args) (declare (ignorable args)) (parser-start construct (original-query construct)) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Fri Nov 26 05:09:20 2010 @@ -9,7 +9,6 @@ (in-package :TM-SPARQL) - (defun make-sparql-parser-condition(rest-of-query entire-query expected) "Creates a spqrql-parser-error object." (declare (String rest-of-query entire-query expected)) @@ -157,7 +156,12 @@ (SPARQL-Query query-object) (Boolean literal-allowed)) (let ((trimmed-str (cut-comment query-string))) - (cond ((string-starts-with trimmed-str "<") + (cond ((string-starts-with trimmed-str "a ") ;;rdf:type + (list :next-query (cut-comment (subseq trimmed-str 1)) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value *rdf-type*))) + ((string-starts-with trimmed-str "<") (parse-base-suffix-pair trimmed-str query-object)) ((or (string-starts-with trimmed-str "?") (string-starts-with trimmed-str "$")) @@ -441,9 +445,7 @@ (predicate-result (parse-triple-elem (if last-subject trimmed-str - (if last-subject - trimmed-str - (getf subject-result :next-query))) + (getf subject-result :next-query)) construct)) (object-result (parse-triple-elem (getf predicate-result :next-query) construct :literal-allowed t))) Modified: trunk/src/ajax/javascripts/constants.js ============================================================================== --- trunk/src/ajax/javascripts/constants.js (original) +++ trunk/src/ajax/javascripts/constants.js Fri Nov 26 05:09:20 2010 @@ -24,7 +24,7 @@ var SUMMARY_URL = HOST_PREF + "json/summary"; var MARK_AS_DELETED_URL = HOST_PREF + "mark-as-deleted"; var TM_OVERVIEW = HOST_PREF + "json/tmcl/overview/"; -var TIMEOUT = 20000; // const TIMEOUT = 10000 --> "const" doesn't work under IE +var TIMEOUT = 30000; // const TIMEOUT = 10000 --> "const" doesn't work under IE Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Fri Nov 26 05:09:20 2010 @@ -39,6 +39,7 @@ :*rdf-nil* :*rdf-first* :*rdf-rest* + :*rdf-type* :*rdf2tm-object* :*rdf2tm-subject* :*rdf2tm-scope-prefix* @@ -126,6 +127,8 @@ (defparameter *rdf-nil* (concatenate 'string *rdf-ns* "nil")) +(defparameter *rdf-type* (concatenate 'string *rdf-ns* "type")) + (defparameter *rdf-first* (concatenate 'string *rdf-ns* "first")) (defparameter *rdf-rest* (concatenate 'string *rdf-ns* "rest")) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Fri Nov 26 05:09:20 2010 @@ -12,8 +12,8 @@ (:use :asdf :cl)) (in-package :isidorus-system) -(defvar *old-external-format* sb-impl::*default-external-format*) -(setf sb-impl::*default-external-format* :UTF-8) +;(defvar *old-external-format* sb-impl::*default-external-format*) ;;should be set by user +;(setf sb-impl::*default-external-format* :UTF-8) (asdf:defsystem "isidorus" :description "The future ingenious, self-evaluating Lisp TM engine" @@ -230,7 +230,9 @@ :uuid :cl-json)) -(setf sb-impl::*default-external-format* *old-external-format*) +;(setf sb-impl::*default-external-format* *old-external-format*) + + ;; ;; For the package pathnames, create a link from ~/.sbcl/systems

1 0

[isidorus-cvs] r350 - in trunk/src: TM-SPARQL model unit_tests
by Lukas Giessmann 23 Nov '10

23 Nov '10

Author: lgiessmann Date: Tue Nov 23 15:10:48 2010 New Revision: 350 Log: TM-SPARQL: fixed a bug with BASE within the select-where statement; extended the object-model of the sparql-interface; adapted all unit-tests of the sparql-interface Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/model/exceptions.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 Tue Nov 23 15:10:48 2010 @@ -17,9 +17,60 @@ (defvar *empty-label* "_empty_label_symbol") -;(defclass SPARQL-Triple () -; (()) -; ) +(defclass SPARQL-Triple-Elem() + ((elem-type :initarg :elem-type + :reader elem-type + :type Symbol + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple-Elem(): elem-type must be set")) + :documentation "Contains information about the type of this element + possible values are 'IRI, 'VARIABLE, or 'LITERAL") + (value :initarg :value + :accessor value + :type T + :initform nil + :documentation "Contains the actual value of any type.") + (literal-lang :initarg :literal-lang + :accessor literal-lang + :initform nil + :type String + :documentation "Contains the @lang attribute of a literal") + (literal-type :initarg :literal-type + :accessor literal-type + :type String + :initform nil + :documentation "Contains the datatype of the literal, e.g. xml:string")) + (:documentation "Represents one element of an RDF-triple.")) + + +(defclass SPARQL-Triple() + ((subject :initarg :subject + :accessor subject + :type SPARQL-Triple-Elem + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple(): subject must be set")) + :documentation "Represents the subject of an RDF-triple.") + (predicate :initarg :predicate + :accessor predicate + :type SPARQL-Triple-Elem + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple(): predicate must be set")) + :documentation "Represents the predicate of an RDF-triple.") + (object :initarg :object + :accessor object + :type SPARQL-Triple-Elem + :initform (error + (make-condition + 'missing-argument-error + :message "From SPARQL-Triple-(): object must be set")) + :documentation "Represents the subject of an RDF-triple.")) + (:documentation "Represents an entire RDF-triple.")) (defclass SPARQL-Query () @@ -53,17 +104,36 @@ :type String :initform nil :documentation "Contains the last set base-value.") - (select-statements :initarg :select-statements - :accessor select-statements ;this value is only for - ;internal purposes purposes - ;and mustn't be reset - :type List - :initform nil - :documentation "A list of the form ((:statement 'statement' - :value value-object))")) + (select-group :initarg :select-group + :accessor select-group ;this value is only for + ;internal purposes purposes + ;and mustn't be reset + :type List + :initform nil + :documentation "Contains a SPARQL-Group that represents + the entire inner select-where statement.")) (:documentation "This class represents the entire request.")) +(defgeneric add-triple (construct triple) + (:documentation "Adds a triple object to the select-group list.") + (:method ((construct SPARQL-Query) (triple SPARQL-Triple)) + (push triple (slot-value construct 'select-group)))) + + +(defgeneric (setf elem-type) (construct elem-type) + (:documentation "Sets the passed elem-type on the passed cosntruct.") + (:method ((construct SPARQL-Triple-Elem) (elem-type Symbol)) + (unless (and (eql elem-type 'IRI) + (eql elem-type 'VARIABLE) + (eql elem-type 'LITERAL)) + (error (make-condition + 'bad-argument-error + :message (format nil "Expected a one of the symbols ~a, but get ~a~%" + '('IRI 'VARIABLE 'LITERAL) elem-type)))) + (setf (slot-value construct 'elem-type) elem-type))) + + (defgeneric add-prefix (construct prefix-label prefix-value) (:documentation "Adds the new prefix tuple to the list of all existing. If there already exists a tuple with the same label Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Nov 23 15:10:48 2010 @@ -109,21 +109,23 @@ query-tail)))) -(defgeneric parse-group (construct query-string &key last-subject values filters) +(defgeneric parse-group (construct query-string &key last-subject) (:documentation "The entry-point for the parsing of a {} statement.") (:method ((construct SPARQL-Query) (query-string String) - &key (last-subject nil) (values nil) (filters nil)) - (declare (List last-subject values filters)) + &key (last-subject nil)) + (declare (type (or Null SPARQL-Triple-Elem) last-subject)) (let ((trimmed-str (cut-comment query-string))) (cond ((string-starts-with trimmed-str "BASE") (parse-base construct (string-after trimmed-str "BASE") - #'parse-where)) + #'(lambda(constr query-str) + (parse-group constr query-str + :last-subject last-subject)))) ((string-starts-with trimmed-str "{") (error (make-sparql-parser-condition trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "FILTER") - nil) ;TODO: parse-filter and store it + nil) ;TODO: parse-filter and store it in construct => extend class ((string-starts-with trimmed-str "OPTIONAL") (error (make-sparql-parser-condition trimmed-str (original-query construct) @@ -133,12 +135,10 @@ 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 + ;TODO: invoke filters with all results on construct in initialize :after (subseq trimmed-str 1)) (t - ;(let ((result - (parse-triple construct trimmed-str :values values - :filters filters :last-subject last-subject)))))) + (parse-triple construct trimmed-str :last-subject last-subject)))))) (defun parse-filter (query-string query-object) @@ -152,9 +152,7 @@ (defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) - "A helper function to parse a subject or predicate of an RDF triple. - Returns an entry of the form (:value (:value string :type <'VAR|'IRI|'LITERAL>) - :next-query string)." + "A helper function to parse a subject or predicate of an RDF triple." (declare (String query-string) (SPARQL-Query query-object) (Boolean literal-allowed)) @@ -165,8 +163,9 @@ (string-starts-with trimmed-str "$")) (let ((result (parse-variable-name trimmed-str query-object))) (list :next-query (cut-comment (getf result :next-query)) - :value (list :value (getf result :value) - :type 'VAR)))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'VARIABLE + :value (getf result :value))))) (t (if (or (string-starts-with-digit trimmed-str) (string-starts-with trimmed-str "\"") @@ -202,10 +201,11 @@ ((string-starts-with-digit trimmed-str) (parse-literal-number-value trimmed-str query-object))))) (list :next-query (getf value-type-lang-query :next-query) - :value (list :value (getf value-type-lang-query :value) - :literal-type (getf value-type-lang-query :type) - :type 'LITERAL - :literal-lang (getf value-type-lang-query :lang))))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'LITERAL + :value (getf value-type-lang-query :value) + :literal-lang (getf value-type-lang-query :lang) + :literal-type (getf value-type-lang-query :type))))) (defun parse-literal-string-value (query-string query-object) @@ -389,7 +389,9 @@ (getf result :value)))) (next-query (getf result :next-query))) (list :next-query (cut-comment next-query) - :value (list :value result-uri :type 'IRI)))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value result-uri)))) (defun parse-prefix-suffix-pair(query-string query-object) @@ -423,20 +425,15 @@ (string-after trimmed-str (concatenate 'string prefix ":" suffix))) - :value (list :value full-url - :type 'IRI)))) + :value (make-instance 'SPARQL-Triple-Elem + :elem-type 'IRI + :value full-url)))) -(defgeneric parse-triple (construct query-string - &key last-subject values filters) - (:documentation "Parses a triple within a trippel group and returns a - a list of the form (:next-query :values (:subject - (:type <'VAR|'IRI> :value string) :predicate - (:type <'VAR|'IRI> :value string) - :object (:type <'VAR|'IRI|'LITERAL> :value string))).") - (:method ((construct SPARQL-Query) (query-string String) - &key (last-subject nil) (values nil) (filters nil)) - (declare (List last-subject filters values)) +(defgeneric parse-triple (construct query-string &key last-subject) + (:documentation "Parses a triple within a trippel group.") + (:method ((construct SPARQL-Query) (query-string String) &key (last-subject nil)) + (declare (type (or Null SPARQL-Triple-Elem) last-subject)) (let* ((trimmed-str (cut-comment query-string)) (subject-result (if last-subject ;;is used after a ";" last-subject @@ -444,28 +441,27 @@ (predicate-result (parse-triple-elem (if last-subject trimmed-str - (getf subject-result :next-query)) + (if last-subject + trimmed-str + (getf subject-result :next-query))) construct)) (object-result (parse-triple-elem (getf predicate-result :next-query) - construct :literal-allowed t)) - (all-values (append values - (list - (list :subject (getf subject-result :value) - :predicate (getf predicate-result :value) - :object (getf object-result :value)))))) + construct :literal-allowed t))) + (add-triple construct + (make-instance 'SPARQL-Triple + :subject (if last-subject + last-subject + (getf subject-result :value)) + :predicate (getf predicate-result :value) + :object (getf object-result :value))) (let ((tr-str (cut-comment (getf object-result :next-query)))) (cond ((string-starts-with tr-str ";") - (parse-group - construct (subseq tr-str 1) - :last-subject (list :value (getf subject-result :value)) - :values all-values - :filters filters)) + (parse-group construct (subseq tr-str 1) + :last-subject (getf subject-result :value))) ((string-starts-with tr-str ".") - (parse-group construct (subseq tr-str 1) :values all-values - :filters filters)) + (parse-group construct (subseq tr-str 1))) ((string-starts-with tr-str "}") - (parse-group construct tr-str :values all-values - :filters filters))))))) + (parse-group construct tr-str))))))) (defgeneric parse-variables (construct query-string) Modified: trunk/src/model/exceptions.lisp ============================================================================== --- trunk/src/model/exceptions.lisp (original) +++ trunk/src/model/exceptions.lisp Tue Nov 23 15:10:48 2010 @@ -18,11 +18,18 @@ :missing-argument-error :tm-reference-error :bad-type-error - :sparql-parser-error)) + :sparql-parser-error + :bad-argument-error)) (in-package :exceptions) +(define-condition bad-argument-error(error) + ((message + :initarg :message + :accessor message))) + + (define-condition sparql-parser-error(error) ((message :initarg :message Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue Nov 23 15:10:48 2010 @@ -174,60 +174,59 @@ (is-true dummy-object) (let ((result (tm-sparql::parse-literal-elem query-1 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) + (is (string= (tm-sparql::value (getf result :value)) "literal-value")) - (is (string= (getf (getf result :value) :literal-lang) + (is (string= (tm-sparql::literal-lang (getf result :value)) "de")) - (is (string= (getf (getf result :value) :literal-type) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-string*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (let ((result (tm-sparql::parse-literal-elem query-2 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (eql (getf (getf result :value) :value) t)) - (is-false (getf (getf result :value) :literal-lang)) - (is (string= (getf (getf result :value) :literal-type) + (is (eql (tm-sparql::value (getf result :value)) t)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-boolean*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (let ((result (tm-sparql::parse-literal-elem query-3 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (eql (getf (getf result :value) :value) nil)) - (is-false (getf (getf result :value) :literal-lang)) - (is (string= (getf (getf result :value) :literal-type) + (is (eql (tm-sparql::value (getf result :value)) nil)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-boolean*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (let ((result (tm-sparql::parse-literal-elem query-4 dummy-object))) (is (string= (getf result :next-query) (string #\tab))) - (is (= (getf (getf result :value) :value) 1234.43e10)) - (is-false (getf (getf result :value) :literal-lang)) - (is (string= (getf (getf result :value) :literal-type) + (is (= (tm-sparql::value (getf result :value)) 1234.43e10)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-double*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (let ((result (tm-sparql::parse-literal-elem query-5 dummy-object))) (is (string= (getf result :next-query) ";")) - (is (eql (getf (getf result :value) :value) t)) - (is-false (getf (getf result :value) :literal-lang)) - (is (string= (getf (getf result :value) :literal-type) + (is (eql (tm-sparql::value (getf result :value)) t)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-boolean*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (let ((result (tm-sparql::parse-literal-elem query-6 dummy-object))) (is (string= (getf result :next-query) (concatenate 'string "." (string #\newline)))) - (is (= (getf (getf result :value) :value) 123.4)) - (is-false (getf (getf result :value) :literal-lang)) - (is (string= (getf (getf result :value) :literal-type) + (is (eql (tm-sparql::value (getf result :value)) 123.4)) + (is-false (tm-sparql::literal-lang (getf result :value))) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-double*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (let ((result (tm-sparql::parse-literal-elem query-7 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) + (is (string= (tm-sparql::value (getf result :value)) "Just a test literal with some \\\"quoted\\\" words!")) - (is (string= (getf (getf result :value) :literal-lang) - "en")) - (is (string= (getf (getf result :value) :literal-type) + (is (string= (tm-sparql::literal-lang (getf result :value)) "en")) + (is (string= (tm-sparql::literal-type (getf result :value)) *xml-string*)) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (is (eql (tm-sparql::elem-type (getf result :value)) 'TM-SPARQL::LITERAL))) (signals sparql-parser-error (tm-sparql::parse-literal-elem query-8 dummy-object)) (signals sparql-parser-error @@ -245,36 +244,42 @@ (query-7 "pref:suffix}") (query-8 "preff:suffix}") (dummy-object (make-instance 'SPARQL-Query :query "" - :base "http://base.value"))) + :base "http://base.value")) + (var 'TM-SPARQL::VARIABLE) + (iri 'TM-SPARQL::IRI)) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value") (let ((result (tm-sparql::parse-triple-elem query-1 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) "var1")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (is (string= (tm-sparql::value (getf result :value)) "var1")) + (is (eql (tm-sparql::elem-type (getf result :value)) var))) (let ((result (tm-sparql::parse-triple-elem query-2 dummy-object))) (is (string= (getf result :next-query) ";")) - (is (string= (getf (getf result :value) :value) "var2")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (is (string= (tm-sparql::value (getf result :value)) "var2")) + (is (eql (tm-sparql::elem-type (getf result :value)) var))) (let ((result (tm-sparql::parse-triple-elem query-3 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (string= (getf (getf result :value) :value) "var3")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (is (string= (tm-sparql::value (getf result :value)) "var3")) + (is (eql (tm-sparql::elem-type (getf result :value)) var))) (let ((result (tm-sparql::parse-triple-elem query-4 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) "http://full.url")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://full.url")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (let ((result (tm-sparql::parse-triple-elem query-5 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (string= (getf (getf result :value) :value) "http://base.value/url-suffix")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://base.value/url-suffix")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (let ((result (tm-sparql::parse-triple-elem query-6 dummy-object))) (is (string= (getf result :next-query) ".")) - (is (string= (getf (getf result :value) :value) "http://prefix.value/suffix")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://prefix.value/suffix")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (let ((result (tm-sparql::parse-triple-elem query-7 dummy-object))) (is (string= (getf result :next-query) "}")) - (is (string= (getf (getf result :value) :value) "http://prefix.value/suffix")) - (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (is (string= (tm-sparql::value (getf result :value)) + "http://prefix.value/suffix")) + (is (eql (tm-sparql::elem-type (getf result :value)) iri))) (signals sparql-parser-error (tm-sparql::parse-triple-elem query-8 dummy-object)))) @@ -286,141 +291,121 @@ (query-2 "<subject> pref:predicate 1234.5e12}") (query-3 "pref:subject ?predicate 'literal'@en}") (dummy-object (make-instance 'SPARQL-Query :query "" - :base "http://base.value/"))) + :base "http://base.value/")) + (var 'TM-SPARQL::VARIABLE) + (lit 'TM-SPARQL::LITERAL) + (iri 'TM-SPARQL::IRI)) (is-true dummy-object) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") - (let ((result (tm-sparql::parse-triple dummy-object query-1))) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 1)) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) - "subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) - "predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :object) :value) - "object"))) - (let ((result (tm-sparql::parse-triple dummy-object query-2))) - (is (string= (getf result :next-query) "}")) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (string= (tm-sparql::parse-triple dummy-object query-1) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 1)) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "subject")) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "predicate")) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::object elem)) "object"))) + (is (string= (tm-sparql::parse-triple dummy-object query-2) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 2)) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://prefix.value/predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (= (getf (getf (first (getf result :values)) :object) :value) - 1234.5e12)) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-type) - *xml-double*))) - (let ((result (tm-sparql::parse-triple dummy-object query-3))) - (is (string= (getf result :next-query) "}")) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (= (tm-sparql::value (tm-sparql::object elem)) 1234.5e12)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-double*)) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (is (string= (tm-sparql::parse-triple dummy-object query-3) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 3)) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://prefix.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::VAR)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) var)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (string= (getf (getf (first (getf result :values)) :object) :value) - "literal")) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-lang) - "en"))))) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (string= (tm-sparql::value (tm-sparql::object elem)) "literal")) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-string*)) + (is (string= (tm-sparql::literal-lang (tm-sparql::object elem)) "en"))))) -(test test-parse-triple-2 +(test test-parse-group-2 "Test various functionality of several functions responsible for parsing the SELECT-WHERE-statement." (let ((query-4 (concatenate 'string "<subject> <predicate> '''true'''^^" *xml-boolean* "; pref:predicate-2 \"12\"^^" *xml-integer* "}")) (query-5 (concatenate 'string "<subject> <predicate> '''false'''^^" - *xml-boolean* "; pref:predicate-2 \"abc\"^^" + *xml-boolean* "; BASE <http://new.base/>" + "<predicate-2> \"abc\"^^" *xml-string* "}")) (dummy-object (make-instance 'SPARQL-Query :query "" - :base "http://base.value/"))) + :base "http://base.value/")) + (lit 'TM-SPARQL::LITERAL) + (iri 'TM-SPARQL::IRI)) (is-true dummy-object) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") - (let ((result (tm-sparql::parse-triple dummy-object query-4 nil))) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (string= (tm-sparql::parse-group dummy-object query-4) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 2)) + (let ((elem (second (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://base.value/predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (eql (getf (getf (first (getf result :values)) :object) :value) t)) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-type) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (eql (tm-sparql::value (tm-sparql::object elem)) t)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) *xml-boolean*)) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (second (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :subject) :value) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (second (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://prefix.value/predicate-2")) - (is (eql (getf (getf (second (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (= (getf (getf (second (getf result :values)) :object) :value) 12)) - (is (string= (getf (getf (second (getf result :values)) :object) - :literal-type) - *xml-integer*))) - (let ((result (tm-sparql::parse-triple dummy-object query-5 nil))) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (first (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :subject) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (= (tm-sparql::value (tm-sparql::object elem)) 12)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-integer*)) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (is (string= "http://base.value/" (tm-sparql::base-value dummy-object))) + (is (string= (tm-sparql::parse-group dummy-object query-5) "")) + (is (= (length (tm-sparql::select-group dummy-object)) 4)) + (is (string= "http://new.base/" (tm-sparql::base-value dummy-object))) + (let ((elem (second (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (first (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) "http://base.value/predicate")) - (is (eql (getf (getf (first (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (eql (getf (getf (first (getf result :values)) :object) :value) nil)) - (is (string= (getf (getf (first (getf result :values)) :object) - :literal-type) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (eql (tm-sparql::value (tm-sparql::object elem)) nil)) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) *xml-boolean*)) - (is (string= (getf result :next-query) "}")) - (is (= (length (getf result :values)) 2)) - (is (eql (getf (getf (second (getf result :values)) :subject) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :subject) :value) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))) + (let ((elem (first (tm-sparql::select-group dummy-object)))) + (is (eql (tm-sparql::elem-type (tm-sparql::subject elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::subject elem)) "http://base.value/subject")) - (is (eql (getf (getf (second (getf result :values)) :predicate) :type) - 'TM-SPARQL::IRI)) - (is (string= (getf (getf (second (getf result :values)) :predicate) :value) - "http://prefix.value/predicate-2")) - (is (eql (getf (getf (second (getf result :values)) :object) :type) - 'TM-SPARQL::LITERAL)) - (is (string= (getf (getf (second (getf result :values)) :object) :value) - "abc")) - (is (string= (getf (getf (second (getf result :values)) :object) - :literal-type) - *xml-string*))))) - + (is (eql (tm-sparql::elem-type (tm-sparql::predicate elem)) iri)) + (is (string= (tm-sparql::value (tm-sparql::predicate elem)) + "http://new.base/predicate-2")) + (is (eql (tm-sparql::elem-type (tm-sparql::object elem)) lit)) + (is (string= (tm-sparql::value (tm-sparql::object elem)) "abc")) + (is (string= (tm-sparql::literal-type (tm-sparql::object elem)) + *xml-string*)) + (is-false (tm-sparql::literal-lang (tm-sparql::object elem)))))) (defun run-sparql-tests ()

1 0

[isidorus-cvs] r349 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 23 Nov '10

23 Nov '10

Author: lgiessmann Date: Tue Nov 23 11:45:57 2010 New Revision: 349 Log: TM-SPARQL: fixed a recursion bug when parsing SELECT-WHERE-statements Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.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 Tue Nov 23 11:45:57 2010 @@ -16,20 +16,13 @@ (defvar *empty-label* "_empty_label_symbol") -(defclass Variable-Container () - ((variables :initarg :variables - :accessor variables ;this value is only for internal purposes - ;purposes and mustn't be reset - :type List - :initform nil - :documentation "A list of the form ((:variable var-name - :value value-object)), that contains tuples - for each variable and its result.")) - (:documentation "This class is used to store all variable in a WHERE{} - statement")) + +;(defclass SPARQL-Triple () +; (()) +; ) -(defclass SPARQL-Query (Variable-Container) +(defclass SPARQL-Query () ((original-query :initarg :query :accessor original-query ;this value is only for internal ;purposes and mustn't be reset @@ -39,6 +32,14 @@ 'missing-argument-error :message "From TM-Query(): original-query must be set")) :documentation "Containst the original received querry as string") + (variables :initarg :variables + :accessor variables ;this value is only for internal purposes + ;purposes and mustn't be reset + :type List + :initform nil + :documentation "A list of the form ((:variable var-name + :value value-object)), that contains tuples + for each selected variable and its result.") (prefixes :initarg :prefixes :accessor prefixes ;this value is only for internal purposes ;purposes and mustn't be reset @@ -97,7 +98,7 @@ If a variable-already exists the existing entry will be overwritten. An entry is of the form (:variable string :value any-type).") - (:method ((construct Variable-Container) (variable-name String) variable-value) + (:method ((construct SPARQL-Query) (variable-name String) variable-value) (let ((existing-tuple (find-if #'(lambda(x) (string= (getf x :variable) variable-name)) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Tue Nov 23 11:45:57 2010 @@ -104,15 +104,16 @@ (unless (string-starts-with trimmed-str "{") (error (make-sparql-parser-condition trimmed-str (original-query construct) "{"))) - (let ((query-tail (parse-group construct (subseq trimmed-str 1) nil nil))) + (let ((query-tail (parse-group construct (subseq trimmed-str 1)))) ;TODO: process query-tail query-tail)))) -(defgeneric parse-group (construct query-string values filters) +(defgeneric parse-group (construct query-string &key last-subject values filters) (:documentation "The entry-point for the parsing of a {} statement.") (:method ((construct SPARQL-Query) (query-string String) - (values List) (filters List)) + &key (last-subject nil) (values nil) (filters nil)) + (declare (List last-subject values filters)) (let ((trimmed-str (cut-comment query-string))) (cond ((string-starts-with trimmed-str "BASE") (parse-base construct (string-after trimmed-str "BASE") @@ -122,7 +123,7 @@ trimmed-str (original-query construct) "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "FILTER") - nil) ;TODO: call parse-group with added filter + nil) ;TODO: parse-filter and store it ((string-starts-with trimmed-str "OPTIONAL") (error (make-sparql-parser-condition trimmed-str (original-query construct) @@ -135,10 +136,19 @@ ;TODO: invoke filters with all results (subseq trimmed-str 1)) (t - (let ((result (parse-triple construct trimmed-str values))) - (parse-group construct (getf result :next-query) - (getf result :values) filters))))))) - + ;(let ((result + (parse-triple construct trimmed-str :values values + :filters filters :last-subject last-subject)))))) + + +(defun parse-filter (query-string query-object) + "A helper functions that returns a filter and the next-query string + in the form (:next-query string :filter object)." + ;; !, +, -, *, /, (, ), &&, ||, =, !=, <, >, >=, <=, REGEX(string, pattern) + (declare (String query-string) + (SPARQL-Query query-object)) + ;;TODO: implement + (or query-string query-object)) (defun parse-triple-elem (query-string query-object &key (literal-allowed nil)) @@ -417,15 +427,16 @@ :type 'IRI)))) -(defgeneric parse-triple (construct query-string values &key last-subject) +(defgeneric parse-triple (construct query-string + &key last-subject values filters) (:documentation "Parses a triple within a trippel group and returns a a list of the form (:next-query :values (:subject (:type <'VAR|'IRI> :value string) :predicate (:type <'VAR|'IRI> :value string) :object (:type <'VAR|'IRI|'LITERAL> :value string))).") - (:method ((construct SPARQL-Query) (query-string String) (values List) - &key (last-subject nil)) - (declare (List last-subject)) + (:method ((construct SPARQL-Query) (query-string String) + &key (last-subject nil) (values nil) (filters nil)) + (declare (List last-subject filters values)) (let* ((trimmed-str (cut-comment query-string)) (subject-result (if last-subject ;;is used after a ";" last-subject @@ -444,14 +455,17 @@ :object (getf object-result :value)))))) (let ((tr-str (cut-comment (getf object-result :next-query)))) (cond ((string-starts-with tr-str ";") - (parse-triple construct (subseq tr-str 1) all-values - :last-subject (list :value - (getf subject-result :value)))) + (parse-group + construct (subseq tr-str 1) + :last-subject (list :value (getf subject-result :value)) + :values all-values + :filters filters)) ((string-starts-with tr-str ".") - (parse-triple construct (subseq tr-str 1) all-values)) - ((string-starts-with tr-str "}") ;no other triples follows - (list :next-query tr-str - :values all-values))))))) + (parse-group construct (subseq tr-str 1) :values all-values + :filters filters)) + ((string-starts-with tr-str "}") + (parse-group construct tr-str :values all-values + :filters filters))))))) (defgeneric parse-variables (construct query-string) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Tue Nov 23 11:45:57 2010 @@ -17,7 +17,9 @@ :sparql-tests :test-prefix-and-base :test-parse-literals - :test-parse-triple-elem)) + :test-parse-triple-elem + :test-parse-group-1 + :test-parse-group-2)) (in-package :sparql-test) @@ -287,7 +289,7 @@ :base "http://base.value/"))) (is-true dummy-object) (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") - (let ((result (tm-sparql::parse-triple dummy-object query-1 nil))) + (let ((result (tm-sparql::parse-triple dummy-object query-1))) (is (string= (getf result :next-query) "}")) (is (= (length (getf result :values)) 1)) (is (eql (getf (getf (first (getf result :values)) :subject) :type) @@ -302,7 +304,7 @@ 'TM-SPARQL::VAR)) (is (string= (getf (getf (first (getf result :values)) :object) :value) "object"))) - (let ((result (tm-sparql::parse-triple dummy-object query-2 nil))) + (let ((result (tm-sparql::parse-triple dummy-object query-2))) (is (string= (getf result :next-query) "}")) (is (eql (getf (getf (first (getf result :values)) :subject) :type) 'TM-SPARQL::IRI)) @@ -319,7 +321,7 @@ (is (string= (getf (getf (first (getf result :values)) :object) :literal-type) *xml-double*))) - (let ((result (tm-sparql::parse-triple dummy-object query-3 nil))) + (let ((result (tm-sparql::parse-triple dummy-object query-3))) (is (string= (getf result :next-query) "}")) (is (eql (getf (getf (first (getf result :values)) :subject) :type) 'TM-SPARQL::IRI)) @@ -338,7 +340,7 @@ "en"))))) -(test test-parse-group-2 +(test test-parse-triple-2 "Test various functionality of several functions responsible for parsing the SELECT-WHERE-statement." (let ((query-4 (concatenate 'string "<subject> <predicate> '''true'''^^"

1 0

[isidorus-cvs] r348 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 22 Nov '10

22 Nov '10

Author: lgiessmann Date: Mon Nov 22 15:54:02 2010 New Revision: 348 Log: TM-SPARQL: added some unit-tests for parsing of more triples in a statment => fixed a bug when collecting the values of those triples Modified: trunk/src/TM-SPARQL/sparql_parser.lisp trunk/src/unit_tests/sparql_test.lisp Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Mon Nov 22 15:54:02 2010 @@ -419,9 +419,10 @@ (defgeneric parse-triple (construct query-string values &key last-subject) (:documentation "Parses a triple within a trippel group and returns a - a list of the form (:next-query :subject (:type <'VAR|'IRI> - :value string) :predicate (:type <'VAR|'IRI> :value string) - :object (:type <'VAR|'IRI|'LITERAL> :value string)).") + a list of the form (:next-query :values (:subject + (:type <'VAR|'IRI> :value string) :predicate + (:type <'VAR|'IRI> :value string) + :object (:type <'VAR|'IRI|'LITERAL> :value string))).") (:method ((construct SPARQL-Query) (query-string String) (values List) &key (last-subject nil)) (declare (List last-subject)) @@ -437,9 +438,10 @@ (object-result (parse-triple-elem (getf predicate-result :next-query) construct :literal-allowed t)) (all-values (append values - (list :subject (getf subject-result :value) - :predicate (getf predicate-result :value) - :object (getf object-result :value))))) + (list + (list :subject (getf subject-result :value) + :predicate (getf predicate-result :value) + :object (getf object-result :value)))))) (let ((tr-str (cut-comment (getf object-result :next-query)))) (cond ((string-starts-with tr-str ";") (parse-triple construct (subseq tr-str 1) all-values Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Mon Nov 22 15:54:02 2010 @@ -276,5 +276,150 @@ (signals sparql-parser-error (tm-sparql::parse-triple-elem query-8 dummy-object)))) + +(test test-parse-group-1 + "Test various functionality of several functions responsible for parsing + the SELECT-WHERE-statement." + (let ((query-1 "?subject ?predicate $object }") + (query-2 "<subject> pref:predicate 1234.5e12}") + (query-3 "pref:subject ?predicate 'literal'@en}") + (dummy-object (make-instance 'SPARQL-Query :query "" + :base "http://base.value/"))) + (is-true dummy-object) + (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") + (let ((result (tm-sparql::parse-triple dummy-object query-1 nil))) + (is (string= (getf result :next-query) "}")) + (is (= (length (getf result :values)) 1)) + (is (eql (getf (getf (first (getf result :values)) :subject) :type) + 'TM-SPARQL::VAR)) + (is (string= (getf (getf (first (getf result :values)) :subject) :value) + "subject")) + (is (eql (getf (getf (first (getf result :values)) :predicate) :type) + 'TM-SPARQL::VAR)) + (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + "predicate")) + (is (eql (getf (getf (first (getf result :values)) :object) :type) + 'TM-SPARQL::VAR)) + (is (string= (getf (getf (first (getf result :values)) :object) :value) + "object"))) + (let ((result (tm-sparql::parse-triple dummy-object query-2 nil))) + (is (string= (getf result :next-query) "}")) + (is (eql (getf (getf (first (getf result :values)) :subject) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :subject) :value) + "http://base.value/subject")) + (is (eql (getf (getf (first (getf result :values)) :predicate) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + "http://prefix.value/predicate")) + (is (eql (getf (getf (first (getf result :values)) :object) :type) + 'TM-SPARQL::LITERAL)) + (is (= (getf (getf (first (getf result :values)) :object) :value) + 1234.5e12)) + (is (string= (getf (getf (first (getf result :values)) :object) + :literal-type) + *xml-double*))) + (let ((result (tm-sparql::parse-triple dummy-object query-3 nil))) + (is (string= (getf result :next-query) "}")) + (is (eql (getf (getf (first (getf result :values)) :subject) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :subject) :value) + "http://prefix.value/subject")) + (is (eql (getf (getf (first (getf result :values)) :predicate) :type) + 'TM-SPARQL::VAR)) + (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + "predicate")) + (is (eql (getf (getf (first (getf result :values)) :object) :type) + 'TM-SPARQL::LITERAL)) + (is (string= (getf (getf (first (getf result :values)) :object) :value) + "literal")) + (is (string= (getf (getf (first (getf result :values)) :object) + :literal-lang) + "en"))))) + + +(test test-parse-group-2 + "Test various functionality of several functions responsible for parsing + the SELECT-WHERE-statement." + (let ((query-4 (concatenate 'string "<subject> <predicate> '''true'''^^" + *xml-boolean* "; pref:predicate-2 \"12\"^^" + *xml-integer* "}")) + (query-5 (concatenate 'string "<subject> <predicate> '''false'''^^" + *xml-boolean* "; pref:predicate-2 \"abc\"^^" + *xml-string* "}")) + (dummy-object (make-instance 'SPARQL-Query :query "" + :base "http://base.value/"))) + (is-true dummy-object) + (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value/") + (let ((result (tm-sparql::parse-triple dummy-object query-4 nil))) + (is (string= (getf result :next-query) "}")) + (is (= (length (getf result :values)) 2)) + (is (eql (getf (getf (first (getf result :values)) :subject) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :subject) :value) + "http://base.value/subject")) + (is (eql (getf (getf (first (getf result :values)) :predicate) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + "http://base.value/predicate")) + (is (eql (getf (getf (first (getf result :values)) :object) :type) + 'TM-SPARQL::LITERAL)) + (is (eql (getf (getf (first (getf result :values)) :object) :value) t)) + (is (string= (getf (getf (first (getf result :values)) :object) + :literal-type) + *xml-boolean*)) + (is (string= (getf result :next-query) "}")) + (is (= (length (getf result :values)) 2)) + (is (eql (getf (getf (second (getf result :values)) :subject) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (second (getf result :values)) :subject) :value) + "http://base.value/subject")) + (is (eql (getf (getf (second (getf result :values)) :predicate) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (second (getf result :values)) :predicate) :value) + "http://prefix.value/predicate-2")) + (is (eql (getf (getf (second (getf result :values)) :object) :type) + 'TM-SPARQL::LITERAL)) + (is (= (getf (getf (second (getf result :values)) :object) :value) 12)) + (is (string= (getf (getf (second (getf result :values)) :object) + :literal-type) + *xml-integer*))) + (let ((result (tm-sparql::parse-triple dummy-object query-5 nil))) + (is (string= (getf result :next-query) "}")) + (is (= (length (getf result :values)) 2)) + (is (eql (getf (getf (first (getf result :values)) :subject) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :subject) :value) + "http://base.value/subject")) + (is (eql (getf (getf (first (getf result :values)) :predicate) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (first (getf result :values)) :predicate) :value) + "http://base.value/predicate")) + (is (eql (getf (getf (first (getf result :values)) :object) :type) + 'TM-SPARQL::LITERAL)) + (is (eql (getf (getf (first (getf result :values)) :object) :value) nil)) + (is (string= (getf (getf (first (getf result :values)) :object) + :literal-type) + *xml-boolean*)) + (is (string= (getf result :next-query) "}")) + (is (= (length (getf result :values)) 2)) + (is (eql (getf (getf (second (getf result :values)) :subject) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (second (getf result :values)) :subject) :value) + "http://base.value/subject")) + (is (eql (getf (getf (second (getf result :values)) :predicate) :type) + 'TM-SPARQL::IRI)) + (is (string= (getf (getf (second (getf result :values)) :predicate) :value) + "http://prefix.value/predicate-2")) + (is (eql (getf (getf (second (getf result :values)) :object) :type) + 'TM-SPARQL::LITERAL)) + (is (string= (getf (getf (second (getf result :values)) :object) :value) + "abc")) + (is (string= (getf (getf (second (getf result :values)) :object) + :literal-type) + *xml-string*))))) + + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0

[isidorus-cvs] r347 - in trunk/src: TM-SPARQL unit_tests
by Lukas Giessmann 22 Nov '10

22 Nov '10

Author: lgiessmann Date: Mon Nov 22 14:47:01 2010 New Revision: 347 Log: TM-SPARQL: added some unit-tests for parsing variables and IRIs in the SELECT-WHERE-statement => fixed some bugs Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.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 Mon Nov 22 14:47:01 2010 @@ -86,8 +86,8 @@ (loop for entry in (prefixes construct) when (string-starts-with string-with-prefix (concatenate 'string (getf entry :label) ":")) - return (concatenate - 'string (getf entry :value) ":" + return (concatenate-uri + (getf entry :value) (string-after string-with-prefix (concatenate 'string (getf entry :label) ":")))))) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Mon Nov 22 14:47:01 2010 @@ -154,7 +154,7 @@ ((or (string-starts-with trimmed-str "?") (string-starts-with trimmed-str "$")) (let ((result (parse-variable-name trimmed-str query-object))) - (list :next-query (getf result :next-query) + (list :next-query (cut-comment (getf result :next-query)) :value (list :value (getf result :value) :type 'VAR)))) (t @@ -378,7 +378,7 @@ (concatenate-uri (base-value query-object) (getf result :value)))) (next-query (getf result :next-query))) - (list :next-query next-query + (list :next-query (cut-comment next-query) :value (list :value result-uri :type 'IRI)))) @@ -396,15 +396,24 @@ (prefix (when elem-str (string-until elem-str ":"))) (suffix (when prefix - (string-after elem-str ":")))) + (string-after elem-str ":"))) + (full-url + (when (and suffix prefix) + (get-prefix query-object (concatenate 'string prefix ":" suffix))))) (unless (and end-pos prefix suffix) (error (make-sparql-parser-condition trimmed-str (original-query query-object) "An IRI of the form prefix:suffix"))) - (list :next-query (string-after - trimmed-str - (concatenate 'string prefix ":" suffix)) - :value (list :value (concatenate 'string prefix ":" suffix) + (unless full-url + (error (make-condition + 'sparql-parser-error + :message (format nil "The prefix in \"~a:~a\" is not registered" + prefix suffix)))) + (list :next-query (cut-comment + (string-after + trimmed-str + (concatenate 'string prefix ":" suffix))) + :value (list :value full-url :type 'IRI)))) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Mon Nov 22 14:47:01 2010 @@ -16,7 +16,8 @@ (:export :run-sparql-tests :sparql-tests :test-prefix-and-base - :test-parse-literals)) + :test-parse-literals + :test-parse-triple-elem)) (in-package :sparql-test) @@ -231,5 +232,49 @@ (tm-sparql::parse-literal-elem query-9 dummy-object)))) +(test test-parse-triple-elem + "Tests various functionality of the parse-triple-elem function." + (let ((query-1 "?var1 .") + (query-2 "$var2 ;") + (query-3 "$var3 }") + (query-4 "<http://full.url>.") + (query-5 "<url-suffix> }") + (query-6 "pref:suffix .") + (query-7 "pref:suffix}") + (query-8 "preff:suffix}") + (dummy-object (make-instance 'SPARQL-Query :query "" + :base "http://base.value"))) + (tm-sparql::add-prefix dummy-object "pref" "http://prefix.value") + (let ((result (tm-sparql::parse-triple-elem query-1 dummy-object))) + (is (string= (getf result :next-query) ".")) + (is (string= (getf (getf result :value) :value) "var1")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (let ((result (tm-sparql::parse-triple-elem query-2 dummy-object))) + (is (string= (getf result :next-query) ";")) + (is (string= (getf (getf result :value) :value) "var2")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (let ((result (tm-sparql::parse-triple-elem query-3 dummy-object))) + (is (string= (getf result :next-query) "}")) + (is (string= (getf (getf result :value) :value) "var3")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::VAR))) + (let ((result (tm-sparql::parse-triple-elem query-4 dummy-object))) + (is (string= (getf result :next-query) ".")) + (is (string= (getf (getf result :value) :value) "http://full.url")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (let ((result (tm-sparql::parse-triple-elem query-5 dummy-object))) + (is (string= (getf result :next-query) "}")) + (is (string= (getf (getf result :value) :value) "http://base.value/url-suffix")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (let ((result (tm-sparql::parse-triple-elem query-6 dummy-object))) + (is (string= (getf result :next-query) ".")) + (is (string= (getf (getf result :value) :value) "http://prefix.value/suffix")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (let ((result (tm-sparql::parse-triple-elem query-7 dummy-object))) + (is (string= (getf result :next-query) "}")) + (is (string= (getf (getf result :value) :value) "http://prefix.value/suffix")) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::IRI))) + (signals sparql-parser-error + (tm-sparql::parse-triple-elem query-8 dummy-object)))) + (defun run-sparql-tests () - (it.bese.fiveam:run! 'sparql-test:sparql-tests)) \ No newline at end of file + (it.bese.fiveam:run! 'sparql-test:sparql-tests))

1 0