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 _ 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 common_prefix ctx1 ctx2 len =
  61   for i = 1 to len do
  62     let e1,p1 = Queue.pop ctx1.events in
  63     let e2,_ = Queue.pop ctx2.events in
  64     if not (eq_event e1 e2) then raise (Diff p1)
  65   done
  66
  67
  68 let diffs fd1 fd2 =
  69   let buffer1 = String.create 4096 in
  70   let buffer2 = String.create 4096 in
  71   let parser1,ctx1 = create_parser () in
  72   let parser2,ctx2 = create_parser () in
  73   let rec loop () =
  74     let read1 = input fd1 buffer1 0 4096 in
  75     let read2 = input fd2 buffer2 0 4096 in
  76     if read1 == 0 && read2 == 0 then begin
  77       let l1 = Queue.length ctx1.events in
  78       let l2 = Queue.length ctx2.events in
  79       if l1 > l2 then let _, p1 = Queue.pop ctx1.events in raise (Diff p1)
  80       else if l2 > l1 then let _, p2 = Queue.pop ctx2.events in raise (Diff p2)
  81       else common_prefix ctx1 ctx2 l1
  82     end else begin
  83       let () = Expat.parse_sub parser1 buffer1 0 read1 in
  84       let () = Expat.parse_sub parser2 buffer2 0 read2 in
  85       common_prefix ctx1 ctx2 (min (Queue.length ctx1.events) (Queue.length ctx2.events));
  86       loop ()
  87     end
  88   in
  89   loop ()
  90
  91 let main () =
  92   if Array.length Sys.argv != 3 then begin
  93     Printf.eprintf "usage: %s file1.xml file2.xml\n%!" Sys.argv.(0);
  94     exit 2
  95   end else
  96     let fn1 = Sys.argv.(1) in
  97     let fn2 = Sys.argv.(2) in
  98     try
  99       let fd1 = open_in fn1 in
 100       let fd2 = open_in fn2 in
 101       let code =
 102         try
 103           diffs fd1 fd2; 0
 104         with
 105           Diff p -> Printf.eprintf "File %s and %s differ at line %i, column %i\n%!"
 106             fn1 fn2 p.line_num p.column_num;1
 107       in close_in fd1; close_in fd2; exit code
 108     with
 109       e -> Printf.eprintf "Error %s\n%!" (Printexc.to_string e); exit 3
 110
 111 let () = main ()
 112