[isidorus-cvs] r344 - in trunk/src: . TM-SPARQL base-tools unit_tests xml/rdf xml/xtm
Lukas Giessmann
lgiessmann at common-lisp.net
Sun Nov 21 18:16:32 UTC 2010
Author: lgiessmann
Date: Sun Nov 21 13:16:32 2010
New Revision: 344
Log:
TM-SAPRQL: added the parsing of tripples in the SELECT-WHERE statement
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_parser.lisp
trunk/src/base-tools/base-tools.lisp
trunk/src/constants.lisp
trunk/src/isidorus.asd
trunk/src/unit_tests/sparql_test.lisp
trunk/src/xml/rdf/rdf_tools.lisp
trunk/src/xml/xtm/importer.lisp
trunk/src/xml/xtm/tools.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Sun Nov 21 13:16:32 2010
@@ -8,7 +8,7 @@
;;+-----------------------------------------------------------------------------
(defpackage :TM-SPARQL
- (:use :cl :datamodel :base-tools :exceptions)
+ (:use :cl :datamodel :base-tools :exceptions :constants)
(:export :SPARQL-Query))
@@ -16,8 +16,20 @@
(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-Query ()
+
+(defclass SPARQL-Query (Variable-Container)
((original-query :initarg :query
:accessor original-query ;this value is only for internal
;purposes and mustn't be reset
@@ -40,22 +52,15 @@
:type String
:initform nil
:documentation "Contains the last set base-value.")
- (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.")
(select-statements :initarg :select-statements
:accessor select-statements ;this value is only for
;internal purposes purposes
;and mustn't be reset
- :type List
+ :type List
:initform nil
:documentation "A list of the form ((:statement 'statement'
- :value value-object))")))
+ :value value-object))"))
+ (:documentation "This class represents the entire request."))
(defgeneric add-prefix (construct prefix-label prefix-value)
@@ -73,12 +78,26 @@
(prefixes construct))))))
+(defgeneric get-prefix (construct string-with-prefix)
+ (:documentation "Returns the URL corresponding to the found prefix-label
+ followed by : and the variable. Otherwise the return
+ value is nil.")
+ (:method ((construct SPARQL-query) (string-with-prefix String))
+ (loop for entry in (prefixes construct)
+ when (string-starts-with string-with-prefix
+ (concatenate 'string (getf entry :label) ":"))
+ return (concatenate
+ 'string (getf entry :value) ":"
+ (string-after string-with-prefix
+ (concatenate 'string (getf entry :label) ":"))))))
+
+
(defgeneric add-variable (construct variable-name variable-value)
(:documentation "Adds a new variable-name with its value to the aexisting list.
If a variable-already exists the existing entry will be
overwritten. An entry is of the form
(:variable string :value any-type).")
- (:method ((construct SPARQL-Query) (variable-name String) variable-value)
+ (:method ((construct Variable-Container) (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 Sun Nov 21 13:16:32 2010
@@ -23,10 +23,23 @@
(make-condition 'sparql-parser-error :message message)))
+(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."
+ (declare (String query-string))
+ (let ((trimmed-str (trim-whitespace-left query-string)))
+ (if (string-starts-with trimmed-str "#")
+ (let ((next-query (string-after trimmed-str (string #\newline))))
+ (if next-query
+ next-query
+ ""))
+ trimmed-str)))
+
+
(defgeneric parser-start(construct query-string)
(:documentation "The entry point of the SPARQL-parser.")
(:method ((construct SPARQL-Query) (query-string String))
- (let ((trimmed-query-string (trim-whitespace-left query-string)))
+ (let ((trimmed-query-string (cut-comment query-string)))
(cond ((string-starts-with trimmed-query-string "SELECT")
(parse-select
construct (string-after trimmed-query-string "SELECT")))
@@ -50,7 +63,7 @@
(:documentation "The entry-point of the parsing of the select - where
statement.")
(:method ((construct SPARQL-Query) (query-string String))
- (let* ((trimmed-str (trim-whitespace-left query-string))
+ (let* ((trimmed-str (cut-comment query-string))
(next-query (if (string-starts-with trimmed-str "WHERE")
trimmed-str
(parse-variables construct trimmed-str))))
@@ -66,19 +79,363 @@
(defgeneric parse-where (construct query-string)
(:documentation "The entry-point for the parsing of the WHERE statement.")
(:method ((construct SPARQL-Query) (query-string String))
- ))
+ (let ((trimmed-str (cut-comment query-string)))
+ (unless (string-starts-with trimmed-str "{")
+ (error (make-sparql-parser-condition trimmed-str
+ (original-query construct) "{")))
+ (parse-group construct (subseq trimmed-str 1) nil))))
+
+
+(defgeneric parse-group (construct query-string values)
+ (:documentation "The entry-point for the parsing of a {} statement.")
+ (:method ((construct SPARQL-Query) (query-string String) (values List))
+ (let ((trimmed-str (cut-comment query-string)))
+ (cond ((string-starts-with trimmed-str "BASE")
+ (parse-base construct (string-after trimmed-str "BASE")
+ #'parse-where))
+ ((string-starts-with trimmed-str "{")
+ (error (make-sparql-parser-condition
+ trimmed-str (original-query construct)
+ "FILTER, BASE, or tripple. Grouping is currently no implemented.")))
+ ((string-starts-with trimmed-str "FILTER")
+ nil) ;TODO: implement => save the filters and call
+ ;it after invoking parse-tripples
+ ((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.")))
+ ((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.")))
+ ((string-starts-with trimmed-str "}") ;ending of this group
+ (subseq trimmed-str 1))
+ (t
+ (parse-tripple construct trimmed-str values))))))
+
+
+(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.
+ Returns an entry of the form (:value (:value string :type <'VAR|'IRI|'LITERAL>)
+ :next-query string)."
+ (declare (String query-string)
+ (SPARQL-Query query-object)
+ (Boolean literal-allowed))
+ (let ((trimmed-str (cut-comment query-string)))
+ (cond ((string-starts-with trimmed-str "<")
+ (parse-base-suffix-pair trimmed-str query-object))
+ ((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)
+ :value (list :value (getf result :value)
+ :type 'VAR))))
+ (t
+ (if (or (string-starts-with-digit trimmed-str)
+ (string-starts-with trimmed-str "\"")
+ (string-starts-with trimmed-str "true")
+ (string-starts-with trimmed-str "false")
+ (string-starts-with trimmed-str "'"))
+ (progn
+ (unless literal-allowed
+ (error (make-sparql-parser-condition
+ trimmed-str (original-query query-object)
+ "an IRI of the form prefix:suffix or <iri> but found a literal.")))
+ (parse-literal-elem trimmed-str query-object))
+ (parse-prefix-suffix-pair trimmed-str query-object))))))
+
+
+(defun parse-literal-elem (query-string query-object)
+ "A helper-function that returns a literal vaue of the form
+ (:value (:value object :literal-type string :literal-lang
+ string :type <'LITERAL>) :next-query string)."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let* ((trimmed-str (cut-comment query-string))
+ (value-type-lang-query
+ (cond ((or (string-starts-with trimmed-str "\"")
+ (string-starts-with trimmed-str "'"))
+ (parse-literal-string-value trimmed-str query-object))
+ ((string-starts-with trimmed-str "true")
+ (list :value t :type *xml-boolean*
+ :next-query (subseq trimmed-str (length "true"))))
+ ((string-starts-with trimmed-str "false")
+ (list :value nil :type *xml-boolean*
+ :next-query (subseq trimmed-str (length "false"))))
+ ((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 :value)
+ :type 'LITERAL))))
+
+
+(defun parse-literal-string-value (query-string query-object)
+ "A helper function that parses a string that is a literal.
+ The return value is of the form
+ (list :value object :type string :lang string :next-query string)."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let* ((trimmed-str (cut-comment query-string))
+ (result-1 (separate-literal-value trimmed-str query-object))
+ (after-literal-value (getf result-1 :next-query))
+ (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)
+ *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))))
+
+
+(defun cast-literal (literal-value literal-type)
+ "A helper function that casts the passed string value of the literal
+ corresponding to the passed literal-type."
+ (declare (String literal-value literal-type))
+ (cond ((string= literal-type *xml-string*)
+ literal-value)
+ ((string= literal-type *xml-boolean*)
+ (when (or (string/= literal-value "false")
+ (string/= literal-value "true"))
+ (error (make-condition
+ 'sparql-parser-error
+ :message (format nil "Could not cast from ~a to ~a"
+ literal-value literal-type))))
+ (if (string= literal-value "false")
+ nil
+ t))
+ ((string= literal-type *xml-integer*)
+ (handler-case (parse-integer literal-value)
+ (condition ()
+ (error (make-condition
+ 'sparql-parser-error
+ :message (format nil "Could not cast from ~a to ~a"
+ literal-value literal-type))))))
+ ((or (string= literal-type *xml-decimal*) ;;both types are
+ (string= literal-type *xml-double*)) ;;handled the same way
+ (let ((value (read-from-string literal-value)))
+ (unless (numberp value)
+ (error (make-condition
+ 'sparql-parser-error
+ :message (format nil "Could not cast from ~a to ~a"
+ literal-value literal-type))))
+ value))))
+
+
+(defun separate-literal-lang-or-type (query-string query-object)
+ "A helper function that returns (:next-query string :lang string
+ :type string). Only one of :lang and :type can be set, the other
+ element is set to nil. The query string must be the string direct
+ after the closing literal bounding."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let ((delimiters (list " ." ". " ";" "}" " " (string #\tab)
+ (string #\newline))))
+ (cond ((string-starts-with query-string "@")
+ (let ((end-pos (search-first (append delimiters (list "."))
+ (subseq query-string 1))))
+ (unless end-pos
+ (error (make-sparql-parser-condition
+ query-string (original-query query-object)
+ "'.', ';', '}', ' ', '\t', or '\n'")))
+ (list :next-query (subseq (subseq query-string 1) end-pos)
+ :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))))
+ (unless end-pos
+ (error (make-sparql-parser-condition
+ query-string (original-query query-object)
+ "'. ', ,' .', ';', '}', ' ', '\t', or '\n'")))
+ (let* ((type-str (subseq (subseq query-string 2) 0 end-pos))
+ (next-query (subseq (subseq query-string 2) end-pos))
+ (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))))
+ (t
+ (list :next-query query-string :type nil :lang nil)))))
+
+
+(defun separate-literal-value (query-string query-object)
+ "A helper function that returns (:next-query string :literal string).
+ The literal string contains the pure literal value."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let* ((trimmed-str (cut-comment query-string))
+ (delimiter (cond ((string-starts-with trimmed-str "\"")
+ "\"")
+ ((string-starts-with trimmed-str "'''")
+ "'''")
+ ((string-starts-with trimmed-str "'")
+ "'")
+ (t
+ (error (make-sparql-parser-condition
+ trimmed-str (original-query query-object)
+ "a literal starting with ', ''', or \"")))))
+ (literal-end (find-literal-end (subseq trimmed-str (length delimiter))
+ delimiter 0)))
+ (list :next-query (subseq trimmed-str (+ literal-end (length delimiter)))
+ :literal (subseq trimmed-str (length delimiter) literal-end))))
+
+
+(defun find-literal-end (query-string delimiter &optional (overall-pos 0))
+ "Returns the end of the literal corresponding to the passed delimiter
+ string. The query-string must start after the opening literal delimiter.
+ The return value is an int that represents the start index of closing
+ delimiter. delimiter must be either \", ', or '''.
+ If the returns value is nil, there is no closing delimiter."
+ (declare (String query-string delimiter)
+ (Integer overall-pos))
+ (let ((current-pos (search delimiter query-string)))
+ (if current-pos
+ (if (string-ends-with (subseq query-string 0 current-pos) "\\")
+ (find-literal-end (subseq query-string (+ current-pos
+ (length delimiter)))
+ delimiter (+ overall-pos current-pos 1))
+ (+ overall-pos current-pos 1))
+ nil)))
+
+
+(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)."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let* ((trimmed-str (cut-comment query-string))
+ (triple-delimiters
+ (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 '}'")))
+ (let* ((literal-number
+ (read-from-string (subseq trimmed-str 0 end-pos)))
+ (number-type
+ (if (search "." (subseq trimmed-str 0 end-pos))
+ *xml-double* ;could also be an xml:decimal, since the doucble has
+ ;a bigger range it shouldn't matter
+ *xml-integer*)))
+ (unless (numberp literal-number)
+ (error (make-sparql-parser-condition
+ trimmed-str (original-query query-object)
+ "a valid number of the form '1', '1.3', 1.0e6'")))
+ (list :value literal-number :type number-type
+ :next-query (subseq trimmed-str end-pos)))))
+
+
+(defun parse-base-suffix-pair (query-string query-object)
+ "A helper function that returns a list of the form
+ (list :next-query string :value (:value uri :type 'IRI))."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let* ((trimmed-str (cut-comment query-string))
+ (result (parse-closed-value trimmed-str query-object))
+ (result-uri
+ (if (or (absolute-uri-p (getf result :value))
+ (not (base-value query-object)))
+ (getf result :value)
+ (concatenate-uri (base-value query-object)
+ (getf result :value)))))
+ (list :next-query (getf result :next-query)
+ :value (list :value result-uri :type 'IRI))))
+
+
+(defun parse-prefix-suffix-pair(query-string query-object)
+ "A helper function that returns a list of the form
+ (list :next-query string :value (:value uri :type 'IRI))."
+ (declare (String query-string)
+ (SPARQL-Query query-object))
+ (let* ((trimmed-str (cut-comment query-string))
+ (delimiters (list "." ";" "}" "<" " " (string #\newline)
+ (string #\tab) "#"))
+ (end-pos (search-first delimiters trimmed-str))
+ (elem-str (when end-pos
+ (subseq trimmed-str 0 end-pos)))
+ (prefix (when elem-str
+ (string-until elem-str ":")))
+ (suffix (when prefix
+ (string-after elem-str ":"))))
+ (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)
+ :type 'IRI))))
+
+
+(defgeneric parse-tripple (construct query-string values)
+ (:documentation "Parses a tripple 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))
+ (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
+ )))
(defgeneric parse-variables (construct query-string)
(:documentation "Parses the variables of the SELECT statement
and adds them to the passed construct.")
(:method ((construct SPARQL-Query) (query-string String))
- (let ((trimmed-str (trim-whitespace-left query-string)))
+ (let ((trimmed-str (cut-comment query-string)))
(if (string-starts-with trimmed-str "WHERE")
trimmed-str
- (let ((result (parse-variable-name trimmed-str construct)))
- (add-variable construct (getf result :value) nil)
- (parse-variables construct (getf result :next-query)))))))
+ (if (string-starts-with trimmed-str "*")
+ (progn (add-variable construct "*" nil)
+ (parse-variables construct (string-after trimmed-str "*")))
+ (let ((result (parse-variable-name trimmed-str construct)))
+ (add-variable construct (getf result :value) nil)
+ (parse-variables construct (getf result :next-query))))))))
(defun parse-variable-name (query-string query-object)
@@ -88,19 +445,19 @@
(:next-query string :value string)."
(declare (String query-string)
(SPARQL-Query query-object))
- (let ((trimmed-str (trim-whitespace-left query-string))
- (delimiters (list " " "?" "$" (string #\newline) (string #\tab))))
+ (let ((trimmed-str (cut-comment query-string))
+ (delimiters (list " " "?" "$" "." (string #\newline) (string #\tab))))
(unless (or (string-starts-with trimmed-str "?")
(string-starts-with trimmed-str "$"))
- (make-sparql-parser-condition
- trimmed-str (original-query query-object) "? or $"))
+ (error (make-sparql-parser-condition
+ trimmed-str (original-query query-object) "? or $")))
(let* ((var-name-end (search-first delimiters (subseq trimmed-str 1)))
(var-name
(if var-name-end
(subseq trimmed-str 0 (+ 1 var-name-end))
(error (make-sparql-parser-condition
trimmed-str (original-query query-object)
- "space, newline, tab, ?, $ or WHERE"))))
+ "space, newline, tab, ?, ., $ or WHERE"))))
(next-query (string-after trimmed-str var-name))
(normalized-var-name
(if (<= (length var-name) 1)
@@ -117,7 +474,7 @@
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))
+ (let* ((trimmed-str (cut-comment query-string))
(result (parse-closed-value trimmed-str construct)))
(setf (base-value construct) (getf result :value))
(funcall next-fun construct (getf result :next-query)))))
@@ -126,7 +483,7 @@
(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)))
+ (let ((trimmed-string (cut-comment query-string)))
(if (string-starts-with trimmed-string ":")
(let ((results
(parse-closed-value (subseq trimmed-string 1) construct)))
@@ -150,7 +507,7 @@
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)))
+ (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)))
@@ -162,43 +519,4 @@
:value pref-url))
(error (make-sparql-parser-condition
trimmed-string (original-query query-object)
- close)))))
-
-
-
-;((PREFIX bounding: <uri-prefix>)|(PREFIX : <uri-prefix>)*
-;(BASE <base-uri>)*)*
-;SELECT ?varName+
-;WHERE {
-;(({?subjectOrVarName predicateOrVarName objectOrVarName}?)*
-;({?FILTER (filterExpression)}?)*
-;(BASE <base-uri>)*)*
-;}
-;Grouping
-;{}
-;Base
-;BASE <uri>
-;…
-;<book>
-;-> uri/book
-;Literals
-;(“anyCharacter*“)|(‘anyCharacter*‘)((anyUri)|(@languageTag)){0,1}
-;
-;Variables
-;($anyChar*)|(?anyChar*)
-;?var = $var
-;Predicate object-lists
-;?x foaf:name ?name ;
-;foaf:mbox ?mbox .
-;This is the same as writing the triple patterns:
-;?x foaf:name ?name .
-;?x foaf:mbox ?mbox .
-;rdf:type
-;rdf:type = a
-;Empty Graph Pattern
-;The group pattern:
-;{ }
-;matches any graph (including the empty graph) with one solution that does not bind any variables. For example:
-;SELECT ?x
-;WHERE {}
-;matches with one solution in which variable x is not bound."
\ No newline at end of file
+ close)))))
\ No newline at end of file
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp (original)
+++ trunk/src/base-tools/base-tools.lisp Sun Nov 21 13:16:32 2010
@@ -18,10 +18,14 @@
:trim-whitespace-right
:trim-whitespace
:string-starts-with
+ :string-ends-with
:string-starts-with-char
:string-until
:string-after
- :search-first))
+ :search-first
+ :concatenate-uri
+ :absolute-uri-p
+ :string-starts-with-digit))
(in-package :base-tools)
@@ -81,12 +85,46 @@
(string-trim '(#\Space #\Tab #\Newline) value))
-(defun string-starts-with (str prefix)
+(defun string-starts-with (str prefix &key (ignore-case nil))
"Checks if string str starts with a given prefix."
- (declare (string str prefix))
- (string= str prefix :start1 0 :end1
- (min (length prefix)
- (length str))))
+ (declare (String str prefix)
+ (Boolean ignore-case))
+ (let ((str-i (if ignore-case
+ (string-downcase str :start 0 :end (min (length str)
+ (length prefix)))
+ str))
+ (prefix-i (if ignore-case
+ (string-downcase prefix)
+ prefix)))
+ (string= str-i prefix-i :start1 0 :end1
+ (min (length prefix-i)
+ (length str-i)))))
+
+
+(defun string-ends-with (str suffix &key (ignore-case nil))
+ "Checks if string str ends with a given suffix."
+ (declare (String str suffix)
+ (Boolean ignore-case))
+ (let ((str-i (if ignore-case
+ (string-downcase str :start (max (- (length str)
+ (length suffix))
+ 0)
+ :end (length str))
+ str))
+ (suffix-i (if ignore-case
+ (string-downcase suffix)
+ suffix)))
+ (string= str-i suffix-i :start1 (max (- (length str)
+ (length suffix))
+ 0))))
+
+
+(defun string-starts-with-digit (str)
+ "Checks whether the passed string starts with a digit."
+ (declare (String str))
+ (loop for item in (list 0 1 2 3 4 5 6 7 8 9)
+ when (string-starts-with str (write-to-string item))
+ return t))
(defun string-starts-with-char (begin str)
@@ -123,4 +161,53 @@
search-strings))))
(let ((sorted-positions (sort positions #'<)))
(when sorted-positions
- (first sorted-positions)))))
\ No newline at end of file
+ (first sorted-positions)))))
+
+
+(defun concatenate-uri (absolute-ns value)
+ "Returns a string conctenated of the absolut namespace an the given value
+ separated by either '#' or '/'."
+ (declare (string absolute-ns value))
+ (unless (and (> (length absolute-ns) 0)
+ (> (length value) 0))
+ (error "From concatenate-uri(): absolute-ns and value must be of length > 0"))
+ (unless (absolute-uri-p absolute-ns)
+ (error "From concatenate-uri(): absolute-ns has to be an absolute URI: ~a" absolute-ns))
+ (let ((last-char
+ (elt absolute-ns (- (length absolute-ns) 1)))
+ (first-char
+ (elt value 0)))
+ (let ((separator
+ (cond
+ ((or (eql first-char #\#)
+ (eql first-char #\/))
+ "")
+ ((or (eql last-char #\#)
+ (eql last-char #\/))
+ "")
+ (t
+ "/"))))
+ (let ((prep-ns
+ (if (and (eql last-char first-char)
+ (or (eql last-char #\#)
+ (eql last-char #\/)))
+ (subseq absolute-ns 0 (- (length absolute-ns) 1))
+ (if (and (eql last-char #\#)
+ (find #\/ value))
+ (progn
+ (when (not (eql first-char #\/))
+ (setf separator "/"))
+ (subseq absolute-ns 0 (- (length absolute-ns) 1)))
+ absolute-ns))))
+ (concatenate 'string prep-ns separator value)))))
+
+
+(defun absolute-uri-p (uri)
+ "Returns t if the passed uri is an absolute one. This
+ is indicated by a ':' with no leadgin '/'."
+ (when uri
+ (let ((position-of-colon
+ (position #\: uri)))
+ (declare (string uri))
+ (and position-of-colon (> position-of-colon 0)
+ (not (find #\/ (subseq uri 0 position-of-colon)))))))
\ No newline at end of file
Modified: trunk/src/constants.lisp
==============================================================================
--- trunk/src/constants.lisp (original)
+++ trunk/src/constants.lisp Sun Nov 21 13:16:32 2010
@@ -26,6 +26,10 @@
:*xml-ns*
:*xmlns-ns*
:*xml-string*
+ :*xml-boolean*
+ :*xml-decimal*
+ :*xml-double*
+ :*xml-integer*
:*xml-uri*
:*rdf2tm-ns*
:*rdf-statement*
@@ -100,6 +104,14 @@
(defparameter *xml-string* "http://www.w3.org/2001/XMLSchema#string")
+(defparameter *xml-boolean* "http://www.w3.org/2001/XMLSchema#boolean")
+
+(defparameter *xml-integer* "http://www.w3.org/2001/XMLSchema#integer")
+
+(defparameter *xml-decimal* "http://www.w3.org/2001/XMLSchema#decimal")
+
+(defparameter *xml-double* "http://www.w3.org/2001/XMLSchema#double")
+
(defparameter *xml-uri* "http://www.w3.org/2001/XMLSchema#anyURI")
(defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/")
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Sun Nov 21 13:16:32 2010
@@ -78,8 +78,8 @@
"base-tools"))
(:module "atom"
:components ((:file "atom")
-;; (:file "configuration"
-;; :depends-on ("atom"))
+ ;; (:file "configuration"
+ ;; :depends-on ("atom"))
(:file "collection"
:depends-on ("atom"))
(:file "snapshots"
@@ -156,7 +156,7 @@
(:file "exporter_xtm2.0_test"
:depends-on ("fixtures"))
(:file "exporter_xtm1.0_test"
- :depends-on ("fixtures" "exporter_xtm2.0_test"))
+ :depends-on ("fixtures" "exporter_xtm2.0_test"))
(:file "atom_test"
:depends-on ("fixtures"))
(:file "json_test"
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 13:16:32 2010
@@ -111,10 +111,13 @@
$var3 ?var3 WHERE{}")
(query-2 "SELECT ?var1$var2 $var3 ?var3 WHERE{}")
(query-3 "SELECT ?var1$var2 $var3 ?var3WHERE{}")
+ (query-4 "SELECT * WHERE{}")
(query-object-1 (make-instance 'SPARQL-Query :query query-1))
- (query-object-2 (make-instance 'SPARQL-Query :query query-2)))
+ (query-object-2 (make-instance 'SPARQL-Query :query query-2))
+ (query-object-3 (make-instance 'SPARQL-QUERY :query query-4)))
(is-true query-object-1)
(is-true query-object-2)
+ (is-true query-object-3)
(signals sparql-parser-error (make-instance 'SPARQL-Query :query query-3))
(is (= (length (TM-SPARQL::variables query-object-1)) 3))
(is-true (find-if #'(lambda(elem)
@@ -141,7 +144,11 @@
(is-true (find-if #'(lambda(elem)
(and (string= (getf elem :variable) "var3")
(null (getf elem :value))))
- (TM-SPARQL::variables query-object-2)))))
+ (TM-SPARQL::variables query-object-2)))
+ (is-true (find-if #'(lambda(elem)
+ (and (string= (getf elem :variable) "*")
+ (null (getf elem :value))))
+ (TM-SPARQL::variables query-object-3)))))
(defun run-sparql-tests ()
Modified: trunk/src/xml/rdf/rdf_tools.lisp
==============================================================================
--- trunk/src/xml/rdf/rdf_tools.lisp (original)
+++ trunk/src/xml/rdf/rdf_tools.lisp Sun Nov 21 13:16:32 2010
@@ -9,88 +9,8 @@
(defpackage :rdf-importer
(:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel
- :base-tools)
- (:import-from :constants
- *rdf-ns*
- *rdfs-ns*
- *xml-ns*
- *xmlns-ns*
- *xml-string*
- *rdf2tm-ns*
- *xtm2.0-ns*
- *type-instance-psi*
- *type-psi*
- *instance-psi*
- *rdf-statement*
- *rdf-object*
- *rdf-subject*
- *rdf-predicate*
- *rdf2tm-object*
- *rdf2tm-subject*
- *supertype-psi*
- *subtype-psi*
- *supertype-subtype-psi*
- *rdf-nil*
- *rdf-first*
- *rdf-rest*
- *rdf2tm-scope-prefix*
- *tm2rdf-topic-type-uri*
- *tm2rdf-name-type-uri*
- *tm2rdf-name-property*
- *tm2rdf-variant-type-uri*
- *tm2rdf-variant-property*
- *tm2rdf-occurrence-type-uri*
- *tm2rdf-occurrence-property*
- *tm2rdf-role-type-uri*
- *tm2rdf-role-property*
- *tm2rdf-association-type-uri*
- *tm2rdf-association-property*
- *tm2rdf-subjectIdentifier-property*
- *tm2rdf-itemIdentity-property*
- *tm2rdf-subjectLocator-property*
- *tm2rdf-ns*
- *tm2rdf-value-property*
- *tm2rdf-scope-property*
- *tm2rdf-nametype-property*
- *tm2rdf-occurrencetype-property*
- *tm2rdf-roletype-property*
- *tm2rdf-player-property*
- *tm2rdf-associationtype-property*
- *rdf2tm-blank-node-prefix*
- *tm2rdf-reifier-property*)
- (:import-from :xml-constants
- *rdf_core_psis.xtm*
- *core_psis.xtm*)
- (:import-from :xml-tools
- get-attribute
- xpath-fn-string
- xpath-child-elems-by-qname
- xpath-single-child-elem-by-qname
- xpath-select-location-path
- xpath-select-single-location-path
- get-ns-attribute
- clear-child-nodes
- has-qname
- absolute-uri-p
- get-node-name
- child-nodes-or-text
- get-xml-lang
- get-xml-base
- absolutize-value
- absolutize-id
- concatenate-uri
- node-to-string)
- (:import-from :xml-importer
- get-uuid
- get-store-spec
- with-tm
- from-topic-elem-to-stub)
- (:import-from :isidorus-threading
- with-reader-lock
- with-writer-lock)
- (:import-from :exceptions
- missing-reference-error
- duplicate-identifier-error)
+ :base-tools :constants :xml-constants :xml-tools
+ :xml-importer :isidorus-threading :exceptions)
(:export :setup-rdf-module
:rdf-importer
:init-rdf-module
Modified: trunk/src/xml/xtm/importer.lisp
==============================================================================
--- trunk/src/xml/xtm/importer.lisp (original)
+++ trunk/src/xml/xtm/importer.lisp Sun Nov 21 13:16:32 2010
@@ -72,6 +72,7 @@
:merge-topic-elem-xtm1.0
:from-association-elem-xtm1.0
:importer-xtm1.0
+ :get-uuid
:with-tm))
(in-package :xml-importer)
Modified: trunk/src/xml/xtm/tools.lisp
==============================================================================
--- trunk/src/xml/xtm/tools.lisp (original)
+++ trunk/src/xml/xtm/tools.lisp Sun Nov 21 13:16:32 2010
@@ -21,56 +21,16 @@
:xpath-select-single-location-path
:get-ns-attribute
:clear-child-nodes
- :absolute-uri-p
:get-node-name
:child-nodes-or-text
:get-xml-lang
:get-xml-base
:absolutize-value
:absolutize-id
- :concatenate-uri
:node-to-string))
(in-package :xml-tools)
-(defun concatenate-uri (absolute-ns value)
- "Returns a string conctenated of the absolut namespace an the given value
- separated by either '#' or '/'."
- (declare (string absolute-ns value))
- (unless (and (> (length absolute-ns) 0)
- (> (length value) 0))
- (error "From concatenate-uri(): absolute-ns and value must be of length > 0"))
- (unless (absolute-uri-p absolute-ns)
- (error "From concatenate-uri(): absolute-ns has to be an absolute URI: ~a" absolute-ns))
- (let ((last-char
- (elt absolute-ns (- (length absolute-ns) 1)))
- (first-char
- (elt value 0)))
- (let ((separator
- (cond
- ((or (eql first-char #\#)
- (eql first-char #\/))
- "")
- ((or (eql last-char #\#)
- (eql last-char #\/))
- "")
- (t
- "/"))))
- (let ((prep-ns
- (if (and (eql last-char first-char)
- (or (eql last-char #\#)
- (eql last-char #\/)))
- (subseq absolute-ns 0 (- (length absolute-ns) 1))
- (if (and (eql last-char #\#)
- (find #\/ value))
- (progn
- (when (not (eql first-char #\/))
- (setf separator "/"))
- (subseq absolute-ns 0 (- (length absolute-ns) 1)))
- absolute-ns))))
- (concatenate 'string prep-ns separator value)))))
-
-
(defun absolutize-id (id xml-base tm-id)
"Returns the passed id as an absolute uri computed
with the given base and tm-id."
@@ -206,17 +166,6 @@
nil))))) ;there were no text nodes available
-(defun absolute-uri-p (uri)
- "Returns t if the passed uri is an absolute one. This
- is indicated by a ':' with no leadgin '/'."
- (when uri
- (let ((position-of-colon
- (position #\: uri)))
- (declare (string uri))
- (and position-of-colon (> position-of-colon 0)
- (not (find #\/ (subseq uri 0 position-of-colon)))))))
-
-
(defun get-node-name (elem)
"Returns the node's name without a prefix."
(if (find #\: (dom:node-name elem))
More information about the Isidorus-cvs
mailing list