[r2005-03-09 16:26:51 by afrisch] dtd2cduce as a cgi-bin

Original author: afrisch
Date: 2005-03-09 16:26:51+00:00

Makefile.distrib

@@ -259,7 +259,7 @@ cduce_lib.$(EXTENSION_LIB): $(OBJECTS:.cmo=.$(EXTENSION))
 
 dtd2cduce: tools/dtd2cduce.ml
 	@echo "Build $@"
-	-$(HIDE)$(OCAMLFIND) $(CAML) -o $@ -package "$(PXP_PACK)" -linkpkg $^
+	-$(HIDE)$(OCAMLFIND) $(CAML) -o $@ -package "$(PXP_PACK) cgi" -linkpkg $^
 
 cduce_validate: $(VALIDATE_OBJECTS:.cmo=.$(EXTENSION)) tools/validate.$(EXTENSION)
 	@echo "Build $@"

driver/evaluator.ml

-open Netcgi
 exception Timeout
 
 let header = "Content-Type: text/plain\n\n"

tools/dtd2cduce.ml

+open Netcgi
+exception Timeout
+
+
 (* TODO: 
     - clever factorizations of content model and attribute specifs
          (e.g.  type XHTML_inlien = [ ( Char | ... ) ])
@@ -11,7 +15,7 @@ open Pxp_types
 let mixed_table : ('a,unit) Hashtbl.t = Hashtbl.create 127
 let regexp_table : ('a,unit) Hashtbl.t = Hashtbl.create 127
 
-let import_dtd ppf name filename =
+let import_dtd ppf name src =
   let rec regexp ppf = function
     | Optional re -> Format.fprintf ppf "%a?" regexp re
     | Repeated re -> Format.fprintf ppf "%a*" regexp re
@@ -33,9 +37,9 @@ let import_dtd ppf name filename =
     | Mixed l -> 
 	(try 
 	   Hashtbl.find mixed_table l;
-	   Format.fprintf ppf "MIXED:CACHED!"
+	   Format.fprintf ppf "MIXED:CACHED!"; raise Not_found
 	 with Not_found ->
-(*	   Hashtbl.add mixed_table l (); *)
+(*	   Hashtbl.add mixed_table l ();  *)
 	   let l = List.map 
 		     (function 
 			| MPCDATA -> "Char"
@@ -44,9 +48,9 @@ let import_dtd ppf name filename =
     | Regexp r -> 
 	(try 
 	   Hashtbl.find regexp_table r;
-	   Format.fprintf ppf "REGEXP:CACHED!"
+	   Format.fprintf ppf "REGEXP:CACHED!"; raise Not_found
 	 with Not_found ->
-(*	   Hashtbl.add regexp_table r ();*)
+(*	   Hashtbl.add regexp_table r (); *)
 	   regexp ppf r
 	)
   in    
@@ -83,15 +87,49 @@ let import_dtd ppf name filename =
       content (e # content_model)
   in      
 
-  let dtd = parse_dtd_entity { default_config with encoding = `Enc_utf8 } (from_file filename) in
+  let dtd = 
+    parse_dtd_entity { default_config with encoding = `Enc_utf8 } src in
   Format.fprintf ppf 
-    "(* This type has been automatically generated from %s by dtd2cduce *)@\n"
-    filename;
+    "(* This file has been automatically by dtd2cduce *)@\n";
   List.iter (fun x -> elt ppf (dtd # element x)) (dtd # element_names)
 
+let main (cgi : Netcgi.std_activation) =
+  try
+    cgi # set_header
+      ~content_type:"text/plain; charset=\"iso-8859-1\""
+      ();
+    let dtd = cgi # argument_value "dtd" in
+    let prefix = cgi # argument_value "prefix" in
+    import_dtd Format.str_formatter (fun s -> prefix ^ s) 
+      (from_string dtd);
+    let res = Format.flush_str_formatter () in
+    cgi # output # output_string res;
+    cgi # output # commit_work();
+  with exn ->
+    cgi # output # rollback_work();
+    cgi # set_header 
+      ~content_type:"text/plain; charset=\"iso-8859-1\""
+      ();
+    let s = Pxp_types.string_of_exn exn in
+    cgi # output # output_string "ERROR:\n";
+    cgi # output # output_string s;
+    cgi # output # output_string "\n";
+    cgi # output # commit_work()
+
+
 let () =
-  if Array.length Sys.argv <> 3 then
-    (prerr_endline "Usage: dtd2cduce <prefix> <.dtd file>";
-     exit 2);
-  let name s = Sys.argv.(1) ^ s in
-  import_dtd Format.std_formatter name Sys.argv.(2)
+  match Array.length Sys.argv with
+    | 3 ->
+	let name s = Sys.argv.(1) ^ s in
+	import_dtd Format.std_formatter name (from_file Sys.argv.(2))
+    | 1 ->
+	let operating_type = Netcgi.buffered_transactional_optype in
+	let cgi = new Netcgi.std_activation ~operating_type () in
+	ignore (Unix.alarm 20);
+	Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout));
+	main cgi;
+	cgi # finalize ()
+   | _ ->
+	if Array.length Sys.argv <> 3 then
+	  (prerr_endline "Usage: dtd2cduce <prefix> <.dtd file>";
+	   exit 2);

web/index.xml

@@ -31,6 +31,7 @@ demo" name="proto"/>-->
 <include file="mailing.xml"/>
 <include file="team.xml"/>
 <include file="funding.xml"/>
+<include file="dtd2cduce.xml"/>
 <include file="sitemap.xml"/>
 
 <left>