tools/xml_diff.ml

   1 type event = Open of string * (string * string) list | Close of string | Text of string
   2
   3 let eq_event e1 e2 =
   4   match e1, e2 with
   5   | Open(t1, l1), Open(t2, l2) -> t1 = t2 &&
   6   let sl1 = List.sort compare l1
   7   and sl2 = List.sort compare l2 in sl1 = sl2
   8   | Close t1, Close t2 -> t1 = t2
   9   | Text s1 , Text s2 -> s1 = s2
  10   | _ -> false
  11
  12
  13 type position = {
  14   byte_index : int;
  15   column_num : int;
  16   line_num : int;
  17   byte_count : int;
  18 }
  19
  20 type ctx = {
  21   text_buffer : Buffer.t;
  22   events : (event*position) Queue.t;
  23 }
  24 let get_position p =
  25   { byte_index = Expat.get_current_byte_index p;
  26     column_num = Expat.get_current_column_number p;
  27     line_num =  Expat.get_current_line_number p;
  28     byte_count =  Expat.get_current_byte_count p;
  29   }
  30
  31
  32 let rec start_element_handler parser_ ctx tag attr_list =
  33   do_text parser_ ctx;
  34   Queue.add (Open(tag, attr_list), get_position parser_) ctx.events
  35
  36 and end_element_handler parser_ ctx tag =
  37   do_text parser_ ctx;
  38   Queue.add (Close(tag), get_position parser_) ctx.events
  39
  40 and do_text parser_ ctx =
  41   if Buffer.length ctx.text_buffer != 0 then
  42     let s = Buffer.contents ctx.text_buffer in
  43     Buffer.clear  ctx.text_buffer;
  44     Queue.add (Text s, get_position parser_) ctx.events
  45
  46 let character_data_handler parser_ ctx text =
  47   Buffer.add_string ctx.text_buffer text
  48
  49 let create_parser () =
  50   let ctx1 = { text_buffer = Buffer.create 512; events = Queue.create (); } in
  51   let parser1 = Expat.parser_create ~encoding:None in
  52   Expat.set_start_element_handler parser1 (start_element_handler parser1 ctx1);
  53   Expat.set_end_element_handler parser1 (end_element_handler parser1 ctx1);
  54   Expat.set_character_data_handler
  55     parser1 (character_data_handler parser1 ctx1);
  56   parser1, ctx1
  57
  58 exception Diff of position
  59
  60 let diffs fd1 fd2 =
  61   let buffer1 = String.create 4096 in
  62   let buffer2 = String.create 4096 in
  63   let parser1,ctx1 = create_parser () in
  64   let parser2,ctx2 = create_parser () in
  65   let rec loop () =
  66     let read1 = input fd1 buffer1 0 4096 in
  67     let read2 = input fd2 buffer2 0 4096 in
  68     if read1 == 0 && read2 == 0 then () else
  69       let () = Expat.parse_sub parser1 buffer1 0 read1 in
  70       let () = Expat.parse_sub parser2 buffer2 0 read2 in
  71       for i = 1 to min (Queue.length ctx1.events) (Queue.length ctx2.events) do
  72         let e1,p1 = Queue.pop ctx1.events in
  73         let e2,_ = Queue.pop ctx2.events in
  74         if not (eq_event e1 e2) then
  75           raise (Diff p1)
  76       done;
  77       loop ()
  78   in
  79   loop ()
  80
  81 let main () =
  82   if Array.length Sys.argv != 3 then
  83     Printf.eprintf "usage: %s file1.xml file2.xml\n%!" Sys.argv.(0)
  84   else
  85     let fn1 = Sys.argv.(1) in
  86     let fn2 = Sys.argv.(2) in
  87     try
  88       let fd1 = open_in fn1 in
  89       let fd2 = open_in fn2 in
  90       let () =
  91       try
  92         diffs fd1 fd2
  93       with
  94         Diff p -> Printf.printf "File %s and %s differ at line %i, column %i\n%!"
  95           fn1 fn2 p.line_num p.column_num
  96       in close_in fd1; close_in fd2
  97     with
  98       _ -> Printf.eprintf "Error\n%!"
  99 let () = main ()
 100