(************************************************************
   merge_dir.ml		Created      : Mon Jan  9 19:36:05 2006
  			Last modified: Fri Nov 10 00:40:53 2006
  Compile: ocamlopt -dtypes unix.cmxa str.cmxa merge_dir.ml -o merge_dir #
  Compile: ocamlc -dtypes unix.cma str.cma merge_dir.ml -o merge_dir #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>

*)

type mode = Normal | SVN | CP
type date = Date of (int * int * int * int * int * int)

module StringSet = Set.Make(String)

let linelimit = 10
(*let date_regexp = Str.regexp ".*Last modified: [^ ]+ \\([A-Za-z]+\\) \\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([0-9]+\\)"*)
let find_regexp_str = "^ *[^ ]+ +[^ ]+ +\\(.\\)[^ ]+ +[^ ]+ +[^ ]+ +[^ ]+ +[^ ]+ +[^ ]+ +[^ ]+ +[^ ]+ +\\(.*\\)$"
let find_regexp = Str.regexp find_regexp_str
let unquote_regexp = Str.regexp "\\\\\\(.\\)"
let do_print_debug = ref false

let debug_print message =
  if !do_print_debug then
    prerr_endline message

(*let month_list = ["Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"]*)
(*let str_month_to_num_month target =*)
(*  let rec get_index n lst =*)
(*    match lst with*)
(*      [] -> raise Not_found*)
(*    | hd::tl ->*)
(*	if hd = target then*)
(*	  n*)
(*	else*)
(*	  get_index (n+1) tl in*)
(*  get_index 1 month_list*)

(*let get_last_modified instream =*)
(*  let rec iter count =*)
(*    if count = 0 then*)
(*      raise Not_found*)
(*    else*)
(*      let line = input_line instream in*)
(*      if Str.string_match date_regexp line 0 then*)
(*	let month = str_month_to_num_month (Str.matched_group 1 line) in*)
(*	let day = int_of_string (Str.matched_group 2 line) in*)
(*	let hour = int_of_string (Str.matched_group 3 line) in*)
(*	let min = int_of_string (Str.matched_group 4 line) in*)
(*	let sec = int_of_string (Str.matched_group 5 line) in*)
(*	let year = int_of_string (Str.matched_group 6 line) in*)
(*	Date(year, month, day, hour, min, sec)*)
(*      else*)
(*	iter (count-1) in*)
(*  iter linelimit*)

(*let print_date date =*)
(*  match date with*)
(*    Date(year, month, day, hour, min, sec) ->*)
(*      Printf.printf "%04d/%02d/%02d %02d/%02d/%02d\n" year month day hour min sec*)

(*let compare_date date1 date2 =*)
(*  let rec iter lst1 lst2 =*)
(*    match (lst1, lst2) with*)
(*      ([], []) ->*)
(*	0*)
(*    | (hd1::tl1, hd2::tl2) ->*)
(*	if hd1 = hd2 then*)
(*	  iter tl1 tl2*)
(*	else*)
(*	  hd1 - hd2*)
(*    | _ -> failwith "why in compare" in*)
(*  match (date1, date2) with*)
(*    (Date(year1, month1, day1, hour1, min1, sec1), Date(year2, month2, day2, hour2, min2, sec2)) ->*)
(*      iter [year1; month1; day1; hour1; min1; sec1] [year2; month2; day2; hour2; min2; sec2]*)

let is_prefix_of prefix str =
  let prefix_len = String.length prefix in
  let str_len = String.length str in
  (prefix_len <= str_len) && (prefix = String.sub str 0 prefix_len)

let differ_regexp = Str.regexp "^Files \\(.+\\) and \\(.+\\) differ$"
let only_regexp = Str.regexp "^Only in \\([^:]+\\): \\(.+\\)$"
let same_regexp = Str.regexp "^Files \\(.+\\) and \\(.+\\) are identical$"

