Author: lgiessmann Date: Fri Nov 19 04:29:06 2010 New Revision: 342 Log: TM-SPARQL: added parsing of BASE statements Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_parser.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Fri Nov 19 04:29:06 2010 @@ -19,7 +19,8 @@ (defclass SPARQL-Query () ((original-query :initarg :query - :reader original-query + :accessor original-query ;this value is only for internal + ;purposes and mustn't be reset :type String :initform (error (make-condition @@ -27,19 +28,29 @@ :message "From TM-Query(): original-query must be set")) :documentation "Containst the original received querry as string") (prefix-list :initarg :prefix-list - :reader prefix-list + :accessor prefix-list ;this value is only for internal purposes + ;purposes and mustn't be reset :type List :initform nil :documentation "A list of the form ((:label 'id' :value 'prefix'))") + (base-value :initarg :base-value ;initialy the requester's address + :accessor base-value ;this value is only for internal purposes + ;purposes and mustn't be reset + :type String + :initform nil + :documentation "Contains the last set base-value.") (variables :initarg :variables - :accessor :variables + :accessor variables ;this value is only for internal purposes + ;purposes and mustn't be reset :type List :documentation "A list of the form ((:variable var-symbol :value value-object)), that contains tuples for each variable and its result.") (select-statements :initarg :select-statements - :accessor select-statements + :accessor select-statements ;this value is only for + ;internal purposes purposes + ;and mustn't be reset :type List :documentation "A list of the form ((:statement 'statement' :value value-object))"))) @@ -57,7 +68,7 @@ (if existing-tuple (setf (getf existing-tuple :value) prefix-value) (push (list :label prefix-label :value prefix-value) - (slot-value construct 'prefix-list)))))) + (prefix-list 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 19 04:29:06 2010 @@ -9,6 +9,7 @@ (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)) @@ -20,7 +21,6 @@ (make-condition 'sparql-parser-error :message message))) - (defgeneric parser-start(construct query-string) (:documentation "The entry point of the SPARQL-parser.") (:method ((construct SPARQL-Query) (query-string String)) @@ -31,38 +31,53 @@ (parse-prefixes construct (string-after trimmed-query-string "PREFIX"))) ((string-starts-with trimmed-query-string "BASE") - nil) ;TODO: implement + (parse-base construct (string-after trimmed-query-string "BASE") + #'parser-start)) + ((= (length trimmed-query-string) 0) ;TODO: remove, only for debugging purposes + construct) (t (error (make-sparql-parser-condition trimmed-query-string (original-query construct) "SELECT, PREFIX or BASE"))))))) +(defgeneric parse-base (construct query-string next-fun) + (:documentation "Parses the Base statment and sets the corresponding + attribute in the query-construct. Since the BASE statement + may appear in different states the next-fun defines the next + call function that calls the next transitions and states.") + (:method ((construct SPARQL-Query) (query-string String) (next-fun Function)) + (let* ((trimmed-str (trim-whitespace-left query-string)) + (result (parse-bracketed-value trimmed-str construct))) + (setf (base-value construct) (getf result :value)) + (funcall next-fun construct (getf result :next-query))))) + + (defgeneric parse-prefixes (construct query-string) (:documentation "Sets the correponding prefix-tuples in the passed object.") (:method ((construct SPARQL-Query) (query-string String)) (let ((trimmed-string (trim-whitespace-left query-string))) (if (string-starts-with trimmed-string ":") (let ((results - (parse-bracket-value (subseq trimmed-string 1) construct))) + (parse-bracketed-value (subseq trimmed-string 1) construct))) (add-prefix construct *empty-label* (getf results :value)) - (parser-start construct (getf results :query-string))) + (parser-start construct (getf results :next-query))) (let* ((label-name (trim-whitespace-right (string-until trimmed-string ":"))) (next-query-str (trim-whitespace-left (string-after trimmed-string ":"))) - (results (parse-bracket-value next-query-str construct))) + (results (parse-bracketed-value next-query-str construct))) (when (string= label-name trimmed-string) (error (make-sparql-parser-condition trimmed-string (original-query construct) ":"))) (add-prefix construct label-name (getf results :value)) - (parser-start construct (getf results :query-string))))))) + (parser-start construct (getf results :next-query))))))) -(defun parse-bracket-value(query-string query-object &key (open "<") (close ">")) +(defun parse-bracketed-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 (:query-string string :value string) is returned." + form (:next-query string :value string) is returned." (declare (String query-string open close) (SPARQL-Query query-object)) (let ((trimmed-string (trim-whitespace-left query-string))) @@ -73,7 +88,7 @@ (error (make-sparql-parser-condition trimmed-string (original-query query-object) close))) - (list :query-string next-query-str + (list :next-query next-query-str :value pref-url)) (error (make-sparql-parser-condition trimmed-string (original-query query-object)