trunk/driver/evaluator.ml

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 v = Cduce_loc.get_viewport () in
    let ppf = Html.ppf v 
    and input = Stream.of_string src in
    Format.pp_set_margin ppf 60;
    Cduce_loc.push_source (`String src);
    Cduce_loc.set_protected true;
    Cduce_config.init_all ();
    let ok = Cduce.script ppf ppf input in
    if ok then Format.fprintf ppf "@\nOk.@\n";
    Html.get v
  in

  Cduce_loc.set_viewport (Html.create true);
  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 60 res in
  print_string header;
  print_endline "<pre>";
  print_endline res;
  print_endline "</pre>"

1	exception Timeout
2
3	let header = "Content-Type: text/plain\n\n"
4
5	let cut w s =
6	let b= Buffer.create 1024 in
7	let rec aux i x =
8	if i < String.length s then
9	match s.[i] with
10	\| '\n' -> Buffer.add_char b '\n'; aux (i + 1) 0
11	\| '\r' -> aux (i + 1) 0
12	\| '<' ->
13	let rec tag i =
14	Buffer.add_char b s.[i];
15	if (s.[i] = '>') then aux (i + 1) x else tag (i + 1) in
16	tag i
17	\| c ->
18	let x =
19	if x = w then (Buffer.add_string b "\\\n:"; 2)
20	else (x + 1) in
21	Buffer.add_char b c;
22	if c = '&' then
23	let rec ent i =
24	Buffer.add_char b s.[i];
25	if (s.[i] = ';') then aux (i + 1) x else ent (i + 1) in
26	ent (i + 1)
27	else
28	aux (i + 1) x
29	in
30	aux 0 0;
31	Buffer.contents b
32
33	let () =
34	let exec src =
35	ignore (Unix.alarm 10);
36	Sys.set_signal Sys.sigalrm
37	(Sys.Signal_handle (fun _ -> raise (Cduce.Escape Timeout)));
38	let v = Cduce_loc.get_viewport () in
39	let ppf = Html.ppf v
40	and input = Stream.of_string src in
41	Format.pp_set_margin ppf 60;
42	Cduce_loc.push_source (`String src);
43	Cduce_loc.set_protected true;
44	Cduce_config.init_all ();
45	let ok = Cduce.script ppf ppf input in
46	if ok then Format.fprintf ppf "@\nOk.@\n";
47	Html.get v
48	in
49
50	Cduce_loc.set_viewport (Html.create true);
51	let prog = Buffer.create 1024 in
52	(try while true do Buffer.add_string prog (read_line ()); Buffer.add_string prog "\n" done;
53	with End_of_file -> ());
54	let prog = Buffer.contents prog in
55	let res = try exec prog with Timeout -> "Timeout reached !" in
56	let res = cut 60 res in
57	print_string header;
58	print_endline "<pre>";
59	print_endline res;
60	print_endline "</pre>"
61