cduce_expat.ml 1.55 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
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
11
      Value.failwith' msg
12 13 14 15 16 17 18 19 20 21 22
  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

23
let rec push p s =
24
  Expat.set_external_entity_ref_handler p 
25 26 27 28
    (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);
29
  try
30 31
    if Url.is_url s then Expat.parse p (Url.load_url s)
    else load_from_file p s
32 33 34
  with Expat.Expat_error e -> 
    let msg =
      Printf.sprintf
35
	"load_xml,%s at line %i, column %i: %s"
36
	s
37 38 39 40
	(Expat.get_current_line_number p)
	(Expat.get_current_column_number p)
	(Expat.xml_error_to_string e)
    in
41 42 43 44 45 46 47 48 49
    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
50

51 52 53
let use () = Load_xml.xml_parser := 
  load_expat Load_xml.start_element_handler Load_xml.end_element_handler
    Load_xml.text_handler
54

55
let () = 
56
  Cduce_config.register 
57 58
    "expat" 
    "Expat XML parser"
59 60
    use

61 62 63
let () = 
  Schema_xml.xml_parser := 
    (fun uri f g -> load_expat f (fun _ -> g ()) (fun _ -> ()) uri)