[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