[isidorus-cvs] r384 - in trunk/src: . TM-SPARQL base-tools json model rest_interface unit_tests xml/rdf xml/xtm

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#%5C" " - "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#%5C" " + "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/%5C" " - "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/%5C" " + "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/%5C" " - "xmlns:rdf="" *rdf-ns* "" " - "xmlns:rdfs="" *rdfs-ns* "" " - "rdf:type="rdfType" rdf:resource="rdfResource" " - "rdf:nodeID="rdfNodeID" " - "prop:prop1="http://should/be/a/literal%5C" " - "prop:prop2="prop-2" " - "prop:prop3="">content-text</prop:property>"))) + (concat "<prop:property xmlns:prop="http://props/%5C" " + "xmlns:rdf="" *rdf-ns* "" " + "xmlns:rdfs="" *rdfs-ns* "" " + "rdf:type="rdfType" rdf:resource="rdfResource" " + "rdf:nodeID="rdfNodeID" " + "prop:prop1="http://should/be/a/literal%5C" " + "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/%5C%22%3E" - "<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:prop6prop6</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:prop14prop14</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/%5C%22%3E" + "<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:prop6prop6</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:prop14prop14</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/%5C" " - "xml:base="xml-base/first" " - "rdf:about="resource" rdf:type="attr-type">" - "<rdf:type rdf:ID="rdfID" " - "rdf:resource="content-type-1"/>" - "<rdf:type /><!-- blank_node -->" - "<rdf:type arcs:arc="literalArc"/>" - "<rdf:type rdf:parseType="Collection" " - " xml:base="http://xml-base/absolute/%5C%22%3E" - "<!-- blank_node that is a list -->" - "<rdf:Description rdf:about="c-about-type"/>" - "<rdf:Description rdf:ID="c-id-type"/>" - "<rdf:Description rdf:nodeID="c-nodeID-type"/>" - "rdf:Description/<!-- blank_node -->" - "</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/%5C%22%3E" - "<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/%5C" " + "xml:base="xml-base/first" " + "rdf:about="resource" rdf:type="attr-type">" + "<rdf:type rdf:ID="rdfID" " + "rdf:resource="content-type-1"/>" + "<rdf:type /><!-- blank_node -->" + "<rdf:type arcs:arc="literalArc"/>" + "<rdf:type rdf:parseType="Collection" " + " xml:base="http://xml-base/absolute/%5C%22%3E" + "<!-- blank_node that is a list -->" + "<rdf:Description rdf:about="c-about-type"/>" + "<rdf:Description rdf:ID="c-id-type"/>" + "<rdf:Description rdf:nodeID="c-nodeID-type"/>" + "rdf:Description/<!-- blank_node -->" + "</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/%5C%22%3E" + "<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/%5C" " - "xml:base="base/first" xml:lang="de" >" - "prop:lit0text0</prop:lit0>" - "<prop:lit1 rdf:parseType="Literal">text1</prop:lit1>" - "<prop:lit2 xml:base="http://base/absolute%5C" " - "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/%5C" " + "xml:base="base/first" xml:lang="de" >" + "prop:lit0text0</prop:lit0>" + "<prop:lit1 rdf:parseType="Literal">text1</prop:lit1>" + "<prop:lit2 xml:base="http://base/absolute%5C" " + "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/%5C" " - "xml:base="xml-base/first" " - "rdf:about="resource" rdf:type="attr-type">" - "<rdfs:subClassOf rdf:ID="rdfID" " - "rdf:resource="content-type-1"/>" - "<rdfs:subClassOf /><!-- blank_node -->" - "<rdfs:subClassOf arcs:arc="literalArc"/>" - "<rdfs:subClassOf rdf:parseType="Collection" " - " xml:base="http://xml-base/absolute/%5C%22%3E" - "<!-- blank_node that is a list -->" - "<rdf:Description rdf:about="c-about-type"/>" - "<rdf:Description rdf:ID="c-id-type"/>" - "<rdf:Description rdf:nodeID="c-nodeID-type"/>" - "rdf:Description/<!-- blank_node -->" - "</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/%5C%22%3E" - "<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/%5C" " + "xml:base="xml-base/first" " + "rdf:about="resource" rdf:type="attr-type">" + "<rdfs:subClassOf rdf:ID="rdfID" " + "rdf:resource="content-type-1"/>" + "<rdfs:subClassOf /><!-- blank_node -->" + "<rdfs:subClassOf arcs:arc="literalArc"/>" + "<rdfs:subClassOf rdf:parseType="Collection" " + " xml:base="http://xml-base/absolute/%5C%22%3E" + "<!-- blank_node that is a list -->" + "<rdf:Description rdf:about="c-about-type"/>" + "<rdf:Description rdf:ID="c-id-type"/>" + "<rdf:Description rdf:nodeID="c-nodeID-type"/>" + "rdf:Description/<!-- blank_node -->" + "</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/%5C%22%3E" + "<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/%5C" " - "xml:base="http://xml-base/first%5C" " - "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/%5C" " + "xml:base="http://xml-base/first%5C" " + "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/%5C" " - "xml:base="http://xml-base/first%5C" " - "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/%5C" " + "xml:base="http://xml-base/first%5C" " + "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/%5C" " - "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/%5C" " + "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/%5C%22%3E" - " <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/%5C%22%3E" + " <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/%5C%22%3E" - " <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/%5C%22%3E" + " <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/%5C%22%3E" - " <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/%5C%22%3E" + " <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/%5C%22%3E" - " <rdf:Description xml:base="http://base-1%5C%22/%3E" - " <rdf:Description xml:base="http://base-2#%5C%22/%3E" - " <rdf:Description xml:base="http://base-3/%5C%22/%3E" - "</rdf:RDF>"))) + (concat "<rdf:RDF xmlns:rdf="" *rdf-ns* "" " + "xmlns:arcs="http://test/arcs/%5C%22%3E" + " <rdf:Description xml:base="http://base-1%5C%22/%3E" + " <rdf:Description xml:base="http://base-2#%5C%22/%3E" + " <rdf:Description xml:base="http://base-3/%5C%22/%3E" + "</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/%5C" " - "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/%5C" " + "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