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