[isidorus-cvs] r342 - trunk/src/TM-SPARQL

[Lukas Giessmann]

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)