[isidorus-cvs] r339 - tags/textgrid-service/src/rest_interface trunk/src trunk/src/rest_interface
Lukas Giessmann
lgiessmann at common-lisp.net
Fri Nov 12 23:23:19 UTC 2010
Author: lgiessmann
Date: Fri Nov 12 18:23:19 2010
New Revision: 339
Log:
fixed ticket #93 => implemented a hunchentoot post handler that imports the received data via the xtm2.0 importer
Modified:
tags/textgrid-service/src/rest_interface/rest-interface.lisp
tags/textgrid-service/src/rest_interface/set-up-json-interface.lisp
trunk/src/isidorus.asd
trunk/src/rest_interface/rest-interface.lisp
trunk/src/rest_interface/set-up-json-interface.lisp
Modified: tags/textgrid-service/src/rest_interface/rest-interface.lisp
==============================================================================
--- tags/textgrid-service/src/rest_interface/rest-interface.lisp (original)
+++ tags/textgrid-service/src/rest_interface/rest-interface.lisp Fri Nov 12 18:23:19 2010
@@ -41,7 +41,8 @@
:*ajax-user-interface-file-path*
:*ajax-javascript-directory-path*
:*ajax-javascript-url-prefix*
- :*mark-as-deleted-url*))
+ :*mark-as-deleted-url*
+ :*xtm-commit-prefix*))
(in-package :rest-interface)
Modified: tags/textgrid-service/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- tags/textgrid-service/src/rest_interface/set-up-json-interface.lisp (original)
+++ tags/textgrid-service/src/rest_interface/set-up-json-interface.lisp Fri Nov 12 18:23:19 2010
@@ -25,8 +25,9 @@
(defparameter *ajax-user-interface-css-directory-path* "ajax/css") ;the directory contains the css files
(defparameter *ajax-user-interface-file-path* "ajax/isidorus.html") ;the file path to the HTML file implements the user interface
(defparameter *ajax-javascript-directory-path* "ajax/javascripts") ;the directory which contains all necessary javascript files
-(defparameter *ajax-javascript-url-prefix* "/javascripts") ; the url prefix of all javascript files
-(defparameter *mark-as-deleted-url* "/mark-as-deleted") ; the url suffix that calls the mark-as-deleted handler
+(defparameter *ajax-javascript-url-prefix* "/javascripts") ;the url prefix of all javascript files
+(defparameter *mark-as-deleted-url* "/mark-as-deleted") ;the url suffix that calls the mark-as-deleted handler
+(defparameter *xtm-commit-prefix* "/import/xtm/2.0/(.+)$") ;the url to commit a TM-fragment in XTM 2.0 format, the regular expression represents the topic map id
(defun set-up-json-interface (&key (json-get-prefix *json-get-prefix*)
(get-rdf-prefix *get-rdf-prefix*)
@@ -45,7 +46,8 @@
(ajax-user-interface-css-directory-path *ajax-user-interface-css-directory-path*)
(ajax-javascripts-directory-path *ajax-javascript-directory-path*)
(ajax-javascripts-url-prefix *ajax-javascript-url-prefix*)
- (mark-as-deleted-url *mark-as-deleted-url*))
+ (mark-as-deleted-url *mark-as-deleted-url*)
+ (xtm-commit-prefix *xtm-commit-prefix*))
"registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
and also registers a file-hanlder to the html-user-interface"
@@ -112,6 +114,9 @@
(create-regex-dispatcher json-commit-url #'json-commit)
hunchentoot:*dispatch-table*)
(push
+ (create-regex-dispatcher xtm-commit-prefix #'xtm-import-handler)
+ hunchentoot:*dispatch-table*)
+ (push
(create-regex-dispatcher json-get-summary-url #'return-topic-summaries)
hunchentoot:*dispatch-table*)
(push
@@ -378,6 +383,29 @@
(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))
+(defun xtm-import-handler (&optional tm-id)
+ "Imports the received data as XTM 2.0 topic map."
+ (assert tm-id)
+ (handler-case
+ (if (eql (hunchentoot:request-method*) :POST)
+ (let ((external-format (flexi-streams:make-external-format
+ :UTF-8 :eol-style :LF)))
+ (let ((xml-data (hunchentoot:raw-post-data
+ :external-format external-format
+ :force-text t)))
+ (let ((xml-dom
+ (dom:document-element
+ (cxml:parse xml-data (cxml-dom:make-dom-builder)))))
+ (xml-importer:importer xml-dom :tm-id tm-id
+ :xtm-id (xml-importer::get-uuid))
+ (format nil ""))))
+ (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))
+ (condition (err)
+ (progn
+ (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+ (setf (hunchentoot:content-type*) "text")
+ (format nil "Condition: \"~a\"" err)))))
+
;; =============================================================================
;; --- some helper functions ---------------------------------------------------
;; =============================================================================
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Fri Nov 12 18:23:19 2010
@@ -101,8 +101,8 @@
:depends-on ("rest-interface"))
(:file "read"
:depends-on ("rest-interface")))
- :depends-on ("model"
- "atom"
+ :depends-on ("model"
+ "atom"
"xml"
"json"
"threading"))
Modified: trunk/src/rest_interface/rest-interface.lisp
==============================================================================
--- trunk/src/rest_interface/rest-interface.lisp (original)
+++ trunk/src/rest_interface/rest-interface.lisp Fri Nov 12 18:23:19 2010
@@ -10,6 +10,7 @@
(defpackage :rest-interface
(:nicknames :rest)
(:use :cl :hunchentoot
+ :cxml
:constants
:atom
:datamodel
@@ -40,7 +41,8 @@
:*ajax-user-interface-url*
:*ajax-user-interface-file-path*
:*ajax-javascript-directory-path*
- :*ajax-javascript-url-prefix*))
+ :*ajax-javascript-url-prefix*
+ :*xtm-commit-prefix*))
(in-package :rest-interface)
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 Fri Nov 12 18:23:19 2010
@@ -20,6 +20,9 @@
(defparameter *get-rdf-prefix* "/json/get/rdf/(.+)$")
;the url to commit a json fragment by "put" or "post"
(defparameter *json-commit-url* "/json/commit/?$")
+;the url to commit a TM-fragment in XTM 2.0 format, the regular
+;expression represents the topic map id
+(defparameter *xtm-commit-prefix* "/import/xtm/2.0/(.+)$")
;the url to get all topic psis of isidorus -> localhost:8000/json/psis
(defparameter *json-get-all-psis* "/json/psis/?$")
;the url to get a summary of all topic stored in isidorus; you have to set the
@@ -75,7 +78,8 @@
(ajax-javascripts-directory-path *ajax-javascript-directory-path*)
(ajax-javascripts-url-prefix *ajax-javascript-url-prefix*)
(mark-as-deleted-url *mark-as-deleted-url*)
- (latest-revision-url *latest-revision-url*))
+ (latest-revision-url *latest-revision-url*)
+ (xtm-commit-prefix *xtm-commit-prefix*))
"registers the json im/exporter to the passed base-url in hunchentoot's dispatch-table
and also registers a file-hanlder to the html-user-interface"
@@ -153,6 +157,9 @@
(create-regex-dispatcher mark-as-deleted-url #'mark-as-deleted-handler)
hunchentoot:*dispatch-table*)
(push
+ (create-regex-dispatcher xtm-commit-prefix #'xtm-import-handler)
+ hunchentoot:*dispatch-table*)
+ (push
(create-regex-dispatcher latest-revision-url #'return-latest-revision)
hunchentoot:*dispatch-table*))
@@ -450,9 +457,31 @@
(setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
(setf (hunchentoot:content-type*) "text")
(format nil "Condition: \"~a\"" err)))))
-
+(defun xtm-import-handler (&optional tm-id)
+ "Imports the received data as XTM 2.0 topic map."
+ (assert tm-id)
+ (handler-case
+ (if (eql (hunchentoot:request-method*) :POST)
+ (let ((external-format (flexi-streams:make-external-format
+ :UTF-8 :eol-style :LF)))
+ (let ((xml-data (hunchentoot:raw-post-data
+ :external-format external-format
+ :force-text t)))
+ (let ((xml-dom
+ (dom:document-element
+ (cxml:parse xml-data (cxml-dom:make-dom-builder)))))
+ (xml-importer:importer xml-dom :tm-id tm-id
+ :xtm-id (xml-importer::get-uuid))
+ (format nil ""))))
+ (setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))
+ (condition (err)
+ (progn
+ (setf (hunchentoot:return-code*) hunchentoot:+http-internal-server-error+)
+ (setf (hunchentoot:content-type*) "text")
+ (format nil "Condition: \"~a\"" err)))))
+
;; =============================================================================
;; --- some helper functions ---------------------------------------------------
;; =============================================================================
More information about the Isidorus-cvs
mailing list