cduce_expat.ml 1.41 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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
      raise (Location.Generic 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 load_expat s =
  let p = Expat.parser_create "" in
  Expat.set_start_element_handler p Load_xml.start_element_handler;
  Expat.set_end_element_handler p Load_xml.end_element_handler;
  Expat.set_character_data_handler p Load_xml.text_handler;
28
  let u = Url.process s in
29
  try
30
    match u with 
31
32
33
34
35
      | Url.Url s -> Expat.parse p s
      | Url.Filename s -> load_from_file p s
  with Expat.Expat_error e -> 
    let line = Expat.get_current_line_number p 
    and col  = Expat.get_current_column_number p in
36
    let src = match u with
37
38
      | Url.Url s -> ""
      | Url.Filename s -> Printf.sprintf " file \"%s\"," s in
39
40
    let msg =
      Printf.sprintf
41
42
	"load_xml,%s at line %i, column %i: %s"
	src
43
44
45
46
47
48
	(Expat.get_current_line_number p)
	(Expat.get_current_column_number p)
	(Expat.xml_error_to_string e)
    in
    raise (Location.Generic msg)

49
50
let use () = Load_xml.xml_parser := load_expat

51
52
53
54
let () = 
  Config.register 
    "expat" 
    "Expat XML parser"
55
56
    use