(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Library General Public License as            *)
(*    published by the Free Software Foundation; either version 2 of the         *)
(*    License, or  any later version.                                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library General Public          *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)


(** Functions executing cvs commands. *)


open Ocvs_types

let print_DEBUG s = () (*print_string s ; print_newline ()*)

let delete_file f =
  try Unix.unlink f
  with _ -> ()

let absolute_name f =
  if Filename.is_relative f then
    Filename.concat (Unix.getcwd()) f
  else
    f

let remove_n_first_lines n s =
  let rec iter m acc =
    if m = 0 then
      acc
    else
      let index = String.index_from s acc '\n' in
      iter (m-1) (index+1)
  in
  try
    let index = iter n 0 in
    String.sub s index ((String.length s) - index)
  with
    Not_found ->
      ""

let get_nth_line n s =
  try
    let l = Str.split (Str.regexp "\n") s in
    List.nth l n
  with _ ->
    ""

(** partition_files_by_dir files return a list of pairs (dir, list of files (basename)) from the given list of files.*)

let partition_files_by_dir files =
  let rec part (acc : (string * (string list ref)) list) l =
    match l with
      [] -> List.map (fun (d,lref) -> (d,!lref)) acc
    | file :: q ->
        let d = Filename.dirname file in
        let f = Filename.basename file in
        try
          let lref = List.assoc d acc in
          lref := f :: !lref;
          part acc q
        with
          Not_found ->
            part ((d, ref [f])::acc) q
  in
  part [] files


(** This function returns a file in the form of one string.*)

let input_file_as_string nom =
  let chanin = open_in_bin nom in
  let len = 1024 in
  let s = String.create len in
  let buf = Buffer.create len in
  let rec iter () =
    try
      let n = input chanin s 0 len in
      if n = 0 then
        ()
      else
        (
         Buffer.add_substring buf s 0 n;
         iter ()
        )
    with
      End_of_file -> ()
  in
  iter ();
  close_in chanin;
  Buffer.contents buf


let analyse_status_file f =
  try
    let s = input_file_as_string f in
    let l = Str.split
        (Str.regexp_string "===================================================================\nFile: ")
        s
    in
    let date = Unix.time () in
    let f acc str =
      try
        (* the file name, between 0 and n1 *)
        let n1 = Str.search_forward (Str.regexp "[ \t]*Status:[ ]") str 0 in
        let file = String.sub str 0 n1 in
        (* the status string, between n2 and n3 *)
        let n2 = n1 + (String.length (Str.matched_string str)) in
        let n3 = Str.search_forward (Str.regexp "\n") str n1 in
        let status_string = String.sub str n2 (n3-n2) in
        let cvs_info =
          if status_string = "Unknown" or status_string = "Locally Added" then
            {
              cvs_file = file ;
              cvs_status = Ocvs_types.status_of_string status_string ;
              cvs_work_rev = "" ;
              cvs_rep_rev = "" ;
              cvs_date_string = "" ;
              cvs_date = date
            }
          else if status_string = "Locally Removed" then
            (
             let len = String.length file in
             let no_file = "no file " in
             let len_no_file = String.length no_file in
             let real_file =
               if len <= len_no_file then
                 file
               else
                 if String.sub file 0 len_no_file = no_file then
                   String.sub file len_no_file (len - len_no_file)
                 else
                   file
             in
             {
              cvs_file = real_file ;
              cvs_status = Ocvs_types.status_of_string status_string ;
              cvs_work_rev = "" ;
              cvs_rep_rev = "" ;
              cvs_date_string = "" ;
              cvs_date = date
            }
            )
          else
            (
             print_DEBUG "after n3";
              (* the working revision *)
             let n4 = Str.search_forward (Str.regexp "Working revision:\t\\([^\t\n]+\\)\t?") str n3 in
             print_DEBUG "after n4";
             let n5 = n4 + (String.length (Str.matched_string str)) in
             let work_rev = Str.matched_group 1 str in
             print_DEBUG ("after work_rev="^work_rev);
             (* the date as string between n5 and n6 *)
             let n6 = Str.search_forward (Str.regexp "\n") str n5 in
             print_DEBUG "after n6";
             (* the repository revision *)
             let _n7 = Str.search_forward (Str.regexp "Repository revision:\t\\([^\t]+\\)\t") str n6 in
             print_DEBUG "after n7";
             let rep_rev = Str.matched_group 1 str in
             let cvs_info =
               {
                 cvs_file = file ;
                 cvs_status = Ocvs_types.status_of_string (String.sub str n2 (n3-n2)) ;
                 cvs_work_rev = work_rev ;
                 cvs_rep_rev = rep_rev ;
                 cvs_date_string = String.sub str n5 (n6-n5) ;
                 cvs_date = date
               }
             in
             cvs_info
            )
        in
        acc @ [cvs_info]
    with
     Not_found ->
       acc
    in
    List.fold_left f [] l

  with
    Sys_error s ->
      raise (Ocvs_types.CvsFailure s)

let analyse_update_file f =
  try
    let s = input_file_as_string f in
    let l = Str.split (Str.regexp "\n") s in
    let f acc str =
      try
        let action = Ocvs_types.update_action_of_string (String.sub str 0 1) in
        let file = String.sub str 2 ((String.length str) - 2) in
        let info = (file, action) in
        acc @ [info]
      with
        _ ->
          acc
    in
    List.fold_left f [] l
  with
    Sys_error s ->
      raise (Ocvs_types.CvsFailure s)

(** Return a list of cvs_info for the files handled by cvs in the given directory, not recursively.*)

let status_dir dir =
  let temp_file = Filename.temp_file "ocamlcvs" "status" in
  let com = Printf.sprintf "cd %s ; cvs status %s -l . > %s"
      (Filename.quote dir)
      !Ocvs_config.status_options
      temp_file
  in
  let n = Sys.command com in
  if n = 0 then
    (
     let l = analyse_status_file temp_file in
     delete_file temp_file ;
     List.map
       (fun ci -> { ci with
                    cvs_file = Filename.concat dir ci.cvs_file }
       )
       l
    )
  else
    (
     delete_file temp_file ;
     raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
    )

(** Return a cvs_info for the given file. @raise CvsFailure if an error occurs (for example the file is not handled by CVS).*)

let status_file file =
  let dir = Filename.dirname file in
  let f = Filename.basename file in
  let temp_file = Filename.temp_file "ocamlcvs" "status" in
  let com = Printf.sprintf "cd %s ; cvs status %s %s > %s"
      (Filename.quote dir)
      !Ocvs_config.status_options
      (Filename.quote f)
      temp_file
  in
  let n = Sys.command com in
  if n = 0 then
    (
     let l = analyse_status_file temp_file in
     delete_file temp_file ;
     try
       match l with
         [] -> raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
       | ci :: _ ->
           { ci with
             cvs_file = file ;
           }
     with
       Invalid_argument _ ->
             (* lists have different lengths *)
         raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
    )
  else
    (
     delete_file temp_file ;
     raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
    )

(** Return a list of cvs_info for the files handled by cvs in the given list of files.*)

let status_files files =
  let rec iter acc l =
    match l with
      [] -> acc
    | file :: q ->
        try
          let i = status_file file in
          iter (i :: acc) q
        with
          CvsFailure s ->
            prerr_endline s;
            iter acc q
  in
  List.rev (iter [] files)