let compare_dir path1 path2 =
  debug_print (Printf.sprintf "compare_dir %s %s" path1 path2);
  let command_string = Printf.sprintf "env LANG=C diff -x .svn -x CVS -qsr '%s' '%s'" path1 path2 in
  let input = Unix.open_process_in command_string in
  let rec iter only1 only2 same differ =
    try
      let line = input_line input in
      let (new_only1, new_only2, new_same, new_differ) = 
	if Str.string_match only_regexp line 0 then
	  begin
	    debug_print (Printf.sprintf "iter1 %s" line);
	    let path = Str.matched_group 1 line in
	    let filename = Str.matched_group 2 line in
	    if is_prefix_of path1 path then
	      ((Filename.concat path filename)::only1, only2, same, differ)
	    else if is_prefix_of path2 path then
	      (only1, (Filename.concat path filename)::only2, same, differ)
	    else
	      failwith (Printf.sprintf "why? %s" path)
	  end
	else if Str.string_match same_regexp line 0 then
	  begin
	    debug_print (Printf.sprintf "iter2 %s" line);
	    let filename1 = Str.matched_group 1 line in
	    let filename2 = Str.matched_group 2 line in
	    (only1, only2, (filename1, filename2)::same, differ)
	  end
	else if Str.string_match differ_regexp line 0 then
	  begin
	    debug_print (Printf.sprintf "iter3 %s" line);
	    let filename1 = Str.matched_group 1 line in
	    let filename2 = Str.matched_group 2 line in
	    (only1, only2, same, (filename1, filename2)::differ)
	  end
	else (* Common subdirectories ... *)
	  begin
	    debug_print (Printf.sprintf "iter4 %s" line);
	    (only1, only2, same, differ)
	  end in
      iter new_only1 new_only2 new_same new_differ
    with End_of_file ->
      (only1, only2, same, differ) in
  debug_print command_string;
  iter [] [] [] []

let compare_dir_by_only_filename path1 path2 =
  let list_of_line len input =
    let rec iter set =
      try
	let line = input_line input in
	if Str.string_match find_regexp line 0 then
	  let is_file = (Str.matched_group 1 line) <> "d" in
	  let path = Str.global_replace unquote_regexp "\\1" (Str.matched_group 2 line) in
	  let pathlen = String.length path in
	  if pathlen >= len then
	    let relative_path =
	      let tmp = String.sub path len (pathlen-len) in
	      let tmplen = pathlen-len in
	      if tmplen > 0 && tmp.[0] = '/' then
		String.sub tmp 1 (tmplen-1)
	      else
		tmp in
	    iter ((relative_path, path, is_file)::set)
	  else
	    iter set
	else
	  failwith ("wrong regexp\n"^line^"\n"^find_regexp_str)
      with End_of_file ->
	List.sort (fun (path1, _, _) (path2, _, _) -> compare path1 path2) set in
    iter [] in
  let rec remove_descendants x xlen lst head =
    match lst with
      [] -> ([], head)
    | ((path1, _, _) as hd)::tl ->
	let path1len = String.length path1 in
	if (path1len > xlen) && (x = String.sub path1 0 xlen) then
	    remove_descendants x xlen tl (head@[hd])
	else
	  (lst, head@lst) in
  let rec minimize lst result =
    match lst with
      [] ->
	result
    | ((path, fullpath, is_file) as hd)::tl ->
	if is_file then
	  minimize tl (result@[hd])
	else
	  let (nextlst, nextresult) = remove_descendants path (String.length path) tl result in
	  minimize nextlst nextresult in
  let rec compare_path lst1 lst2 ((only1, only2, same, diff) as result) =
    match (lst1, lst2) with
      ([], _) ->
	let new_only2 = (List.map (fun (_, path, _) -> path) (minimize lst2 []))@only2 in
	(only1, new_only2, same, diff)
    | (_, []) ->
	let new_only1 = (List.map (fun (_, path, _) -> path) (minimize lst1 []))@only1 in
	(new_only1, only2, same, diff)
    | ((path1, fullpath1, is_file1)::tl1, (path2, fullpath2, is_file2)::tl2) ->
	let compare_result = compare path1 path2 in
	if compare_result < 0 then
	  compare_path tl1 lst2 (fullpath1::only1, only2, same, diff)
	else if compare_result = 0 then
	  let new_result =
	    if (not is_file1) && (not is_file2) then
	      result
	    else if is_file1 && is_file2 then
	       (only1, only2, (fullpath1, fullpath2)::same, diff)
	    else
	       (only1, only2, same, (fullpath1, fullpath2)::diff) in
	    compare_path tl1 tl2 new_result
	else
	   compare_path lst1 tl2 (only1, fullpath2::only2, same, diff) in
  let input1 = Unix.open_process_in (Printf.sprintf "env LANG=C find '%s' -ls" path1) in
  let input2 = Unix.open_process_in (Printf.sprintf "env LANG=C find '%s' -ls" path2) in
  let lst1 = list_of_line (String.length path1) input1 in
  let lst2 = list_of_line (String.length path2) input2 in
  debug_print path1;
  debug_print path2;
  compare_path lst1 lst2 ([], [], [], [])

