[r2004-12-28 00:27:55 by afrisch] evalutor + demo

Original author: afrisch
Date: 2004-12-28 00:27:55+00:00

Makefile.distrib

@@ -214,10 +214,11 @@ VALIDATE_OBJECTS := $(shell for o in $(OBJECTS); do echo $$o; if [ "$$o" = "sche
 
 CDUCE = $(OBJECTS) driver/run.cmo $(CQL_OBJECTS_RUN)
 WEBIFACE  = $(OBJECTS) driver/examples.cmo driver/webiface.cmo
+EVALUATOR = $(OBJECTS) driver/examples.cmo driver/evaluator.cmo
 DTD2CDUCE = tools/dtd2cduce.cmo
 
 ALL_OBJECTS = $(OBJECTS) $(NEW_SCHEMA_OBJS) \
- driver/run.cmo driver/examples.cmo driver/webiface.cmo \
+ driver/run.cmo driver/examples.cmo driver/webiface.cmo driver/evaluater.cmo \
  tools/dtd2cduce.cmo tools/validate.cmo \
  $(ML_INTERFACE_OBJS) parser/cduce_curl.cmo \
  parser/cduce_netclient.cmo \
@@ -257,6 +258,10 @@ webiface: $(WEBIFACE:.cmo=.$(EXTENSION))
 	@echo "Build $@"
 	$(HIDE)$(LINK) -verbose $(INCLUDES) -o $@ $^ $(EXTRA_OPTS_WEBIFACE)
 
+evaluator: $(EVALUATOR:.cmo=.$(EXTENSION))
+	@echo "Build $@"
+	$(HIDE)$(LINK) -verbose $(INCLUDES) -o $@ $^ $(EXTRA_OPTS_WEBIFACE)
+
 dtd2cduce: $(DTD2CDUCE:.cmo=.$(EXTENSION))
 	@echo "Build $@"
 	$(HIDE)$(LINK) $(INCLUDES) -o $@ $^
@@ -283,7 +288,7 @@ clean:
 	rm -f `find . -name "*~"`
 	rm -f *.cmi *.cmo *.cma *.cmx *.a *.cmxa *.o *~ META
 	rm -f cduce$(EXE) ocamlprof.dump
-	rm -f dtd2cduce$(EXE) webiface$(EXE) validate$(EXE) cdo2ml$(EXE)
+	rm -f dtd2cduce$(EXE) webiface$(EXE) validate$(EXE) cdo2ml$(EXE) evaluator$(EXE)
 	rm -Rf prepro package
 	rm -f web/www/*.html web/*~
 	rm -f web/*.cdo

driver/cduce.ml

 open Location
 open Ident
 
+exception Escape of exn
 exception InvalidInputFilename of string
 exception InvalidObjectFilename of string
 
@@ -300,7 +301,7 @@ let parse rule input =
 
 let run rule ppf ppf_err input =
   try phrases ppf (parse rule input); true
-  with exn -> catch_exn ppf_err exn; false
+  with Escape exn -> raise exn | exn -> catch_exn ppf_err exn; false
 
 let topinput = run Parser.top_phrases
 let script = run Parser.prog

driver/cduce.mli

+exception Escape of exn
+
 val toplevel: bool ref
 val verbose: bool ref
 

driver/evaluator.ml

+open Netcgi
+exception Timeout
+
+let header = "Content-Type: text/plain\n\n"
+
+let cut w s =
+  let b= Buffer.create 1024 in
+  let rec aux i x =
+    if i < String.length s then
+      match s.[i] with
+	| '\n' -> Buffer.add_char b '\n'; aux (i + 1) 0
+	| '\r' -> aux (i + 1) 0
+	| '<' ->
+	    let rec tag i =
+	      Buffer.add_char b s.[i];
+	      if (s.[i] = '>') then aux (i + 1) x else tag (i + 1) in
+	    tag i
+	| c -> 
+	    let x = 
+	      if x = w then (Buffer.add_string b "\\\n:"; 2) 
+	      else (x + 1) in
+	    Buffer.add_char b c; 
+	    if c = '&' then
+	      let rec ent i =
+		Buffer.add_char b s.[i];
+		if (s.[i] = ';') then aux (i + 1) x else ent (i + 1) in
+	      ent (i + 1)
+	    else
+	      aux (i + 1) x
+  in
+  aux 0 0;
+  Buffer.contents b
+
+let () =
+  let exec src =
+    ignore (Unix.alarm 10);
+    Sys.set_signal Sys.sigalrm 
+      (Sys.Signal_handle (fun _ -> raise (Cduce.Escape Timeout)));
+    let ppf = Format.str_formatter
+    and input = Stream.of_string src in
+    Location.push_source (`String src);
+    Location.set_protected true;
+    Location.warning_ppf := ppf;
+    let ok = Cduce.script ppf ppf input in
+    if ok then Format.fprintf ppf "@\nOk.@\n";
+    Format.flush_str_formatter ()
+  in
+
+  Location.set_viewport `Html;
+  let prog = Buffer.create 1024 in
+  (try while true do Buffer.add_string prog (read_line ()); Buffer.add_string prog "\n" done;
+   with End_of_file -> ());
+  let prog = Buffer.contents prog in
+  let res = try exec prog with Timeout -> "Timeout reached !" in
+  let res = cut 80 res in
+  print_string header;
+  print_endline res
+  

driver/webiface.ml

@@ -31,15 +31,6 @@ let () =
     try Unix.mkdir session_dir 0o755
     with Unix.Unix_error(_,_,_)-> fatal_error "Fatal error" "Cannot create session directory"
 
-(*
-let session_dirs = ["/usr/local/tmp/"; "/home/beppe/sessions"; "/home/frisch/sessions";
-"/users/formel/cduce/sessions"; "/home/zack/cduce/sessions"; "/tmp" ]
-let session_dir = 
-  try List.find Sys.file_exists session_dirs
-  with Not_found -> fatal_error "Internal error" 
-    "Cannot find sessions directory"
-*)
-
 let timeout = 60 * 5  (* seconds *)
 let max_sess = 10
 

web/demo.html

+<!-- http://jibbering.com/2002/4/httprequest.html -->
+<html>
+<head><title>CDuce demo</title></head>
+<body>
+
+<h1><a href="http://www.cduce.org/">CDuce</a> online demo</h1>
+<table width="100%" border="1">
+<tr>
+<td width="50%" valign="top">
+<input type="submit" value="Evaluate" onclick="submit('a');"/>
+<input type="button" value="Clear" onclick="clearreq('a');"/>
+<textarea id="areq" cols="80" rows="25">
+</textarea>
+<br/>
+</td>
+<td width="50%" valign="top" onmousedown="show_result('a','');">
+<input type="button" value="Clear" onclick="show_result('a','');"/>
+<pre><div id="ares"></div></pre>
+</td>
+</tr>
+</td>
+<script>
+
+function clearreq(pr) 
+{ document.getElementById(pr+"req").value = ""; }
+
+function show_result(pr,res)
+{ document.getElementById(pr+"res").innerHTML = res; }
+
+function submit(pr) {
+ var xmlhttp = new XMLHttpRequest();
+ xmlhttp.open("POST", "/cgi-bin/evaluator" ,true);
+ xmlhttp.onreadystatechange=function() {
+  if (xmlhttp.readyState==4) { show_result(pr,xmlhttp.responseText); }
+ }
+ show_result(pr,"Computing...");
+ xmlhttp.send(document.getElementById(pr+"req").value);
+}
+
+
+</script>
+</body>
+</html>
\ No newline at end of file