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

[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)) ...@@ -259,7 +259,7 @@ cduce_lib.$(EXTENSION_LIB): $(OBJECTS:.cmo=.$(EXTENSION))
dtd2cduce: tools/dtd2cduce.ml dtd2cduce: tools/dtd2cduce.ml
@echo "Build $@" @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) cduce_validate: $(VALIDATE_OBJECTS:.cmo=.$(EXTENSION)) tools/validate.$(EXTENSION)
@echo "Build $@" @echo "Build $@"
......
open Netcgi
exception Timeout exception Timeout
let header = "Content-Type: text/plain\n\n" let header = "Content-Type: text/plain\n\n"
......
open Netcgi
exception Timeout
(* TODO: (* TODO:
- clever factorizations of content model and attribute specifs - clever factorizations of content model and attribute specifs
(e.g. type XHTML_inlien = [ ( Char | ... ) ]) (e.g. type XHTML_inlien = [ ( Char | ... ) ])
...@@ -11,7 +15,7 @@ open Pxp_types ...@@ -11,7 +15,7 @@ open Pxp_types
let mixed_table : ('a,unit) Hashtbl.t = Hashtbl.create 127 let mixed_table : ('a,unit) Hashtbl.t = Hashtbl.create 127
let regexp_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 let rec regexp ppf = function
| Optional re -> Format.fprintf ppf "%a?" regexp re | Optional re -> Format.fprintf ppf "%a?" regexp re
| Repeated 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 = ...@@ -33,9 +37,9 @@ let import_dtd ppf name filename =
| Mixed l -> | Mixed l ->
(try (try
Hashtbl.find mixed_table l; Hashtbl.find mixed_table l;
Format.fprintf ppf "MIXED:CACHED!" Format.fprintf ppf "MIXED:CACHED!"; raise Not_found
with Not_found -> with Not_found ->
(* Hashtbl.add mixed_table l (); *) (* Hashtbl.add mixed_table l (); *)
let l = List.map let l = List.map
(function (function
| MPCDATA -> "Char" | MPCDATA -> "Char"
...@@ -44,9 +48,9 @@ let import_dtd ppf name filename = ...@@ -44,9 +48,9 @@ let import_dtd ppf name filename =
| Regexp r -> | Regexp r ->
(try (try
Hashtbl.find regexp_table r; Hashtbl.find regexp_table r;
Format.fprintf ppf "REGEXP:CACHED!" Format.fprintf ppf "REGEXP:CACHED!"; raise Not_found
with Not_found -> with Not_found ->
(* Hashtbl.add regexp_table r ();*) (* Hashtbl.add regexp_table r (); *)
regexp ppf r regexp ppf r
) )
in in
...@@ -83,15 +87,49 @@ let import_dtd ppf name filename = ...@@ -83,15 +87,49 @@ let import_dtd ppf name filename =
content (e # content_model) content (e # content_model)
in 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 Format.fprintf ppf
"(* This type has been automatically generated from %s by dtd2cduce *)@\n" "(* This file has been automatically by dtd2cduce *)@\n";
filename;
List.iter (fun x -> elt ppf (dtd # element x)) (dtd # element_names) 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 () = let () =
if Array.length Sys.argv <> 3 then match Array.length Sys.argv with
(prerr_endline "Usage: dtd2cduce <prefix> <.dtd file>"; | 3 ->
exit 2); let name s = Sys.argv.(1) ^ s in
let name s = Sys.argv.(1) ^ s in import_dtd Format.std_formatter name (from_file Sys.argv.(2))
import_dtd Format.std_formatter name 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"/>--> ...@@ -31,6 +31,7 @@ demo" name="proto"/>-->
<include file="mailing.xml"/> <include file="mailing.xml"/>
<include file="team.xml"/> <include file="team.xml"/>
<include file="funding.xml"/> <include file="funding.xml"/>
<include file="dtd2cduce.xml"/>
<include file="sitemap.xml"/> <include file="sitemap.xml"/>
<left> <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