(* TODO: - HTML design, logo *) open Netcgi exception Timeout let operating_type = Netcgi.buffered_transactional_optype let cgi = new Netcgi.std_activation ~operating_type () let fatal_error title s = cgi # output # rollback_work(); cgi # set_header ~content_type:"text/html; charset=\"iso-8859-1\"" ~cache:`No_cache (); cgi # output # output_string ("

" ^ title ^ "

"); cgi # output # output_string s; cgi # output # output_string "\n"; cgi # output # commit_work(); cgi # finalize (); exit 0 (* Loading examples *) let example code = try List.assoc code Examples.examples with Not_found -> "" let begin_table = "
" let end_table = "
" let (|||) p x = p x; p let (||=) p () = () let html_header p = p " CDuce online prototype

CDuce online prototype

"; p ||| "

Sample programs

You can start from one of the predefined examples below or try with you own program...

" ||| Examples.present ||| "
" ||= () let html_form p content = p "

Input

"; p ||| "

" ||= () let html_footer p = p "
" let cmds = [ "exec", `Exec; "example", `Example; ] let cut p w s = let rec aux i x = if i < String.length s then match s.[i] with | '\n' -> p '\n'; aux (i + 1) 0 | '\r' -> aux (i + 1) 0 | '<' -> let rec tag i = p s.[i]; if (s.[i] = '>') then aux (i + 1) x else tag (i + 1) in tag i | c -> let x = if x = w then (p '\\'; p '\n'; p ':'; 2) else (x + 1) in p c; if c = '&' then let rec ent i = p 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 let main (cgi : Netcgi.std_activation) = let p = cgi # output # output_string in let clicked s = cgi # argument_value s <> "" in try cgi # set_header (); let cmd = try snd (List.find (fun (x,y) -> clicked x) cmds) with Not_found -> `New in let dialog content = html_form p content in let exec src = let v = Cduce_loc.get_viewport () in let ppf = Html.ppf v and input = Stream.of_string src in Cduce_loc.push_source (`String src); Cduce_loc.set_protected true; let ok = Cduce.script ppf ppf input in if ok then Format.fprintf ppf "@\nOk.@\n"; let res = Html.get v in p "

Results

"; 
      cut (cgi # output # output_char) 80 res;  
      p "
"; dialog src in Cduce_loc.set_viewport (Html.create true); html_header p; let prog = cgi # argument_value "prog" in (match cmd with | `Exec -> exec prog | `Example -> dialog (example (cgi # argument_value "example")) | `New -> dialog "" ); p ("

About the prototype

CDuce is under active development; some features may not work properly.

Webmaster

Prototype version "^ <:symbol> ^", built on "^ <:symbol> ^".

"); html_footer p; cgi # output # commit_work() with exn -> let msg = match exn with | Unix.Unix_error (e,f,arg) -> "System error: " ^ (Unix.error_message e) ^ "; function " ^ f ^ "; argument " ^ arg | Timeout -> "Timeout reached ! This prototype limits computation time ..." | exn -> Printexc.to_string exn in fatal_error "Internal software error!" msg let () = ignore (Unix.alarm 20); Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout)); Random.self_init (); main cgi; cgi # finalize ()