isidorus-cvs

Download

isidorus-cvs@common-lisp.net

January 2011

1 participants
2 discussions

[isidorus-cvs] r385 - in trunk/src: . TM-SPARQL
by Lukas Giessmann 25 Jan '11

25 Jan '11

Author: lgiessmann Date: Tue Jan 25 12:46:43 2011 New Revision: 385 Log: tm-sparql: added an xtm file that contains all special uris defined by the networkedplanet tmsparql proposal as topic with corresponding PSIs; added a funtion that allos to initialise the tmsparql module, ie. the tmsparql xtm is imported Added: trunk/src/TM-SPARQL/sparql_constants.lisp trunk/src/TM-SPARQL/tmsparql_core_psis.xtm Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/isidorus.asd trunk/src/xml-constants.lisp Modified: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql.lisp (original) +++ trunk/src/TM-SPARQL/sparql.lisp Tue Jan 25 12:46:43 2011 @@ -8,9 +8,12 @@ ;;+----------------------------------------------------------------------------- (defpackage :TM-SPARQL - (:use :cl :datamodel :base-tools :exceptions :constants) + (:use :cl :datamodel :base-tools :exceptions :constants + :TM-SPARQL-Constants :xml-importer :xml-constants + :isidorus-threading :xml-tools) (:export :SPARQL-Query - :result)) + :result + :init-tm-sparql)) (in-package :TM-SPARQL) @@ -19,6 +22,30 @@ (defvar *equal-operators* nil "A Table taht contains tuples of classes and equality operators.") + +(defun init-tm-sparql (&optional (revision (get-revision))) + "Imports the file tmsparql_core_psis.xtm. core_psis.xtm has to be imported + before." + (with-writer-lock + (with-tm (revision "tmsparql.xtm" (concat *tms* "topic-map")) + (let ((core-dom (cxml:parse-file *tmsparql_core_psis.xtm* + (cxml-dom:make-dom-builder))) + (xtm-id (reverse + (base-tools:string-until + (reverse + (pathname-name + xml-constants:*tmsparql_core_psis.xtm*)) "/")))) + (elephant:ensure-transaction (:txn-nosync t) + (loop for top-elem across + (xpath-child-elems-by-qname (dom:document-element core-dom) + *xtm2.0-ns* "topic") + do (let ((top + (from-topic-elem-to-stub top-elem revision + :xtm-id xtm-id))) + (add-to-tm xml-importer::tm top)))))))) + + + (defun init-*equal-operators* () (setf *equal-operators* (list (list :class 'Boolean :operator #'eql) @@ -1164,8 +1191,5 @@ ;; filters all entries that are not important for the result ;; => an intersection is invoked (reduce-results construct (make-result-lists construct)) -; (dolist (triple (select-group construct)) -; (dolist (filter (filters construct)) -; (invoke-filter triple construct filter))) (process-filters construct) construct) \ No newline at end of file Added: trunk/src/TM-SPARQL/sparql_constants.lisp ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/sparql_constants.lisp Tue Jan 25 12:46:43 2011 @@ -0,0 +1,35 @@ +;;+----------------------------------------------------------------------------- +;;+ Isidorus +;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff +;;+ +;;+ Isidorus is freely distributable under the LLGPL license. +;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and +;;+ trunk/docs/LGPL-LICENSE.txt. +;;+----------------------------------------------------------------------------- + +(defpackage :TM-SPARQL-Constants + (:use :cl :base-tools) + (:nicknames tms) + (:export :*tms* + :*tms-reifier* + :*tms-role* + :*tms-player* + :*tms-topicProperty* + :*tms-scope* + :*tms-value*)) + +(in-package :TM-SPARQL-Constants) + +(defvar *tms* "http://www.networkedplanet.com/tmsparql/") + +(defvar *tms-reifier* (concat *tms* "reifier")) + +(defvar *tms-role* (concat *tms* "role")) + +(defvar *tms-player* (concat *tms* "player")) + +(defvar *tms-topicProperty* (concat *tms* "topicProperty")) + +(defvar *tms-scope* (concat *tms* "scope")) + +(defvar *tms-value* (concat *tms* "value")) \ No newline at end of file Added: trunk/src/TM-SPARQL/tmsparql_core_psis.xtm ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/tmsparql_core_psis.xtm Tue Jan 25 12:46:43 2011 @@ -0,0 +1,45 @@ +<?xml version="1.0"?> + + + + + + + + + + + + + + + +<topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0"> + <topic id="reifier"> + <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/reifier"/> + </topic> + + <topic id="role"> + <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/role"/> + </topic> + + <topic id="player"> + <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/player"/> + </topic> + + <topic id="topicProperty"> + <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/topicProperty"/> + </topic> + + <topic id="scope"> + <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/scope"/> + </topic> + + <topic id="value"> + <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/value"/> + </topic> + +</topicMap> Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Jan 25 12:46:43 2011 @@ -23,6 +23,7 @@ :depends-on ("base-tools")) (:static-file "xml/xtm/core_psis.xtm") (:static-file "xml/rdf/rdf_core_psis.xtm") + (:static-file "TM-SPARQL/tmsparql_core_psis.xtm") (:file "xml-constants" :depends-on ("xml/xtm/core_psis.xtm" "constants")) @@ -40,14 +41,21 @@ :depends-on ("exceptions"))) :depends-on ("constants" "base-tools")) (:module "TM-SPARQL" - :components ((:file "sparql") + :components ((:file "sparql_constants") + (:file "sparql" + :depends-on ("sparql_constants")) (:file "filter_wrappers" :depends-on ("sparql")) (:file "sparql_filter" :depends-on ("sparql" "filter_wrappers")) (:file "sparql_parser" :depends-on ("sparql" "sparql_filter"))) - :depends-on ("constants" "base-tools" "model")) + :depends-on ("constants" + "base-tools" + "model" + "xml-constants" + "xml" + "threading")) (:module "xml" :components ((:module "xtm" :components ((:file "tools") Modified: trunk/src/xml-constants.lisp ============================================================================== --- trunk/src/xml-constants.lisp (original) +++ trunk/src/xml-constants.lisp Tue Jan 25 12:46:43 2011 @@ -14,7 +14,8 @@ *isidorus-system*) (:export :*xml-component* :*core_psis.xtm* - :*rdf_core_psis.xtm*)) + :*rdf_core_psis.xtm* + :*tmsparql_core_psis.xtm*)) (in-package :xml-constants) @@ -27,4 +28,8 @@ (defparameter *rdf_core_psis.xtm* (asdf:component-pathname - (asdf:find-component *isidorus-system* "xml/rdf/rdf_core_psis.xtm"))) \ No newline at end of file + (asdf:find-component *isidorus-system* "xml/rdf/rdf_core_psis.xtm"))) + +(defparameter *tmsparql_core_psis.xtm* + (asdf:component-pathname + (asdf:find-component *isidorus-system* "TM-SPARQL/tmsparql_core_psis.xtm"))) \ No newline at end of file

1 0

[isidorus-cvs] r384 - in trunk/src: . TM-SPARQL base-tools json model rest_interface unit_tests xml/rdf xml/xtm
by Lukas Giessmann 05 Jan '11

05 Jan '11

Author: lgiessmann Date: Wed Jan 5 18:37:15 2011 New Revision: 384 Log: code-maintenance: replaced some code sections by functions of base-tools; removed some "hacks" in the code Modified: trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_filter.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/json/json_exporter.lisp trunk/src/json/json_tmcl.lisp trunk/src/json/json_tmcl_validation.lisp trunk/src/model/datamodel.lisp trunk/src/rest_interface/rest-interface.lisp trunk/src/rest_interface/set-up-json-interface.lisp trunk/src/unit_tests/datamodel_test.lisp trunk/src/unit_tests/json_test.lisp trunk/src/unit_tests/rdf_exporter_test.lisp trunk/src/unit_tests/rdf_importer_test.lisp trunk/src/unit_tests/reification_test.lisp trunk/src/unit_tests/sparql_test.lisp trunk/src/xml/rdf/exporter.lisp trunk/src/xml/rdf/importer.lisp trunk/src/xml/rdf/rdf_tools.lisp trunk/src/xml/xtm/exporter_xtm1.0.lisp trunk/src/xml/xtm/exporter_xtm2.0.lisp trunk/src/xml/xtm/importer.lisp trunk/src/xml/xtm/importer_xtm1.0.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 Wed Jan 5 18:37:15 2011 @@ -203,9 +203,9 @@ (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)) + (when (and (not (eql elem-type 'IRI)) + (not (eql elem-type 'VARIABLE)) + (not (eql elem-type 'LITERAL))) (error (make-condition 'bad-argument-error :message (format nil "Expected a one of the symbols ~a, but get ~a~%" @@ -470,7 +470,7 @@ or name. The subject is the owner topic and the predicate is the characteristic's type." (declare (Integer revision) - (String literal-value literal-datatype)) + (String literal-datatype)) (let ((chars (cond ((string= literal-datatype *xml-string*) (remove-if #'(lambda(elem) @@ -481,13 +481,13 @@ (elephant:get-instances-by-value 'NameC 'charvalue literal-value)))) ((and (string= literal-datatype *xml-boolean*) - (eql literal-value t)) + literal-value) (remove-if #'(lambda(elem) (string/= (charvalue elem) "true")) (elephant:get-instances-by-value 'OccurrenceC 'charvalue "true"))) ((and (string= literal-datatype *xml-boolean*) - (eql literal-value nil)) + (not literal-value)) (remove-if #'(lambda(elem) (string/= (charvalue elem) "false")) (elephant:get-instances-by-value Modified: trunk/src/TM-SPARQL/sparql_filter.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_filter.lisp (original) +++ trunk/src/TM-SPARQL/sparql_filter.lisp Wed Jan 5 18:37:15 2011 @@ -181,8 +181,8 @@ (arg-list (bracket-scope cleaned-right-str)) (cleaned-arg-list (clean-function-arguments arg-list)) (modified-str - (concatenate - 'string left-str "(" fun-name " " cleaned-arg-list ")" + (concat + left-str "(" fun-name " " cleaned-arg-list ")" (subseq right-str (+ (- (length right-str) (length cleaned-right-str)) (length arg-list)))))) @@ -240,11 +240,10 @@ (left-scope (find-compare-left-scope left-str)) (right-scope (find-compare-right-scope right-str)) (modified-str - (concatenate - 'string (subseq left-str 0 (- (length left-str) - (length left-scope))) - "(" op-str " " left-scope " " right-scope ")" - (subseq right-str (length right-scope))))) + (concat (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" op-str " " left-scope " " right-scope ")" + (subseq right-str (length right-scope))))) (set-compare-operators construct modified-str)))))) @@ -357,9 +356,9 @@ (left-scope (find-*/-left-scope left-str)) (right-scope (find-*/-right-scope right-str)) (modified-str - (concatenate - 'string (subseq left-str 0 (- (length left-str) - (length left-scope))) + (concat + (subseq left-str 0 (- (length left-str) + (length left-scope))) "(" op-str " " left-scope " " right-scope ")" (subseq right-str (length right-scope))))) (set-*-and-/-operators construct modified-str)))))) @@ -438,11 +437,10 @@ (left-scope (find-+--left-scope left-str)) (right-scope (find-+--right-scope right-str)) (modified-str - (concatenate - 'string (subseq left-str 0 (- (length left-str) - (length left-scope))) - "(" op-str " " left-scope " " right-scope ")" - (subseq right-str (length right-scope))))) + (concat (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" op-str " " left-scope " " right-scope ")" + (subseq right-str (length right-scope))))) (set-+-and---operators construct modified-str)))))) @@ -537,11 +535,11 @@ (left-scope (find-or-and-left-scope left-str)) (right-scope (find-or-and-right-scope right-str)) (modified-str - (concatenate 'string (subseq left-str 0 (- (length left-str) - (length left-scope))) - "(" (if (string= op-str "||") "or" "and") " " - "(progn " left-scope ")" "(progn " right-scope ")) " - (subseq right-str (length right-scope))))) + (concat (subseq left-str 0 (- (length left-str) + (length left-scope))) + "(" (if (string= op-str "||") "or" "and") " " + "(progn " left-scope ")" "(progn " right-scope ")) " + (subseq right-str (length right-scope))))) (when (or (= (length (trim-whitespace left-scope)) 0) (= (length (trim-whitespace right-scope)) 0)) (error (make-condition @@ -666,7 +664,7 @@ (string-ends-with-one-of string-before (append (*supported-operators*) (list "(")))) (let ((result (unary-operator-scope filter-string idx))) - (push-string (concatenate 'string "(one" current-char " ") + (push-string (concat "(one" current-char " ") result-string) (push-string (set-unary-operators construct (getf result :scope)) @@ -754,7 +752,7 @@ (when fun-suffix (let* ((args (bracket-scope fun-suffix)) (fun-name (string-until cleaned-str args))) - (concatenate 'string fun-name args))))) + (concat fun-name args))))) (defun get-filter-variable (str) Modified: trunk/src/TM-SPARQL/sparql_parser.lisp ============================================================================== --- trunk/src/TM-SPARQL/sparql_parser.lisp (original) +++ trunk/src/TM-SPARQL/sparql_parser.lisp Wed Jan 5 18:37:15 2011 @@ -228,8 +228,8 @@ (string #\newline))) (delimiters-2 (list " ." ". " ";" "}" " " (string #\tab) (string #\newline) - (concatenate 'string "." (string #\newline)) - (concatenate 'string "." (string #\tab))))) + (concat "." (string #\newline)) + (concat "." (string #\tab))))) (cond ((string-starts-with query-string "@") (let ((end-pos (search-first delimiters-1 (subseq query-string 1)))) @@ -344,7 +344,7 @@ (string-after elem-str ":"))) (full-url (when (and suffix prefix) - (get-prefix construct (concatenate 'string prefix ":" suffix))))) + (get-prefix construct (concat prefix ":" suffix))))) (unless (and end-pos prefix suffix) (error (make-sparql-parser-condition trimmed-str (original-query construct) @@ -355,9 +355,8 @@ :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))) + (string-after trimmed-str + (concat prefix ":" suffix))) :value (make-instance 'SPARQL-Triple-Elem :elem-type 'IRI :value full-url))))) Modified: trunk/src/base-tools/base-tools.lisp ============================================================================== --- trunk/src/base-tools/base-tools.lisp (original) +++ trunk/src/base-tools/base-tools.lisp Wed Jan 5 18:37:15 2011 @@ -59,14 +59,14 @@ *white-space*)) +(defmacro concat (&rest strings) + `(concatenate 'string ,@strings)) + + (defmacro push-string (obj place) "Imitates the push macro but instead of pushing object in a list, there will be appended the given string to the main string object." - `(setf ,place (concatenate 'string ,place ,obj))) - - -(defmacro concat (&rest strings) - `(concatenate 'string ,@strings)) + `(setf ,place (concat ,place ,obj))) (defmacro when-do (result-bounding condition-statement do-with-result) @@ -103,12 +103,12 @@ (remove-if #'null (map 'list #'(lambda(item) (when (stringp item) - (concatenate 'string "/" item))) + (concat "/" item))) (pathname-directory pathname)))) (full-path-string "")) (dolist (segment segments) (push-string segment full-path-string)) - (concatenate 'string full-path-string "/" (pathname-name pathname)))) + (concat full-path-string "/" (pathname-name pathname)))) (defun trim-whitespace-left (value) @@ -193,9 +193,10 @@ (if (not search-idx) main-string (let ((modified-string - (concatenate 'string (subseq main-string 0 search-idx) - new-string (subseq main-string - (+ search-idx (length string-to-replace)))))) + (concat (subseq main-string 0 search-idx) + new-string + (subseq main-string + (+ search-idx (length string-to-replace)))))) (string-replace modified-string string-to-replace new-string)))))) @@ -225,7 +226,7 @@ (type (or Null String) digits)) (if (string-starts-with-digit str) (separate-leading-digits - (subseq str 1) (concatenate 'string digits (subseq str 0 1))) + (subseq str 1) (concat digits (subseq str 0 1))) digits)) @@ -314,9 +315,9 @@ (find-literal-end (subseq query-string 3) (subseq query-string 0 3)))) (when literal-end (list :next-string (subseq query-string (+ 3 literal-end)) - :literal (concatenate 'string quotation - (subseq query-string 3 literal-end) - quotation))))) + :literal (concat quotation + (subseq query-string 3 literal-end) + quotation))))) ((or (string-starts-with query-string "\"") (string-starts-with query-string "'")) (unless local-quotation @@ -328,8 +329,8 @@ (let ((literal (escape-string (subseq query-string 1 literal-end) "\""))) (list :next-string (subseq query-string (+ 1 literal-end)) - :literal (concatenate 'string local-quotation literal - local-quotation))))))))) + :literal (concat local-quotation literal + local-quotation))))))))) (defun search-first-ignore-literals (search-strings main-string &key from-end) @@ -396,7 +397,7 @@ (setf separator "/")) (subseq absolute-ns 0 (- (length absolute-ns) 1))) absolute-ns)))) - (concatenate 'string prep-ns separator value))))) + (concat prep-ns separator value))))) (defun absolute-uri-p (uri) Modified: trunk/src/constants.lisp ============================================================================== --- trunk/src/constants.lisp (original) +++ trunk/src/constants.lisp Wed Jan 5 18:37:15 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :constants - (:use :cl) + (:use :cl :base-tools) (:export :*atom-ns* :*egovpt-ns* :*instance-psi* @@ -117,74 +117,74 @@ (defparameter *rdf2tm-ns* "http://isidorus/rdf2tm_mapping/") -(defparameter *rdf-statement* (concatenate 'string *rdf-ns* "Statement")) +(defparameter *rdf-statement* (concat *rdf-ns* "Statement")) -(defparameter *rdf-object* (concatenate 'string *rdf-ns* "object")) +(defparameter *rdf-object* (concat *rdf-ns* "object")) -(defparameter *rdf-subject* (concatenate 'string *rdf-ns* "subject")) +(defparameter *rdf-subject* (concat *rdf-ns* "subject")) -(defparameter *rdf-predicate* (concatenate 'string *rdf-ns* "predicate")) +(defparameter *rdf-predicate* (concat *rdf-ns* "predicate")) -(defparameter *rdf-nil* (concatenate 'string *rdf-ns* "nil")) +(defparameter *rdf-nil* (concat *rdf-ns* "nil")) -(defparameter *rdf-type* (concatenate 'string *rdf-ns* "type")) +(defparameter *rdf-type* (concat *rdf-ns* "type")) -(defparameter *rdf-first* (concatenate 'string *rdf-ns* "first")) +(defparameter *rdf-first* (concat *rdf-ns* "first")) -(defparameter *rdf-rest* (concatenate 'string *rdf-ns* "rest")) +(defparameter *rdf-rest* (concat *rdf-ns* "rest")) -(defparameter *rdf2tm-object* (concatenate 'string *rdf2tm-ns* "object")) +(defparameter *rdf2tm-object* (concat *rdf2tm-ns* "object")) -(defparameter *rdf2tm-subject* (concatenate 'string *rdf2tm-ns* "subject")) +(defparameter *rdf2tm-subject* (concat *rdf2tm-ns* "subject")) -(defparameter *rdf2tm-scope-prefix* (concatenate 'string *rdf2tm-ns* "scope/")) +(defparameter *rdf2tm-scope-prefix* (concat *rdf2tm-ns* "scope/")) -(defparameter *rdf2tm-blank-node-prefix* (concatenate 'string *rdf2tm-ns* "blank_node/")) +(defparameter *rdf2tm-blank-node-prefix* (concat *rdf2tm-ns* "blank_node/")) (defparameter *tm2rdf-ns* "http://isidorus/tm2rdf_mapping/") -(defparameter *tm2rdf-topic-type-uri* (concatenate 'string *tm2rdf-ns* "types/Topic")) +(defparameter *tm2rdf-topic-type-uri* (concat *tm2rdf-ns* "types/Topic")) -(defparameter *tm2rdf-name-type-uri* (concatenate 'string *tm2rdf-ns* "types/Name")) +(defparameter *tm2rdf-name-type-uri* (concat *tm2rdf-ns* "types/Name")) -(defparameter *tm2rdf-name-property* (concatenate 'string *tm2rdf-ns* "name")) +(defparameter *tm2rdf-name-property* (concat *tm2rdf-ns* "name")) -(defparameter *tm2rdf-variant-type-uri* (concatenate 'string *tm2rdf-ns* "types/Variant")) +(defparameter *tm2rdf-variant-type-uri* (concat *tm2rdf-ns* "types/Variant")) -(defparameter *tm2rdf-variant-property* (concatenate 'string *tm2rdf-ns* "variant")) +(defparameter *tm2rdf-variant-property* (concat *tm2rdf-ns* "variant")) -(defparameter *tm2rdf-occurrence-type-uri* (concatenate 'string *tm2rdf-ns* "types/Occurrence")) +(defparameter *tm2rdf-occurrence-type-uri* (concat *tm2rdf-ns* "types/Occurrence")) -(defparameter *tm2rdf-occurrence-property* (concatenate 'string *tm2rdf-ns* "occurrence")) +(defparameter *tm2rdf-occurrence-property* (concat *tm2rdf-ns* "occurrence")) -(defparameter *tm2rdf-role-type-uri* (concatenate 'string *tm2rdf-ns* "types/Role")) +(defparameter *tm2rdf-role-type-uri* (concat *tm2rdf-ns* "types/Role")) -(defparameter *tm2rdf-role-property* (concatenate 'string *tm2rdf-ns* "role")) +(defparameter *tm2rdf-role-property* (concat *tm2rdf-ns* "role")) -(defparameter *tm2rdf-association-type-uri* (concatenate 'string *tm2rdf-ns* "types/Association")) +(defparameter *tm2rdf-association-type-uri* (concat *tm2rdf-ns* "types/Association")) -(defparameter *tm2rdf-association-property* (concatenate 'string *tm2rdf-ns* "association")) +(defparameter *tm2rdf-association-property* (concat *tm2rdf-ns* "association")) -(defparameter *tm2rdf-subjectIdentifier-property* (concatenate 'string *tm2rdf-ns* "subjectIdentifier")) +(defparameter *tm2rdf-subjectIdentifier-property* (concat *tm2rdf-ns* "subjectIdentifier")) -(defparameter *tm2rdf-subjectLocator-property* (concatenate 'string *tm2rdf-ns* "subjectLocator")) +(defparameter *tm2rdf-subjectLocator-property* (concat *tm2rdf-ns* "subjectLocator")) -(defparameter *tm2rdf-itemIdentity-property* (concatenate 'string *tm2rdf-ns* "itemIdentity")) +(defparameter *tm2rdf-itemIdentity-property* (concat *tm2rdf-ns* "itemIdentity")) -(defparameter *tm2rdf-value-property* (concatenate 'string *tm2rdf-ns* "value")) +(defparameter *tm2rdf-value-property* (concat *tm2rdf-ns* "value")) -(defparameter *tm2rdf-nametype-property* (concatenate 'string *tm2rdf-ns* "nametype")) +(defparameter *tm2rdf-nametype-property* (concat *tm2rdf-ns* "nametype")) -(defparameter *tm2rdf-scope-property* (concatenate 'string *tm2rdf-ns* "scope")) +(defparameter *tm2rdf-scope-property* (concat *tm2rdf-ns* "scope")) -(defparameter *tm2rdf-varianttype-property* (concatenate 'string *tm2rdf-ns* "varianttype")) +(defparameter *tm2rdf-varianttype-property* (concat *tm2rdf-ns* "varianttype")) -(defparameter *tm2rdf-occurrencetype-property* (concatenate 'string *tm2rdf-ns* "occurrencetype")) +(defparameter *tm2rdf-occurrencetype-property* (concat *tm2rdf-ns* "occurrencetype")) -(defparameter *tm2rdf-roletype-property* (concatenate 'string *tm2rdf-ns* "roletype")) +(defparameter *tm2rdf-roletype-property* (concat *tm2rdf-ns* "roletype")) -(defparameter *tm2rdf-associationtype-property* (concatenate 'string *tm2rdf-ns* "associationtype")) +(defparameter *tm2rdf-associationtype-property* (concat *tm2rdf-ns* "associationtype")) -(defparameter *tm2rdf-player-property* (concatenate 'string *tm2rdf-ns* "player")) +(defparameter *tm2rdf-player-property* (concat *tm2rdf-ns* "player")) -(defparameter *tm2rdf-reifier-property* (concatenate 'string *tm2rdf-ns* "reifier")) +(defparameter *tm2rdf-reifier-property* (concat *tm2rdf-ns* "reifier")) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Wed Jan 5 18:37:15 2011 @@ -19,8 +19,8 @@ :version "0.1" :author "Marc Kuester, Christoph Ludwig, Lukas Georgieff" :licence "LGPL" - :components ( - (:file "constants") + :components ((:file "constants" + :depends-on ("base-tools")) (:static-file "xml/xtm/core_psis.xtm") (:static-file "xml/rdf/rdf_core_psis.xtm") (:file "xml-constants" @@ -76,6 +76,7 @@ :depends-on ("xtm"))) :depends-on ("constants" "xml-constants" + "base-tools" "model" "threading" "base-tools")) @@ -109,7 +110,8 @@ "xml" "TM-SPARQL" "json" - "threading")) + "threading" + "base-tools")) (:module "unit_tests" :components ((:static-file "textgrid.xtm") (:static-file "textgrid_old.xtm") @@ -197,7 +199,8 @@ :depends-on ("json_tmcl_validation" "json_importer")) (:file "json_delete_interface" :depends-on ("json_importer"))) - :depends-on ("model" + :depends-on ("base-tools" + "model" "xml" "TM-SPARQL")) (:module "ajax" Modified: trunk/src/json/json_exporter.lisp ============================================================================== --- trunk/src/json/json_exporter.lisp (original) +++ trunk/src/json/json_exporter.lisp Wed Jan 5 18:37:15 2011 @@ -43,24 +43,23 @@ (defun resourceX-to-json-string (value datatype &key (xtm-id d:*current-xtm*)) "returns a resourceRef and resourceData json object" - ;(declare (string value datatype)) (if (string= datatype "http://www.w3.org/2001/XMLSchema#anyURI") - (concatenate - 'string "\"resourceRef\":" - (let ((inner-value - (let ((ref-topic (when (and (> (length value) 0) - (eql (elt value 0) #\#)) - (get-item-by-id (subseq value 1) :xtm-id xtm-id)))) - (if ref-topic - (concatenate 'string "#" (topic-id ref-topic)) - value)))) - (json:encode-json-to-string inner-value)) - ",\"resourceData\":null") - (concatenate 'string "\"resourceRef\":null," - "\"resourceData\":{\"datatype\":" - (json:encode-json-to-string datatype) - ",\"value\":" - (json:encode-json-to-string value) "}"))) + (concat "\"resourceRef\":" + (let ((inner-value + (let ((ref-topic + (when (and (> (length value) 0) + (eql (elt value 0) #\#)) + (get-item-by-id (subseq value 1) :xtm-id xtm-id)))) + (if ref-topic + (concat "#" (topic-id ref-topic)) + value)))) + (json:encode-json-to-string inner-value)) + ",\"resourceData\":null") + (concat "\"resourceRef\":null," + "\"resourceData\":{\"datatype\":" + (json:encode-json-to-string datatype) + ",\"value\":" + (json:encode-json-to-string value) "}"))) (defun ref-topics-to-json-string (topics &key (revision *TM-REVISION*)) @@ -82,13 +81,12 @@ "returns a json string of the type of the passed parent-elem" (declare (TypableC parent-elem) (type (or integer null) revision)) - (concatenate - 'string "\"type\":" - (if (instance-of parent-elem :revision revision) - (json:encode-json-to-string - (map 'list #'uri (psis (instance-of parent-elem :revision revision) - :revision revision))) - "null"))) + (concat "\"type\":" + (if (instance-of parent-elem :revision revision) + (json:encode-json-to-string + (map 'list #'uri (psis (instance-of parent-elem :revision revision) + :revision revision))) + "null"))) (defmethod to-json-string ((instance VariantC) &key (xtm-id d:*current-xtm*) @@ -97,15 +95,13 @@ (declare (type (or string null) xtm-id) (type (or integer null) revision)) (let ((itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string instance :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string instance :what 'item-identifiers + :revision revision))) (scope - (concatenate - 'string "\"scopes\":" (ref-topics-to-json-string - (themes instance :revision revision) - :revision revision))) + (concat "\"scopes\":" (ref-topics-to-json-string + (themes instance :revision revision) + :revision revision))) (resourceX (let ((value (when (slot-boundp instance 'charvalue) @@ -114,7 +110,7 @@ (when (slot-boundp instance 'datatype) (datatype instance)))) (resourceX-to-json-string value type :xtm-id xtm-id)))) - (concatenate 'string "{" itemIdentity "," scope "," resourceX "}"))) + (concat "{" itemIdentity "," scope "," resourceX "}"))) (defmethod to-json-string ((instance NameC) &key (xtm-id d:*current-xtm*) @@ -123,40 +119,34 @@ (declare (type (or string null) xtm-id) (type (or integer null) revision)) (let ((itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string instance :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string instance :what 'item-identifiers + :revision revision))) (type (type-to-json-string instance :revision revision)) (scope - (concatenate - 'string "\"scopes\":" - (ref-topics-to-json-string (themes instance :revision revision) - :revision revision))) + (concat "\"scopes\":" + (ref-topics-to-json-string (themes instance :revision revision) + :revision revision))) (value - (concatenate 'string "\"value\":" - (if (slot-boundp instance 'charvalue) - (json:encode-json-to-string (charvalue instance)) - "null"))) + (concat "\"value\":" + (if (slot-boundp instance 'charvalue) + (json:encode-json-to-string (charvalue instance)) + "null"))) (variant (if (variants instance :revision revision) - (concatenate - 'string "\"variants\":" + (concat + "\"variants\":" (let ((j-variants "[")) (loop for variant in (variants instance :revision revision) - do (setf j-variants - (concatenate - 'string j-variants - (json-exporter::to-json-string variant :xtm-id xtm-id - :revision revision) - ","))) - (concatenate - 'string (subseq j-variants 0 - (- (length j-variants) 1)) "]"))) - (concatenate 'string "\"variants\":null")))) - (concatenate 'string "{" itemIdentity "," type "," scope "," value - "," variant "}"))) + do (push-string + (concat (json-exporter::to-json-string + variant :xtm-id xtm-id :revision revision) + ",") + j-variants)) + (concat (subseq j-variants 0 (- (length j-variants) 1)) "]"))) + (concat "\"variants\":null")))) + (concat "{" itemIdentity "," type "," scope "," value "," variant "}"))) (defmethod to-json-string ((instance OccurrenceC) &key (xtm-id d:*current-xtm*) @@ -165,17 +155,15 @@ (declare (type (or string null) xtm-id) (type (or integer null) revision)) (let ((itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string instance :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string instance :what 'item-identifiers + :revision revision))) (type (type-to-json-string instance :revision revision)) (scope - (concatenate - 'string "\"scopes\":" - (ref-topics-to-json-string (themes instance :revision revision) - :revision revision))) + (concat "\"scopes\":" + (ref-topics-to-json-string (themes instance :revision revision) + :revision revision))) (resourceX (let ((value (when (slot-boundp instance 'charvalue) @@ -184,7 +172,7 @@ (when (slot-boundp instance 'datatype) (datatype instance)))) (resourceX-to-json-string value type :xtm-id xtm-id)))) - (concatenate 'string "{" itemIdentity "," type "," scope "," resourceX "}"))) + (concat "{" itemIdentity "," type "," scope "," resourceX "}"))) (defmethod to-json-string ((instance TopicC) &key (xtm-id d:*current-xtm*) @@ -193,59 +181,51 @@ (declare (type (or string null) xtm-id) (type (or integer null) revision)) (let ((id - (concatenate - 'string "\"id\":" - (json:encode-json-to-string (topic-id instance revision)))) + (concat "\"id\":" + (json:encode-json-to-string (topic-id instance revision)))) (itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string instance :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string instance :what 'item-identifiers + :revision revision))) (subjectLocator - (concatenate - 'string "\"subjectLocators\":" - (identifiers-to-json-string instance :what 'locators - :revision revision))) + (concat "\"subjectLocators\":" + (identifiers-to-json-string instance :what 'locators + :revision revision))) (subjectIdentifier - (concatenate - 'string "\"subjectIdentifiers\":" - (identifiers-to-json-string instance :what 'psis - :revision revision))) + (concat "\"subjectIdentifiers\":" + (identifiers-to-json-string instance :what 'psis + :revision revision))) (instanceOf - (concatenate - 'string "\"instanceOfs\":" - (ref-topics-to-json-string (list-instanceOf instance :revision revision) - :revision revision))) + (concat "\"instanceOfs\":" + (ref-topics-to-json-string + (list-instanceOf instance :revision revision) + :revision revision))) (name - (concatenate - 'string "\"names\":" - (if (names instance :revision revision) - (let ((j-names "[")) - (loop for item in (names instance :revision revision) - do (setf j-names - (concatenate - 'string j-names (to-json-string item :xtm-id xtm-id - :revision revision) - ","))) - (concatenate 'string (subseq j-names 0 (- (length j-names) 1)) "]")) - "null"))) + (concat "\"names\":" + (if (names instance :revision revision) + (let ((j-names "[")) + (loop for item in (names instance :revision revision) + do (push-string + (concat (to-json-string item :xtm-id xtm-id + :revision revision) ",") + j-names)) + (concat (subseq j-names 0 (- (length j-names) 1)) "]")) + "null"))) (occurrence - (concatenate - 'string "\"occurrences\":" + (concat + "\"occurrences\":" (if (occurrences instance :revision revision) (let ((j-occurrences "[")) (loop for item in (occurrences instance :revision revision) - do (setf j-occurrences - (concatenate - 'string j-occurrences - (to-json-string item :xtm-id xtm-id :revision revision) - ","))) - (concatenate - 'string (subseq j-occurrences 0 (- (length j-occurrences) 1)) "]")) + do (push-string + (concat + (to-json-string item :xtm-id xtm-id :revision revision) + ",") + j-occurrences)) + (concat (subseq j-occurrences 0 (- (length j-occurrences) 1)) "]")) "null")))) - (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," - subjectIdentifier "," - instanceOf "," name "," occurrence "}"))) + (concat "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier "," + instanceOf "," name "," occurrence "}"))) (defun to-json-topicStub-string (topic &key (revision *TM-REVISION*)) @@ -257,24 +237,19 @@ (type (or integer null) revision)) (when topic (let ((id - (concatenate - 'string "\"id\":" - (json:encode-json-to-string (topic-id topic revision)))) + (concat "\"id\":" + (json:encode-json-to-string (topic-id topic revision)))) (itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string topic :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string topic :what 'item-identifiers + :revision revision))) (subjectLocator - (concatenate - 'string "\"subjectLocators\":" - (identifiers-to-json-string topic :what 'locators :revision revision))) + (concat "\"subjectLocators\":" + (identifiers-to-json-string topic :what 'locators :revision revision))) (subjectIdentifier - (concatenate - 'string "\"subjectIdentifiers\":" - (identifiers-to-json-string topic :what 'psis :revision revision)))) - (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," - subjectIdentifier "}")))) + (concat "\"subjectIdentifiers\":" + (identifiers-to-json-string topic :what 'psis :revision revision)))) + (concat "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier "}")))) (defmethod to-json-string ((instance RoleC) &key (xtm-id d:*current-xtm*) @@ -283,52 +258,46 @@ (declare (ignorable xtm-id) (type (or integer null) revision)) (let ((itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string instance :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string instance :what 'item-identifiers + :revision revision))) (type (type-to-json-string instance :revision revision)) (topicRef - (concatenate - 'string "\"topicRef\":" - (if (player instance :revision revision) - (json:encode-json-to-string - (map 'list #'uri (psis (player instance :revision revision) - :revision revision))) - "null")))) - (concatenate 'string "{" itemIdentity "," type "," topicRef "}"))) + (concat "\"topicRef\":" + (if (player instance :revision revision) + (json:encode-json-to-string + (map 'list #'uri (psis (player instance :revision revision) + :revision revision))) + "null")))) + (concat "{" itemIdentity "," type "," topicRef "}"))) (defmethod to-json-string ((instance AssociationC) &key (xtm-id d:*current-xtm*) (revision *TM-REVISION*)) "transforms an AssociationC object to a json string" (let ((itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string instance :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string instance :what 'item-identifiers + :revision revision))) (type (type-to-json-string instance :revision revision)) (scope - (concatenate - 'string "\"scopes\":" - (ref-topics-to-json-string (themes instance :revision revision) - :revision revision))) + (concat "\"scopes\":" + (ref-topics-to-json-string (themes instance :revision revision) + :revision revision))) (role - (concatenate - 'string "\"roles\":" - (if (roles instance :revision revision) - (let ((j-roles "[")) - (loop for item in (roles instance :revision revision) - do (setf j-roles - (concatenate - 'string j-roles (to-json-string item :xtm-id xtm-id - :revision revision) - ","))) - (concatenate 'string (subseq j-roles 0 (- (length j-roles) 1)) "]")) - "null")))) - (concatenate 'string "{" itemIdentity "," type "," scope "," role "}"))) + (concat "\"roles\":" + (if (roles instance :revision revision) + (let ((j-roles "[")) + (loop for item in (roles instance :revision revision) + do (push-string + (concat (to-json-string item :xtm-id xtm-id + :revision revision) ",") + j-roles)) + (concat (subseq j-roles 0 (- (length j-roles) 1)) "]")) + "null")))) + (concat "{" itemIdentity "," type "," scope "," role "}"))) (defmethod to-json-string ((instance TopicMapC) &key (xtm-id d:*current-xtm*) @@ -349,47 +318,40 @@ (declare (type (or string null) xtm-id) (type (or integer null) revision)) (let ((main-topic - (concatenate - 'string "\"topic\":" - (to-json-string (topic instance) :xtm-id xtm-id :revision revision))) + (concat "\"topic\":" + (to-json-string (topic instance) :xtm-id xtm-id :revision revision))) (topicStubs - (concatenate - 'string "\"topicStubs\":" - (if (referenced-topics instance) - (let ((j-topicStubs "[")) - (loop for item in (referenced-topics instance) - do (setf j-topicStubs - (concatenate - 'string j-topicStubs - (to-json-topicStub-string item :revision revision) - ","))) - (concatenate - 'string (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]")) - "null"))) + (concat "\"topicStubs\":" + (if (referenced-topics instance) + (let ((j-topicStubs "[")) + (loop for item in (referenced-topics instance) + do (push-string + (concat (to-json-topicStub-string item :revision revision) + ",") + j-topicStubs)) + (concat (subseq j-topicStubs 0 (- (length j-topicStubs) 1)) "]")) + "null"))) (associations - (concatenate - 'string "\"associations\":" - (if (associations instance) - (let ((j-associations "[")) - (loop for item in (associations instance) - do (setf j-associations - (concatenate 'string j-associations - (to-json-string item :xtm-id xtm-id - :revision revision) ","))) - (concatenate 'string (subseq j-associations 0 - (- (length j-associations) 1)) "]")) - "null"))) + (concat "\"associations\":" + (if (associations instance) + (let ((j-associations "[")) + (loop for item in (associations instance) + do (push-string + (concat (to-json-string item :xtm-id xtm-id + :revision revision) ",") + j-associations)) + (concat (subseq j-associations 0 + (- (length j-associations) 1)) "]")) + "null"))) (tm-ids - (concatenate - 'string "\"tmIds\":" - (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 "}"))) + (concat "\"tmIds\":" + (let ((uris + (loop for tm in (in-topicmaps (topic instance)) + collect (when (item-identifiers tm) + (uri (first (item-identifiers + tm :revision revision))))))) + (json:encode-json-to-string uris))))) + (concat "{" main-topic "," topicStubs "," associations "," tm-ids "}"))) ;; ============================================================================= @@ -418,45 +380,39 @@ (declare (TopicC topic) (type (or integer null) revision)) (let ((id - (concatenate 'string "\"id\":\"" (topic-id topic revision) "\"")) + (concat "\"id\":\"" (topic-id topic revision) "\"")) (itemIdentity - (concatenate - 'string "\"itemIdentities\":" - (identifiers-to-json-string topic :what 'item-identifiers - :revision revision))) + (concat "\"itemIdentities\":" + (identifiers-to-json-string topic :what 'item-identifiers + :revision revision))) (subjectLocator - (concatenate - 'string "\"subjectLocators\":" - (identifiers-to-json-string topic :what 'locators :revision revision))) + (concat "\"subjectLocators\":" + (identifiers-to-json-string topic :what 'locators :revision revision))) (subjectIdentifier - (concatenate - 'string "\"subjectIdentifiers\":" - (identifiers-to-json-string topic :what 'psis :revision revision))) + (concat "\"subjectIdentifiers\":" + (identifiers-to-json-string topic :what 'psis :revision revision))) (instanceOf - (concatenate - 'string "\"instanceOfs\":" - (ref-topics-to-json-string (list-instanceOf topic :revision revision) - :revision revision))) + (concat "\"instanceOfs\":" + (ref-topics-to-json-string (list-instanceOf topic :revision revision) + :revision revision))) (name - (concatenate - 'string "\"names\":" - (if (names topic :revision revision) - (json:encode-json-to-string - (loop for name in (names topic :revision revision) - when (slot-boundp name 'charvalue) - collect (charvalue name))) - "null"))) + (concat "\"names\":" + (if (names topic :revision revision) + (json:encode-json-to-string + (loop for name in (names topic :revision revision) + when (slot-boundp name 'charvalue) + collect (charvalue name))) + "null"))) (occurrence - (concatenate - 'string "\"occurrences\":" - (if (occurrences topic :revision revision) - (json:encode-json-to-string - (loop for occurrence in (occurrences topic :revision revision) - when (slot-boundp occurrence 'charvalue) - collect (charvalue occurrence))) - "null")))) - (concatenate 'string "{" id "," itemIdentity "," subjectLocator "," - subjectIdentifier "," instanceOf "," name "," occurrence "}"))) + (concat "\"occurrences\":" + (if (occurrences topic :revision revision) + (json:encode-json-to-string + (loop for occurrence in (occurrences topic :revision revision) + when (slot-boundp occurrence 'charvalue) + collect (charvalue occurrence))) + "null")))) + (concat "{" id "," itemIdentity "," subjectLocator "," subjectIdentifier + "," instanceOf "," name "," occurrence "}"))) (defun make-topic-summary (topic-list &key (revision *TM-REVISION*)) @@ -466,15 +422,12 @@ (if topic-list (let ((json-string (let ((inner-string nil)) - (concatenate - 'string - (loop for topic in topic-list - do (setf inner-string - (concatenate - 'string inner-string - (to-json-string-summary topic :revision revision) ",")))) + (loop for topic in topic-list + do (push-string + (concat (to-json-string-summary topic :revision revision) ",") + inner-string)) (subseq inner-string 0 (- (length inner-string) 1))))) - (concatenate 'string "[" json-string "]")) + (concat "[" json-string "]")) "null")) @@ -491,9 +444,8 @@ (let ((j-str "{")) (loop for entry in query-result do (push-string - (concatenate - 'string + (concat (json:encode-json-to-string (getf entry :variable)) ":" (json:encode-json-to-string (getf entry :result)) ",") j-str)) - (concatenate 'string (subseq j-str 0 (- (length j-str) 1)) "}"))))) \ No newline at end of file + (concat (subseq j-str 0 (- (length j-str) 1)) "}"))))) \ No newline at end of file Modified: trunk/src/json/json_tmcl.lisp ============================================================================== --- trunk/src/json/json_tmcl.lisp (original) +++ trunk/src/json/json_tmcl.lisp Wed Jan 5 18:37:15 2011 @@ -41,7 +41,7 @@ (let ((value (get-constraints-of-topic topics :treat-as treat-as :revision revision))) - (concatenate 'string "\"topicConstraints\":" value)))) + (concat "\"topicConstraints\":" value)))) (let ((available-associations (remove-duplicates (loop for topic in topics @@ -51,29 +51,22 @@ (topictype-p item associationtype associationtype-constraint nil revision)) (let ((associations-constraints - (concatenate - 'string "\"associationsConstraints\":" - (let ((inner-associations-constraints "[")) - (loop for available-association in available-associations - do (let ((value - (get-constraints-of-association - available-association :revision revision))) - (setf inner-associations-constraints - (concatenate 'string inner-associations-constraints - value ",")))) - (if (string= inner-associations-constraints "[") - (setf inner-associations-constraints "null") - (setf inner-associations-constraints - (concatenate - 'string - (subseq inner-associations-constraints 0 - (- (length inner-associations-constraints) 1)) - "]"))))))) - (let ((json-string - (concatenate 'string - "{" topic-constraints "," associations-constraints - "}"))) - json-string))))))) + (concat "\"associationsConstraints\":" + (let ((inner-associations-constraints "[")) + (loop for available-association in available-associations + do (let ((value + (get-constraints-of-association + available-association :revision revision))) + (push-string (concat value ",") + inner-associations-constraints))) + (if (string= inner-associations-constraints "[") + (setf inner-associations-constraints "null") + (setf inner-associations-constraints + (concat + (subseq inner-associations-constraints 0 + (- (length inner-associations-constraints) 1)) + "]"))))))) + (concat "{" topic-constraints "," associations-constraints "}"))))))) ;; ============================================================================= @@ -89,26 +82,26 @@ (get-all-constraint-topics-of-association associationtype-topic :revision revision))) (let ((associationtype - (concatenate 'string "\"associationType\":" - (json-exporter::identifiers-to-json-string - associationtype-topic :revision revision))) + (concat "\"associationType\":" + (json-exporter::identifiers-to-json-string + associationtype-topic :revision revision))) (associationtypescope-constraints (let ((value (get-typescope-constraints associationtype-topic :what 'association :revision revision))) - (concatenate 'string "\"scopeConstraints\":" value))) + (concat "\"scopeConstraints\":" value))) (associationrole-constraints (let ((value (get-associationrole-constraints (getf constraint-topics :associationrole-constraints) :revision revision))) - (concatenate 'string "\"associationRoleConstraints\":" value))) + (concat "\"associationRoleConstraints\":" value))) (roleplayer-constraints (let ((value (get-roleplayer-constraints (getf constraint-topics :roleplayer-constraints) :revision revision))) - (concatenate 'string "\"rolePlayerConstraints\":" value))) + (concat "\"rolePlayerConstraints\":" value))) (otherrole-constraints (let ((value (handler-case @@ -116,13 +109,10 @@ (getf constraint-topics :otherrole-constraints) :revision revision) (condition () "null")))) - (concatenate 'string "\"otherRoleConstraints\":" value)))) - (let ((json-string - (concatenate 'string "{" associationtype "," associationrole-constraints - "," roleplayer-constraints "," - otherrole-constraints "," associationtypescope-constraints - "}"))) - json-string)))) + (concat "\"otherRoleConstraints\":" value)))) + (concat "{" associationtype "," associationrole-constraints + "," roleplayer-constraints "," otherrole-constraints "," + associationtypescope-constraints "}")))) (defun get-otherrole-constraints (constraint-topics &key (revision *TM-REVISION*)) @@ -271,69 +261,66 @@ constraint-lists)) (let ((json-player-type - (concatenate - 'string "\"playerType\":" - (topics-to-json-list - (getf (list-subtypes (getf involved-topic-tupple :player) - nil nil nil nil revision) - :subtypes) :revision revision))) + (concat "\"playerType\":" + (topics-to-json-list + (getf (list-subtypes + (getf involved-topic-tupple :player) + nil nil nil nil revision) + :subtypes) :revision revision))) (json-player - (concatenate - 'string "\"players\":" - (topics-to-json-list - (list-instances (getf involved-topic-tupple :player) - topictype topictype-constraint revision) - :revision revision))) + (concat "\"players\":" + (topics-to-json-list + (list-instances + (getf involved-topic-tupple :player) + topictype topictype-constraint revision) + :revision revision))) (json-role - (concatenate - 'string "\"roleType\":" - (topics-to-json-list - (getf (list-subtypes (getf involved-topic-tupple :role) - roletype roletype-constraint nil - nil revision) - :subtypes) :revision revision))) + (concat "\"roleType\":" + (topics-to-json-list + (getf (list-subtypes + (getf involved-topic-tupple :role) + roletype roletype-constraint nil + nil revision) + :subtypes) :revision revision))) (json-otherplayer-type - (concatenate - 'string "\"otherPlayerType\":" - (topics-to-json-list - (getf (list-subtypes - (getf involved-topic-tupple :otherplayer) - nil nil nil nil revision) :subtypes) - :revision revision))) + (concat "\"otherPlayerType\":" + (topics-to-json-list + (getf (list-subtypes + (getf involved-topic-tupple :otherplayer) + nil nil nil nil revision) :subtypes) + :revision revision))) (json-otherplayer - (concatenate - 'string "\"otherPlayers\":" - (topics-to-json-list - (list-instances (getf involved-topic-tupple :otherplayer) - topictype topictype-constraint revision) - :revision revision))) + (concat "\"otherPlayers\":" + (topics-to-json-list + (list-instances + (getf involved-topic-tupple :otherplayer) + topictype topictype-constraint revision) + :revision revision))) (json-otherrole - (concatenate - 'string "\"otherRoleType\":" - (topics-to-json-list - (getf (list-subtypes - (getf involved-topic-tupple :otherrole) - roletype roletype-constraint nil nil revision) - :subtypes) :revision revision))) + (concat "\"otherRoleType\":" + (topics-to-json-list + (getf (list-subtypes + (getf involved-topic-tupple :otherrole) + roletype roletype-constraint nil nil revision) + :subtypes) :revision revision))) (card-min - (concatenate 'string "\"cardMin\":" - (getf (first constraint-lists) :card-min))) + (concat "\"cardMin\":" + (getf (first constraint-lists) :card-min))) (card-max - (concatenate 'string "\"cardMax\":" - (getf (first constraint-lists) :card-max)))) + (concat "\"cardMax\":" + (getf (first constraint-lists) :card-max)))) (setf cleaned-otherrole-constraints - (concatenate 'string cleaned-otherrole-constraints - "{" json-player-type "," json-player "," - json-role "," json-otherplayer-type "," - json-otherplayer "," json-otherrole "," - card-min "," card-max "},"))))) + (concat cleaned-otherrole-constraints + "{" json-player-type "," json-player "," + json-role "," json-otherplayer-type "," + json-otherplayer "," json-otherrole "," + card-min "," card-max "},"))))) (if (string= cleaned-otherrole-constraints "[") (setf cleaned-otherrole-constraints "null") (setf cleaned-otherrole-constraints - (concatenate - 'string (subseq cleaned-otherrole-constraints 0 - (- (length cleaned-otherrole-constraints) 1)) - "]"))) + (concat (subseq cleaned-otherrole-constraints 0 + (- (length cleaned-otherrole-constraints) 1)) + "]"))) cleaned-otherrole-constraints))))) @@ -442,47 +429,44 @@ :revision revision))) constraint-lists)) (let ((json-player-type - (concatenate - 'string "\"playerType\":" - (topics-to-json-list - (getf (list-subtypes (getf role-player-tupple :player) - nil nil nil nil revision) :subtypes) - :revision revision))) + (concat "\"playerType\":" + (topics-to-json-list + (getf (list-subtypes + (getf role-player-tupple :player) + nil nil nil nil revision) :subtypes) + :revision revision))) (json-players - (concatenate - 'string "\"players\":" - (topics-to-json-list - (list-instances (getf role-player-tupple :player) - topictype topictype-constraint revision) - :revision revision))) + (concat "\"players\":" + (topics-to-json-list + (list-instances + (getf role-player-tupple :player) + topictype topictype-constraint revision) + :revision revision))) (json-role - (concatenate - 'string "\"roleType\":" - (topics-to-json-list - (getf (list-subtypes (getf role-player-tupple :role) - roletype roletype-constraint nil - nil revision) - :subtypes) - :revision revision))) + (concat "\"roleType\":" + (topics-to-json-list + (getf (list-subtypes + (getf role-player-tupple :role) + roletype roletype-constraint nil + nil revision) + :subtypes) + :revision revision))) (card-min - (concatenate - 'string "\"cardMin\":" - (getf (first constraint-lists) :card-min))) + (concat "\"cardMin\":" + (getf (first constraint-lists) :card-min))) (card-max - (concatenate - 'string "\"cardMax\":" - (getf (first constraint-lists) :card-max)))) + (concat "\"cardMax\":" + (getf (first constraint-lists) :card-max)))) (setf cleaned-roleplayer-constraints - (concatenate 'string cleaned-roleplayer-constraints - "{" json-player-type "," json-players "," - json-role "," card-min "," card-max "},"))))) + (concat cleaned-roleplayer-constraints + "{" json-player-type "," json-players "," + json-role "," card-min "," card-max "},"))))) (if (string= cleaned-roleplayer-constraints "[") (setf cleaned-roleplayer-constraints "null") (setf cleaned-roleplayer-constraints - (concatenate - 'string (subseq cleaned-roleplayer-constraints 0 - (- (length cleaned-roleplayer-constraints) 1)) - "]"))) + (concat (subseq cleaned-roleplayer-constraints 0 + (- (length cleaned-roleplayer-constraints) 1)) + "]"))) cleaned-roleplayer-constraints))))) @@ -555,20 +539,18 @@ roletype roletype-constraint nil nil revision) :subtypes))))) (setf cleaned-associationrole-constraints - (concatenate 'string - cleaned-associationrole-constraints - "{\"roleType\":" roletype-with-subtypes - ",\"cardMin\":" (getf (first constraint-lists) - :card-min) - ",\"cardMax\":" (getf (first constraint-lists) - :card-max) "},"))))) + (concat cleaned-associationrole-constraints + "{\"roleType\":" roletype-with-subtypes + ",\"cardMin\":" (getf (first constraint-lists) + :card-min) + ",\"cardMax\":" (getf (first constraint-lists) + :card-max) "},"))))) (if (string= cleaned-associationrole-constraints "[") (setf cleaned-associationrole-constraints "null") (setf cleaned-associationrole-constraints - (concatenate - 'string (subseq cleaned-associationrole-constraints 0 - (- (length cleaned-associationrole-constraints) - 1)) "]"))) + (concat (subseq cleaned-associationrole-constraints 0 + (- (length cleaned-associationrole-constraints) + 1)) "]"))) cleaned-associationrole-constraints))))) @@ -627,51 +609,49 @@ (let ((value "[")) (loop for exclusive-instance-constraint in exclusive-instance-constraints do (setf value - (concatenate 'string value - (get-exclusive-instance-constraints - (first exclusive-instance-constraint) - (second exclusive-instance-constraint) - :revision revision) ","))) + (concat value (get-exclusive-instance-constraints + (first exclusive-instance-constraint) + (second exclusive-instance-constraint) + :revision revision) ","))) (if (string= value "[") (setf value "null") - (setf value (concatenate 'string (subseq value 0 - (- (length value) 1)) "]"))) - (concatenate 'string "\"exclusiveInstances\":" value))) + (setf value (concat (subseq value 0 (- (length value) 1)) "]"))) + (concat "\"exclusiveInstances\":" value))) (subjectidentifier-constraints (let ((value (get-simple-constraints subjectidentifier-constraints :error-msg-constraint-name "subjectidentifier" :revision revision))) - (concatenate 'string "\"subjectIdentifierConstraints\":" value))) + (concat "\"subjectIdentifierConstraints\":" value))) (subjectlocator-constraints (let ((value (get-simple-constraints subjectlocator-constraints :error-msg-constraint-name "subjectlocator" :revision revision))) - (concatenate 'string "\"subjectLocatorConstraints\":" value))) + (concat "\"subjectLocatorConstraints\":" value))) (topicname-constraints (let ((value (get-topicname-constraints topicname-constraints :revision revision))) - (concatenate 'string "\"topicNameConstraints\":" value))) + (concat "\"topicNameConstraints\":" value))) (topicoccurrence-constraints (let ((value (get-topicoccurrence-constraints topicoccurrence-constraints uniqueoccurrence-constraints :revision revision))) - (concatenate 'string "\"topicOccurrenceConstraints\":" value))) + (concat "\"topicOccurrenceConstraints\":" value))) (abstract-constraint - (concatenate 'string "\"abstractConstraint\":" - (if abstract-topictype-constraints - "true" - "false")))) + (concat "\"abstractConstraint\":" + (if abstract-topictype-constraints + "true" + "false")))) (let ((json-string - (concatenate 'string "{" exclusive-instance-constraints "," - subjectidentifier-constraints - "," subjectlocator-constraints "," topicname-constraints "," - topicoccurrence-constraints "," abstract-constraint "}"))) + (concat "{" exclusive-instance-constraints "," + subjectidentifier-constraints "," subjectlocator-constraints + "," topicname-constraints "," topicoccurrence-constraints + "," abstract-constraint "}"))) json-string)))) @@ -721,15 +701,15 @@ (player other-role :revision revision) topictype topictype-constraint nil nil revision) :subtypes))))))))) - (concatenate 'string "{\"owner\":" (json-exporter::identifiers-to-json-string - owner :revision revision) - ",\"exclusives\":" - (json:encode-json-to-string - (map 'list #'(lambda(y) - (map 'list #'uri y)) - (map 'list #'(lambda(z) - (psis z :revision revision)) - topics))) "}")))) + (concat "{\"owner\":" (json-exporter::identifiers-to-json-string + owner :revision revision) + ",\"exclusives\":" + (json:encode-json-to-string + (map 'list #'(lambda(y) + (map 'list #'uri y)) + (map 'list #'(lambda(z) + (psis z :revision revision)) + topics))) "}")))) (defun get-simple-constraints(constraint-topics &key @@ -763,21 +743,19 @@ (let ((constraints "[")) (loop for constraint in simple-constraints do (let ((constraint - (concatenate - 'string "{\"regexp\":" - (json:encode-json-to-string (getf constraint :regexp)) - ",\"cardMin\":" - (json:encode-json-to-string (getf constraint :card-min)) - ",\"cardMax\":" - (json:encode-json-to-string (getf constraint :card-max)) - "}"))) + (concat "{\"regexp\":" + (json:encode-json-to-string (getf constraint :regexp)) + ",\"cardMin\":" + (json:encode-json-to-string (getf constraint :card-min)) + ",\"cardMax\":" + (json:encode-json-to-string (getf constraint :card-max)) + "}"))) (if (string= constraints "[") - (setf constraints (concatenate 'string constraints constraint)) - (setf constraints (concatenate 'string constraints "," constraint))))) + (push-string constraint constraints) + (push-string (concat "," constraint) constraints)))) (if (string= constraints "[") - (setf constraints "null") - (setf constraints (concatenate 'string constraints "]"))) - constraints)) + "null" + (concat constraints "]")))) (defun get-topicname-constraints(constraint-topics &key (revision *TM-REVISION*)) @@ -850,8 +828,8 @@ (let ((nametypescopes "\"nametypescopes\":[")) (loop for current-topic in nametype-with-subtypes do (let ((current-json-string - (concatenate - 'string "{\"nameType\":" + (concat + "{\"nameType\":" (json-exporter::identifiers-to-json-string current-topic :revision revision) ",\"scopeConstraints\":" @@ -859,30 +837,25 @@ :what 'topicname :revision revision) "}"))) - (setf nametypescopes - (concatenate 'string nametypescopes - current-json-string ",")))) + (push-string (concat current-json-string ",") + nametypescopes))) (if (string= nametypescopes "\"nametypescopes\"[") (setf nametypescopes "null") (setf nametypescopes - (concatenate - 'string (subseq nametypescopes 0 - (- (length nametypescopes) 1)) "]"))) + (concat (subseq nametypescopes 0 + (- (length nametypescopes) 1)) "]"))) (let ((json-constraint-lists - (concatenate - 'string "\"constraints\":" - (simple-constraints-to-json constraint-lists)))) + (concat "\"constraints\":" + (simple-constraints-to-json constraint-lists)))) (setf cleaned-topicname-constraints - (concatenate - 'string cleaned-topicname-constraints "{" - nametypescopes "," json-constraint-lists "},"))))))) + (concat cleaned-topicname-constraints "{" + nametypescopes "," json-constraint-lists "},"))))))) (if (string= cleaned-topicname-constraints "[") (setf cleaned-topicname-constraints "null") (setf cleaned-topicname-constraints - (concatenate - 'string (subseq cleaned-topicname-constraints 0 - (- (length cleaned-topicname-constraints) 1)) - "]"))) + (concat (subseq cleaned-topicname-constraints 0 + (- (length cleaned-topicname-constraints) 1)) + "]"))) cleaned-topicname-constraints))))) @@ -963,51 +936,43 @@ (let ((occurrencetypes-json-string "\"occurrenceTypes\":[")) (loop for current-topic in occurrencetype-with-subtypes do (let ((current-json-string - (concatenate - 'string "{\"occurrenceType\":" - (json-exporter::identifiers-to-json-string - current-topic :revision revision) - ",\"scopeConstraints\":" - (get-typescope-constraints - current-topic :what 'topicoccurrence - :revision revision) - ",\"datatypeConstraint\":" - (get-occurrence-datatype-constraint - current-topic :revision revision) - "}"))) - (setf occurrencetypes-json-string - (concatenate 'string occurrencetypes-json-string - current-json-string ",")))) + (concat "{\"occurrenceType\":" + (json-exporter::identifiers-to-json-string + current-topic :revision revision) + ",\"scopeConstraints\":" + (get-typescope-constraints + current-topic :what 'topicoccurrence + :revision revision) + ",\"datatypeConstraint\":" + (get-occurrence-datatype-constraint + current-topic :revision revision) + "}"))) + (push-string (concat current-json-string ",") + occurrencetypes-json-string))) (if (string= occurrencetypes-json-string "\"occurrenceTypes\"[") (setf occurrencetypes-json-string "null") (setf occurrencetypes-json-string - (concatenate - 'string (subseq occurrencetypes-json-string 0 - (- (length - occurrencetypes-json-string) 1)) - "]"))) + (concat (subseq occurrencetypes-json-string 0 + (- (length + occurrencetypes-json-string) 1)) + "]"))) (let ((unique-constraints - (concatenate 'string "\"uniqueConstraints\":" - (get-simple-constraints - unique-constraint-topics - :revision revision))) + (concat "\"uniqueConstraints\":" + (get-simple-constraints unique-constraint-topics + :revision revision))) (json-constraint-lists - (concatenate - 'string "\"constraints\":" - (simple-constraints-to-json constraint-lists)))) + (concat "\"constraints\":" + (simple-constraints-to-json constraint-lists)))) (let ((current-json-string - (concatenate - 'string "{" occurrencetypes-json-string "," - json-constraint-lists "," unique-constraints "}"))) - (setf cleaned-topicoccurrence-constraints - (concatenate - 'string cleaned-topicoccurrence-constraints - current-json-string ",")))))))) + (concat "{" occurrencetypes-json-string "," + json-constraint-lists "," + unique-constraints "}"))) + (push-string (concat current-json-string ",") + cleaned-topicoccurrence-constraints))))))) (if (string= cleaned-topicoccurrence-constraints "[") (setf cleaned-topicoccurrence-constraints "null") (setf cleaned-topicoccurrence-constraints - (concatenate - 'string + (concat (subseq cleaned-topicoccurrence-constraints 0 (- (length cleaned-topicoccurrence-constraints) 1)) "]"))) @@ -1185,8 +1150,8 @@ (let ((card-min (getf (first constraint-lists) :card-min)) (card-max (getf (first constraint-lists) :card-max))) (let ((json-scopes - (concatenate - 'string "\"scopeTypes\":" + (concat + "\"scopeTypes\":" (let ((scopetypes-with-subtypes (remove-if #'null @@ -1207,17 +1172,15 @@ topic-group)) scopetypes-with-subtypes)))))) (let ((current-json-string - (concatenate 'string "{" json-scopes - ",\"cardMin\":\"" card-min - "\",\"cardMax\":\"" card-max "\"}"))) - (setf cleaned-typescope-constraints - (concatenate 'string cleaned-typescope-constraints - current-json-string ","))))))) + (concat "{" json-scopes + ",\"cardMin\":\"" card-min + "\",\"cardMax\":\"" card-max "\"}"))) + (push-string (concat current-json-string ",") + cleaned-typescope-constraints)))))) (if (string= cleaned-typescope-constraints "[") (setf cleaned-typescope-constraints "null") (setf cleaned-typescope-constraints - (concatenate - 'string + (concat (subseq cleaned-typescope-constraints 0 (- (length cleaned-typescope-constraints) 1)) "]"))) cleaned-typescope-constraints))))))) @@ -1725,16 +1688,14 @@ (defun tree-view-to-json-string (tree-views) "Returns a full tree-view as json-string." (let ((json-string - (concatenate - 'string "[" + (concat + "[" (if tree-views (let ((inner-string "")) (loop for tree-view in tree-views - do (setf inner-string - (concatenate 'string inner-string - (node-to-json-string tree-view) ","))) - (concatenate 'string (subseq inner-string 0 - (- (length inner-string) 1)) "]")) + do (push-string (concat (node-to-json-string tree-view) ",") + inner-string)) + (concat (subseq inner-string 0 (- (length inner-string) 1)) "]")) "null")))) json-string)) @@ -1784,50 +1745,46 @@ (declare (type (or integer null) revision) (list node)) (let ((topic-psis - (concatenate - 'string "\"topic\":" + (concat + "\"topic\":" (json:encode-json-to-string (map 'list #'d:uri (d:psis (getf node :topic) :revision revision))))) (is-type - (concatenate 'string "\"isType\":" - (if (getf node :is-type) - "true" - "false"))) + (concat "\"isType\":" (if (getf node :is-type) + "true" + "false"))) (is-instance - (concatenate 'string "\"isInstance\":" - (if (getf node :is-instance) - "true" - "false"))) + (concat "\"isInstance\":" (if (getf node :is-instance) + "true" + "false"))) (instances - (concatenate - 'string "\"instances\":" + (concat + "\"instances\":" (if (getf node :instances) (let ((inner-string "[")) (loop for instance-node in (getf node :instances) do (setf inner-string - (concatenate - 'string inner-string + (concat + inner-string (node-to-json-string instance-node :revision revision) ","))) - (concatenate 'string (subseq inner-string 0 - (- (length inner-string) 1)) "]")) + (concat (subseq inner-string 0 (- (length inner-string) 1)) "]")) "null"))) (subtypes - (concatenate - 'string "\"subtypes\":" + (concat + "\"subtypes\":" (if (getf node :subtypes) (let ((inner-string "[")) (loop for instance-node in (getf node :subtypes) - do (setf inner-string - (concatenate 'string inner-string - (node-to-json-string instance-node - :revision revision) - ","))) - (concatenate 'string (subseq inner-string 0 - (- (length inner-string) 1)) "]")) + do (push-string (concat + (node-to-json-string instance-node + :revision revision) + ",") + inner-string)) + (concat (subseq inner-string 0 (- (length inner-string) 1)) "]")) "null")))) - (concatenate 'string "{" topic-psis "," is-type "," is-instance "," instances - "," subtypes"}"))) + (concat "{" topic-psis "," is-type "," is-instance "," instances + "," subtypes"}"))) (defun make-nodes (topic-instance is-type is-instance &key (revision *TM-REVISION*)) Modified: trunk/src/json/json_tmcl_validation.lisp ============================================================================== --- trunk/src/json/json_tmcl_validation.lisp (original) +++ trunk/src/json/json_tmcl_validation.lisp Wed Jan 5 18:37:15 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :json-tmcl - (:use :cl :datamodel :constants :json-tmcl-constants :json-importer) + (:use :cl :datamodel :constants :json-tmcl-constants :json-importer :base-tools) (:export :get-constraints-of-fragment :topictype-p :abstract-p Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Wed Jan 5 18:37:15 2011 @@ -1634,7 +1634,7 @@ (unless possible-identifiers (error (make-object-not-found-condition (format nil "Could not find an object ~a in xtm-id ~a" construct xtm-id)))) (uri (first possible-identifiers))) - (concatenate 'string "t" (write-to-string (internal-id construct)))))) + (concat "t" (write-to-string (internal-id construct)))))) (defgeneric topic-identifiers (construct &key revision) Modified: trunk/src/rest_interface/rest-interface.lisp ============================================================================== --- trunk/src/rest_interface/rest-interface.lisp (original) +++ trunk/src/rest_interface/rest-interface.lisp Wed Jan 5 18:37:15 2011 @@ -21,6 +21,7 @@ :xml-importer :json-exporter :json-importer + :base-tools :isidorus-threading) (:export :import-fragments-feed :import-snapshots-feed 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 Wed Jan 5 18:37:15 2011 @@ -532,37 +532,14 @@ (let ((last-position-of-current-path (- (length current-path-string) 1))) (let ((current-url - (concatenate - 'string url-prefix + (concat + url-prefix (subseq current-path-string start-position-of-relative-path last-position-of-current-path)))) (push (list :path current-path :url current-url) files-and-urls)))))) files-and-urls))) -(defun string-replace (str search-str replace-str) - "replaces all sub-strings in str of the form search-str with - the string replace-str and returns the new generated string" - (if (= (length search-str) 0) - str - (progn - (let ((ret-str "") - (idx 0)) - (loop - (if (string= str search-str - :start1 idx - :end1 (min (length str) - (+ idx (length search-str)))) - (progn - (setf ret-str (concatenate 'string ret-str replace-str)) - (incf idx (length search-str))) - (progn - (setf ret-str (concatenate 'string ret-str (subseq str idx (1+ idx)))) - (incf idx))) - (unless (< idx (length str)) - (return ret-str))))))) - - (defun init-cache() "Initializes the type and instance cache-tables with all valid types/instances" (with-writer-lock Modified: trunk/src/unit_tests/datamodel_test.lisp ============================================================================== --- trunk/src/unit_tests/datamodel_test.lisp (original) +++ trunk/src/unit_tests/datamodel_test.lisp Wed Jan 5 18:37:15 2011 @@ -13,6 +13,7 @@ :datamodel :it.bese.FiveAM :fixtures + :base-tools :unittests-constants) (:import-from :exceptions duplicate-identifier-error @@ -481,12 +482,10 @@ :revision rev-0))) (is (eql top-3 (get-item-by-id - (concatenate 'string "t" (write-to-string - (elephant::oid top-3))) + (concat "t" (write-to-string (elephant::oid top-3))) :revision rev-0 :xtm-id nil))) (is-false (get-item-by-id - (concatenate 'string "t" (write-to-string - (elephant::oid top-3))) + (concat "t" (write-to-string (elephant::oid top-3))) :revision rev-1 :xtm-id nil))))) Modified: trunk/src/unit_tests/json_test.lisp ============================================================================== --- trunk/src/unit_tests/json_test.lisp (original) +++ trunk/src/unit_tests/json_test.lisp Wed Jan 5 18:37:15 2011 @@ -14,6 +14,7 @@ :json-exporter :json-importer :json-tmcl + :base-tools :datamodel :it.bese.FiveAM :unittests-constants @@ -86,28 +87,28 @@ (let ((t50a (get-item-by-id "t50a" :xtm-id *TEST-TM* :revision rev-0))) (let ((t50a-string (to-json-string t50a :revision 0)) (json-string - (concatenate 'string "{\"id\":\"" (topic-id t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) + (concat "{\"id\":\"" (topic-id t50a) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t50a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/occurrence-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"long version of a name\",\"variants\":[{\"itemIdentities\":null,\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Long-Version\"}}]}],\"occurrences\":null}" ))) (is (string= t50a-string json-string))) (let ((t8 (get-item-by-id "t8" :revision rev-0 :xtm-id *TEST-TM*))) (let ((t8-string (to-json-string t8 :revision rev-0 :xtm-id *TEST-TM*)) (json-string - (concatenate 'string "{\"id\":\"" (topic-id t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) + (concat "{\"id\":\"" (topic-id t8) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t8\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/association-role-type\"],\"instanceOfs\":[[\"http:\\/\\/www.networkedplanet.com\\/psi\\/npcl\\/meta-types\\/topic-type\"]],\"names\":[{\"itemIdentities\":null,\"type\":null,\"scopes\":null,\"value\":\"Association Role Type\",\"variants\":null}],\"occurrences\":null}"))) (is (string= t8-string json-string)))) (let ((t-topic (get-item-by-id "topic" :xtm-id "core.xtm" :revision rev-0))) (let ((t-topic-string (to-json-string t-topic :xtm-id "core.xtm" :revision rev-0)) (json-string - (concatenate 'string "{\"id\":\"" (topic-id t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) + (concat "{\"id\":\"" (topic-id t-topic) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null}"))) (is (string= t-topic-string json-string)))) (let ((t301 (get-item-by-id "t301" :xtm-id *TEST-TM* :revision rev-0))) (let ((t301-string (to-json-string t301 :xtm-id *TEST-TM* :revision rev-0)) (json-string - (concatenate 'string "{\"id\":\"" (topic-id t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}"))) + (concat "{\"id\":\"" (topic-id t301) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/service\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/topic\\/t301a_n1\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps\",\"variants\":null},{\"itemIdentities\":null,\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/long-name\"]],\"value\":\"Google Maps Application\",\"variants\":null}],\"occurrences\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"a popular geodata service that is widely used for mashups with geodataProbably not really conformant to ISO 19115, but who cares in this context.\"}},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.com\",\"resourceData\":null},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/maps.google.de\",\"resourceData\":null}]}"))) (is (string= t301-string json-string)))) (let ((t100 (get-item-by-id "t100" :revision rev-0 :xtm-id *TEST-TM*))) (let ((t100-string (to-json-string t100 :revision rev-0 :xtm-id *TEST-TM*)) (json-string - (concatenate 'string "{\"id\":\"" (topic-id t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}"))) + (concat "{\"id\":\"" (topic-id t100) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]}"))) (is (string= t100-string json-string)))))))) @@ -152,12 +153,12 @@ (let ((association-1-string (to-json-string association-1 :revision rev-0 :xtm-id *TEST-TM*)) (json-string - (concatenate 'string "{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/broaderSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Data\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/narrowerSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]}"))) + (concat "{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/isNarrowerSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/broaderSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Data\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/narrowerSubject\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]}"))) (is (string= association-1-string json-string))) (let ((association-7-string (to-json-string association-7 :revision rev-0 :xtm-id *TEST-TM*)) (json-string - (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}"))) + (concat "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}"))) (is (string= association-7-string json-string))) (let ((rev-1 (get-revision))) (delete-role association-7 (first (roles association-7 :revision 0)) @@ -171,7 +172,7 @@ (let ((association-7-string (to-json-string association-7 :revision rev-0 :xtm-id *TEST-TM*)) (json-string - (concatenate 'string "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]],\"roles\":null}"))) + (concat "{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":null,\"scopes\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]],\"roles\":null}"))) (is (string= association-7-string json-string)))))))) @@ -189,9 +190,9 @@ (frag-topic (create-latest-fragment-of-topic "http://www.topicmaps.org/xtm/1.0/core.xtm#topic"))) (let ((frag-t100-string - (concatenate 'string "{\"topic\":{\"id\":\"" (d:topic-id (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}")) + (concat "{\"topic\":{\"id\":\"" (d:topic-id (d:topic frag-t100)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"],\"instanceOfs\":[[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]],\"names\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1\"],\"type\":null,\"scopes\":null,\"value\":\"ISO 19115\",\"variants\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v1\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"Geographic Information - Metadata\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_n1_v2\"],\"scopes\":[[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]],\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"ISO-19115\"}}]}],\"occurrences\":[{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o1\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.budabe.de\\/\",\"resourceData\":null},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o2\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#string\",\"value\":\"The ISO 19115 standard ...\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o3\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"],\"scopes\":null,\"resourceRef\":null,\"resourceData\":{\"datatype\":\"http:\\/\\/www.w3.org\\/2001\\/XMLSchema#date\",\"value\":\"2003-01-01\"}},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t100_o4\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"],\"scopes\":null,\"resourceRef\":\"http:\\/\\/www.editeur.org\\/standards\\/ISO19115.pdf\",\"resourceData\":null}]},\"topicStubs\":[{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 0)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t3a\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/semanticstandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 1)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#display\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 2)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#sort\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 3)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t51\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardHasStatus\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 4)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t53\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 5)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t54\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardValidFromDate\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 6)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t55\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/links\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 7)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 8)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t60\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 9)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t61\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 10)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 11)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t64\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 12)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t63\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 13)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"id\":\"" (topic-id (elt (referenced-topics frag-t100) 14)) "\",\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#t62\"],\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"]}],\"associations\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/GeoData\"]}]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/standardIsAboutSubject\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/SubjectRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/subject\\/Semantic+Description\"]}]},{\"itemIdentities\":[\"http:\\/\\/psi.egovpt.org\\/itemIdentifiers#assoc_7\"],\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/serviceUsesStandard\"],\"scopes\":null,\"roles\":[{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/ServiceRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/service\\/Google+Maps\",\"http:\\/\\/maps.google.com\"]},{\"itemIdentities\":null,\"type\":[\"http:\\/\\/psi.egovpt.org\\/types\\/StandardRoleType\"],\"topicRef\":[\"http:\\/\\/psi.egovpt.org\\/standard\\/ISO+19115%3A+Geographic+Information+-+Metadata\"]}]}],\"tmIds\":[\"http:\\/\\/www.isidor.us\\/unittests\\/testtm\"]}")) (frag-topic-string - (concatenate 'string "{\"topic\":{\"id\":\"" (topic-id (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}"))) + (concat "{\"topic\":{\"id\":\"" (topic-id (topic frag-topic)) "\",\"itemIdentities\":null,\"subjectLocators\":null,\"subjectIdentifiers\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm#topic\"],\"instanceOfs\":null,\"names\":null,\"occurrences\":null},\"topicStubs\":null,\"associations\":null,\"tmIds\":[\"http:\\/\\/www.topicmaps.org\\/xtm\\/1.0\\/core.xtm\"]}"))) (is (string= frag-t100-string (to-json-string frag-t100 :xtm-id *TEST-TM* :revision rev-0))) @@ -331,7 +332,7 @@ "http://psi.egovpt.org/types/standardHasStatus")) (is-false (getf occurrence-1 :scopes)) (is (string= (getf occurrence-1 :resourceRef) - (concatenate 'string "#" (d:topic-id ref-topic)))) + (concat "#" (d:topic-id ref-topic)))) (is-false (getf occurrence-1 :resourceData)) (is-false (getf occurrence-2 :itemIdentities)) (is (= (length (getf occurrence-2 :type)) 1)) @@ -1649,11 +1650,11 @@ :start-revision rev-1 :psis (list (make-construct 'PersistentIdC :uri "nScope-2"))))) - (let ((j-req-1 (concatenate 'string j-type j-parent-1 j-name-1)) - (j-req-2 (concatenate 'string j-type j-parent-1 j-name-2)) - (j-req-3 (concatenate 'string j-type j-parent-1 j-name-3)) - (j-req-4 (concatenate 'string j-type j-parent-2 j-name-1)) - (j-req-5 (concatenate 'string j-type j-parent-2 j-name-2)) + (let ((j-req-1 (concat j-type j-parent-1 j-name-1)) + (j-req-2 (concat j-type j-parent-1 j-name-2)) + (j-req-3 (concat j-type j-parent-1 j-name-3)) + (j-req-4 (concat j-type j-parent-2 j-name-1)) + (j-req-5 (concat j-type j-parent-2 j-name-2)) (top-1 (make-construct 'TopicC :start-revision rev-1 @@ -1751,11 +1752,11 @@ :start-revision rev-1 :psis (list (make-construct 'PersistentIdC :uri "oScope-2"))))) - (let ((j-req-1 (concatenate 'string j-type j-parent-1 j-occ-1)) - (j-req-2 (concatenate 'string j-type j-parent-1 j-occ-2)) - (j-req-3 (concatenate 'string j-type j-parent-1 j-occ-3)) - (j-req-4 (concatenate 'string j-type j-parent-2 j-occ-1)) - (j-req-5 (concatenate 'string j-type j-parent-2 j-occ-2)) + (let ((j-req-1 (concat j-type j-parent-1 j-occ-1)) + (j-req-2 (concat j-type j-parent-1 j-occ-2)) + (j-req-3 (concat j-type j-parent-1 j-occ-3)) + (j-req-4 (concat j-type j-parent-2 j-occ-1)) + (j-req-5 (concat j-type j-parent-2 j-occ-2)) (top-1 (make-construct 'TopicC :start-revision rev-1 @@ -1864,12 +1865,9 @@ :start-revision rev-1 :psis (list (make-construct 'PersistentIdC :uri "vScope-2"))))) - (let ((j-req-1 (concatenate 'string j-type j-parent-of-parent-1 - j-parent-1 j-var-1)) - (j-req-2 (concatenate 'string j-type j-parent-of-parent-1 - j-parent-1 j-var-2)) - (j-req-3 (concatenate 'string j-type j-parent-of-parent-1 - j-parent-2 j-var-1)) + (let ((j-req-1 (concat j-type j-parent-of-parent-1 j-parent-1 j-var-1)) + (j-req-2 (concat j-type j-parent-of-parent-1 j-parent-1 j-var-2)) + (j-req-3 (concat j-type j-parent-of-parent-1 j-parent-2 j-var-1)) (top-1 (make-construct 'TopicC :start-revision rev-1 @@ -1987,9 +1985,9 @@ (j-role-3 "{\"type\":[\"rType-1\"],\"topicRef\":[\"player-2\"]}") (rev-1 100) (rev-2 200)) - (let ((j-req-1 (concatenate 'string j-type "\"delete\":{\"type\":[\"aType-1\"],\"scopes\":[[\"aScope-1\"]],\"roles\":[" j-role-1 "," j-role-2 "]}}")) - (j-req-2 (concatenate 'string j-type "\"delete\":{\"type\":[\"aType-2\"],\"scopes\":[[\"aScope-1\"],[\"aScope-2\"]],\"roles\":[" j-role-1 "," j-role-2 "]}}")) - (j-req-3 (concatenate 'string j-type "\"delete\":{\"type\":[\"aType-1\"],\"scopes\":null,\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]}}")) + (let ((j-req-1 (concat j-type "\"delete\":{\"type\":[\"aType-1\"],\"scopes\":[[\"aScope-1\"]],\"roles\":[" j-role-1 "," j-role-2 "]}}")) + (j-req-2 (concat j-type "\"delete\":{\"type\":[\"aType-2\"],\"scopes\":[[\"aScope-1\"],[\"aScope-2\"]],\"roles\":[" j-role-1 "," j-role-2 "]}}")) + (j-req-3 (concat j-type "\"delete\":{\"type\":[\"aType-1\"],\"scopes\":null,\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]}}")) (aType-1 (make-construct 'TopicC :start-revision rev-1 :psis (list (make-construct 'PersistentIdC @@ -2066,9 +2064,9 @@ (j-role-3 "{\"type\":[\"rType-1\"],\"topicRef\":[\"player-2\"]}") (rev-1 100) (rev-2 200)) - (let ((j-req-1 (concatenate 'string j-type "\"parent\":{\"type\":[\"aType-1\"],\"scopes\":[[\"aScope-1\"]],\"roles\":[" j-role-1 "," j-role-2 "," j-role-3"]},\"delete\":" j-role-1 "}")) - (j-req-2 (concatenate 'string j-type "\"parent\":{\"type\":[\"aType-2\"],\"scopes\":[[\"aScope-1\"],[\"aScope-2\"]],\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]},\"delete\":" j-role-1 "}")) - (j-req-3 (concatenate 'string j-type "\"parent\":{\"type\":[\"aType-1\"],\"scopes\":null,\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]},\"delete\":" j-role-2 "}")) + (let ((j-req-1 (concat j-type "\"parent\":{\"type\":[\"aType-1\"],\"scopes\":[[\"aScope-1\"]],\"roles\":[" j-role-1 "," j-role-2 "," j-role-3"]},\"delete\":" j-role-1 "}")) + (j-req-2 (concat j-type "\"parent\":{\"type\":[\"aType-2\"],\"scopes\":[[\"aScope-1\"],[\"aScope-2\"]],\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]},\"delete\":" j-role-1 "}")) + (j-req-3 (concat j-type "\"parent\":{\"type\":[\"aType-1\"],\"scopes\":null,\"roles\":[" j-role-1 "," j-role-2 "," j-role-3 "]},\"delete\":" j-role-2 "}")) (aType-1 (make-construct 'TopicC :start-revision rev-1 :psis (list (make-construct 'PersistentIdC Modified: trunk/src/unit_tests/rdf_exporter_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_exporter_test.lisp (original) +++ trunk/src/unit_tests/rdf_exporter_test.lisp Wed Jan 5 18:37:15 2011 @@ -13,7 +13,8 @@ :xml-importer :datamodel :it.bese.FiveAM - :fixtures) + :fixtures + :base-tools) (:import-from :constants *rdf-ns* *rdfs-ns* @@ -99,7 +100,7 @@ (+ 3 (length item-identifiers))) (string= node-ns *tm2rdf-ns*) (string= node-name "role") - (type-p descr (concatenate 'string *tm2rdf-ns* "types/Role")) + (type-p descr (concat *tm2rdf-ns* "types/Role")) (if player-uri (property-p descr *tm2rdf-ns* "player" :resource player-uri) @@ -227,8 +228,7 @@ (length (loop for ii in item-identifiers when (identifier-p descr ii) collect ii))) - (type-p descr (concatenate 'string *tm2rdf-ns* - "types/Variant")))) + (type-p descr (concat *tm2rdf-ns* "types/Variant")))) return t)) @@ -252,8 +252,7 @@ (length variants))) (string= node-ns *tm2rdf-ns*) (string= node-name "name") - (type-p descr (concatenate 'string *tm2rdf-ns* - "types/Name")) + (type-p descr (concat *tm2rdf-ns* "types/Name")) (property-p descr *tm2rdf-ns* "nametype" :resource name-type) (= (length name-scopes) (length (loop for scope in name-scopes @@ -295,8 +294,7 @@ (length item-identifiers))) (string= node-ns *tm2rdf-ns*) (string= node-name "occurrence") - (type-p descr (concatenate 'string *tm2rdf-ns* - "types/Occurrence")) + (type-p descr (concat *tm2rdf-ns* "types/Occurrence")) (property-p descr *tm2rdf-ns* "occurrencetype" :resource occurrence-type) (= (length occurrence-scopes) @@ -345,15 +343,15 @@ "von Goethe")) (is (name-p me "http://some.where/relationship/firstName" nil (list "http://some.where/name_ii_1") "Johann Wolfgang")) - (let ((born-id (concatenate - 'string "id_" + (let ((born-id (concat + "id_" (write-to-string (elephant::oid (d:parent (elephant:get-instance-by-value 'd:OccurrenceC 'd:charvalue "28.08.1749")))))) - (died-id (concatenate - 'string "id_" + (died-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -383,7 +381,7 @@ erlkoenigs))) (is-true me) (is-true (type-p me "http://some.where/types/Ballad")) - (is-true (type-p me (concatenate 'string *tm2rdf-ns* "types/Topic"))) + (is-true (type-p me (concat *tm2rdf-ns* "types/Topic"))) (is-true (literal-p me *sw-arc* "content" "Wer reitet so spät durch Nacht und Wind? ..." :xml-lang "de")) @@ -391,8 +389,8 @@ (list "http://some.where/scope/en") nil "Der Erlkönig")) (let ((dateRange-id - (concatenate - 'string "id_" + (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -419,8 +417,8 @@ "Bedecke deinen Himmel, Zeus, ..." :xml-lang "de")) (let ((dateRange-id - (concatenate - 'string "id_" + (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -441,7 +439,7 @@ zauberlehrlings))) (is-true me) (is-true (type-p me "http://some.where/types/Poem")) - (is-true (type-p me (concatenate 'string *tm2rdf-ns* "types/Topic"))) + (is-true (type-p me (concat *tm2rdf-ns* "types/Topic"))) (is-true (identifier-p me "http://some.where/poem/Zauberlehrling" :what "subjectIdentifier")) (is-true (identifier-p @@ -461,8 +459,8 @@ "http://some.where/occurrence_ii_2") "Der Zauberlehrling")) (let ((dateRange-id - (concatenate - 'string "id_" + (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -596,8 +594,8 @@ (test test-born-event "Tests the blank node of the born-event." (with-fixture rdf-exporter-test-db () - (let ((born-id (concatenate - 'string "id_" + (let ((born-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -623,8 +621,8 @@ (test test-died-event "Tests the blank node of the born-event." (with-fixture rdf-exporter-test-db () - (let ((born-id (concatenate - 'string "id_" + (let ((born-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -650,8 +648,8 @@ (test test-dateRange-zauberlehrling "Tests the node of zauberlehrling's dateRange." (with-fixture rdf-exporter-test-db () - (let ((dr-id (concatenate - 'string "id_" + (let ((dr-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -671,8 +669,8 @@ (test test-dateRange-erlkoenig "Tests the node of erlkoenig's dateRange." (with-fixture rdf-exporter-test-db () - (let ((dr-id (concatenate - 'string "id_" + (let ((dr-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -692,8 +690,8 @@ (test test-dateRange-prometheus "Tests the node of prometheus' dateRange." (with-fixture rdf-exporter-test-db () - (let ((dr-id (concatenate - 'string "id_" + (let ((dr-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -713,8 +711,8 @@ (test test-schiller "Tests the node of schiller." (with-fixture rdf-exporter-test-db () - (let ((schiller-id (concatenate - 'string "id_" + (let ((schiller-id (concat + "id_" (write-to-string (elephant::oid (d:parent @@ -725,7 +723,7 @@ (is (= (length (get-resources-by-id schiller-id)) 1)) (let ((me (elt (get-resources-by-id schiller-id) 0))) (is-true (type-p me "http://some.where/types/Author")) - (is-true (type-p me (concatenate 'string *tm2rdf-ns* "types/Topic"))) + (is-true (type-p me (concat *tm2rdf-ns* "types/Topic"))) (is-true (literal-p me *sw-arc* "authorInfo" "http://de.wikipedia.org/wiki/Schiller" :datatype *xml-uri*)) @@ -755,7 +753,7 @@ (poem (get-resources-by-uri "http://some.where/types/Poem")) (ballad (get-resources-by-uri "http://some.where/types/Ballad")) (language (get-resources-by-uri "http://some.where/types/Language")) - (rdf-nil (get-resources-by-uri (concatenate 'string *rdf-ns* "nil")))) + (rdf-nil (get-resources-by-uri (concat *rdf-ns* "nil")))) (is-true authors) (is (= (length authors) 1)) (is (= (length (dom:child-nodes (elt authors 0))) 0)) @@ -842,7 +840,7 @@ (property-p (elt node-3s 0) *rdf-ns* "rest" :resource - (concatenate 'string *rdf-ns* "nil"))))))))))))))) + (concat *rdf-ns* "nil"))))))))))))))) (test test-association @@ -855,21 +853,20 @@ "http://some.where/test-association"))))) (is-true assoc-id) (let ((assocs (get-resources-by-id - (concatenate 'string "id_" (write-to-string assoc-id))))) + (concat "id_" (write-to-string assoc-id))))) (is (= (length assocs))) (let ((me (elt assocs 0))) (is (= (length (dom:child-nodes me)) 7)) - (is-true (type-p me (concatenate 'string *tm2rdf-ns* "types/Association"))) + (is-true (type-p me (concat *tm2rdf-ns* "types/Association"))) (is-true (identifier-p me "http://some.where/test-association")) (is-true (property-p me *tm2rdf-ns* "associationtype" - :resource (concatenate - 'string *sw-arc* - "associatedWithEachOther"))) + :resource (concat + *sw-arc* "associatedWithEachOther"))) (is-true (role-p me "http://some.where/roletype/writer" nil :player-uri "http://some.where/author/Goethe")) - (let ((schiller-id (concatenate - 'string "id_" + (let ((schiller-id (concat + "id_" (write-to-string (elephant::oid (d:parent Modified: trunk/src/unit_tests/rdf_importer_test.lisp ============================================================================== --- trunk/src/unit_tests/rdf_importer_test.lisp (original) +++ trunk/src/unit_tests/rdf_importer_test.lisp Wed Jan 5 18:37:15 2011 @@ -12,6 +12,7 @@ :common-lisp :xml-importer :datamodel + :base-tools :it.bese.FiveAM :fixtures) (:import-from :constants @@ -92,12 +93,12 @@ (test test-get-literals-of-node "Tests the helper function get-literals-of-node." (let ((doc-1 - (concatenate 'string "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:isi=\"http://isidorus/test#\" " - "rdf:type=\"rdfType\" rdf:ID=\"rdfID\" rdf:nodeID=\"" - "rdfNodeID\" rdf:unknown=\"rdfUnknown\" " - "isi:ID=\"isiID\" isi:arc=\"isiArc\" " - "isi:empty=\"\"/>"))) + (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:isi=\"http://isidorus/test#\" " + "rdf:type=\"rdfType\" rdf:ID=\"rdfID\" rdf:nodeID=\"" + "rdfNodeID\" rdf:unknown=\"rdfUnknown\" " + "isi:ID=\"isiID\" isi:arc=\"isiArc\" " + "isi:empty=\"\"/>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is (= (length (dom:child-nodes dom-1)) 1)) (let ((literals (rdf-importer::get-literals-of-node @@ -108,7 +109,7 @@ (and (string= (getf x :value) "rdfUnknown") (string= (getf x :type) - (concatenate 'string *rdf-ns* "unknown")) + (concat *rdf-ns* "unknown")) (not (getf x :ID)))) literals)) (is-true (find-if #'(lambda(x) @@ -147,7 +148,7 @@ (and (string= (getf x :value) "rdfUnknown") (string= (getf x :type) - (concatenate 'string *rdf-ns* "unknown")) + (concat *rdf-ns* "unknown")) (not (getf x :ID)))) literals)) (is-true (find-if #'(lambda(x) @@ -178,15 +179,15 @@ (test test-parse-node "Tests the parse-node function." (let ((doc-1 - (concatenate 'string "<rdf:UnknownType xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:isi=\"" *rdf2tm-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "rdf:ID=\"rdfID\" xml:base=\"xmlBase\" " - "arcs:arc=\"arcsArc\">" - "<arcs:rel>" - "<rdf:Description rdf:about=\"element\"/>" - "</arcs:rel>" - "</rdf:UnknownType>"))) + (concat "<rdf:UnknownType xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:isi=\"" *rdf2tm-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "rdf:ID=\"rdfID\" xml:base=\"xmlBase\" " + "arcs:arc=\"arcsArc\">" + "<arcs:rel>" + "<rdf:Description rdf:about=\"element\"/>" + "</arcs:rel>" + "</rdf:UnknownType>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is (length (dom:child-nodes dom-1)) 1) (let ((node (elt (dom:child-nodes dom-1) 0))) @@ -220,14 +221,14 @@ (test test-get-literals-of-property "Tests the function get-literals-or-property." (let ((doc-1 - (concatenate 'string "<prop:property xmlns:prop=\"http://props/\" " - "xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:rdfs=\"" *rdfs-ns* "\" " - "rdf:type=\"rdfType\" rdf:resource=\"rdfResource\" " - "rdf:nodeID=\"rdfNodeID\" " - "prop:prop1=\"http://should/be/a/literal\" " - "prop:prop2=\"prop-2\" " - "prop:prop3=\"\">content-text</prop:property>"))) + (concat "<prop:property xmlns:prop=\"http://props/\" " + "xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:rdfs=\"" *rdfs-ns* "\" " + "rdf:type=\"rdfType\" rdf:resource=\"rdfResource\" " + "rdf:nodeID=\"rdfNodeID\" " + "prop:prop1=\"http://should/be/a/literal\" " + "prop:prop2=\"prop-2\" " + "prop:prop3=\"\">content-text</prop:property>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)) 1)) @@ -258,39 +259,39 @@ (test test-parse-property "Tests the function parse-property." (let ((doc-1 - (concatenate 'string "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:rdfs=\"" *rdfs-ns* "\" " - "xmlns:prop=\"http://isidorus/props/\">" - "<prop:prop0 rdf:parseType=\"Resource\" />" - "<prop:prop1 rdf:parseType=\"Resource\">" - "<prop:prop1_0 rdf:resource=\"prop21\" />" - "</prop:prop1>" - "<prop:prop2 rdf:parseType=\"Literal\">" - "<content_root>content-text</content_root>" - "</prop:prop2>" - "<prop:prop3 rdf:parseType=\"Collection\" />" - "<prop:prop4 rdf:parseType=\"Collection\">" - "<prop:prop4_0 rdf:resource=\"prop5_1\" />" - "<prop:prop4_1 rdf:nodeID=\"prop5_2\" />" - "<prop:prop4_2/>" - "</prop:prop4>" - "<prop:prop5 />" - "<prop:prop6>prop6</prop:prop6>" - "<prop:prop7 rdf:nodeID=\"prop7\"/>" - "<prop:prop8 rdf:resource=\"prop8\" />" - "<prop:prop9 rdf:type=\"typeProp9\"> </prop:prop9>" - "<prop:prop10 rdf:datatype=\"datatypeProp10\" />" - "<prop:prop11 rdf:ID=\"IDProp11\"> </prop:prop11>" - "<prop:prop12 rdf:ID=\"IDprop12\" rdf:nodeID=\"prop12\">" - " </prop:prop12>" - "<prop:prop13 />" - "<prop:prop14>prop14</prop:prop14>" - "<prop:prop15 rdf:nodeID=\"prop15\"/>" - "<prop:prop16 rdf:resource=\"prop16\" />" - "<prop:prop17 rdf:type=\"typeProp17\"> </prop:prop17>" - "<prop:prop18 rdf:ID=\"IDprop18\" rdf:nodeID=\"prop18\">" - " </prop:prop18>" - "</rdf:Description>"))) + (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:rdfs=\"" *rdfs-ns* "\" " + "xmlns:prop=\"http://isidorus/props/\">" + "<prop:prop0 rdf:parseType=\"Resource\" />" + "<prop:prop1 rdf:parseType=\"Resource\">" + "<prop:prop1_0 rdf:resource=\"prop21\" />" + "</prop:prop1>" + "<prop:prop2 rdf:parseType=\"Literal\">" + "<content_root>content-text</content_root>" + "</prop:prop2>" + "<prop:prop3 rdf:parseType=\"Collection\" />" + "<prop:prop4 rdf:parseType=\"Collection\">" + "<prop:prop4_0 rdf:resource=\"prop5_1\" />" + "<prop:prop4_1 rdf:nodeID=\"prop5_2\" />" + "<prop:prop4_2/>" + "</prop:prop4>" + "<prop:prop5 />" + "<prop:prop6>prop6</prop:prop6>" + "<prop:prop7 rdf:nodeID=\"prop7\"/>" + "<prop:prop8 rdf:resource=\"prop8\" />" + "<prop:prop9 rdf:type=\"typeProp9\"> </prop:prop9>" + "<prop:prop10 rdf:datatype=\"datatypeProp10\" />" + "<prop:prop11 rdf:ID=\"IDProp11\"> </prop:prop11>" + "<prop:prop12 rdf:ID=\"IDprop12\" rdf:nodeID=\"prop12\">" + " </prop:prop12>" + "<prop:prop13 />" + "<prop:prop14>prop14</prop:prop14>" + "<prop:prop15 rdf:nodeID=\"prop15\"/>" + "<prop:prop16 rdf:resource=\"prop16\" />" + "<prop:prop17 rdf:type=\"typeProp17\"> </prop:prop17>" + "<prop:prop18 rdf:ID=\"IDprop18\" rdf:nodeID=\"prop18\">" + " </prop:prop18>" + "</rdf:Description>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)) 1)) @@ -378,40 +379,40 @@ get-node-rerfs, absolute-uri-p, absolutize-value and absolutize-id." (let ((tm-id "http://test-tm") (doc-1 - (concatenate 'string "<rdf:anyType xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:isi=\"" *rdf2tm-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xml:base=\"xml-base/first\" " - "rdf:about=\"resource\" rdf:type=\"attr-type\">" - "<rdf:type rdf:ID=\"rdfID\" " - "rdf:resource=\"content-type-1\"/>" - "<rdf:type />" - "<rdf:type arcs:arc=\"literalArc\"/>" - "<rdf:type rdf:parseType=\"Collection\" " - " xml:base=\"http://xml-base/absolute/\">" - "" - "<rdf:Description rdf:about=\"c-about-type\"/>" - "<rdf:Description rdf:ID=\"c-id-type\"/>" - "<rdf:Description rdf:nodeID=\"c-nodeID-type\"/>" - "<rdf:Description/>" - "</rdf:type>" - "<rdf:type rdf:ID=\"rdfID2\">" - "<rdf:Description rdf:about=\"c-about-type-2\"/>" - "</rdf:type>" - "<rdf:type>" - "<rdf:Description rdf:nodeID=\"c-nodeID-type-2\"/>" - "</rdf:type>" - "<rdf:type xml:base=\"http://new-base/\">" - "<rdf:Description rdf:ID=\"c-ID-type-2\"/>" - "</rdf:type>" - "<rdf:type rdf:ID=\"rdfID3\">" - "<rdf:Description/>" - "</rdf:type>" - "<arcs:arc rdf:resource=\"anyArc\"/>" - "<rdf:arc>" - "<rdf:Description rdf:about=\"anyResource\"/>" - "</rdf:arc>" - "</rdf:anyType>"))) + (concat "<rdf:anyType xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:isi=\"" *rdf2tm-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xml:base=\"xml-base/first\" " + "rdf:about=\"resource\" rdf:type=\"attr-type\">" + "<rdf:type rdf:ID=\"rdfID\" " + "rdf:resource=\"content-type-1\"/>" + "<rdf:type />" + "<rdf:type arcs:arc=\"literalArc\"/>" + "<rdf:type rdf:parseType=\"Collection\" " + " xml:base=\"http://xml-base/absolute/\">" + "" + "<rdf:Description rdf:about=\"c-about-type\"/>" + "<rdf:Description rdf:ID=\"c-id-type\"/>" + "<rdf:Description rdf:nodeID=\"c-nodeID-type\"/>" + "<rdf:Description/>" + "</rdf:type>" + "<rdf:type rdf:ID=\"rdfID2\">" + "<rdf:Description rdf:about=\"c-about-type-2\"/>" + "</rdf:type>" + "<rdf:type>" + "<rdf:Description rdf:nodeID=\"c-nodeID-type-2\"/>" + "</rdf:type>" + "<rdf:type xml:base=\"http://new-base/\">" + "<rdf:Description rdf:ID=\"c-ID-type-2\"/>" + "</rdf:type>" + "<rdf:type rdf:ID=\"rdfID3\">" + "<rdf:Description/>" + "</rdf:type>" + "<arcs:arc rdf:resource=\"anyArc\"/>" + "<rdf:arc>" + "<rdf:Description rdf:about=\"anyResource\"/>" + "</rdf:arc>" + "</rdf:anyType>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)) 1)) @@ -439,23 +440,19 @@ (is-true (find-if #'(lambda(x) (and (string= (getf x :topicid) - (concatenate - 'string *rdf-ns* "anyType")) + (concat *rdf-ns* "anyType")) (string= (getf x :topicid) - (concatenate - 'string *rdf-ns* "anyType")) + (concat *rdf-ns* "anyType")) (not (getf x :ID)))) types)) (is-true (find-if #'(lambda(x) (and (string= (getf x :topicid) - (concatenate - 'string tm-id + (concat tm-id "/xml-base/first/attr-type")) (string= (getf x :psi) - (concatenate - 'string tm-id - "/xml-base/first/attr-type")) + (concat tm-id + "/xml-base/first/attr-type")) (not (getf x :ID)))) types)) (is-true (find-if @@ -470,12 +467,10 @@ (is-true (find-if #'(lambda(x) (and (string= (getf x :topicid) - (concatenate - 'string tm-id + (concat tm-id "/xml-base/first/c-about-type-2")) (string= (getf x :psi) - (concatenate - 'string tm-id + (concat tm-id "/xml-base/first/c-about-type-2")) (string= (getf x :ID) "http://test-tm/xml-base/first#rdfID2"))) @@ -508,26 +503,26 @@ (test test-get-literals-of-content (let ((doc-1 - (concatenate 'string "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:rdfs=\"" *rdfs-ns* "\" " - "xmlns:prop=\"http://isidorus/props/\" " - "xml:base=\"base/first\" xml:lang=\"de\" >" - "<prop:lit0>text0</prop:lit0>" - "<prop:lit1 rdf:parseType=\"Literal\">text1</prop:lit1>" - "<prop:lit2 xml:base=\"http://base/absolute\" " - "rdf:datatype=\"dType1\">text2</prop:lit2>" - "<prop:arc rdf:parseType=\"Collection\"/>" - "<prop:lit3 xml:lang=\"en\" rdf:datatype=\"dType2\">" - "<![CDATA[text3]]></prop:lit3>" - "<prop:lit4 rdf:datatype=\"dType2\"><root><child/></root>" - " </prop:lit4>" - "<prop:lit5 rdf:ID=\"rdfID\" " - "rdf:parseType=\"Literal\"><root><child>" - "childText5</child> </root></prop:lit5>" - "<prop:lit6 xml:lang=\"\" rdf:parseType=\"Literal\">" - " <![CDATA[text6]]> abc " - "</prop:lit6>" - "</rdf:Description>"))) + (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:rdfs=\"" *rdfs-ns* "\" " + "xmlns:prop=\"http://isidorus/props/\" " + "xml:base=\"base/first\" xml:lang=\"de\" >" + "<prop:lit0>text0</prop:lit0>" + "<prop:lit1 rdf:parseType=\"Literal\">text1</prop:lit1>" + "<prop:lit2 xml:base=\"http://base/absolute\" " + "rdf:datatype=\"dType1\">text2</prop:lit2>" + "<prop:arc rdf:parseType=\"Collection\"/>" + "<prop:lit3 xml:lang=\"en\" rdf:datatype=\"dType2\">" + "<![CDATA[text3]]></prop:lit3>" + "<prop:lit4 rdf:datatype=\"dType2\"><root><child/></root>" + " </prop:lit4>" + "<prop:lit5 rdf:ID=\"rdfID\" " + "rdf:parseType=\"Literal\"><root><child>" + "childText5</child> </root></prop:lit5>" + "<prop:lit6 xml:lang=\"\" rdf:parseType=\"Literal\">" + " <![CDATA[text6]]> abc " + "</prop:lit6>" + "</rdf:Description>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))) (tm-id "http://test-tm")) (is-true dom-1) @@ -612,41 +607,41 @@ (test test-get-super-classes-of-node-content (let ((doc-1 - (concatenate 'string "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:isi=\"" *rdf2tm-ns* "\" " - "xmlns:rdfs=\"" *rdfs-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xml:base=\"xml-base/first\" " - "rdf:about=\"resource\" rdf:type=\"attr-type\">" - "<rdfs:subClassOf rdf:ID=\"rdfID\" " - "rdf:resource=\"content-type-1\"/>" - "<rdfs:subClassOf />" - "<rdfs:subClassOf arcs:arc=\"literalArc\"/>" - "<rdfs:subClassOf rdf:parseType=\"Collection\" " - " xml:base=\"http://xml-base/absolute/\">" - "" - "<rdf:Description rdf:about=\"c-about-type\"/>" - "<rdf:Description rdf:ID=\"c-id-type\"/>" - "<rdf:Description rdf:nodeID=\"c-nodeID-type\"/>" - "<rdf:Description/>" - "</rdfs:subClassOf>" - "<rdfs:subClassOf rdf:ID=\"rdfID2\">" - "<rdf:Description rdf:about=\"c-about-type-2\"/>" - "</rdfs:subClassOf>" - "<rdfs:subClassOf>" - "<rdf:Description rdf:nodeID=\"c-nodeID-type-2\"/>" - "</rdfs:subClassOf>" - "<rdfs:subClassOf xml:base=\"http://new-base/\">" - "<rdf:Description rdf:ID=\"c-ID-type-2\"/>" - "</rdfs:subClassOf>" - "<rdfs:subClassOf rdf:ID=\"rdfID3\">" - "<rdf:Description/>" - "</rdfs:subClassOf>" - "<arcs:arc rdf:resource=\"anyArc\"/>" - "<rdfs:arc>" - "<rdf:Description rdf:about=\"anyResource\"/>" - "</rdfs:arc>" - "</rdf:Description>"))) + (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:isi=\"" *rdf2tm-ns* "\" " + "xmlns:rdfs=\"" *rdfs-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xml:base=\"xml-base/first\" " + "rdf:about=\"resource\" rdf:type=\"attr-type\">" + "<rdfs:subClassOf rdf:ID=\"rdfID\" " + "rdf:resource=\"content-type-1\"/>" + "<rdfs:subClassOf />" + "<rdfs:subClassOf arcs:arc=\"literalArc\"/>" + "<rdfs:subClassOf rdf:parseType=\"Collection\" " + " xml:base=\"http://xml-base/absolute/\">" + "" + "<rdf:Description rdf:about=\"c-about-type\"/>" + "<rdf:Description rdf:ID=\"c-id-type\"/>" + "<rdf:Description rdf:nodeID=\"c-nodeID-type\"/>" + "<rdf:Description/>" + "</rdfs:subClassOf>" + "<rdfs:subClassOf rdf:ID=\"rdfID2\">" + "<rdf:Description rdf:about=\"c-about-type-2\"/>" + "</rdfs:subClassOf>" + "<rdfs:subClassOf>" + "<rdf:Description rdf:nodeID=\"c-nodeID-type-2\"/>" + "</rdfs:subClassOf>" + "<rdfs:subClassOf xml:base=\"http://new-base/\">" + "<rdf:Description rdf:ID=\"c-ID-type-2\"/>" + "</rdfs:subClassOf>" + "<rdfs:subClassOf rdf:ID=\"rdfID3\">" + "<rdf:Description/>" + "</rdfs:subClassOf>" + "<arcs:arc rdf:resource=\"anyArc\"/>" + "<rdfs:arc>" + "<rdf:Description rdf:about=\"anyResource\"/>" + "</rdfs:arc>" + "</rdf:Description>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)))) @@ -679,15 +674,13 @@ (and (string= (getf x :topicid) - (concatenate 'string tm-id xml-base - "/xml-base/first/c-about-type-2")) + (concat tm-id xml-base "/xml-base/first/c-about-type-2")) (string= (getf x :psi) - (concatenate 'string tm-id xml-base - "/xml-base/first/c-about-type-2")) + (concat tm-id xml-base "/xml-base/first/c-about-type-2")) (string= (getf x :ID) - (concatenate 'string tm-id xml-base - "/xml-base/first#rdfID2")))) + (concat tm-id xml-base + "/xml-base/first#rdfID2")))) super-classes)) (is-true (find-if #'(lambda(x) @@ -723,43 +716,43 @@ (test test-get-associations-of-node-content (let ((doc-1 - (concatenate 'string "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:isi=\"" *rdf2tm-ns* "\" " - "xmlns:rdfs=\"" *rdfs-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xml:base=\"http://xml-base/first\" " - "rdf:about=\"resource\" rdf:type=\"attr-type\">" - "<rdf:type rdf:resource=\"anyType\" />" - "<rdf:type> </rdf:type>" - "<rdfs:subClassOf rdf:nodeID=\"anyClass\" />" - "<rdfs:subClassOf> </rdfs:subClassOf>" - "<rdf:unknown rdf:resource=\"assoc-1\"/>" - "<rdfs:unknown rdf:type=\"assoc-2-type\">" - " </rdfs:unknown>" - "<arcs:arc1 rdf:ID=\"rdfID-1\" " - "rdf:nodeID=\"arc1-nodeID\"/>" - "<arcs:arc2 rdf:parseType=\"Collection\">" - "<rdf:Description rdf:about=\"col\" />" - "</arcs:arc2>" - "<arcs:arc3 rdf:parseType=\"Resource\" " - "rdf:ID=\"rdfID-2\" />" - "<arcs:lit rdf:parseType=\"Literal\" />" - "<arcs:arc4 arcs:arc5=\"text-arc5\" />" - "<arcs:arc6 rdf:ID=\"rdfID-3\">" - "<rdf:Description rdf:about=\"con-1\" />" - "</arcs:arc6>" - "<arcs:arc7>" - "<rdf:Description rdf:nodeID=\"con-2\" />" - "</arcs:arc7>" - "<arcs:arc8>" - "<rdf:Description rdf:ID=\"rdfID-4\" />" - "</arcs:arc8>" - "<arcs:arc9 rdf:ID=\"rdfID-5\" xml:base=\"add\">" - "<rdf:Description />" - "</arcs:arc9>" - "<rdfs:type rdf:resource=\"assoc-11\"> </rdfs:type>" - "<rdf:subClassOf rdf:nodeID=\"assoc-12\" />" - "</rdf:Description>"))) + (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:isi=\"" *rdf2tm-ns* "\" " + "xmlns:rdfs=\"" *rdfs-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xml:base=\"http://xml-base/first\" " + "rdf:about=\"resource\" rdf:type=\"attr-type\">" + "<rdf:type rdf:resource=\"anyType\" />" + "<rdf:type> </rdf:type>" + "<rdfs:subClassOf rdf:nodeID=\"anyClass\" />" + "<rdfs:subClassOf> </rdfs:subClassOf>" + "<rdf:unknown rdf:resource=\"assoc-1\"/>" + "<rdfs:unknown rdf:type=\"assoc-2-type\">" + " </rdfs:unknown>" + "<arcs:arc1 rdf:ID=\"rdfID-1\" " + "rdf:nodeID=\"arc1-nodeID\"/>" + "<arcs:arc2 rdf:parseType=\"Collection\">" + "<rdf:Description rdf:about=\"col\" />" + "</arcs:arc2>" + "<arcs:arc3 rdf:parseType=\"Resource\" " + "rdf:ID=\"rdfID-2\" />" + "<arcs:lit rdf:parseType=\"Literal\" />" + "<arcs:arc4 arcs:arc5=\"text-arc5\" />" + "<arcs:arc6 rdf:ID=\"rdfID-3\">" + "<rdf:Description rdf:about=\"con-1\" />" + "</arcs:arc6>" + "<arcs:arc7>" + "<rdf:Description rdf:nodeID=\"con-2\" />" + "</arcs:arc7>" + "<arcs:arc8>" + "<rdf:Description rdf:ID=\"rdfID-4\" />" + "</arcs:arc8>" + "<arcs:arc9 rdf:ID=\"rdfID-5\" xml:base=\"add\">" + "<rdf:Description />" + "</arcs:arc9>" + "<rdfs:type rdf:resource=\"assoc-11\"> </rdfs:type>" + "<rdf:subClassOf rdf:nodeID=\"assoc-12\" />" + "</rdf:Description>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))) (tm-id "http://test-tm")) (is-true dom-1) @@ -773,7 +766,7 @@ (is-true (find-if #'(lambda(x) (and (string= (getf x :type) - (concatenate 'string *rdf-ns* "unknown")) + (concat *rdf-ns* "unknown")) (string= (getf x :topicid) "http://xml-base/first/assoc-1") (string= (getf x :psi) @@ -853,7 +846,7 @@ (is-true (find-if #'(lambda(x) (and (string= (getf x :type) - (concatenate 'string *rdfs-ns* "type")) + (concat *rdfs-ns* "type")) (not (getf x :ID)) (string= (getf x :psi) "http://xml-base/first/assoc-11") @@ -863,8 +856,7 @@ (is-true (find-if #'(lambda(x) (and (string= (getf x :type) - (concatenate 'string *rdf-ns* - "subClassOf")) + (concat *rdf-ns* "subClassOf")) (not (getf x :ID)) (not (getf x :psi)) (string= (getf x :topicid) "assoc-12"))) @@ -873,24 +865,24 @@ (test test-parse-properties-of-node (let ((doc-1 - (concatenate 'string "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xml:base=\"http://xml-base/first\" " - "rdf:about=\"resource\" rdf:type=\"attr-type\" " - "rdf:li=\"li-attr\">" - "<rdf:li rdf:resource=\"anyType\" />" - "<rdf:li> text-1 </rdf:li>" - "<rdf:li rdf:nodeID=\"anyClass\" />" - "<rdf:li> </rdf:li>" - "<rdf:li rdf:resource=\"assoc-1\"/>" - "<rdf:li rdf:type=\"assoc-2-type\">" - " </rdf:li>" - "<rdf:li rdf:parseType=\"Literal\" > text-3</rdf:li>" - "<rdf:_123 arcs:arc5=\"text-arc5\"/>" - "<rdf:arc6 rdf:ID=\"rdfID-3\"> text-4 </rdf:arc6>" - "<rdf:arcs rdf:ID=\"rdfID-4\" xml:lang=\" \">" - "text-5</rdf:arcs>" - "</rdf:Description>"))) + (concat "<rdf:Description xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xml:base=\"http://xml-base/first\" " + "rdf:about=\"resource\" rdf:type=\"attr-type\" " + "rdf:li=\"li-attr\">" + "<rdf:li rdf:resource=\"anyType\" />" + "<rdf:li> text-1 </rdf:li>" + "<rdf:li rdf:nodeID=\"anyClass\" />" + "<rdf:li> </rdf:li>" + "<rdf:li rdf:resource=\"assoc-1\"/>" + "<rdf:li rdf:type=\"assoc-2-type\">" + " </rdf:li>" + "<rdf:li rdf:parseType=\"Literal\" > text-3</rdf:li>" + "<rdf:_123 arcs:arc5=\"text-arc5\"/>" + "<rdf:arc6 rdf:ID=\"rdfID-3\"> text-4 </rdf:arc6>" + "<rdf:arcs rdf:ID=\"rdfID-4\" xml:lang=\" \">" + "text-5</rdf:arcs>" + "</rdf:Description>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder))) (tm-id "http://test-tm")) (setf rdf-importer::*_n-map* nil) @@ -906,9 +898,8 @@ (is-true (find-if #'(lambda(x) (string= (getf x :name) - (concatenate - 'string *rdf-ns* "_" - (write-to-string (+ 1 iter))))) + (concat *rdf-ns* "_" + (write-to-string (+ 1 iter))))) (getf (first rdf-importer::*_n-map*) :props)))) (let ((assocs (rdf-importer::get-associations-of-node-content node tm-id nil)) @@ -921,7 +912,7 @@ (is (= (length attr-literals) 1)) (is-true (find-if #'(lambda(x) (and (string= (getf x :type) - (concatenate 'string *rdf-ns* "_1")) + (concat *rdf-ns* "_1")) (not (getf x :lang)) (string= (getf x :value) "li-attr") (not (getf x :lang)) @@ -933,7 +924,7 @@ (string= (getf x :psi) "http://xml-base/first/anyType") (string= (getf x :type) - (concatenate 'string *rdf-ns* "_2")) + (concat *rdf-ns* "_2")) (not (getf x :ID)))) assocs)) (is-true (find-if #'(lambda(x) @@ -941,20 +932,20 @@ (string= (getf x :lang) "de") (string= (getf x :datatype) *xml-string*) (string= (getf x :type) - (concatenate 'string *rdf-ns* "_3")) + (concat *rdf-ns* "_3")) (not (getf x :ID)))) content-literals)) (is-true (find-if #'(lambda(x) (and (string= (getf x :topicid) "anyClass") (not (getf x :psi)) (string= (getf x :type) - (concatenate 'string *rdf-ns* "_4")) + (concat *rdf-ns* "_4")) (not (getf x :ID)))) assocs)) (is-true (find-if #'(lambda(x) (and (string= (getf x :value) " ") (string= (getf x :type) - (concatenate 'string *rdf-ns* "_5")) + (concat *rdf-ns* "_5")) (string= (getf x :datatype) *xml-string*) (string= (getf x :lang) "de") (not (getf x :ID)))) @@ -965,14 +956,14 @@ (string= (getf x :psi) "http://xml-base/first/assoc-1") (string= (getf x :type) - (concatenate 'string *rdf-ns* "_6")) + (concat *rdf-ns* "_6")) (not (getf x :ID)))) assocs)) (is-true (find-if #'(lambda(x) (and (> (length (getf x :topicid)) 0) (not (getf x :psi)) (string= (getf x :type) - (concatenate 'string *rdf-ns* "_7")) + (concat *rdf-ns* "_7")) (not (getf x :ID)))) assocs)) (is-true (find-if #'(lambda(x) @@ -980,7 +971,7 @@ (string= (getf x :lang) "de") (string= (getf x :datatype) *xml-string*) (string= (getf x :type) - (concatenate 'string *rdf-ns* "_8")) + (concat *rdf-ns* "_8")) (not (getf x :ID)))) content-literals)) (is-true (find-if #'(lambda(x) @@ -989,7 +980,7 @@ (string= (getf x :datatype) *xml-string*) (string= (getf x :type) - (concatenate 'string *rdf-ns* "arc6")) + (concat *rdf-ns* "arc6")) (string= (getf x :ID) "http://xml-base/first#rdfID-3"))) @@ -1000,7 +991,7 @@ (string= (getf x :datatype) *xml-string*) (string= (getf x :type) - (concatenate 'string *rdf-ns* "arcs")) + (concat *rdf-ns* "arcs")) (string= (getf x :ID) "http://xml-base/first#rdfID-4"))) @@ -1017,32 +1008,32 @@ (revision-3 300) (document-id "doc-id") (doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xmlns:rdfs=\"" *rdfs-ns* "\">" - "<rdf:Description rdf:about=\"first-node\">" - "<rdf:type rdf:resource=\"first-type\" />" - "</rdf:Description>" - "<rdf:Description rdf:type=\"second-type\" " - "rdf:nodeID=\"second-node\">" - "<rdfs:subClassOf>" - "<rdf:Description rdf:ID=\"third-node\" />" - "</rdfs:subClassOf>" - "</rdf:Description>" - "<rdf:Description arcs:arc1=\"arc-1\">" - "<arcs:arc2 rdf:datatype=\"dt\">arc-2</arcs:arc2>" - "</rdf:Description>" - "<rdf:Description rdf:about=\"fourth-node\">" - "<arcs:arc3 rdf:parseType=\"Literal\"><root>" - "<content type=\"anyContent\">content</content>" - "</root></arcs:arc3>" - "</rdf:Description>" - "<rdf:Description rdf:ID=\"fifth-node\">" - "<arcs:arc4 rdf:parseType=\"Resource\">" - "<arcs:arc5 rdf:resource=\"arc-5\" />" - "</arcs:arc4>" - "</rdf:Description>" - "</rdf:RDF>"))) + (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xmlns:rdfs=\"" *rdfs-ns* "\">" + "<rdf:Description rdf:about=\"first-node\">" + "<rdf:type rdf:resource=\"first-type\" />" + "</rdf:Description>" + "<rdf:Description rdf:type=\"second-type\" " + "rdf:nodeID=\"second-node\">" + "<rdfs:subClassOf>" + "<rdf:Description rdf:ID=\"third-node\" />" + "</rdfs:subClassOf>" + "</rdf:Description>" + "<rdf:Description arcs:arc1=\"arc-1\">" + "<arcs:arc2 rdf:datatype=\"dt\">arc-2</arcs:arc2>" + "</rdf:Description>" + "<rdf:Description rdf:about=\"fourth-node\">" + "<arcs:arc3 rdf:parseType=\"Literal\"><root>" + "<content type=\"anyContent\">content</content>" + "</root></arcs:arc3>" + "</rdf:Description>" + "<rdf:Description rdf:ID=\"fifth-node\">" + "<arcs:arc4 rdf:parseType=\"Resource\">" + "<arcs:arc5 rdf:resource=\"arc-5\" />" + "</arcs:arc4>" + "</rdf:Description>" + "</rdf:RDF>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) (is (= (length (dom:child-nodes dom-1)) 1)) @@ -1238,340 +1229,337 @@ (revision-1 100) (document-id "doc-id") (doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\">" - " <rdf:Description rdf:about=\"first-node\">" - " <rdf:type rdf:nodeID=\"second-node\"/>" - " <arcs:arc1 rdf:resource=\"third-node\"/>" - " <arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>" - " <arcs:arc3>" - " <rdf:Description>" - " <arcs:arc4 rdf:parseType=\"Collection\">" - " <rdf:Description rdf:about=\"item-1\"/>" - " <rdf:Description rdf:about=\"item-2\">" - " <arcs:arc5 rdf:parseType=\"Resource\">" - " <arcs:arc6 rdf:resource=\"fourth-node\"/>" - " <arcs:arc7>" - " <rdf:Description rdf:about=\"fifth-node\"/>" - " </arcs:arc7>" - " <arcs:arc8 rdf:parseType=\"Collection\" />" - " </arcs:arc5>" - " </rdf:Description>" - " </arcs:arc4>" - " </rdf:Description>" - " </arcs:arc3>" - " </rdf:Description>" - " <rdf:Description rdf:nodeID=\"second-node\" />" - "</rdf:RDF>"))) - (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) - (is-true dom-1) - (is (= (length (dom:child-nodes dom-1)) 1)) - (rdf-init-db :db-dir db-dir :start-revision revision-1) - (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) - (is (= (length (rdf-importer::child-nodes-or-text rdf-node - :trim t)) - 2)) - (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id - :document-id document-id) - (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40)) - (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12)) - (setf rdf-importer::*current-xtm* document-id) - (is (= (length - (intersection - (map 'list #'d:instance-of - (elephant:get-instances-by-class 'd:AssociationC)) - (list - (d:get-item-by-id (concatenate - 'string - constants::*rdf-nil*) - :xtm-id rdf-importer::*rdf-core-xtm*) - (d:get-item-by-psi constants::*type-instance-psi*) - (dotimes (iter 9) - (let ((pos (+ iter 1)) - (topics nil)) - (when (/= pos 2) - (push (get-item-by-id - (concatenate - 'string "http://test/arcs/arc" - (write-to-string pos))) topics)) - topics))))))) - (let ((first-node (get-item-by-id "http://test-tm/first-node")) - (second-node (get-item-by-id "second-node")) - (third-node (get-item-by-id "http://test-tm/third-node")) - (fourth-node (get-item-by-id "http://test-tm/fourth-node")) - (fifth-node (get-item-by-id "http://test-tm/fifth-node")) - (item-1 (get-item-by-id "http://test-tm/item-1")) - (item-2 (get-item-by-id "http://test-tm/item-2")) - (arc1 (get-item-by-id "http://test/arcs/arc1")) - (arc2 (get-item-by-id "http://test/arcs/arc2")) - (arc3 (get-item-by-id "http://test/arcs/arc3")) - (arc4 (get-item-by-id "http://test/arcs/arc4")) - (arc5 (get-item-by-id "http://test/arcs/arc5")) - (arc6 (get-item-by-id "http://test/arcs/arc6")) - (arc7 (get-item-by-id "http://test/arcs/arc7")) - (arc8 (get-item-by-id "http://test/arcs/arc8")) - (instance (d:get-item-by-psi constants::*instance-psi*)) - (type (d:get-item-by-psi constants::*type-psi*)) - (type-instance (d:get-item-by-psi - constants:*type-instance-psi*)) - (subject (d:get-item-by-psi constants::*rdf2tm-subject*)) - (object (d:get-item-by-psi constants::*rdf2tm-object*)) - (rdf-first (d:get-item-by-psi constants:*rdf-first*)) - (rdf-rest (d:get-item-by-psi constants:*rdf-rest*)) - (rdf-nil (d:get-item-by-psi constants:*rdf-nil*))) - (is (= (length (d:psis first-node)) 1)) - (is (string= (d:uri (first (d:psis first-node))) - "http://test-tm/first-node")) - (is (= (length (d:psis second-node)) 0)) - (is (= (length (d:psis third-node)) 1)) - (is (string= (d:uri (first (d:psis third-node))) - "http://test-tm/third-node")) - (is (= (length (d:psis fourth-node)) 1)) - (is (string= (d:uri (first (d:psis fourth-node))) - "http://test-tm/fourth-node")) - (is (= (length (d:psis fifth-node)) 1)) - (is (string= (d:uri (first (d:psis fifth-node))) - "http://test-tm/fifth-node")) - (is (= (length (d:psis item-1)) 1)) - (is (string= (d:uri (first (d:psis item-1))) - "http://test-tm/item-1")) - (is (= (length (d:psis item-2)) 1)) - (is (string= (d:uri (first (d:psis item-2))) - "http://test-tm/item-2")) - (is (= (length (d:psis arc1)) 1)) - (is (string= (d:uri (first (d:psis arc1))) - "http://test/arcs/arc1")) - (is (= (length (d:psis arc2)) 1)) - (is (string= (d:uri (first (d:psis arc2))) - "http://test/arcs/arc2")) - (is (= (length (d:psis arc3)) 1)) - (is (string= (d:uri (first (d:psis arc3))) - "http://test/arcs/arc3")) - (is (= (length (d:psis arc4)) 1)) - (is (string= (d:uri (first (d:psis arc4))) - "http://test/arcs/arc4")) - (is (= (length (d:psis arc5)) 1)) - (is (string= (d:uri (first (d:psis arc5))) - "http://test/arcs/arc5")) - (is (= (length (d:psis arc6)) 1)) - (is (string= (d:uri (first (d:psis arc6))) - "http://test/arcs/arc6")) - (is (= (length (d:psis arc7)) 1)) - (is (string= (d:uri (first (d:psis arc7))) - "http://test/arcs/arc7")) - (is (= (length (d:psis arc8)) 1)) - (is (string= (d:uri (first (d:psis arc8))) - "http://test/arcs/arc8")) - (is (= (length (d:psis rdf-first)) 1)) - (is (string= (d:uri (first (d:psis rdf-first))) - constants:*rdf-first*)) - (is (= (length (d:psis rdf-rest)) 1)) - (is (string= (d:uri (first (d:psis rdf-rest))) - constants:*rdf-rest*)) - (is (= (length (d:psis rdf-nil)) 1)) - (is (string= (d:uri (first (d:psis rdf-nil))) - constants:*rdf-nil*)) - (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) - 1)) - (is (string= (d:charvalue (first (elephant:get-instances-by-class - 'd:OccurrenceC))) - "123")) - (is (string= (d:datatype (first (elephant:get-instances-by-class - 'd:OccurrenceC))) - "http://test-tm/long")) - (is (= (length (d:occurrences first-node)) 1)) - (is (= (length (d:player-in-roles first-node)) 3)) - (is (= (count-if + (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description rdf:about=\"first-node\">" + " <rdf:type rdf:nodeID=\"second-node\"/>" + " <arcs:arc1 rdf:resource=\"third-node\"/>" + " <arcs:arc2 rdf:datatype=\"long\">123</arcs:arc2>" + " <arcs:arc3>" + " <rdf:Description>" + " <arcs:arc4 rdf:parseType=\"Collection\">" + " <rdf:Description rdf:about=\"item-1\"/>" + " <rdf:Description rdf:about=\"item-2\">" + " <arcs:arc5 rdf:parseType=\"Resource\">" + " <arcs:arc6 rdf:resource=\"fourth-node\"/>" + " <arcs:arc7>" + " <rdf:Description rdf:about=\"fifth-node\"/>" + " </arcs:arc7>" + " <arcs:arc8 rdf:parseType=\"Collection\" />" + " </arcs:arc5>" + " </rdf:Description>" + " </arcs:arc4>" + " </rdf:Description>" + " </arcs:arc3>" + " </rdf:Description>" + " <rdf:Description rdf:nodeID=\"second-node\" />" + "</rdf:RDF>"))) + (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) + (is-true dom-1) + (is (= (length (dom:child-nodes dom-1)) 1)) + (rdf-init-db :db-dir db-dir :start-revision revision-1) + (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) + (is (= (length (rdf-importer::child-nodes-or-text rdf-node + :trim t)) + 2)) + (rdf-importer::import-dom rdf-node revision-1 :tm-id tm-id + :document-id document-id) + (is (= (length (elephant:get-instances-by-class 'd:TopicC)) 40)) + (is (= (length (elephant:get-instances-by-class 'd:AssociationC)) 12)) + (setf rdf-importer::*current-xtm* document-id) + (is (= (length + (intersection + (map 'list #'d:instance-of + (elephant:get-instances-by-class 'd:AssociationC)) + (list + (d:get-item-by-id (concat constants::*rdf-nil*) + :xtm-id rdf-importer::*rdf-core-xtm*) + (d:get-item-by-psi constants::*type-instance-psi*) + (dotimes (iter 9) + (let ((pos (+ iter 1)) + (topics nil)) + (when (/= pos 2) + (push (get-item-by-id + (concat "http://test/arcs/arc" + (write-to-string pos))) topics)) + topics))))))) + (let ((first-node (get-item-by-id "http://test-tm/first-node")) + (second-node (get-item-by-id "second-node")) + (third-node (get-item-by-id "http://test-tm/third-node")) + (fourth-node (get-item-by-id "http://test-tm/fourth-node")) + (fifth-node (get-item-by-id "http://test-tm/fifth-node")) + (item-1 (get-item-by-id "http://test-tm/item-1")) + (item-2 (get-item-by-id "http://test-tm/item-2")) + (arc1 (get-item-by-id "http://test/arcs/arc1")) + (arc2 (get-item-by-id "http://test/arcs/arc2")) + (arc3 (get-item-by-id "http://test/arcs/arc3")) + (arc4 (get-item-by-id "http://test/arcs/arc4")) + (arc5 (get-item-by-id "http://test/arcs/arc5")) + (arc6 (get-item-by-id "http://test/arcs/arc6")) + (arc7 (get-item-by-id "http://test/arcs/arc7")) + (arc8 (get-item-by-id "http://test/arcs/arc8")) + (instance (d:get-item-by-psi constants::*instance-psi*)) + (type (d:get-item-by-psi constants::*type-psi*)) + (type-instance (d:get-item-by-psi + constants:*type-instance-psi*)) + (subject (d:get-item-by-psi constants::*rdf2tm-subject*)) + (object (d:get-item-by-psi constants::*rdf2tm-object*)) + (rdf-first (d:get-item-by-psi constants:*rdf-first*)) + (rdf-rest (d:get-item-by-psi constants:*rdf-rest*)) + (rdf-nil (d:get-item-by-psi constants:*rdf-nil*))) + (is (= (length (d:psis first-node)) 1)) + (is (string= (d:uri (first (d:psis first-node))) + "http://test-tm/first-node")) + (is (= (length (d:psis second-node)) 0)) + (is (= (length (d:psis third-node)) 1)) + (is (string= (d:uri (first (d:psis third-node))) + "http://test-tm/third-node")) + (is (= (length (d:psis fourth-node)) 1)) + (is (string= (d:uri (first (d:psis fourth-node))) + "http://test-tm/fourth-node")) + (is (= (length (d:psis fifth-node)) 1)) + (is (string= (d:uri (first (d:psis fifth-node))) + "http://test-tm/fifth-node")) + (is (= (length (d:psis item-1)) 1)) + (is (string= (d:uri (first (d:psis item-1))) + "http://test-tm/item-1")) + (is (= (length (d:psis item-2)) 1)) + (is (string= (d:uri (first (d:psis item-2))) + "http://test-tm/item-2")) + (is (= (length (d:psis arc1)) 1)) + (is (string= (d:uri (first (d:psis arc1))) + "http://test/arcs/arc1")) + (is (= (length (d:psis arc2)) 1)) + (is (string= (d:uri (first (d:psis arc2))) + "http://test/arcs/arc2")) + (is (= (length (d:psis arc3)) 1)) + (is (string= (d:uri (first (d:psis arc3))) + "http://test/arcs/arc3")) + (is (= (length (d:psis arc4)) 1)) + (is (string= (d:uri (first (d:psis arc4))) + "http://test/arcs/arc4")) + (is (= (length (d:psis arc5)) 1)) + (is (string= (d:uri (first (d:psis arc5))) + "http://test/arcs/arc5")) + (is (= (length (d:psis arc6)) 1)) + (is (string= (d:uri (first (d:psis arc6))) + "http://test/arcs/arc6")) + (is (= (length (d:psis arc7)) 1)) + (is (string= (d:uri (first (d:psis arc7))) + "http://test/arcs/arc7")) + (is (= (length (d:psis arc8)) 1)) + (is (string= (d:uri (first (d:psis arc8))) + "http://test/arcs/arc8")) + (is (= (length (d:psis rdf-first)) 1)) + (is (string= (d:uri (first (d:psis rdf-first))) + constants:*rdf-first*)) + (is (= (length (d:psis rdf-rest)) 1)) + (is (string= (d:uri (first (d:psis rdf-rest))) + constants:*rdf-rest*)) + (is (= (length (d:psis rdf-nil)) 1)) + (is (string= (d:uri (first (d:psis rdf-nil))) + constants:*rdf-nil*)) + (is (= (length (elephant:get-instances-by-class 'd:OccurrenceC)) + 1)) + (is (string= (d:charvalue (first (elephant:get-instances-by-class + 'd:OccurrenceC))) + "123")) + (is (string= (d:datatype (first (elephant:get-instances-by-class + 'd:OccurrenceC))) + "http://test-tm/long")) + (is (= (length (d:occurrences first-node)) 1)) + (is (= (length (d:player-in-roles first-node)) 3)) + (is (= (count-if + #'(lambda(x) + (or (and (eql (d:instance-of x) instance) + (eql (d:instance-of (d:parent x)) + type-instance)) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc1)) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc3)))) + (d:player-in-roles first-node)) + 3)) + (is (= (length (d:player-in-roles second-node)) 1)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) type) + (eql (d:instance-of (d:parent x)) + type-instance))) + (d:player-in-roles second-node))) + (is (= (length (d:player-in-roles third-node)) 1)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) + arc1))) + (d:player-in-roles third-node))) + (let ((uuid-1 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if #'(lambda(x) - (or (and (eql (d:instance-of x) instance) - (eql (d:instance-of (d:parent x)) - type-instance)) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc1)) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc3)))) - (d:player-in-roles first-node)) - 3)) - (is (= (length (d:player-in-roles second-node)) 1)) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc3))) + (d:player-in-roles first-node)))))))) + (is-true uuid-1) + (is (= (length (d:player-in-roles uuid-1)) 2)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc4))) + (d:player-in-roles uuid-1))) + (let ((col-1 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc4))) + (d:player-in-roles uuid-1)))))))) + (is-true col-1) + (is (= (length (d:player-in-roles col-1)) 3)) (is-true (find-if #'(lambda(x) - (and (eql (d:instance-of x) type) - (eql (d:instance-of (d:parent x)) - type-instance))) - (d:player-in-roles second-node))) - (is (= (length (d:player-in-roles third-node)) 1)) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-first))) + (d:player-in-roles col-1))) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-1))) (is-true (find-if #'(lambda(x) (and (eql (d:instance-of x) object) - (eql (d:instance-of (d:parent x)) - arc1))) - (d:player-in-roles third-node))) - (let ((uuid-1 - (d:player - (find-if - #'(lambda(y) - (and (eql (d:instance-of y) object) - (= 0 (length (d:psis (d:player y)))))) - (d:roles - (d:parent - (find-if + (eql (d:instance-of (d:parent x)) + arc4))) + (d:player-in-roles col-1))) + (is (= (length (d:player-in-roles item-1)) 1)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) + rdf-first))) + (d:player-in-roles item-1))) + (let ((col-2 + (let ((role + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-1)))) + (is (= (length (d:roles (d:parent role))) 2)) + (let ((other-role + (find-if #'(lambda(x) + (and (not (eql x role)) + (eql (d:instance-of x) + object))) + (d:roles (d:parent role))))) + (d:player other-role))))) + (is-true col-2) + (is (= (length (d:psis col-2)) 0)) + (is (= (length (d:player-in-roles col-2)) 3)) + (is-true (find-if #'(lambda(x) (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc3))) - (d:player-in-roles first-node)))))))) - (is-true uuid-1) - (is (= (length (d:player-in-roles uuid-1)) 2)) + (eql (d:instance-of (d:parent x)) + rdf-first))) + (d:player-in-roles col-2))) (is-true (find-if #'(lambda(x) (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc4))) - (d:player-in-roles uuid-1))) - (let ((col-1 - (d:player - (find-if - #'(lambda(y) - (and (eql (d:instance-of y) object) - (= 0 (length (d:psis (d:player y)))))) - (d:roles - (d:parent - (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc4))) - (d:player-in-roles uuid-1)))))))) - (is-true col-1) - (is (= (length (d:player-in-roles col-1)) 3)) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - rdf-first))) - (d:player-in-roles col-1))) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - rdf-rest))) - (d:player-in-roles col-1))) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) object) - (eql (d:instance-of (d:parent x)) - arc4))) - (d:player-in-roles col-1))) - (is (= (length (d:player-in-roles item-1)) 1)) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) object) - (eql (d:instance-of (d:parent x)) - rdf-first))) - (d:player-in-roles item-1))) - (let ((col-2 - (let ((role + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-2))) + (let ((col-3 + (let ((role + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) + rdf-rest))) + (d:player-in-roles col-2)))) + + (is (= (length (d:roles (d:parent role))) 2)) + (let ((other-role (find-if #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - rdf-rest))) - (d:player-in-roles col-1)))) - (is (= (length (d:roles (d:parent role))) 2)) - (let ((other-role - (find-if #'(lambda(x) - (and (not (eql x role)) - (eql (d:instance-of x) - object))) - (d:roles (d:parent role))))) - (d:player other-role))))) - (is-true col-2) - (is (= (length (d:psis col-2)) 0)) - (is (= (length (d:player-in-roles col-2)) 3)) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - rdf-first))) - (d:player-in-roles col-2))) - (is-true (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - rdf-rest))) - (d:player-in-roles col-2))) - (let ((col-3 - (let ((role - (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) - rdf-rest))) - (d:player-in-roles col-2)))) - - (is (= (length (d:roles (d:parent role))) 2)) - (let ((other-role - (find-if - #'(lambda(x) - (not (eql x role))) - (d:roles (d:parent role))))) - (d:player other-role))))) - (is-true col-3) - (is (= (length (d:psis col-3)) 1)) - (is (string= (d:uri (first (d:psis col-3))) - constants:*rdf-nil*)) - (is (= (length (d:player-in-roles col-3)) 2))))) - (is (= (length (d:player-in-roles item-1)) 1)) - (is (= (length (d:player-in-roles item-2)) 2)) - (is-true (find-if - #'(lambda(x) + (not (eql x role))) + (d:roles (d:parent role))))) + (d:player other-role))))) + (is-true col-3) + (is (= (length (d:psis col-3)) 1)) + (is (string= (d:uri (first (d:psis col-3))) + constants:*rdf-nil*)) + (is (= (length (d:player-in-roles col-3)) 2))))) + (is (= (length (d:player-in-roles item-1)) 1)) + (is (= (length (d:player-in-roles item-2)) 2)) + (is-true (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc5))) + (d:player-in-roles item-2))) + (let ((uuid-2 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 0 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if + #'(lambda(x) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc5))) + (d:player-in-roles item-2)))))))) + (is-true uuid-2) + (is (= (length (d:player-in-roles uuid-2)) 4)) + (is (= (count-if + #'(lambda(x) + (or (and (eql (d:instance-of x) object) + (eql (d:instance-of (d:parent x)) arc5)) (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc5))) - (d:player-in-roles item-2))) - (let ((uuid-2 - (d:player - (find-if - #'(lambda(y) - (and (eql (d:instance-of y) object) - (= 0 (length (d:psis (d:player y)))))) - (d:roles - (d:parent - (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc5))) - (d:player-in-roles item-2)))))))) - (is-true uuid-2) - (is (= (length (d:player-in-roles uuid-2)) 4)) - (is (= (count-if + (or + (eql (d:instance-of (d:parent x)) arc6) + (eql (d:instance-of (d:parent x)) arc7) + (eql (d:instance-of + (d:parent x)) arc8))))) + (d:player-in-roles uuid-2)) + 4)) + (is (= (length (d:player-in-roles fourth-node)) 1)) + (is (= (length (d:player-in-roles fifth-node)) 1)) + (let ((col-2 + (d:player + (find-if + #'(lambda(y) + (and (eql (d:instance-of y) object) + (= 1 (length (d:psis (d:player y)))))) + (d:roles + (d:parent + (find-if #'(lambda(x) - (or (and (eql (d:instance-of x) object) - (eql (d:instance-of (d:parent x)) arc5)) - (and (eql (d:instance-of x) subject) - (or - (eql (d:instance-of (d:parent x)) arc6) - (eql (d:instance-of (d:parent x)) arc7) - (eql (d:instance-of - (d:parent x)) arc8))))) - (d:player-in-roles uuid-2)) - 4)) - (is (= (length (d:player-in-roles fourth-node)) 1)) - (is (= (length (d:player-in-roles fifth-node)) 1)) - (let ((col-2 - (d:player - (find-if - #'(lambda(y) - (and (eql (d:instance-of y) object) - (= 1 (length (d:psis (d:player y)))))) - (d:roles - (d:parent - (find-if - #'(lambda(x) - (and (eql (d:instance-of x) subject) - (eql (d:instance-of (d:parent x)) arc8))) - (d:player-in-roles uuid-2)))))))) - (is (= (length (d:psis col-2)) 1)) - (is (string= constants:*rdf-nil* - (d:uri (first (d:psis col-2))))) - (is-true col-2) - (is (= (length (d:player-in-roles col-2)) 2))))))))) + (and (eql (d:instance-of x) subject) + (eql (d:instance-of (d:parent x)) arc8))) + (d:player-in-roles uuid-2)))))))) + (is (= (length (d:psis col-2)) 1)) + (is (string= constants:*rdf-nil* + (d:uri (first (d:psis col-2))))) + (is-true col-2) + (is (= (length (d:player-in-roles col-2)) 2))))))))) (elephant:close-store)) @@ -1602,7 +1590,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "firstName")) + (concat arcs "firstName")) (string= *xml-string* (d:datatype x)) (= (length (d:themes x)) 0) (= (length (d:psis (d:parent x))) 1) @@ -1614,7 +1602,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "lastName")) + (concat arcs "lastName")) (string= *xml-string* (d:datatype x)) (= (length (d:themes x)) 0) (= (length (d:psis (d:parent x))) 1) @@ -1626,7 +1614,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "fullName")) + (concat arcs "fullName")) (string= *xml-string* (d:datatype x)) (= (length (d:themes x)) 0) (= (length (d:psis (d:parent x))) 1) @@ -1638,7 +1626,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "fullName")) + (concat arcs "fullName")) (string= *xml-string* (d:datatype x)) (= (length (d:themes x)) 0) (= (length (d:psis (d:parent x))) 1) @@ -1650,7 +1638,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "nativeName")) + (concat arcs "nativeName")) (string= *xml-string* (d:datatype x)) (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) @@ -1663,7 +1651,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "title")) + (concat arcs "title")) (string= *xml-string* (d:datatype x)) (string= (d:charvalue x) "Der Zauberlehrling") (= 1 (length (d:themes x))) @@ -1677,7 +1665,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "title")) + (concat arcs "title")) (= 0 (length (d:themes x))) (string= (d:charvalue x) "Prometheus") (string= *xml-string* (d:datatype x)) @@ -1690,7 +1678,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "title")) + (concat arcs "title")) (string= *xml-string* (d:datatype x)) (string= (d:charvalue x) "Der Erlkönig") (= 1 (length (d:themes x))) @@ -1704,7 +1692,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "content")) + (concat arcs "content")) (string= *xml-string* (d:datatype x)) (string= (d:charvalue x) "Hat der alte Hexenmeister ...") (= 1 (length (d:themes x))) @@ -1718,7 +1706,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "content")) + (concat arcs "content")) (string= *xml-string* (d:datatype x)) (string= (d:charvalue x) " Bedecke deinen Himmel, Zeus, ... ") @@ -1733,7 +1721,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "content")) + (concat arcs "content")) (string= *xml-string* (d:datatype x)) (string= (d:charvalue x) "Wer reitet so spät durch Nacht und Wind? ...") @@ -1748,7 +1736,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "population")) + (concat arcs "population")) (string= long (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 1) @@ -1760,7 +1748,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "population")) + (concat arcs "population")) (string= long (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 1) @@ -1772,7 +1760,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "population")) + (concat arcs "population")) (string= long (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 1) @@ -1784,7 +1772,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "population")) + (concat arcs "population")) (string= long (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 1) @@ -1796,7 +1784,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "date")) + (concat arcs "date")) (string= date (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 0))) @@ -1806,7 +1794,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "start")) + (concat arcs "start")) (string= date (d:datatype x)) (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) @@ -1818,7 +1806,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "start")) + (concat arcs "start")) (string= date (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 0))) @@ -1829,7 +1817,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "end")) + (concat arcs "end")) (string= date (d:datatype x)) (= 1 (length (d:themes x))) (eql (first (d:themes x)) de) @@ -1840,7 +1828,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "end")) + (concat arcs "end")) (string= date (d:datatype x)) (= 0 (length (d:themes x))) (= (length (d:psis (d:parent x))) 0))) @@ -1869,7 +1857,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "born")) + (concat arcs "born")) (= (length (d:roles x)) 2) (find-if #'(lambda(y) @@ -1889,7 +1877,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "died")) + (concat arcs "died")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -1908,7 +1896,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "wrote")) + (concat arcs "wrote")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -1927,7 +1915,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "capital")) + (concat arcs "capital")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -1948,7 +1936,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "officialese")) + (concat arcs "officialese")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -1969,7 +1957,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "place")) + (concat arcs "place")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-object) @@ -1988,7 +1976,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "place")) + (concat arcs "place")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-object) @@ -2007,7 +1995,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "locatedIn")) + (concat arcs "locatedIn")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2028,7 +2016,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "locatedIn")) + (concat arcs "locatedIn")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2049,7 +2037,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "locatedIn")) + (concat arcs "locatedIn")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2070,7 +2058,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "dateRange")) + (concat arcs "dateRange")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2089,7 +2077,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "dateRange")) + (concat arcs "dateRange")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2108,7 +2096,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string arcs "dateRange")) + (concat arcs "dateRange")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2127,7 +2115,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_1")) + (concat constants:*rdf-ns* "_1")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2146,7 +2134,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_2")) + (concat constants:*rdf-ns* "_2")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2165,7 +2153,7 @@ #'(lambda(x) (and (= (length (d:psis (d:instance-of x))) 1) (string= (d:uri (first (d:psis (d:instance-of x)))) - (concatenate 'string constants:*rdf-ns* "_3")) + (concat constants:*rdf-ns* "_3")) (find-if #'(lambda(y) (and (eql (d:instance-of y) isi-subject) @@ -2204,7 +2192,7 @@ (german "http://some.where/language/German") (author "http://some.where/types/Author") (goethe "http://some.where/author/Goethe") - (bag (concatenate 'string constants::*rdf-ns* "Bag")) + (bag (concat constants::*rdf-ns* "Bag")) (poem "http://some.where/types/Poem") (ballad "http://some.where/types/Ballad") (zauberlehrling "http://some.where/poem/Der_Zauberlehrling") @@ -2465,101 +2453,101 @@ (let ((arcs "http://some.where/relationship/") (types "http://some.where/types/")) (let ((goethe (get-item-by-id "http://some.where/author/Goethe")) - (author (get-item-by-id (concatenate 'string types "Author"))) + (author (get-item-by-id (concat types "Author"))) (first-name (get-item-by-id - (concatenate 'string arcs "firstName"))) + (concat arcs "firstName"))) (last-name (get-item-by-id - (concatenate 'string arcs "lastName"))) - (born (get-item-by-id (concatenate 'string arcs "born"))) - (event (get-item-by-id (concatenate 'string types "Event"))) - (date (get-item-by-id (concatenate 'string arcs "date"))) - (place (get-item-by-id (concatenate 'string arcs "place"))) + (concat arcs "lastName"))) + (born (get-item-by-id (concat arcs "born"))) + (event (get-item-by-id (concat types "Event"))) + (date (get-item-by-id (concat arcs "date"))) + (place (get-item-by-id (concat arcs "place"))) (frankfurt (get-item-by-id "http://some.where/metropolis/FrankfurtMain")) - (metropolis (get-item-by-id (concatenate 'string types + (metropolis (get-item-by-id (concat types "Metropolis"))) - (region (get-item-by-id (concatenate 'string types "Region"))) - (population (get-item-by-id (concatenate 'string arcs + (region (get-item-by-id (concat types "Region"))) + (population (get-item-by-id (concat arcs "population"))) - (locatedIn (get-item-by-id (concatenate 'string arcs + (locatedIn (get-item-by-id (concat arcs "locatedIn"))) (germany (get-item-by-id "http://some.where/country/Germany")) - (country (get-item-by-id (concatenate 'string types "Country"))) - (native-name (get-item-by-id (concatenate 'string arcs + (country (get-item-by-id (concat types "Country"))) + (native-name (get-item-by-id (concat arcs "nativeName"))) - (officialese (get-item-by-id (concatenate 'string arcs + (officialese (get-item-by-id (concat arcs "officialese"))) (german (get-item-by-id "http://some.where/language/German")) - (capital (get-item-by-id (concatenate 'string arcs "capital"))) + (capital (get-item-by-id (concat arcs "capital"))) (berlin (get-item-by-id "http://some.where/metropolis/Berlin")) - (died (get-item-by-id (concatenate 'string arcs "died"))) + (died (get-item-by-id (concat arcs "died"))) (weimar (get-item-by-id "http://some.where/city/Weimar")) - (city (get-item-by-id (concatenate 'string types "City"))) - (wrote (get-item-by-id (concatenate 'string arcs "wrote"))) + (city (get-item-by-id (concat types "City"))) + (wrote (get-item-by-id (concat arcs "wrote"))) (goethe-literature (get-item-by-id "goethe_literature")) - (bag (get-item-by-id (concatenate 'string *rdf-ns* "Bag"))) - (_1 (get-item-by-id (concatenate 'string *rdf-ns* "_1"))) - (_2 (get-item-by-id (concatenate 'string *rdf-ns* "_2"))) - (_3 (get-item-by-id (concatenate 'string *rdf-ns* "_3"))) + (bag (get-item-by-id (concat *rdf-ns* "Bag"))) + (_1 (get-item-by-id (concat *rdf-ns* "_1"))) + (_2 (get-item-by-id (concat *rdf-ns* "_2"))) + (_3 (get-item-by-id (concat *rdf-ns* "_3"))) (zauberlehrling (get-item-by-id "http://some.where/poem/Der_Zauberlehrling")) - (poem (get-item-by-id (concatenate 'string types "Poem"))) - (dateRange (get-item-by-id (concatenate 'string arcs "dateRange"))) - (start (get-item-by-id (concatenate 'string arcs "start"))) - (end (get-item-by-id (concatenate 'string arcs "end"))) - (title (get-item-by-id (concatenate 'string arcs "title"))) - (content (get-item-by-id (concatenate 'string arcs "content"))) + (poem (get-item-by-id (concat types "Poem"))) + (dateRange (get-item-by-id (concat arcs "dateRange"))) + (start (get-item-by-id (concat arcs "start"))) + (end (get-item-by-id (concat arcs "end"))) + (title (get-item-by-id (concat arcs "title"))) + (content (get-item-by-id (concat arcs "content"))) (erlkoenig (get-item-by-id "http://some.where/ballad/Der_Erlkoenig")) - (ballad (get-item-by-id (concatenate 'string types "Ballad"))) + (ballad (get-item-by-id (concat types "Ballad"))) (de (get-item-by-id (concatenate 'string constants::*rdf2tm-scope-prefix* "de"))) (prometheus (get-item-by-id "http://some.where/poem/Prometheus")) - (language (get-item-by-id (concatenate 'string types "Language"))) - (full-name (get-item-by-id (concatenate 'string arcs "fullName")))) + (language (get-item-by-id (concat types "Language"))) + (full-name (get-item-by-id (concat arcs "fullName")))) (check-topic goethe "http://some.where/author/Goethe") - (check-topic author (concatenate 'string types "Author")) - (check-topic first-name (concatenate 'string arcs "firstName")) - (check-topic last-name (concatenate 'string arcs "lastName")) - (check-topic born (concatenate 'string arcs "born")) - (check-topic event (concatenate 'string types "Event")) - (check-topic date (concatenate 'string arcs "date")) - (check-topic place (concatenate 'string arcs "place")) + (check-topic author (concat types "Author")) + (check-topic first-name (concat arcs "firstName")) + (check-topic last-name (concat arcs "lastName")) + (check-topic born (concat arcs "born")) + (check-topic event (concat types "Event")) + (check-topic date (concat arcs "date")) + (check-topic place (concat arcs "place")) (check-topic frankfurt "http://some.where/metropolis/FrankfurtMain") - (check-topic metropolis (concatenate 'string types "Metropolis")) - (check-topic region (concatenate 'string types "Region")) - (check-topic population (concatenate 'string arcs "population")) - (check-topic locatedIn (concatenate 'string arcs "locatedIn")) + (check-topic metropolis (concat types "Metropolis")) + (check-topic region (concat types "Region")) + (check-topic population (concat arcs "population")) + (check-topic locatedIn (concat arcs "locatedIn")) (check-topic germany "http://some.where/country/Germany") - (check-topic country (concatenate 'string types "Country")) - (check-topic native-name (concatenate 'string arcs "nativeName")) - (check-topic officialese (concatenate 'string arcs "officialese")) + (check-topic country (concat types "Country")) + (check-topic native-name (concat arcs "nativeName")) + (check-topic officialese (concat arcs "officialese")) (check-topic german "http://some.where/language/German") - (check-topic capital (concatenate 'string arcs "capital")) + (check-topic capital (concat arcs "capital")) (check-topic berlin "http://some.where/metropolis/Berlin") - (check-topic died (concatenate 'string arcs "died")) + (check-topic died (concat arcs "died")) (check-topic weimar "http://some.where/city/Weimar") - (check-topic city (concatenate 'string types "City")) - (check-topic wrote (concatenate 'string arcs "wrote")) + (check-topic city (concat types "City")) + (check-topic wrote (concat arcs "wrote")) (check-topic goethe-literature nil) - (check-topic bag (concatenate 'string *rdf-ns* "Bag")) - (check-topic _1 (concatenate 'string *rdf-ns* "_1")) - (check-topic _2 (concatenate 'string *rdf-ns* "_2")) - (check-topic _3 (concatenate 'string *rdf-ns* "_3")) + (check-topic bag (concat *rdf-ns* "Bag")) + (check-topic _1 (concat *rdf-ns* "_1")) + (check-topic _2 (concat *rdf-ns* "_2")) + (check-topic _3 (concat *rdf-ns* "_3")) (check-topic zauberlehrling "http://some.where/poem/Der_Zauberlehrling") - (check-topic poem (concatenate 'string types "Poem")) - (check-topic dateRange (concatenate 'string arcs "dateRange")) - (check-topic start (concatenate 'string arcs "start")) - (check-topic end (concatenate 'string arcs "end")) - (check-topic title (concatenate 'string arcs "title")) - (check-topic content (concatenate 'string arcs "content")) + (check-topic poem (concat types "Poem")) + (check-topic dateRange (concat arcs "dateRange")) + (check-topic start (concat arcs "start")) + (check-topic end (concat arcs "end")) + (check-topic title (concat arcs "title")) + (check-topic content (concat arcs "content")) (check-topic erlkoenig "http://some.where/ballad/Der_Erlkoenig") - (check-topic ballad (concatenate 'string types "Ballad")) - (check-topic de (concatenate 'string constants::*rdf2tm-scope-prefix* + (check-topic ballad (concat types "Ballad")) + (check-topic de (concat constants::*rdf2tm-scope-prefix* "de")) (check-topic prometheus "http://some.where/poem/Prometheus") - (check-topic language (concatenate 'string types "Language")) - (check-topic full-name (concatenate 'string arcs "fullName")) + (check-topic language (concat types "Language")) + (check-topic full-name (concat arcs "fullName")) (is (= (count-if #'(lambda(x) (null (d:psis x))) (elephant:get-instances-by-class 'd:TopicC)) @@ -2573,12 +2561,12 @@ (revision-1 100) (document-id "doc-id") (doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\">" - " <rdf:Description rdf:about=\"first-node\">" - " <arcs:arc rdf:parseType=\"Collection\" />" - " </rdf:Description>" - "</rdf:RDF>"))) + (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description rdf:about=\"first-node\">" + " <arcs:arc rdf:parseType=\"Collection\" />" + " </rdf:Description>" + "</rdf:RDF>"))) (let ((rdf-node (elt (dom:child-nodes (cxml:parse doc-1 (cxml-dom:make-dom-builder))) 0))) @@ -2633,15 +2621,15 @@ (revision-1 100) (document-id "doc-id") (doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\">" - " <rdf:Description rdf:about=\"first-node\">" - " <arcs:arc rdf:parseType=\"Collection\">" - " <rdf:Description rdf:about=\"item-1\"/>" - " <arcs:Node rdf:about=\"item-2\"/>" - " </arcs:arc>" - " </rdf:Description>" - "</rdf:RDF>"))) + (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description rdf:about=\"first-node\">" + " <arcs:arc rdf:parseType=\"Collection\">" + " <rdf:Description rdf:about=\"item-1\"/>" + " <arcs:Node rdf:about=\"item-2\"/>" + " </arcs:arc>" + " </rdf:Description>" + "</rdf:RDF>"))) (let ((rdf-node (elt (dom:child-nodes (cxml:parse doc-1 (cxml-dom:make-dom-builder))) 0))) @@ -2790,12 +2778,12 @@ (test test-xml-base "Tests the function get-xml-base." (let ((doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\">" - " <rdf:Description xml:base=\"http://base-1\"/>" - " <rdf:Description xml:base=\"http://base-2#\"/>" - " <rdf:Description xml:base=\"http://base-3/\"/>" - "</rdf:RDF>"))) + (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\">" + " <rdf:Description xml:base=\"http://base-1\"/>" + " <rdf:Description xml:base=\"http://base-2#\"/>" + " <rdf:Description xml:base=\"http://base-3/\"/>" + "</rdf:RDF>"))) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (let ((rdf-node (elt (dom:child-nodes dom-1) 0))) (let ((n-1 (elt (rdf-importer::child-nodes-or-text rdf-node Modified: trunk/src/unit_tests/reification_test.lisp ============================================================================== --- trunk/src/unit_tests/reification_test.lisp (original) +++ trunk/src/unit_tests/reification_test.lisp Wed Jan 5 18:37:15 2011 @@ -14,6 +14,7 @@ :it.bese.FiveAM :unittests-constants :fixtures + :base-tools :exporter) (:import-from :constants *xtm2.0-ns* @@ -531,26 +532,26 @@ (revision-1 100) (document-id "doc-id") (doc-1 - (concatenate 'string "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " - "xmlns:arcs=\"http://test/arcs/\" " - "xmlns:rdfs=\"" *rdfs-ns* "\">" - "<rdf:Description rdf:about=\"first-node\">" - "<arcs:arc1 rdf:ID=\"reification-1\">" - "<rdf:Description rdf:about=\"second-node\" />" - "</arcs:arc1>" - "</rdf:Description>" - "<rdf:Description rdf:ID=\"#reification-1\">" - "<arcs:arc2 rdf:resource=\"third-node\"/>" - "</rdf:Description>" - "<rdf:Description rdf:nodeID=\"fourth-node\">" - "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">" - "occurrence data" - "</arcs:arc3>" - "</rdf:Description>" - "<rdf:Description rdf:ID=\"#reification-2\">" - "<arcs:arc4 rdf:resource=\"fifth-node\" />" - "</rdf:Description>" - "</rdf:RDF>"))) + (concat "<rdf:RDF xmlns:rdf=\"" *rdf-ns* "\" " + "xmlns:arcs=\"http://test/arcs/\" " + "xmlns:rdfs=\"" *rdfs-ns* "\">" + "<rdf:Description rdf:about=\"first-node\">" + "<arcs:arc1 rdf:ID=\"reification-1\">" + "<rdf:Description rdf:about=\"second-node\" />" + "</arcs:arc1>" + "</rdf:Description>" + "<rdf:Description rdf:ID=\"#reification-1\">" + "<arcs:arc2 rdf:resource=\"third-node\"/>" + "</rdf:Description>" + "<rdf:Description rdf:nodeID=\"fourth-node\">" + "<arcs:arc3 rdf:ID=\"reification-2\" rdf:datatype=\"dt\">" + "occurrence data" + "</arcs:arc3>" + "</rdf:Description>" + "<rdf:Description rdf:ID=\"#reification-2\">" + "<arcs:arc4 rdf:resource=\"fifth-node\" />" + "</rdf:Description>" + "</rdf:RDF>"))) (clean-out-db db-dir) (let ((dom-1 (cxml:parse doc-1 (cxml-dom:make-dom-builder)))) (is-true dom-1) @@ -685,17 +686,17 @@ (is-true (reified-construct (reifier name))) (is (= (length (psis (reifier name))) 1)) (is (string= (uri (first (psis (reifier name)))) - (concatenate 'string tm-id "lisa-name"))) + (concat tm-id "lisa-name"))) (is-true (reifier variant)) (is-true (reified-construct (reifier variant))) (is (= (length (psis (reifier variant))) 1)) (is (string= (uri (first (psis (reifier variant)))) - (concatenate 'string tm-id "lisa-name-variant"))) + (concat tm-id "lisa-name-variant"))) (is-true (reifier occurrence)) (is-true (reified-construct (reifier occurrence))) (is (= (length (psis (reifier occurrence))) 1)) (is (string= (uri (first (psis (reifier occurrence)))) - (concatenate 'string tm-id "lisa-occurrence"))))))) + (concat tm-id "lisa-occurrence"))))))) (elephant:close-store)) @@ -722,7 +723,7 @@ (is-true (reified-construct (reifier friendship-association))) (is (= (length (psis (reifier friendship-association))) 1)) (is (string= (uri (first (psis (reifier friendship-association)))) - (concatenate 'string tm-id "friendship-association"))) + (concat tm-id "friendship-association"))) (is (= (length (roles friendship-association)) 2)) (let ((carl-role (find-if #'(lambda(role) @@ -733,7 +734,7 @@ (is-true (reified-construct (reifier carl-role))) (is (= (length (psis (reifier carl-role))) 1)) (is (string= (uri (first (psis (reifier carl-role)))) - (concatenate 'string tm-id "friend-role"))))))) + (concat tm-id "friend-role"))))))) (elephant:close-store)) Modified: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- trunk/src/unit_tests/sparql_test.lisp (original) +++ trunk/src/unit_tests/sparql_test.lisp Wed Jan 5 18:37:15 2011 @@ -168,15 +168,14 @@ (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-4 (concat "1234.43e10" (string #\tab))) + (query-5 (concat "'''true'''^^" *xml-boolean* " ;")) + (query-6 (concat "'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* " .")) + (query-8 (concat "'''12.4'''^^" *xml-integer* ". ")) + (query-9 (concat "\"13e4\"^^" *xml-boolean* " .")) (dummy-object (make-instance 'SPARQL-Query :query ""))) (is-true dummy-object) (let ((res (tm-sparql::parse-literal-elem dummy-object query-1))) @@ -218,7 +217,7 @@ (is (eql (tm-sparql::elem-type (getf res :value)) 'TM-SPARQL::LITERAL))) (let ((res (tm-sparql::parse-literal-elem dummy-object query-6))) (is (string= (getf res :next-query) - (concatenate 'string "." (string #\newline)))) + (concat "." (string #\newline)))) (is (eql (tm-sparql::value (getf res :value)) 123.4)) (is-false (tm-sparql::literal-lang (getf res :value))) (is (string= (tm-sparql::literal-datatype (getf res :value)) @@ -346,13 +345,13 @@ (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* "; BASE <http://new.base/>" - "<predicate-2> \"abc\"^^" - *xml-string* "}")) + (let ((query-4 (concat "<subject> <predicate> '''true'''^^" + *xml-boolean* "; pref:predicate-2 \"12\"^^" + *xml-integer* "}")) + (query-5 (concat "<subject> <predicate> '''false'''^^" + *xml-boolean* "; BASE <http://new.base/>" + "<predicate-2> \"abc\"^^" + *xml-string* "}")) (dummy-object (make-instance 'SPARQL-Query :query "" :base "http://base.value/")) (lit 'TM-SPARQL::LITERAL) Modified: trunk/src/xml/rdf/exporter.lisp ============================================================================== --- trunk/src/xml/rdf/exporter.lisp (original) +++ trunk/src/xml/rdf/exporter.lisp Wed Jan 5 18:37:15 2011 @@ -51,12 +51,12 @@ of the type rdf:_n there will be returned rdf:li." (let ((rdf-len (length *rdf-ns*))) (let ((prep-uri (when (string-starts-with - uri (concatenate 'string *rdf-ns* "_")) + uri (concat *rdf-ns* "_")) (subseq uri (+ rdf-len 1))))) (if prep-uri (handler-case (progn (parse-integer prep-uri) - (concatenate 'string *rdf-ns* "li")) + (concat *rdf-ns* "li")) (condition () uri)) uri)))) @@ -86,8 +86,7 @@ (let ((ns (getf ns-list :prefix)) (tag-name (getf ns-list :suffix))) (cxml:with-namespace ((get-ns-prefix ns) ns) - (cxml:with-element (concatenate 'string (get-ns-prefix ns) - ":" tag-name) + (cxml:with-element (concat (get-ns-prefix ns) ":" tag-name) ,@body))))) @@ -154,9 +153,8 @@ *ns-map*))) (if ns-entry (getf ns-entry :prefix) - (let ((new-name (concatenate - 'string "ns" - (write-to-string (+ 1 (length *ns-map*)))))) + (let ((new-name (concat "ns" + (write-to-string (+ 1 (length *ns-map*)))))) (push (list :prefix new-name :uri ns-uri) *ns-map*) @@ -209,7 +207,7 @@ (defun make-object-id (object) "Returns a string of the form id_<integer> which can be used as nodeID." - (concatenate 'string "id_" (write-to-string (elephant::oid object)))) + (concat "id_" (write-to-string (elephant::oid object)))) (defun make-topic-reference (topic) @@ -221,7 +219,7 @@ (if (reified-construct topic) (let ((psi (get-reifier-psi topic))) (if psi - (concatenate 'string "#" (get-reifier-uri topic)) + (concat "#" (get-reifier-uri topic)) (uri (first (psis topic))))) (uri (first (psis topic))))) (cxml:attribute "rdf:nodeID" (make-object-id topic)))) @@ -597,7 +595,8 @@ (if (reified-construct construct) (let ((reifier-uri (get-reifier-uri construct))) (if reifier-uri - (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) + (cxml:attribute "rdf:about" + (concat "#" (get-reifier-uri construct))) (cxml:attribute "rdf:about" (uri psi)))) (cxml:attribute "rdf:about" (uri psi))) (cxml:attribute "rdf:nodeID" (make-object-id construct))) @@ -632,7 +631,8 @@ (if (reified-construct construct) (let ((reifier-uri (get-reifier-uri construct))) (if reifier-uri - (cxml:attribute "rdf:about" (concatenate 'string "#" (get-reifier-uri construct))) + (cxml:attribute "rdf:about" + (concat "#" (get-reifier-uri construct))) (cxml:attribute "rdf:about" (uri psi)))) (cxml:attribute "rdf:about" (uri psi))) (cxml:attribute "rdf:nodeID" (make-object-id construct))) Modified: trunk/src/xml/rdf/importer.lisp ============================================================================== --- trunk/src/xml/rdf/importer.lisp (original) +++ trunk/src/xml/rdf/importer.lisp Wed Jan 5 18:37:15 2011 @@ -423,8 +423,7 @@ (let ((topic-id (or about ID nodeID UUID)) (psi-uri (or about ID)) (ii-uri (unless (or about ID) - (concatenate 'string *rdf2tm-blank-node-prefix* - (or nodeID UUID))))) + (concat *rdf2tm-blank-node-prefix* (or nodeID UUID))))) (let ((top (get-item-by-id topic-id :xtm-id document-id :revision start-revision))) (if top Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Wed Jan 5 18:37:15 2011 @@ -100,8 +100,8 @@ *_n-map*))) (if owner (let ((new-name - (concatenate - 'string *rdf-ns* "_" + (concat + *rdf-ns* "_" (write-to-string (+ (length (getf owner :props)) 1))))) (push (list :elem property :name new-name) @@ -112,7 +112,7 @@ (list :owner owner-identifier :props (list (list :elem property - :name (concatenate 'string *rdf-ns* "_1")))) + :name (concat *rdf-ns* "_1")))) *_n-map*) "_1")))))) @@ -183,15 +183,11 @@ (when (or resource datatype parseType class subClassOf) (error "~a~a is not allowed here (~a)!" err-pref (cond - (resource (concatenate 'string "resource(" - resource ")")) - (datatype (concatenate 'string "datatype(" - datatype ")")) - (parseType (concatenate 'string "parseType(" - parseType ")")) - (class (concatenate 'string "Class(" class ")")) - (subClassOf (concatenate 'string "subClassOf(" - subClassOf ")"))) + (resource (concat "resource(" resource ")")) + (datatype (concat "datatype(" datatype ")")) + (parseType (concat "parseType(" parseType ")")) + (class (concat "Class(" class ")")) + (subClassOf (concat "subClassOf(" subClassOf ")"))) (dom:node-name node))) (dolist (item *rdf-types*) (when (get-ns-attribute node item) @@ -310,9 +306,9 @@ (error "~aonly one of ~a and rdf:datatype (~a) is allowed!" err-pref (cond - (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) - (resource (concatenate 'string "rdf:resource (" resource ")")) - (type (concatenate 'string "rdf:type (" type ")")) + (nodeID (concat "rdf:nodeID (" nodeID ")")) + (resource (concat "rdf:resource (" resource ")")) + (type (concat "rdf:type (" type ")")) (literals literals)) datatype)) (when (and (or nodeID resource) @@ -320,8 +316,8 @@ (error "~awhen ~a is set no content is allowed: ~a!" err-pref (cond - (nodeID (concatenate 'string "rdf:nodeID (" nodeID ")")) - (resource (concatenate 'string "rdf:resource (" resource ")"))) + (nodeID (concat "rdf:nodeID (" nodeID ")")) + (resource (concat "rdf:resource (" resource ")"))) content)) (when (and type (stringp content) @@ -340,8 +336,8 @@ (error "~a~a not allowed here!" err-pref (if about - (concatenate 'string "rdf:about (" about ")") - (concatenate 'string "rdfs:subClassOf (" subClassOf ")")))) + (concat "rdf:about (" about ")") + (concat "rdfs:subClassOf (" subClassOf ")")))) (when (and (string= node-name "subClassOf") (string= node-ns *rdfs-ns*) (not (or nodeID resource content))) @@ -424,8 +420,7 @@ (remove-if #'null (append (unless (string= (get-type-of-node-name elem) - (concatenate 'string *rdf-ns* - "Description")) + (concat *rdf-ns* "Description")) (list (list :topicid (get-type-of-node-name elem) :psi (get-type-of-node-name elem) Modified: trunk/src/xml/xtm/exporter_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm1.0.lisp Wed Jan 5 18:37:15 2011 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :exporter - (:use :cl :cxml :elephant :datamodel :isidorus-threading) + (:use :cl :cxml :elephant :datamodel :isidorus-threading :base-tools) (:import-from :constants *XTM2.0-NS* *XTM1.0-NS* @@ -72,11 +72,14 @@ ""))) (if (string= characteristic-type "http://www.w3.org/2001/XMLSchema#anyURI") (cxml:with-element "t:resourceRef" - (cxml:attribute "xlink:href" - (let ((ref-topic (when (and (> (length characteristic-value) 0) - (eql (elt characteristic-value 0) #\#)) - (get-item-by-id (subseq characteristic-value 1) :revision revision)))) - (if ref-topic (concatenate 'string "#" (topic-id ref-topic revision)) characteristic-value)))) + (cxml:attribute + "xlink:href" + (let ((ref-topic (when (and (> (length characteristic-value) 0) + (eql (elt characteristic-value 0) #\#)) + (get-item-by-id (subseq characteristic-value 1) + :revision revision)))) + (if ref-topic (concat "#" (topic-id ref-topic revision)) + characteristic-value)))) (cxml:with-element "t:resourceData" (cxml:text characteristic-value))))) @@ -94,7 +97,7 @@ (type (or integer nil) revision)) (cxml:with-element "t:instanceOf" (cxml:with-element "t:topicRef" - (cxml:attribute "xlink:href" (concatenate 'string "#" (topic-id topic revision)))))) + (cxml:attribute "xlink:href" (concat "#" (topic-id topic revision)))))) (defun to-subjectIdentity-elem-xtm1.0 (psis locator revision) Modified: trunk/src/xml/xtm/exporter_xtm2.0.lisp ============================================================================== --- trunk/src/xml/xtm/exporter_xtm2.0.lisp (original) +++ trunk/src/xml/xtm/exporter_xtm2.0.lisp Wed Jan 5 18:37:15 2011 @@ -90,7 +90,7 @@ :revision revision)))) (cxml:attribute "href" (if ref-topic - (concatenate 'string "#" (topic-id ref-topic revision)) + (concat "#" (topic-id ref-topic revision)) characteristic-value)))) (cxml:with-element "t:resourceData" (when (slot-boundp characteristic 'datatype) @@ -165,7 +165,7 @@ (cxml:with-element "t:instanceOf" (loop for item in ios do (cxml:with-element "t:topicRef" - (cxml:attribute "href" (concatenate 'string "#" (topic-id item revision)))))))) + (cxml:attribute "href" (concat "#" (topic-id item revision)))))))) (map 'list #'(lambda(x) (to-elem x revision)) (names topic :revision revision)) Modified: trunk/src/xml/xtm/importer.lisp ============================================================================== --- trunk/src/xml/xtm/importer.lisp (original) +++ trunk/src/xml/xtm/importer.lisp Wed Jan 5 18:37:15 2011 @@ -14,7 +14,7 @@ ;; raise some kind of error (--> condition) if something goes wrong. (defpackage :xml-importer - (:use :cl :cxml :elephant :datamodel :isidorus-threading) + (:use :cl :cxml :elephant :datamodel :isidorus-threading :base-tools) (:import-from :constants *type-instance-psi* *type-psi* Modified: trunk/src/xml/xtm/importer_xtm1.0.lisp ============================================================================== --- trunk/src/xml/xtm/importer_xtm1.0.lisp (original) +++ trunk/src/xml/xtm/importer_xtm1.0.lisp Wed Jan 5 18:37:15 2011 @@ -19,7 +19,7 @@ (> (length reifier-uri) 0)) (let ((psi (elephant:get-instance-by-value 'd:PersistentIdC 'd:uri - (concatenate 'string "#" reifier-uri)))) + (concat "#" reifier-uri)))) (when psi (let ((reifier-topic (identified-construct psi :revision start-revision))) (when reifier-topic Modified: trunk/src/xml/xtm/tools.lisp ============================================================================== --- trunk/src/xml/xtm/tools.lisp (original) +++ trunk/src/xml/xtm/tools.lisp Wed Jan 5 18:37:15 2011 @@ -40,7 +40,7 @@ (let ((prep-id (if (and (> (length id) 0) (eql (elt id 0) #\#)) id - (concatenate 'string "#" (string-left-trim "/" id))))) + (concat "#" (string-left-trim "/" id))))) (absolutize-value prep-id xml-base tm-id))) @@ -65,8 +65,8 @@ (let ((fragment (if (and (> (length prep-value) 0) (eql (elt prep-value 0) #\#)) - (concatenate 'string prep-base prep-value) - (concatenate 'string prep-base "/" prep-value)))) + (concat prep-base prep-value) + (concat prep-base "/" prep-value)))) (if (absolute-uri-p fragment) fragment (let ((prep-fragment @@ -79,7 +79,7 @@ (if (eql (elt prep-fragment 0) #\#) "" "/"))) - (concatenate 'string prep-tm-id separator prep-fragment)))))))) + (concat prep-tm-id separator prep-fragment)))))))) (defun get-xml-lang(elem &key (old-lang nil)) @@ -123,8 +123,8 @@ new-base (if (not new-base) old-base - (concatenate 'string (string-right-trim "/" old-base) - "/" (string-left-trim "/" new-base)))))) + (concat (string-right-trim "/" old-base) + "/" (string-left-trim "/" new-base)))))) (defun child-nodes-or-text (elem &key (trim nil)) @@ -170,7 +170,7 @@ "Returns the node's name without a prefix." (if (find #\: (dom:node-name elem)) (subseq (dom:node-name elem) - (length (concatenate 'string (dom:prefix elem) ":"))) + (length (concat (dom:prefix elem) ":"))) (dom:node-name elem))) @@ -190,17 +190,16 @@ (defun xpath-fn-string (elem &optional (strip-whitespace t)) "Extract the string value of an XML DOM element (with subelements)" (declare (dom:element elem)) - ;; ((conditional-fn #'(lambda(s) (string-trim " #\t#\n" s)) strip-whitespace ; (handle-whitespace strip-whitespace - (apply #'concatenate 'string - (map 'list - (lambda (s) - (cond - ((dom:text-node-p s) - (dom:node-value s)) - ((dom:element-p s) - (xpath-fn-string s)))) - (dom:child-nodes elem))))) + (apply #'concatenate 'string + (map 'list + (lambda (s) + (cond + ((dom:text-node-p s) + (dom:node-value s)) + ((dom:element-p s) + (xpath-fn-string s)))) + (dom:child-nodes elem))))) (defun attr-value (attr) (dom:node-value attr)) @@ -312,16 +311,15 @@ (attributes (dom:attributes elem)) (child-nodes (dom:child-nodes elem)) (elem-string "")) - (push-string (concatenate 'string "<" node-name) elem-string) + (push-string (concat "<" node-name) elem-string) (dom:map-node-map #'(lambda(attr) (let ((attr-name (dom:node-name attr)) (attr-value (dom:node-value attr))) - (push-string (concatenate 'string " " attr-name "=\"" - attr-value "\"") + (push-string (concat " " attr-name "=\"" attr-value "\"") elem-string))) attributes) (push-string ">" elem-string) (loop for child-node across child-nodes do (push-string (node-to-string child-node) elem-string)) - (push-string (concatenate 'string "</" node-name ">") elem-string)))) \ No newline at end of file + (push-string (concat "</" node-name ">") elem-string)))) \ No newline at end of file

1 0