viewcvs.cgi/runtime/cduce_expat.ml

let buflen = 1024
let buf = String.create buflen

let load_from_file p s =
  let ic = 
    try open_in s
    with exn ->
      let msg = 
        Printf.sprintf "load_xml, file \"%s\": %s" s (Printexc.to_string exn)
      in
      Value.failwith' msg
  in
  let rec loop () =
    let n = input ic buf 0 buflen in
    if (n > 0) then (Expat.parse_sub p buf 0 n; loop ()) 
  in
  try
    loop(); 
    Expat.final p;
    close_in ic
  with exn -> close_in ic; raise exn

let rec push p s =
  Expat.set_external_entity_ref_handler p 
    (fun ctx base sys pub -> 
       let s = Url.local s sys in
       let p = Expat.external_entity_parser_create p ctx None in
       push p s);
  try
    if Url.is_url s then Expat.parse p (Url.load_url s)
    else load_from_file p s
  with Expat.Expat_error e -> 
    let msg =
      Printf.sprintf
        "load_xml,%s at line %i, column %i: %s"
        s
        (Expat.get_current_line_number p)
        (Expat.get_current_column_number p)
        (Expat.xml_error_to_string e)
    in
    Value.failwith' msg

let rec load_expat se ee txt s =
  let p = Expat.parser_create None in
  Expat.set_start_element_handler p se;
  Expat.set_end_element_handler p ee;
  Expat.set_character_data_handler p txt;
  ignore (Expat.set_param_entity_parsing p Expat.ALWAYS);
  push p s

let use () = Load_xml.xml_parser := 
  load_expat Load_xml.start_element_handler Load_xml.end_element_handler
    Load_xml.text_handler

let () = 
  Config.register 
    "expat" 
    "Expat XML parser"
    use

let () = 
  Schema_xml.xml_parser := 
    (fun uri f g -> load_expat f (fun _ -> g ()) (fun _ -> ()) uri)
1	let buflen = 1024
2	let buf = String.create buflen
3
4	let load_from_file p s =
5	let ic =
6	try open_in s
7	with exn ->
8	let msg =
9	Printf.sprintf "load_xml, file \"%s\": %s" s (Printexc.to_string exn)
10	in
11	Value.failwith' msg
12	in
13	let rec loop () =
14	let n = input ic buf 0 buflen in
15	if (n > 0) then (Expat.parse_sub p buf 0 n; loop ())
16	in
17	try
18	loop();
19	Expat.final p;
20	close_in ic
21	with exn -> close_in ic; raise exn
22
23	let rec push p s =
24	Expat.set_external_entity_ref_handler p
25	(fun ctx base sys pub ->
26	let s = Url.local s sys in
27	let p = Expat.external_entity_parser_create p ctx None in
28	push p s);
29	try
30	if Url.is_url s then Expat.parse p (Url.load_url s)
31	else load_from_file p s
32	with Expat.Expat_error e ->
33	let msg =
34	Printf.sprintf
35	"load_xml,%s at line %i, column %i: %s"
36	s
37	(Expat.get_current_line_number p)
38	(Expat.get_current_column_number p)
39	(Expat.xml_error_to_string e)
40	in
41	Value.failwith' msg
42
43	let rec load_expat se ee txt s =
44	let p = Expat.parser_create None in
45	Expat.set_start_element_handler p se;
46	Expat.set_end_element_handler p ee;
47	Expat.set_character_data_handler p txt;
48	ignore (Expat.set_param_entity_parsing p Expat.ALWAYS);
49	push p s
50
51	let use () = Load_xml.xml_parser :=
52	load_expat Load_xml.start_element_handler Load_xml.end_element_handler
53	Load_xml.text_handler
54
55	let () =
56	Config.register
57	"expat"
58	"Expat XML parser"
59	use
60
61	let () =
62	Schema_xml.xml_parser :=
63	(fun uri f g -> load_expat f (fun _ -> g ()) (fun _ -> ()) uri)