[isidorus-cvs] r167 - in trunk/src: rest_interface unit_tests xml/rdf
Lukas Giessmann
lgiessmann at common-lisp.net
Thu Dec 10 13:01:01 UTC 2009
Author: lgiessmann
Date: Thu Dec 10 08:00:55 2009
New Revision: 167
Log:
added a restful handler that is able to export TM-Fragments as RDF/XML
Modified:
trunk/src/rest_interface/set-up-json-interface.lisp
trunk/src/unit_tests/reification_test.lisp
trunk/src/xml/rdf/exporter.lisp
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 Thu Dec 10 08:00:55 2009
@@ -9,7 +9,8 @@
(in-package :rest-interface)
-(defparameter *json-get-prefix* "/json/get/(.+)$") ;the prefix to get a fragment by the psis -> localhost:8000/json/get/<fragment-psi>
+(defparameter *json-get-prefix* "/json/get/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/get/<fragment-psi>
+(defparameter *json-get-rdf-prefix* "/json/get/rdf/(.+)$") ;the prefix to get a fragment by the psi -> localhost:8000/json/rdf/get/<fragment-psi>
(defparameter *json-commit-url* "/json/commit/?$") ;the url to commit a json fragment by "put" or "post"
(defparameter *json-get-all-psis* "/json/psis/?$") ;the url to get all topic psis of isidorus -> localhost:8000/json/psis
(defparameter *json-get-summary-url* "/json/summary/?$") ;the url to get a summary of all topic stored in isidorus; you have to set the GET-parameter "start" for the start index of all topics within elephant and the GET-paramter "end" for the last index of the topic sequence -> http://localhost:8000/json/summary/?start=12&end=13
@@ -27,6 +28,7 @@
(defparameter *ajax-javascript-url-prefix* "/javascripts") ; the url prefix of all javascript files
(defun set-up-json-interface (&key (json-get-prefix *json-get-prefix*)
+ (json-get-rdf-prefix *json-get-rdf-prefix*)
(json-get-all-psis *json-get-all-psis*)
(json-commit-url *json-commit-url*)
(json-get-summary-url *json-get-summary-url*)
@@ -80,6 +82,9 @@
(create-regex-dispatcher json-get-prefix #'return-json-fragment)
hunchentoot:*dispatch-table*)
(push
+ (create-regex-dispatcher json-get-rdf-prefix #'return-json-rdf-fragment)
+ hunchentoot:*dispatch-table*)
+ (push
(create-regex-dispatcher json-get-topic-stub-prefix #'return-topic-stub-of-psi)
hunchentoot:*dispatch-table*)
(push
@@ -238,6 +243,31 @@
(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
+(defun return-json-rdf-fragment(&optional psi)
+ "returns the json-fragmen belonging to the psi passed by the parameter psi"
+ (assert psi)
+ (let ((http-method (hunchentoot:request-method*)))
+ (if (eq http-method :GET)
+ (let ((identifier (string-replace psi "%23" "#")))
+ (setf (hunchentoot:content-type*) "application/json") ;RFC 4627
+ (let ((fragment
+ (with-writer-lock
+ (create-latest-fragment-of-topic identifier))))
+ (if fragment
+ (handler-case (with-reader-lock
+ (rdf-exporter:to-rdf-string fragment))
+ (condition (err)
+ (progn
+ (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+ (setf (hunchentoot:content-type*) "text")
+ (format nil "Condition: \"~a\"" err))))
+ (progn
+ (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
+ (setf (hunchentoot:content-type*) "text")
+ (format nil "Topic \"~a\" not found" psi)))))
+ (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
+
+
(defun json-commit(&optional param)
"calls the json-to-elem method for a json-fragment and imports it to elephant"
(declare (ignorable param)) ;param is currently not used
Modified: trunk/src/unit_tests/reification_test.lisp
==============================================================================
--- trunk/src/unit_tests/reification_test.lisp (original)
+++ trunk/src/unit_tests/reification_test.lisp Thu Dec 10 08:00:55 2009
@@ -1005,11 +1005,6 @@
(elephant:close-store))
-;;TODO: check merge-reifier-topics (--> versioning)
-;;TODO: extend the fragment-importer in the RESTful-interface
-;;TODO: DOKU
-
-
(defun run-reification-tests ()
(it.bese.fiveam:run! 'test-merge-reifier-topics)
(it.bese.fiveam:run! 'test-xtm1.0-reification)
Modified: trunk/src/xml/rdf/exporter.lisp
==============================================================================
--- trunk/src/xml/rdf/exporter.lisp (original)
+++ trunk/src/xml/rdf/exporter.lisp Thu Dec 10 08:00:55 2009
@@ -31,7 +31,8 @@
(:import-from :isidorus-threading
with-reader-lock
with-writer-lock)
- (:export :export-rdf))
+ (:export :export-rdf
+ :to-rdf-string))
(in-package :rdf-exporter)
@@ -356,39 +357,7 @@
(xml-lang-p construct)))
nil ;; do not export this topic explicitly, since it has been exported as
;; rdf:resource, property or any other reference
- (cxml:with-element "rdf:Description"
- (let ((psi (get-reifier-psi construct))
- (ii (item-identifiers construct))
- (sl (locators construct))
- (t-names (names construct))
- (t-occs (occurrences construct))
- (t-assocs (list-rdf-mapped-associations construct)))
- (if psi
- (if (reified 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" (uri psi))))
- (cxml:attribute "rdf:about" (uri psi)))
- (cxml:attribute "rdf:nodeID" (make-object-id construct)))
- (when (or (> (length (psis construct)) 1)
- ii sl t-names
- (isi-occurrence-p construct))
- (make-isi-type *tm2rdf-topic-type-uri*))
- (map 'list #'to-rdf-elem (remove psi (psis construct)))
- (map 'list #'to-rdf-elem sl)
- (map 'list #'to-rdf-elem ii)
- (map 'list #'(lambda(x)
- (cxml:with-element "rdf:type"
- (make-topic-reference x)))
- (list-instanceOf construct))
- (map 'list #'(lambda(x)
- (cxml:with-element "rdfs:subClassOf"
- (make-topic-reference x)))
- (list-super-types construct))
- (map 'list #'to-rdf-elem t-names)
- (map 'list #'to-rdf-elem (sort-constructs
- (union t-occs t-assocs)))))))
+ (topic-to-rdf-elem construct)))
(defun sort-constructs (constructs)
@@ -594,4 +563,86 @@
(< slash-position (- (length (uri psi)) 1))))
psi
nil)))
- (psis topic)))
\ No newline at end of file
+ (psis topic)))
+
+
+(defmethod to-rdf-elem ((construct FragmentC))
+ "Exports TM-Fragments as RDF/XML data."
+ (topic-to-rdf-elem (topic construct))
+ ;all stubs are exported implicitely by references of the topic or associations
+ (map 'list #'to-rdf-elem (intersection (list-tm-associations) (associations construct))))
+
+
+(defun topic-to-rdf-elem (construct)
+ "Creates a node that describes a TM topic. The passed topic is exported
+ explicitely, although it was exported as a resource-reference."
+ (declare (TopicC construct))
+ (cxml:with-element "rdf:Description"
+ (let ((psi (get-reifier-psi construct))
+ (ii (item-identifiers construct))
+ (sl (locators construct))
+ (t-names (names construct))
+ (t-occs (occurrences construct))
+ (t-assocs (list-rdf-mapped-associations construct)))
+ (if psi
+ (if (reified 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" (uri psi))))
+ (cxml:attribute "rdf:about" (uri psi)))
+ (cxml:attribute "rdf:nodeID" (make-object-id construct)))
+ (when (or (> (length (psis construct)) 1)
+ ii sl t-names
+ (isi-occurrence-p construct))
+ (make-isi-type *tm2rdf-topic-type-uri*))
+ (map 'list #'to-rdf-elem (remove psi (psis construct)))
+ (map 'list #'to-rdf-elem sl)
+ (map 'list #'to-rdf-elem ii)
+ (map 'list #'(lambda(x)
+ (cxml:with-element "rdf:type"
+ (make-topic-reference x)))
+ (list-instanceOf construct))
+ (map 'list #'(lambda(x)
+ (cxml:with-element "rdfs:subClassOf"
+ (make-topic-reference x)))
+ (list-super-types construct))
+ (map 'list #'to-rdf-elem t-names)
+ (map 'list #'to-rdf-elem (sort-constructs
+ (union t-occs t-assocs))))))
+
+
+(defgeneric to-rdf-string (construct)
+ (:documentation "Prints the string representation of a Fragment element as RDF/XML"))
+
+
+(defmethod to-rdf-string ((construct FragmentC))
+ "Exports a FragmentC object as a string in RDF/XML representation."
+ (init-*ns-map*)
+ (let ((str
+ (cxml:with-xml-output (cxml:make-string-sink :indentation 2 :canonical nil)
+ (cxml:with-namespace ("isi" *tm2rdf-ns*)
+ (cxml:with-namespace ("rdf" *rdf-ns*)
+ (cxml:with-namespace ("rdfs" *rdfs-ns*)
+ (cxml:with-namespace ("xml" *xml-ns*)
+ (cxml:with-element "rdf:RDF"
+ (to-rdf-elem construct)))))))))
+ (setf *ns-map* nil)
+ str))
+
+
+(defmethod to-rdf-string ((construct TopicMapConstructC))
+ "Exports a TopicMapConstructC object as a string in RDF/XML representation."
+ (init-*ns-map*)
+ (let ((str
+ (cxml:with-xml-output (cxml:make-string-sink :indentation 2 :canonical nil)
+ (cxml:with-namespace ("isi" *tm2rdf-ns*)
+ (cxml:with-namespace ("rdf" *rdf-ns*)
+ (cxml:with-namespace ("rdfs" *rdfs-ns*)
+ (cxml:with-namespace ("xml" *xml-ns*)
+ (cxml:with-element "rdf:RDF"
+ (to-rdf-elem construct)))))))))
+ (setf *ns-map* nil)
+ str))
+
+
More information about the Isidorus-cvs
mailing list