(* mv files which exists only in path2 to path1 *)
let merge_dir mode nodiff path1 path2 =
  let (only1, only2, same, diff) =
    if nodiff then
      compare_dir_by_only_filename path1 path2      
    else
      compare_dir path1 path2 in
  let path2_len = String.length path2 in
  let print_mv path =
    let path_len = String.length path in
    let relative_path = 
      let relative_str = String.sub path path2_len (path_len - path2_len) in
      let relative_str_len = String.length relative_str in
      if relative_str_len > 1 && String.get relative_str 0 = '/' then
	String.sub relative_str 1 (relative_str_len - 1)
      else
	relative_str in
    let path1_path = Filename.concat path1 relative_path in
    let command = 
      match mode with
	Normal -> "mv"
      | SVN -> "svn mv"
      | CP -> "cp -r" in
    debug_print (Printf.sprintf "merge_dir print command %s %s %s" command path path1_path);
    Printf.printf "%s '%s' '%s'\n" command path path1_path in
  let print_rm path =
    let command =
      match mode with
	Normal -> "rm -fr"
      | SVN -> "svn rm"
      | CP -> failwith "why in print_rm" in
    Printf.printf "%s '%s'\n" command path in
  debug_print (Printf.sprintf "merge_dir path1 %s, path2 %s" path1 path2);
  List.iter print_mv only2;
  (match mode with
    Normal | SVN ->
      List.iter (fun (_, path2) -> print_rm path2) same
  | CP -> ());
  List.iter (fun (f1, f2) -> Printf.printf "echo Please merge '%s' '%s'\n" f1 f2) diff

let main () =
  let mode = ref Normal in
  let nodiff = ref false in
  let arg_list = ref [] in
  let arg_spec = [
    ("-svn", Arg.Unit(fun () -> mode := SVN), "output svn command");
    ("-nodiff", Arg.Set(nodiff), "do not execute diff, just compare filename");
    ("-cp", Arg.Unit(fun () -> mode := CP), "use cp instead of mv, and do not remove files");
    ("-debug", Arg.Set(do_print_debug), "debug mode")
  ] in
  let usage_message = ("usage: "^(Filename.basename Sys.argv.(0))^" dir1 dir2") in
  Arg.parse arg_spec (fun x -> arg_list := !arg_list@[x]) usage_message;
  let args = !arg_list in
  if List.length args = 2 then
    match args with
      [path1; path2] ->
	if path1 = path2 then
	  prerr_endline "Do not compare same directry"
	else
	  merge_dir !mode !nodiff path1 path2
    | _ -> failwith "List.length is incorrect!?"
  else
    Arg.usage arg_spec usage_message

let _ =
  Printexc.print main ()

(*
 * Local Variables:
 *  namazu-default-dir:"/home/tak/.indexes/ocaml"
 * End:
 *)