Commit 76be483f authored by Pietro Abate's avatar Pietro Abate

[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
parent 72786352
......@@ -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 $@"
......
open Netcgi
exception Timeout
let header = "Content-Type: text/plain\n\n"
......
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);
......@@ -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>
......
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