Commit e4742a11 authored by Pietro Abate's avatar Pietro Abate

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

Original author: afrisch
Date: 2004-12-28 00:27:55+00:00
parent 2a8c6752
......@@ -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
......
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
......
exception Escape of exn
val toplevel: bool ref
val verbose: bool ref
......
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
......@@ -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
......
<!-- 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment