(****************************************************************************)
(*                           the diy toolsuite                              *)
(*                                                                          *)
    , University College London , UK .                             
    , INRIA Paris - Rocquencourt , France .                          
(*                                                                          *)
  Copyright 2010 - present Institut National de Recherche en Informatique et
(* en Automatique and the authors. All rights reserved.                     *)
(*                                                                          *)
  This software is governed by the CeCILL - B license under French law and   
(* abiding by the rules of distribution of free software. You can use,      *)
  modify and/ or redistribute the software under the terms of the CeCILL - B
  license as circulated by CEA , CNRS and INRIA at the following URL        
  "  " . We also give a copy in LICENSE.txt .            
(****************************************************************************)

(* Beware, this file is litmus/gen.new common, change with caution *)

open Printf

module type Option = sig
  val verbose : int
(* Output name *)
  val outname : string option
end

module type S = sig
(* Gives actual output name, ie add path to directory where the file is created *)
  val outname : string -> string

(* Build archive or not *)
  val is_archive : bool

(* Returns z if O.outname is *.tgz or empty string otherwise *)
  val tarz : unit -> string

(* Produce final tar archive (and remove temporary directory) *)
  val tar : unit -> unit

(* 'tar_dir dir' Similar, but archive contains top directory 'dir' *)
dir
end

module Make(O:Option) : S =
  struct

    type style = Dir | Tar | TarGz

    let arg = match O.outname with
    | None -> Filename.current_dir_name
    | Some n -> n

    let style =
      if Filename.check_suffix arg ".tgz" then TarGz
      else if Filename.check_suffix arg ".tar" then Tar
      else Dir

    let is_archive = match style with
    | Dir -> false
    | Tar|TarGz -> true

(* Limited system interface *)

    let command cmd =
      if O.verbose > 1 then begin
        eprintf "Exec: %s -> %!" cmd
      end ;
      let r = Sys.command cmd in
      if O.verbose > 1 then begin
        eprintf "%i\n%!" r
      end ;
      r

    let exec cmd = match command cmd with
    | 0 -> ()
    | _ -> Warn.fatal "Exec of '%s' failed" cmd

    let rmdir name = exec (sprintf "/bin/rm -rf %s" name)
    let mkdir name = exec (sprintf "/bin/rm -rf %s && mkdir %s" name name)
    let direxists name = Sys.file_exists name && Sys.is_directory name

(************)
(* Let's go *)
(************)

    let mk_temp_dir () =
      let name = Filename.temp_file  "dir" ".tmp" in
      mkdir name ;
      name

    let out_dir = match style with
    | Dir ->
        if direxists arg then
          arg
        else
          Warn.fatal "directory %s does not exist"  arg
    | Tar|TarGz -> mk_temp_dir ()


    let outname name = Filename.concat out_dir name

    let tarz () =  match style with
    | TarGz -> "z"
    | Tar|Dir -> ""


    let exec_tar2 dir1 dir2 tar =
      let z = tarz () in
      exec
        (sprintf "( cd %s && tar c%sf - %s ) > %s" dir1 z dir2 tar)

    let exec_tar dir tar = exec_tar2 dir "." tar

    let tar () = match style with
    | Tar|TarGz ->
        let dir = out_dir in
        exec_tar dir arg ;
        rmdir dir
    | Dir -> ()


    let tar_dir dir =
      let tar = arg in
      let up = Filename.dirname dir
      and name =  Filename.basename dir in
      exec_tar2 up name tar ;
      rmdir up
  end

**************************************************************************
                           the diy toolsuite                              
                                                                          
                                                                          
 en Automatique and the authors. All rights reserved.                     
                                                                          
 abiding by the rules of distribution of free software. You can use,      
**************************************************************************
 Beware, this file is litmus/gen.new common, change with caution 
 Output name 
 Gives actual output name, ie add path to directory where the file is created 
 Build archive or not 
 Returns z if O.outname is *.tgz or empty string otherwise 
 Produce final tar archive (and remove temporary directory) 
 'tar_dir dir' Similar, but archive contains top directory 'dir' 
 Limited system interface 
**********
 Let's go 
**********
    , University College London , UK .                             
    , INRIA Paris - Rocquencourt , France .                          
  Copyright 2010 - present Institut National de Recherche en Informatique et
  This software is governed by the CeCILL - B license under French law and   
  modify and/ or redistribute the software under the terms of the CeCILL - B
  license as circulated by CEA , CNRS and INRIA at the following URL        
  "  " . We also give a copy in LICENSE.txt .            


open Printf

module type Option = sig
  val verbose : int
  val outname : string option
end

module type S = sig
  val outname : string -> string

  val is_archive : bool

  val tarz : unit -> string

  val tar : unit -> unit

dir
end

module Make(O:Option) : S =
  struct

    type style = Dir | Tar | TarGz

    let arg = match O.outname with
    | None -> Filename.current_dir_name
    | Some n -> n

    let style =
      if Filename.check_suffix arg ".tgz" then TarGz
      else if Filename.check_suffix arg ".tar" then Tar
      else Dir

    let is_archive = match style with
    | Dir -> false
    | Tar|TarGz -> true


    let command cmd =
      if O.verbose > 1 then begin
        eprintf "Exec: %s -> %!" cmd
      end ;
      let r = Sys.command cmd in
      if O.verbose > 1 then begin
        eprintf "%i\n%!" r
      end ;
      r

    let exec cmd = match command cmd with
    | 0 -> ()
    | _ -> Warn.fatal "Exec of '%s' failed" cmd

    let rmdir name = exec (sprintf "/bin/rm -rf %s" name)
    let mkdir name = exec (sprintf "/bin/rm -rf %s && mkdir %s" name name)
    let direxists name = Sys.file_exists name && Sys.is_directory name


    let mk_temp_dir () =
      let name = Filename.temp_file  "dir" ".tmp" in
      mkdir name ;
      name

    let out_dir = match style with
    | Dir ->
        if direxists arg then
          arg
        else
          Warn.fatal "directory %s does not exist"  arg
    | Tar|TarGz -> mk_temp_dir ()


    let outname name = Filename.concat out_dir name

    let tarz () =  match style with
    | TarGz -> "z"
    | Tar|Dir -> ""


    let exec_tar2 dir1 dir2 tar =
      let z = tarz () in
      exec
        (sprintf "( cd %s && tar c%sf - %s ) > %s" dir1 z dir2 tar)

    let exec_tar dir tar = exec_tar2 dir "." tar

    let tar () = match style with
    | Tar|TarGz ->
        let dir = out_dir in
        exec_tar dir arg ;
        rmdir dir
    | Dir -> ()


    let tar_dir dir =
      let tar = arg in
      let up = Filename.dirname dir
      and name =  Filename.basename dir in
      exec_tar2 up name tar ;
      rmdir up
  end
