[isidorus-cvs] r865 - branches/gdl-frontend/src/rest_interface

[lgiessmann at common-lisp.net]

Author: lgiessmann
Date: Mon Sep 12 00:53:29 2011
New Revision: 865

Log:
gdl-backend: added a default tm-id for committing new fragments

Modified:
   branches/gdl-frontend/src/rest_interface/rest-interface.lisp
   branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp

Modified: branches/gdl-frontend/src/rest_interface/rest-interface.lisp
==============================================================================
--- branches/gdl-frontend/src/rest_interface/rest-interface.lisp	Mon Sep 12 00:24:24 2011	(r864)
+++ branches/gdl-frontend/src/rest_interface/rest-interface.lisp	Mon Sep 12 00:53:29 2011	(r865)
@@ -51,7 +51,15 @@
 	   :*ajax-javascript-directory-path*
 	   :*ajax-javascript-url-prefix*
 	   :*xtm-commit-prefix*
-	   :*sparql-url*))
+	   :*sparql-url*
+	   :*gdl-get-fragment*
+	   :*gdl-get-schema*
+	   :*gdl-commit-fragment*
+	   :*gdl-delete-fragment*
+	   :*gdl-host-address*
+	   :*gdl-base-path*
+	   :*gdl-host-file*
+	   :*gdl-tm-id*))
 
 
 (in-package :rest-interface)

Modified: branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp
==============================================================================
--- branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Mon Sep 12 00:24:24 2011	(r864)
+++ branches/gdl-frontend/src/rest_interface/set-up-gdl-interface.lisp	Mon Sep 12 00:53:29 2011	(r865)
@@ -9,22 +9,23 @@
 
 (in-package :rest-interface)
 
-(defparameter *get-fragment* "/gdl/fragment/(.+)$")
-(defparameter *get-schema* "/gdl/schema/?$")
-(defparameter *commit-fragment* "/gdl/commit/?")
-(defparameter *delete-fragment* "/gdl/delete/?")
-(defparameter *host-address* "/anatomia")
-(defparameter *base-path* "anaToMia/hosted_files/")
-(defparameter *host-file* (concat *base-path* "GDL_Widgets.html"))
-
-
-(defun set-up-gdl-interface (&key (get-fragment *get-fragment*)
-			     (get-schema *get-schema*)
-			     (commit-fragment *commit-fragment*)
-			     (delete-fragment *delete-fragment*)
-			     (base-path *base-path*)
-			     (host-address *host-address*)
-			     (host-file *host-file*))
+(defparameter *gdl-get-fragment* "/gdl/fragment/(.+)$")
+(defparameter *gdl-get-schema* "/gdl/schema/?$")
+(defparameter *gdl-commit-fragment* "/gdl/commit/?")
+(defparameter *gdl-delete-fragment* "/gdl/delete/?")
+(defparameter *gdl-host-address* "/anatomia")
+(defparameter *gdl-base-path* "anaToMia/hosted_files/")
+(defparameter *gdl-host-file* (concat *gdl-base-path* "GDL_Widgets.html"))
+(defparameter *gdl-tm-id* "http://textgrid.org/serviceregistry/gdl-frontend/gdl-tm")
+
+
+(defun set-up-gdl-interface (&key (get-fragment *gdl-get-fragment*)
+			     (get-schema *gdl-get-schema*)
+			     (commit-fragment *gdl-commit-fragment*)
+			     (delete-fragment *gdl-delete-fragment*)
+			     (base-path *gdl-base-path*)
+			     (host-address *gdl-host-address*)
+			     (host-file *gdl-host-file*))
   (declare (String get-fragment get-schema commit-fragment
 		   delete-fragment host-address))
 
@@ -58,9 +59,9 @@
    hunchentoot:*dispatch-table*))
 
 
-(defun init-hosted-files (&key (host-address *host-address*)
-			  (host-file *host-file*)
-			  (base-path *base-path*))
+(defun init-hosted-files (&key (host-address *gdl-host-address*)
+			  (host-file *gdl-host-file*)
+			  (base-path *gdl-base-path*))
   "Adds handlers for the css, html and js files needed by the frontend."
   (declare (String host-address host-file base-path))
   ;; add the actual html file
@@ -150,7 +151,7 @@
 					    :force-text t)))
 	    (with-writer-lock 
 	      (let ((frag (jtm-importer:import-construct-from-jtm-string
-			   json-data :revision (get-revision))))
+			   json-data :revision (get-revision) :tm-id *gdl-tm-id*)))
 		(when frag
 		  (push-to-cache (d:topic frag)))))))
 	(setf (hunchentoot:return-code*) hunchentoot:+http-bad-request+))))