From lgiessmann at common-lisp.net  Fri Jul  2 16:44:03 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Fri, 02 Jul 2010 12:44:03 -0400
Subject: [isidorus-cvs] r307 - branches/new-datamodel/src/json
Message-ID: <E1OUjLP-0004ht-Hq@common-lisp.net>

Author: lgiessmann
Date: Fri Jul  2 12:44:02 2010
New Revision: 307

Log:
new-datamodel: adapted some functions of the rest-interface to the new datamodel, so it is possible to read fragments

Modified:
   branches/new-datamodel/src/json/json_tmcl.lisp
   branches/new-datamodel/src/json/json_tmcl_validation.lisp

Modified: branches/new-datamodel/src/json/json_tmcl.lisp
==============================================================================
--- branches/new-datamodel/src/json/json_tmcl.lisp	(original)
+++ branches/new-datamodel/src/json/json_tmcl.lisp	Fri Jul  2 12:44:02 2010
@@ -1757,7 +1757,8 @@
 		      (let ((l-is-type
 			     (handler-case
 				 (progn
-				   (topictype-p root topictype topictype-constraint)
+				   (topictype-p root topictype topictype-constraint
+						nil revision)
 				   t)
 			       (Condition () nil)))
 			    (l-is-instance

Modified: branches/new-datamodel/src/json/json_tmcl_validation.lisp
==============================================================================
--- branches/new-datamodel/src/json/json_tmcl_validation.lisp	(original)
+++ branches/new-datamodel/src/json/json_tmcl_validation.lisp	Fri Jul  2 12:44:02 2010
@@ -95,9 +95,8 @@
    topictype or it is an instanceOf of the topictype or it is a subtype of
    the topictype. TMDM 7.2 + TMDM 7.3"
   (declare (type (or integer null) revision)
-	   (TopicC topictype)
-	   (list checked-topics)
-	   (type (or TopicC null) topictype-constraint topictype))
+	   (type (or TopicC null) topictype topic-instance)
+	   (list checked-topics))
   (let ((current-checked-topics (append checked-topics (list topic-instance)))
 	(akos-of-this (get-direct-supertypes-of-topic topic-instance
 						      :revision revision))
@@ -308,10 +307,6 @@
    // ...
    The return value is a named list of the form (:subtypes (<topic> <...>)
    :checked-topics (<topic> <...>)"
-  (declare (type (or integer null) revision)
-	   (list checked-topics)
-	   (TopicC topic-instance)
-	   (type (or TopicC null) topictype topictype-constraint))
   (let ((current-checked-topics (append checked-topics (list topic-instance))))
     (handler-case (topictype-p topic-instance topictype topictype-constraint
 			       nil revision)
@@ -350,11 +345,9 @@
 		       (revision *TM-REVISION*))
   "Returns the topic-instance, all subtypes found by the function list-subtypes
    and all direct instances for the found subtypes."
-  (declare (type (or integer null) revision)
-	   (TopicC topic-instance)
-	   (type (or TopicC null) topictype topictype-constraint))
   (let ((all-subtypes-of-this
-	 (getf (list-subtypes topic-instance topictype topictype-constraint revision)
+	 (getf (list-subtypes topic-instance topictype topictype-constraint
+			      nil nil revision)
 	       :subtypes))
 	(type (get-item-by-psi *type-psi* :revision revision))
 	(instance (get-item-by-psi *instance-psi* :revision revision))



From lgiessmann at common-lisp.net  Fri Jul 16 09:07:52 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Fri, 16 Jul 2010 05:07:52 -0400
Subject: [isidorus-cvs] r308 - in branches/new-datamodel/src:
	ajax/javascripts rest_interface
Message-ID: <E1OZgtb-0000T4-UN@common-lisp.net>

Author: lgiessmann
Date: Fri Jul 16 05:07:51 2010
New Revision: 308

Log:
new-datamodel: adapted the start-tm-engine to the new datamodel, all fragmentsa are created when the engine starts; set the defualt timeout of all ajax-requests to 20 seconds

Modified:
   branches/new-datamodel/src/ajax/javascripts/constants.js
   branches/new-datamodel/src/rest_interface/rest-interface.lisp
   branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp

Modified: branches/new-datamodel/src/ajax/javascripts/constants.js
==============================================================================
--- branches/new-datamodel/src/ajax/javascripts/constants.js	(original)
+++ branches/new-datamodel/src/ajax/javascripts/constants.js	Fri Jul 16 05:07:51 2010
@@ -23,7 +23,7 @@
 var OWN_URL = HOST_PREF + "isidorus";
 var SUMMARY_URL = HOST_PREF + "json/summary"
 var TM_OVERVIEW = "/json/tmcl/overview/";
-var TIMEOUT = 10000; // const TIMEOUT = 10000 --> "const" doesn't work under IE
+var TIMEOUT = 20000; // const TIMEOUT = 10000 --> "const" doesn't work under IE
 
 
 

Modified: branches/new-datamodel/src/rest_interface/rest-interface.lisp
==============================================================================
--- branches/new-datamodel/src/rest_interface/rest-interface.lisp	(original)
+++ branches/new-datamodel/src/rest_interface/rest-interface.lisp	Fri Jul 16 05:07:51 2010
@@ -62,7 +62,8 @@
 (defvar *server-acceptor* nil)
 
 
-(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp") (host-name "localhost") (port 8000))
+(defun start-tm-engine (repository-path &key (conffile "atom/conf.lisp")
+			(host-name "localhost") (port 8000))
   "Start the Topic Map Engine on a given port, assuming a given
    hostname. Use the repository under repository-path"
   (when *server-acceptor*
@@ -80,6 +81,11 @@
   (setf *server-acceptor* (make-instance 'hunchentoot:acceptor :address host-name :port port))
   (setf hunchentoot:*lisp-errors-log-level* :info)
   (setf hunchentoot:*message-log-pathname* "./hunchentoot-errors.log")
+  (map 'list #'(lambda(top)
+		 (let ((psis-of-top (psis top)))
+		   (when psis-of-top
+		     (create-latest-fragment-of-topic (uri (first psis-of-top))))))
+       (elephant:get-instances-by-class 'd:TopicC))
   (hunchentoot:start *server-acceptor*))
 
 (defun shutdown-tm-engine ()

Modified: branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp
==============================================================================
--- branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp	(original)
+++ branches/new-datamodel/src/rest_interface/set-up-json-interface.lisp	Fri Jul 16 05:07:51 2010
@@ -180,8 +180,11 @@
   (let ((http-method (hunchentoot:request-method*)))
     (if (or (eq http-method :POST)
 	    (eq http-method :PUT))
-	(let ((external-format (flexi-streams:make-external-format :UTF-8 :eol-style :LF)))
-	  (let ((json-data (hunchentoot:raw-post-data :external-format external-format :force-text t)))
+	(let ((external-format
+	       (flexi-streams:make-external-format :UTF-8 :eol-style :LF)))
+	  (let ((json-data
+		 (hunchentoot:raw-post-data :external-format external-format
+					    :force-text t)))
 	    (handler-case
 		(let ((psis
 		       (json:decode-json-from-string json-data)))
@@ -360,18 +363,22 @@
    concatenated of the url-prefix and the relative path of all all files in the
    passed directory and its subdirectories"
   (let ((start-position-of-relative-path
-	 (- (length (write-to-string (com.gigamonkeys.pathnames:file-exists-p path-to-files-directory))) 2)))
+	 (- (length (write-to-string (com.gigamonkeys.pathnames:file-exists-p
+				      path-to-files-directory))) 2)))
     (let ((files-and-urls nil))
-      (com.gigamonkeys.pathnames:walk-directory path-to-files-directory
-						#'(lambda(current-path)
-						    (let ((current-path-string
-							   (write-to-string current-path)))
-						      (let ((last-position-of-current-path
-							     (- (length current-path-string) 1)))
-							(let ((current-url
-							       (concatenate 'string 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))))))
+      (com.gigamonkeys.pathnames:walk-directory
+       path-to-files-directory
+       #'(lambda(current-path)
+	   (let ((current-path-string
+		  (write-to-string current-path)))
+	     (let ((last-position-of-current-path
+		    (- (length current-path-string) 1)))
+	       (let ((current-url
+		      (concatenate
+		       'string 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)))
 
 



From lgiessmann at common-lisp.net  Wed Jul 21 12:24:50 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Wed, 21 Jul 2010 08:24:50 -0400
Subject: [isidorus-cvs] r309 - branches/new-datamodel/playground
Message-ID: <E1ObYLy-0007np-Ni@common-lisp.net>

Author: lgiessmann
Date: Wed Jul 21 08:24:50 2010
New Revision: 309

Log:
new-datamodel: added a simple bash test-script for isidorus

Added:
   branches/new-datamodel/playground/isidorus_test.sh   (contents, props changed)

Added: branches/new-datamodel/playground/isidorus_test.sh
==============================================================================
--- (empty file)
+++ branches/new-datamodel/playground/isidorus_test.sh	Wed Jul 21 08:24:50 2010
@@ -0,0 +1,76 @@
+#!/bin/bash
+
+host="http://192.168.0.6:8000";
+
+wDir="isidorus_test";
+resDir="results"
+logDir="logfiles"
+
+dir1="req1";
+dir2="req2";
+dir3="req3";
+dir4="req4";
+
+req1=$host"/isidorus/json/psis/";
+req2=$host"/isidorus/json/get/http://textgrid.org/serviceregistry/development/webpublish"
+req3=$host"/isidorus/json/tmcl/types/"
+req4=$host"/isidorus/json/topicstubs/http://textgrid.org/serviceregistry/development/webpublish"
+
+log1=$logDir"/"$dir1"/iteration_";
+log2=$logDir"/"$dir2"/iteration_";
+log3=$logDir"/"$dir3"/iteration_";
+log4=$logDir"/"$dir4"/iteration_";
+
+res1=$resDir"/"$dir1"/iteration_";
+res2=$resDir"/"$dir2"/iteration_";
+res3=$resDir"/"$dir3"/iteration_";
+res4=$resDir"/"$dir4"/iteration_";
+
+function flow {
+    echo "==== iteration: ${1} ====";
+    counter=$1;
+    if [ $1 -lt 10 ]; then
+	counter="0000"$1;
+    else
+	if [ $1 -lt 100 ]; then
+	    counter="000"$1;
+	else
+	    if [ $1 -lt 1000 ]; then
+		counter="00"$1;
+	    else
+		if [ $1 -lt 10000 ]; then
+		    counter="0"$1;
+		fi
+	    fi
+	fi
+    fi
+
+    path1=$log1$counter;
+    path2=$log2$counter;
+    path3=$log3$counter;
+    path4=$log4$counter;
+    result1=$res1$counter;
+    result2=$res2$counter;
+    result3=$res3$counter;
+    result4=$res4$counter;
+    wget  -o $path1".log" -O $result1".res" $req1;
+    wget  -o $path2".log" -O $result2".res" $req2;
+    wget  -o $path3".log" -O $result3".res" $req3;
+    wget  -o $path4".log" -O $result4".res" $req4;
+}
+
+
+
+mkdir $wDir;
+cd $wDir;
+mkdir -p $logDir"/"$dir1;
+mkdir -p $logDir"/"$dir2;
+mkdir -p $logDir"/"$dir3;
+mkdir -p $logDir"/"$dir4;
+mkdir -p $resDir"/"$dir1;
+mkdir -p $resDir"/"$dir2;
+mkdir -p $resDir"/"$dir3;
+mkdir -p $resDir"/"$dir4;
+for i in `seq 1 50000`; do
+    flow $i;
+done



From lgiessmann at common-lisp.net  Wed Jul 21 14:39:20 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Wed, 21 Jul 2010 10:39:20 -0400
Subject: [isidorus-cvs] r310 - branches/new-datamodel/playground
Message-ID: <E1ObaS8-0000SV-MH@common-lisp.net>

Author: lgiessmann
Date: Wed Jul 21 10:39:18 2010
New Revision: 310

Log:
new-datamodel: modified the test-script

Modified:
   branches/new-datamodel/playground/isidorus_test.sh

Modified: branches/new-datamodel/playground/isidorus_test.sh
==============================================================================
--- branches/new-datamodel/playground/isidorus_test.sh	(original)
+++ branches/new-datamodel/playground/isidorus_test.sh	Wed Jul 21 10:39:18 2010
@@ -6,6 +6,14 @@
 resDir="results"
 logDir="logfiles"
 
+T="true";
+Nil="false";
+
+doReq1=$T;
+doReq2=$Nil;
+doReq3=$Nil;
+doReq4=$Nil;
+
 dir1="req1";
 dir2="req2";
 dir3="req3";
@@ -45,32 +53,68 @@
 	fi
     fi
 
-    path1=$log1$counter;
-    path2=$log2$counter;
-    path3=$log3$counter;
-    path4=$log4$counter;
-    result1=$res1$counter;
-    result2=$res2$counter;
-    result3=$res3$counter;
-    result4=$res4$counter;
-    wget  -o $path1".log" -O $result1".res" $req1;
-    wget  -o $path2".log" -O $result2".res" $req2;
-    wget  -o $path3".log" -O $result3".res" $req3;
-    wget  -o $path4".log" -O $result4".res" $req4;
+
+    if [ $doReq1 == $T ]; then
+	path1=$log1$counter;
+	result1=$res1$counter;
+	wget  -o $path1".log" -O $result1".res" $req1;
+    fi
+
+    if [ $doReq2 == $T ]; then
+	path2=$log2$counter;
+	result2=$res2$counter;
+	wget  -o $path2".log" -O $result2".res" $req2;
+    fi
+
+    if [ $doReq3 == $T ]; then
+	path3=$log3$counter;
+	result3=$res3$counter;
+	wget  -o $path3".log" -O $result3".res" $req3;
+    fi
+
+    if [ $doReq4 == $T ]; then
+	path4=$log4$counter;
+	result4=$res4$counter;
+	wget  -o $path4".log" -O $result4".res" $req4;
+    fi
+}
+
+
+function init {
+    mkdir $wDir;
+    cd $wDir;
+
+    if [ $doReq1 == $T ]; then
+	mkdir -p $logDir"/"$dir1;
+	mkdir -p $resDir"/"$dir1;
+    fi
+
+    if [ $doReq2 == $T ]; then
+	mkdir -p $logDir"/"$dir2;
+	mkdir -p $resDir"/"$dir2;
+    fi
+
+    if [ $doReq3 == $T ]; then
+	mkdir -p $logDir"/"$dir3;
+	mkdir -p $resDir"/"$dir3;
+    fi
+
+    if [ $doReq4 == $T ]; then
+	mkdir -p $logDir"/"$dir4;
+	mkdir -p $resDir"/"$dir4;
+    fi
+}
+
+
+
+function main {
+    init;
+    
+    for i in `seq 1 200000`; do
+	flow $i;
+    done
 }
 
 
 
-mkdir $wDir;
-cd $wDir;
-mkdir -p $logDir"/"$dir1;
-mkdir -p $logDir"/"$dir2;
-mkdir -p $logDir"/"$dir3;
-mkdir -p $logDir"/"$dir4;
-mkdir -p $resDir"/"$dir1;
-mkdir -p $resDir"/"$dir2;
-mkdir -p $resDir"/"$dir3;
-mkdir -p $resDir"/"$dir4;
-for i in `seq 1 50000`; do
-    flow $i;
-done
+main;