- isidorus-cvs@common-lisp.net - mailman3.common-lisp.net

[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

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

21 Nov '10

Author: lgiessmann Date: Sun Nov 21 16:03:08 2010 New Revision: 346 Log: TM-SPARQL: added some unit-tests for parsing of literals => fixed some bugs 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 Sun Nov 21 16:03:08 2010 @@ -193,8 +193,9 @@ (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 :value) - :type 'LITERAL)))) + :literal-type (getf value-type-lang-query :type) + :type 'LITERAL + :literal-lang (getf value-type-lang-query :lang))))) (defun parse-literal-string-value (query-string query-object) @@ -209,12 +210,12 @@ (l-value (getf result-1 :literal)) (result-2 (separate-literal-lang-or-type after-literal-value query-object)) - (l-type (getf result-2 :type)) - (l-lang (if (getf result-2 :lang) - (getf result-2 :lang) + (l-type (if (getf result-2 :type) + (getf result-2 :type) *xml-string*)) + (l-lang (getf result-2 :lang)) (next-query (getf result-2 :next-query))) - (list :next-query next-query :lang l-lang :type l-lang + (list :next-query next-query :lang l-lang :type l-type :value (cast-literal l-value l-type)))) @@ -225,8 +226,8 @@ (cond ((string= literal-type *xml-string*) literal-value) ((string= literal-type *xml-boolean*) - (when (or (string/= literal-value "false") - (string/= literal-value "true")) + (when (and (string/= literal-value "false") + (string/= literal-value "true")) (error (make-condition 'sparql-parser-error :message (format nil "Could not cast from ~a to ~a" @@ -259,10 +260,14 @@ after the closing literal bounding." (declare (String query-string) (SPARQL-Query query-object)) - (let ((delimiters (list "." ";" "}" " " (string #\tab) - (string #\newline)))) + (let ((delimiters-1 (list "." ";" "}" " " (string #\tab) + (string #\newline))) + (delimiters-2 (list " ." ". " ";" "}" " " (string #\tab) + (string #\newline) + (concatenate 'string "." (string #\newline)) + (concatenate 'string "." (string #\tab))))) (cond ((string-starts-with query-string "@") - (let ((end-pos (search-first delimiters + (let ((end-pos (search-first delimiters-1 (subseq query-string 1)))) (unless end-pos (error (make-sparql-parser-condition @@ -272,7 +277,7 @@ :lang (subseq (subseq query-string 1) 0 end-pos) :type nil))) ((string-starts-with query-string "^^") - (let ((end-pos (search-first delimiters (subseq query-string 2)))) + (let ((end-pos (search-first delimiters-2 (subseq query-string 2)))) (unless end-pos (error (make-sparql-parser-condition query-string (original-query query-object) @@ -282,9 +287,10 @@ (final-type (if (get-prefix query-object type-str) (get-prefix query-object type-str) type-str))) - (list :next-query next-query :type final-type :lang nil)))) + (list :next-query (cut-comment next-query) + :type final-type :lang nil)))) (t - (list :next-query query-string :type nil :lang nil))))) + (list :next-query (cut-comment query-string) :type nil :lang nil))))) (defun separate-literal-value (query-string query-object) @@ -323,7 +329,7 @@ (find-literal-end (subseq query-string (+ current-pos (length delimiter))) delimiter (+ overall-pos current-pos 1)) - (+ overall-pos current-pos 1)) + (+ overall-pos current-pos (length delimiter))) nil))) @@ -370,8 +376,9 @@ (not (base-value query-object))) (getf result :value) (concatenate-uri (base-value query-object) - (getf result :value))))) - (list :next-query (getf result :next-query) + (getf result :value)))) + (next-query (getf result :next-query))) + (list :next-query next-query :value (list :value result-uri :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 Sun Nov 21 16:03:08 2010 @@ -15,7 +15,8 @@ :constants) (:export :run-sparql-tests :sparql-tests - :test-prefix-and-base)) + :test-prefix-and-base + :test-parse-literals)) (in-package :sparql-test) @@ -152,18 +153,82 @@ (TM-SPARQL::variables query-object-3))))) -;(test test-parse-literal-string-value -; "Tests the helper function parse-literal-string-value." -; (let ((query-1 " \"literal-value\"@de.") -; (query-2 "true.") -; (query-3 "false}") -; (query-4 "1234.43e10") -; (query-4 (concatenate 'string "'''true'''\"^^" *xml-boolean* " ;")) - - - ;TODO: delimiter " ;" or " ." - ;TODO: handle: subject predicate object; predicate object -; ) +(test test-parse-literals + "Tests the helper functions for parsing literals." + (let ((query-1 " \"literal-value\"@de.") + (query-2 "true.") + (query-3 "false}") + (query-4 (concatenate 'string "1234.43e10" (string #\tab))) + (query-5 (concatenate 'string "'''true'''^^" *xml-boolean* " ;")) + (query-6 (concatenate 'string "'123.4'^^" *xml-double* + "." (string #\newline))) + (query-7 "\"Just a test + +literal with some \\\"quoted\\\" words!\"@en.") + (query-8 (concatenate 'string "'''12.4'''^^" *xml-integer* ". ")) + (query-9 (concatenate 'string "\"13e4\"^^" *xml-boolean* " .")) + (dummy-object (make-instance 'SPARQL-Query :query ""))) + (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) + "literal-value")) + (is (string= (getf (getf result :value) :literal-lang) + "de")) + (is (string= (getf (getf result :value) :literal-type) + *xml-string*)) + (is (eql (getf (getf result :value) :type) '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) + *xml-boolean*)) + (is (eql (getf (getf result :value) :type) '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) + *xml-boolean*)) + (is (eql (getf (getf result :value) :type) '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) + *xml-double*)) + (is (eql (getf (getf result :value) :type) '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) + *xml-boolean*)) + (is (eql (getf (getf result :value) :type) '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) + *xml-double*)) + (is (eql (getf (getf result :value) :type) '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) + "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) + *xml-string*)) + (is (eql (getf (getf result :value) :type) 'TM-SPARQL::LITERAL))) + (signals sparql-parser-error + (tm-sparql::parse-literal-elem query-8 dummy-object)) + (signals sparql-parser-error + (tm-sparql::parse-literal-elem query-9 dummy-object)))) (defun run-sparql-tests ()

1 0

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

21 Nov '10

Author: lgiessmann Date: Sun Nov 21 14:57:58 2010 New Revision: 345 Log: TM-SPARQL: fixed a bug by calling the next function from a group-pattern 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 Sun Nov 21 14:57:58 2010 @@ -23,6 +23,27 @@ (make-condition 'sparql-parser-error :message message))) +(defun parse-closed-value(query-string query-object &key (open "<") (close ">")) + "A helper function that checks the value of a statement within + two brackets, i.e. <prefix-value>. A list of the + form (:next-query string :value string) is returned." + (declare (String query-string open close) + (SPARQL-Query query-object)) + (let ((trimmed-string (cut-comment query-string))) + (if (string-starts-with trimmed-string open) + (let* ((pref-url (string-until (string-after trimmed-string open) close)) + (next-query-str (string-after trimmed-string close))) + (unless next-query-str + (error (make-sparql-parser-condition + trimmed-string (original-query query-object) + close))) + (list :next-query next-query-str + :value pref-url)) + (error (make-sparql-parser-condition + trimmed-string (original-query query-object) + close))))) + + (defun cut-comment (query-string) "Returns the given string back. If the query starts with a # or space # the characters until the nextline are removed." @@ -70,8 +91,8 @@ (unless (string-starts-with next-query "WHERE") (error (make-sparql-parser-condition next-query (original-query construct) "WHERE"))) - (let* ((tripples (string-after next-query "WHERE")) - (query-tail (parse-where construct tripples))) + (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, ... construct)))) @@ -83,12 +104,15 @@ (unless (string-starts-with trimmed-str "{") (error (make-sparql-parser-condition trimmed-str (original-query construct) "{"))) - (parse-group construct (subseq trimmed-str 1) nil)))) + (let ((query-tail (parse-group construct (subseq trimmed-str 1) nil nil))) + ;TODO: process query-tail + query-tail)))) -(defgeneric parse-group (construct query-string values) +(defgeneric parse-group (construct query-string values filters) (:documentation "The entry-point for the parsing of a {} statement.") - (:method ((construct SPARQL-Query) (query-string String) (values List)) + (:method ((construct SPARQL-Query) (query-string String) + (values List) (filters List)) (let ((trimmed-str (cut-comment query-string))) (cond ((string-starts-with trimmed-str "BASE") (parse-base construct (string-after trimmed-str "BASE") @@ -96,26 +120,29 @@ ((string-starts-with trimmed-str "{") (error (make-sparql-parser-condition trimmed-str (original-query construct) - "FILTER, BASE, or tripple. Grouping is currently no implemented."))) + "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "FILTER") - nil) ;TODO: implement => save the filters and call - ;it after invoking parse-tripples + nil) ;TODO: call parse-group with added filter ((string-starts-with trimmed-str "OPTIONAL") (error (make-sparql-parser-condition trimmed-str (original-query construct) - "FILTER, BASE, or tripple. Grouping is currently no implemented."))) + "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "UNION") (error (make-sparql-parser-condition trimmed-str (original-query construct) - "FILTER, BASE, or tripple. Grouping is currently no implemented."))) + "FILTER, BASE, or triple. Grouping is currently no implemented."))) ((string-starts-with trimmed-str "}") ;ending of this group + ;TODO: invoke filters with all results (subseq trimmed-str 1)) (t - (parse-tripple construct trimmed-str values)))))) + (let ((result (parse-triple construct trimmed-str values))) + (parse-group construct (getf result :next-query) + (getf result :values) filters))))))) + -(defun parse-tripple-elem (query-string query-object &key (literal-allowed nil)) - "A helper function to parse a subject or predicate of an RDF tripple. +(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)." (declare (String query-string) @@ -188,7 +215,7 @@ *xml-string*)) (next-query (getf result-2 :next-query))) (list :next-query next-query :lang l-lang :type l-lang - :value (cast-literal l-value l-type query-object)))) + :value (cast-literal l-value l-type)))) (defun cast-literal (literal-value literal-type) @@ -232,10 +259,10 @@ after the closing literal bounding." (declare (String query-string) (SPARQL-Query query-object)) - (let ((delimiters (list " ." ". " ";" "}" " " (string #\tab) + (let ((delimiters (list "." ";" "}" " " (string #\tab) (string #\newline)))) (cond ((string-starts-with query-string "@") - (let ((end-pos (search-first (append delimiters (list ".")) + (let ((end-pos (search-first delimiters (subseq query-string 1)))) (unless end-pos (error (make-sparql-parser-condition @@ -303,19 +330,19 @@ (defun parse-literal-number-value (query-string query-object) "A helper function that parses any number that is a literal. The return value is of the form - (list :value nil :type string :pos int)." + (list :value nil :type string :next-query string." (declare (String query-string) (SPARQL-Query query-object)) (let* ((trimmed-str (cut-comment query-string)) (triple-delimiters - (list ". " ". " ";" " " (string #\tab) + (list ". " ";" " " (string #\tab) (string #\newline) "}")) (end-pos (search-first triple-delimiters trimmed-str))) (unless end-pos (error (make-sparql-parser-condition trimmed-str (original-query query-object) - "'. ', ' .', ';' ' ', '\\t', '\\n' or '}'"))) + "'. ', , ';' ' ', '\\t', '\\n' or '}'"))) (let* ((literal-number (read-from-string (subseq trimmed-str 0 end-pos))) (number-type @@ -374,53 +401,39 @@ :type 'IRI)))) -(defgeneric parse-tripple (construct query-string values) - (:documentation "Parses a tripple within a trippel group and returns a +(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)).") - (:method ((construct SPARQL-Query) (query-string String) (values List)) + (:method ((construct SPARQL-Query) (query-string String) (values List) + &key (last-subject nil)) + (declare (List last-subject)) (let* ((trimmed-str (cut-comment query-string)) - (subject - (let ((result (parse-tripple-elem trimmed-str construct))) - (setf trimmed-str (getf result :next-query)) - (getf result :value))) - (predicate - (let ((result (parse-tripple-elem trimmed-str construct))) - (setf trimmed-str (getf result :next-query)) - (getf result :value))) - (object - (let ((result (parse-tripple-elem trimmed-str construct - :literal-allowed t))) - (setf trimmed-str (getf result :next-query)) - (getf result :value)))) - (or subject object predicate);;TODO: implement - ;; 0) ; => use last subject - ;; 1) search for <url> => if full-url use it otherwise set bse - ;; 2) search for label:suffix - ;; 3) varname => ?|$ - ;; 4) literal => only the object - - ;; => BASE is also allowed - ;; => ;-shortcut - - ;; <full-url> - ;; <base-suffix> - ;; label:pref-suffix - ;; ?var - ;; $var - ;; "literal" - ;; 'literal' - ;; "literal"@language - ;; "literal"^^type - ;; '''"literal"''' - ;; 1, which is the same as "1"^^xsd:integer - ;; 1.3, which is the same as "1.3"^^xsd:decimal - ;; 1.300, which is the same as "1.300"^^xsd:decimal - ;; 1.0e6, which is the same as "1.0e6"^^xsd:double - ;; true, which is the same as "true"^^xsd:boolean - ;; false, which is the same as "false"^^xsd:boolean - ))) + (subject-result (if last-subject ;;is used after a ";" + last-subject + (parse-triple-elem trimmed-str construct))) + (predicate-result (parse-triple-elem + (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 :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 + :last-subject (list :value + (getf subject-result :value)))) + ((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))))))) (defgeneric parse-variables (construct query-string) @@ -498,25 +511,4 @@ (error (make-sparql-parser-condition trimmed-string (original-query construct) ":"))) (add-prefix construct label-name (getf results :value)) - (parser-start construct (getf results :next-query))))))) - - -(defun parse-closed-value(query-string query-object &key (open "<") (close ">")) - "A helper function that checks the value of a statement within - two brackets, i.e. <prefix-value>. A list of the - form (:next-query string :value string) is returned." - (declare (String query-string open close) - (SPARQL-Query query-object)) - (let ((trimmed-string (cut-comment query-string))) - (if (string-starts-with trimmed-string open) - (let* ((pref-url (string-until (string-after trimmed-string open) close)) - (next-query-str (string-after trimmed-string close))) - (unless next-query-str - (error (make-sparql-parser-condition - trimmed-string (original-query query-object) - close))) - (list :next-query next-query-str - :value pref-url)) - (error (make-sparql-parser-condition - trimmed-string (original-query query-object) - close))))) \ No newline at end of file + (parser-start construct (getf results :next-query))))))) \ No newline at end of file Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Sun Nov 21 14:57:58 2010 @@ -11,7 +11,8 @@ (:use :cl :it.bese.FiveAM :TM-SPARQL - :exceptions) + :exceptions + :constants) (:export :run-sparql-tests :sparql-tests :test-prefix-and-base)) @@ -151,5 +152,19 @@ (TM-SPARQL::variables query-object-3))))) +;(test test-parse-literal-string-value +; "Tests the helper function parse-literal-string-value." +; (let ((query-1 " \"literal-value\"@de.") +; (query-2 "true.") +; (query-3 "false}") +; (query-4 "1234.43e10") +; (query-4 (concatenate 'string "'''true'''\"^^" *xml-boolean* " ;")) + + + ;TODO: delimiter " ;" or " ." + ;TODO: handle: subject predicate object; predicate object +; ) + + (defun run-sparql-tests () (it.bese.fiveam:run! 'sparql-test:sparql-tests)) \ No newline at end of file

1 0