let commit_files_in_dir ?(comment="") dir base_files =
  let com =
    Printf.sprintf "cd %s ; cvs commit %s -m %s %s"
      (Filename.quote dir)
      !Ocvs_config.commit_options
      (Filename.quote comment)
      (List.fold_left (fun acc -> fun f -> acc^" "^(Filename.quote f)^"""" base_files)
  in
  let n = Sys.command com in
  if n = 0 then
    ()
  else
    raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))

let commit_files ?(comment="") files =
  let parts = partition_files_by_dir files in
  let f (d,l) = commit_files_in_dir ~comment d l in
  List.iter f parts

let commit_dir ?(comment="") dir =
  let com = Printf.sprintf "cd %s ; cvs commit %s -m %s "
      (Filename.quote dir)
      !Ocvs_config.commit_options
      (Filename.quote comment)
  in
  let n = Sys.command com in
  if n = 0 then
    ()
  else
    raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))


let update_dir ?(recursive=true) dir =
  let temp_file = Filename.temp_file "ocamlcvs" "update" in
  let com = Printf.sprintf
    "cd %s ; cvs update %s -d %s > %s"
      (Filename.quote dir)
      !Ocvs_config.update_options
      (if recursive then "-R" else "-l")
      temp_file
  in
  let n = Sys.command com in
  if n = 0 then
    (
     let l = analyse_update_file temp_file in
     delete_file temp_file ;
     List.map
       (fun (f, action) -> (Filename.concat dir f, action))
       l
    )
  else
    (
     delete_file temp_file ;
     raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
    )

let add_dir dir =
  let parent = Filename.dirname dir in
  let d = Filename.basename dir in
  let com = Printf.sprintf "cd %s ; cvs add %s %s"
      (Filename.quote parent)
      !Ocvs_config.add_options
      (Filename.quote d)
  in
  let n = Sys.command com in
  if n = 0 then
    ()
  else
    raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))

let create_and_add_dir dir =
  try
    Unix.mkdir dir 0o755;
    add_dir dir
  with
    Unix.Unix_error (e, s1, s2) ->
      let s = Unix.error_message e in
      raise (Ocvs_types.CvsFailure (Ocvs_messages.error_mkdir dir s))

(** Return the list of added files, which must then have the "Locally Added" status, and the list of files for which an error occured. *)

let add_files ?(binary=false) files =
  match files with
    [] ->
      ([], [])
  | files ->
      let f (acc_ok, acc_ko) file =
        let d = Filename.dirname file in
        let f = Filename.basename file in
        let com = Printf.sprintf "cd %s ; cvs add %s %s %s"
            (Filename.quote d)
            !Ocvs_config.add_options
            (if binary then "-kb " else "")
            (Filename.quote f)
        in
        let n = Sys.command com in
        if n = 0 then
          (acc_ok @ [file], acc_ko)
        else
          (acc_ok, acc_ko @ [file])
      in
      List.fold_left f ([], []) files


let remove_files files =
  match files with
    [] ->
      ([], [])
  | files ->
      let f (acc_ok, acc_ko) file =
        let d = Filename.dirname file in
        let f = Filename.basename file in
        let com = Printf.sprintf "cd %s ; cvs remove %s -f %s"
            (Filename.quote d)
            !Ocvs_config.remove_options
            (Filename.quote f)
        in
        let n = Sys.command com in
        if n = 0 then
          (acc_ok @ [file], acc_ko)
        else
          (acc_ok, acc_ko @ [file])
      in
      List.fold_left f ([], []) files


(** Get the last modifications of the given file, or between two revisions, or between a revision and the working file. Also gives the archive filename. Warning : Never give rev2 without rev.*)

let diff_file ?rev ?rev2 file =
  let dir = Filename.dirname file in
  let f = Filename.basename file in
  let temp_file = Filename.temp_file "ocamlcvs" "diff" in
  let com = "cd "^(Filename.quote dir)^" ; cvs -f diff "^
    (match rev with
      None -> ""
    | Some r -> " -r "^(Ocvs_revision.string_of_revision_number r.rev_number)^" ")^
    (match rev2 with
      None -> ""
    | Some r -> " -r "^(Ocvs_revision.string_of_revision_number r.rev_number)^" ")^
    (Filename.quote f)^" > "^temp_file
  in
  begin
    match Sys.command com with
      0 -> ()
    | n ->
        delete_file temp_file;
        raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
  end;
  let s = input_file_as_string temp_file in
  (* we must remove some cvs information (5 or 6 lines) to get only the diffs *)
  let s2 = remove_n_first_lines
      (match rev with None -> 5 | Some _ -> 6)
      s
  in
  try
     (* get the rcs archive name *)
    let rcs_file =
      try
        let s_rcs = "RCS file: " in
        let i1 = (Str.search_forward (Str.regexp_string s_rcs) s 0) + (String.length s_rcs) in
        let i2 = String.index_from s i1 '\n' in
        String.sub s i1 (i2 - i1)
      with
        Not_found ->
          raise (Failure Ocvs_messages.error_rcs_archive)
    in
    let l = Odiff.from_string s2 in
    delete_file temp_file ;
    (l, rcs_file)
  with
    Failure s ->
      delete_file temp_file ;
      raise (Failure s)

(** Get the content of a revision from the RCS archive in a file and return the name of the file. *)

let rcs_revision rev archive =
  let temp_file = Filename.temp_file "ocamlcvs" "rcs" in
  let com =
    "co -p -r"^(Ocvs_revision.string_of_revision_number rev.rev_number)^" "^
    (Filename.quote archive)^" > "^temp_file
  in
  let n = Sys.command com in
  if n = 0 then
    temp_file
  else
    (
     delete_file temp_file ;
     raise (Failure (Ocvs_messages.error_exec com))
    )

(** Read the list of revisions in a file from a file created by the cvs log command. *)

let read_revisions file =
  let s = input_file_as_string file in
  let l = Str.split (Str.regexp "^----------------------------\n") s in
  match l with
    [] | [_] -> []
  | _ :: lrev ->
      let f str_rev =
        let lines = Str.split (Str.regexp "\n") str_rev in
        match lines with
          l_number :: l_info :: l_coms ->
            let number =
              try
                let n = String.index l_number ' ' in
                let s = String.sub l_number (n+1) ((String.length l_number) - n - 1) in
                List.map int_of_string (Str.split (Str.regexp "\\.") s)
              with
                Not_found ->        []
              | Invalid_argument s ->
                  prerr_endline s;
                  prerr_endline l_number ;
                  []
            in
            let n = String.index l_info ' ' in
            let n2 = String.index_from l_info n ';' in
            let n3 = String.index_from l_info n2 ':' in
            let n4 = String.index_from l_info n3 ';' in
            let date = String.sub l_info (n + 1) (n2 - n - 1) in
            let author = String.sub l_info (n3 + 1) (n4 - n3 - 1) in
            let list_lines_coms =
              match l_coms with
                first_line :: q ->
                  if Str.string_match (Str.regexp "^branches:") first_line 0 then
                    q
                  else
                    l_coms
              |        _ -> l_coms
            in
            {
              rev_number = number ;
              rev_author = author ;
              rev_date = date ;
              rev_comment =
                String.concat "\n"
                (List.filter
                   (fun s ->
                     s <> ("==================================="^
                           "==========================================")
                   )
                   list_lines_coms
                )
            }
        | _ ->
            raise (Ocvs_types.CvsFailure (Ocvs_messages.error_analyze_revision str_rev))
      in
      List.map f lrev

(** Get the list of the revisions of a file. @raise Ocvs_types.CvsFailure if an error occurs.*)

let revisions_file file =
  let dir = Filename.dirname file in
  let f = Filename.basename file in
  let temp_file = Filename.temp_file "ocamlcvs" "log" in
  let com = Printf.sprintf
      "cd %s ; cvs log %s > %s"
      (Filename.quote dir)
      (Filename.quote f)
      temp_file
  in
  let n = Sys.command com in
  try
    if n = 0 then
      let revisions = read_revisions temp_file in
      delete_file temp_file ;
      revisions
    else
      raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
  with
    Failure s ->
      delete_file temp_file ;
      raise (Ocvs_types.CvsFailure s)


(** Functions for tags *)


(** Read the list of tags in a file from a file created by the cvs log command. *)

let read_tags file =
  let s = input_file_as_string file in
  let l = Str.split (Str.regexp "^----------------------------$") s in
  match l with
    [] | [_] -> []
  | preambule :: _ ->
      try
        print_DEBUG "Ocvs_commands.read_tags after preambule";
        let s = "symbolic names:" in
        let pos = Str.search_forward (Str.regexp ("^"^s^"$")) preambule 0 in
        print_DEBUG "Ocvs_commands.read_tags after pos";
        let pos2 = pos + (String.length s) + 1 in
        let pos3 = Str.search_forward (Str.regexp "^keyword substitution:") preambule pos2 in
        print_DEBUG "Ocvs_commands.read_tags after pos3";
        let s2 = String.sub preambule pos2 (pos3 - pos2) in
        let lines = Str.split (Str.regexp "\n") s2 in
        let f_line acc line =
          try
            let pos = String.index line ':' in
            let tag = String.sub line 1 (pos - 1) in
            let revision = String.sub line (pos + 2) ((String.length line) - pos - 2) in
            (tag, revision) :: acc
          with
            Not_found | Invalid_argument _ ->
              acc
        in
        List.fold_left f_line [] lines
      with
        Not_found ->
          []

(** Get the list of tags in the given file. @return a list of (tag, revision number) (both are strings).*)

let tags_file file =
  let dir = Filename.dirname file in
  let f = Filename.basename file in
  let temp_file = Filename.temp_file "ocamlcvs" "log" in
  let com = Printf.sprintf
      "cd %s ; cvs log %s > %s"
      (Filename.quote dir)
      (Filename.quote f)
      temp_file
  in
  let n = Sys.command com in
  try
    if n = 0 then
      let revisions = read_tags temp_file in
      delete_file temp_file ;
      revisions
    else
      raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
  with
    Failure s ->
      delete_file temp_file ;
      raise (Ocvs_types.CvsFailure s)

(** Check the syntax of the given tag. @raise Tag_error if the tag is incorrect.*)

let check_tag tag =
  for i = 0 to (String.length tag) - 1 do
    match tag.[i] with
      'a' .. 'z'
    | 'A' .. 'Z' -> ()
    | '_' | '-' | '0' .. '9' when i > 0 -> ()
    | _ -> raise (Tag_error i)
  done

(** Return true if the given file alerady has the given tag. *)

let file_has_tag tag file =
  let tags = List.map fst (tags_file file) in
  List.mem tag tags

(** Return the list of CVS files in the given directory and in its subdirectories. *)

let rec get_cvs_files dir =
  let files = List.map (fun ci  -> ci.cvs_file) (status_dir dir) in
  let subdirs = List.map (Filename.concat dir) (Ocvs_misc.get_cvs_directories dir) in
  List.iter prerr_endline subdirs;
  let ll = List.map get_cvs_files subdirs in
  List.flatten (files :: ll)

(** Add a tag to a list of files. The tag syntax is checked before any CVS command is performed. @param f_confirm is a function taking a string and returning true or false if the user confirm or not the message. @raise Tag_error if the given tag is incorrect. @raise CvsFailure if the CVS command fails.*)

let tag_files f_confirm tag files =
  match files with
    [] -> ()
  | _ ->
      check_tag tag ;
      (* check if some of the given files already have this tag. *)
      (* if yes, then the user must confirm, because the revision number
         associated to the tag will change. *)

      let (ko, ok) = List.partition (file_has_tag tag) files in
      let continue =
        (ko = []) || f_confirm (Ocvs_messages.files_already_has_tag ko tag)
      in
      if continue then
        let parts = partition_files_by_dir files in
        let f_part (d,l) =
          let com = Printf.sprintf
              "cd %s; cvs tag -F -c %s %s"
              (Filename.quote d)
              tag
              (List.fold_left (fun acc -> fun f -> acc^" "^(Filename.quote f)^"""" l)
          in
          let n = Sys.command com in
          if n = 0 then
            ()
          else
            raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
        in
        List.iter f_part parts
      else
        ()

(** Add a tag to a directory. The tag syntax is checked before any CVS command is performed. @param f_confirm is a function taking a string and returning true or false if the user confirm or not the message. @raise Tag_error if the given tag is incorrect. @raise CvsFailure if the CVS command fails.*)

let tag_dir ?(recursive=true) f_confirm tag dir =
  check_tag tag ;
  (* check if some of the files in the directory or one of its subidrs
     already have this tag. *)

  (* if yes, then the user must confirm, because the revision number
     associated to the tag will change. *)

  let files = get_cvs_files dir in
  let (ko, ok) = List.partition (file_has_tag tag) files in
  let continue =
    (ko = []) || f_confirm (Ocvs_messages.files_already_has_tag ko tag)
  in
  if continue then
    let com = Printf.sprintf
      "cd %s ; cvs tag %s -F -c %s"
        (Filename.quote dir)
        (if recursive then "-R" else "-l")
        tag
    in
    let n = Sys.command com in
    if n = 0 then
      ()
    else
      raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
  else
    ()


(** Return the result string of the cvs log command for the given file handled by cvs.*)

let log file =
  let dir = Filename.dirname file in
  let f = Filename.basename file in
  let temp_file = Filename.temp_file "ocamlcvs" "log" in
  let com = Printf.sprintf "cd %s ; cvs log %s > %s"
      (Filename.quote dir)
      f
      temp_file
  in
  let n = Sys.command com in
  if n = 0 then
    (
     let s = input_file_as_string temp_file in
     delete_file temp_file ;
     s
    )
  else
    (
     delete_file temp_file ;
     raise (Ocvs_types.CvsFailure (Ocvs_messages.error_exec com))
    )