Source file stdcompat__filename.ml

include Filename

(*
let chop_suffix_opt ~suffix filename =
  let len_suffix = String.length suffix in
  let len_filename = String.length filename in
  if len_suffix <= len_filename then
    let len_base = len_filename - len_suffix in
    let filename_suffix = String.sub filename len_base len_suffix in
(*
    let filename_suffix, suffix =
        Stdcompat__string.lowercase_ascii filename_suffix,
        Stdcompat__string.lowercase_ascii suffix in
*)
    if filename_suffix = suffix then
      Some (String.sub filename 0 len_base)
    else
      None
  else
    None
*)


let chop_suffix filename suffix =
  match chop_suffix_opt ~suffix filename with
  | Some base -> base
  | None -> invalid_arg "Filename.chop_suffix"


(*
let temp_dir_name =
(*
  try Sys.getenv "TEMP"
  with Not_found -> "."
*)

  try Sys.getenv "TMPDIR"
  with Not_found -> "/tmp"

*)

(*
let current_temp_dir_name = ref temp_dir_name

let get_temp_dir_name () =
  !current_temp_dir_name

let set_temp_dir_name dir =
  current_temp_dir_name := dir
*)


let prng = lazy (Random.State.make_self_init ())

let temp_file_name temp_dir prefix suffix =
  let rnd = Random.State.bits (Lazy.force prng) land 0xFFFFFF in
  concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)

let rec try_name temp_dir prefix suffix counter f =
  let name = temp_file_name temp_dir prefix suffix in
  try
    name, f name
  with Sys_error _ as e ->
    if counter >= 1000 then
      raise e
    else
      try_name temp_dir prefix suffix (succ counter) f


(*
let open_temp_file ?(mode = [Open_text]) ?(perms = 0o600)
    ?(temp_dir = get_temp_dir_name ()) prefix suffix =
  try_name temp_dir prefix suffix 0 (fun name -> 
    open_out_gen (Open_wronly :: Open_creat :: Open_excl :: mode) perms name)
*)

(*
let temp_file ?(temp_dir = !current_temp_dir_name) prefix suffix =

  temp_file ~temp_dir prefix suffix

(*
  let name, out_channel = open_temp_file ~mode:[] ~temp_dir prefix suffix in
  close_out out_channel;
  name
*)
*)


let temp_dir
    ?(temp_dir = get_temp_dir_name ()) ?(perms = 0o600) prefix suffix =
  let name, () =
    try_name temp_dir prefix suffix 0 (fun name -> Stdcompat__sys.mkdir name perms) in
  name


(*
let dir_sep =
(*
  "\\"
*)

  "/"

*)

(*

let is_dir_sep c =
  c = '/'

(*
let is_dir_sep c =
  match c with
  | '/' | '\\' | ':' -> true
  | _ -> false
*)

let rec extension_start_from i s =
  if i < 0 then
    String.length s
  else
    let c = String.unsafe_get s i in
    if c = '.' then
      i
    else if is_dir_sep c then
      String.length s
    else
      extension_start_from (pred i) s

let extension_start s =
  extension_start_from (String.length s - 1) s

let extension s =
  let i = extension_start s in
  String.sub s i (String.length s - i)

let remove_extension s =
  let i = extension_start s in
  String.sub s 0 i
*)

(*
let null =
(*
  "NUL"
*)

   "/dev/null"


open Stdcompat__pervasives

let quote_redirections buffer quote_string stdin stdout stderr =
  stdin |> Stdcompat__option.iter (fun f ->
    Buffer.add_string buffer " <";
    quote_string buffer f);
  stdout |> Stdcompat__option.iter (fun f ->
    Buffer.add_string buffer " >";
    quote_string buffer f);
  stderr |> Stdcompat__option.iter (fun f ->
    if stderr = stdout then
      Buffer.add_string buffer " 2>&1"
    else (
        Buffer.add_string buffer " 2>";
        quote_string buffer f
     ))

(*
let quote_cmd buffer (s : string) =
  s |> String.iter (fun c ->
    (match c with
    | '(' | ')' | '!' | '^' | '%' | '\"' | '<' | '>' | '&' | '|' ->
        Buffer.add_char buffer '^'
    | _ ->
        ());
    Buffer.add_char buffer c)

let check_filename (filename : string) =
  let contains_space = ref false in
  filename |> String.iter (fun c ->
    match c with
    | '\"' | '%' ->
        failwith ("Filename.quote_command: bad file name " ^ filename)
    | ' ' ->
        contains_space := true
    | _ ->
        ());
  !contains_space

let quote s =
  let buffer = Buffer.create (String.length s + 20) in
  Buffer.add_char buffer '\"';
  let bs_count = ref 0 in
  let add_bs count =
    for _ = 1 to count do
      Buffer.add_char buffer '\\'
    done in
  s |> String.iter (fun c ->
    match c with
    | '\\' ->
        incr bs_count
    | '\"' ->
        add_bs (2 * !bs_count + 1);
        bs_count := 0;
        Buffer.add_char buffer '\"'
    | _ ->
        add_bs !bs_count;
        bs_count := 0;
        Buffer.add_char buffer c);
  Buffer.add_char buffer '\"';
  add_bs !bs_count;
  Buffer.contents buffer

let quote_cmd_filename buffer (filename : string) =
  if check_filename filename then (
    Buffer.add_char buffer '"';
    quote_cmd buffer filename;
    Buffer.add_char buffer '"')
  else
    Buffer.add_string buffer filename

let quote_command (command : string) ?(stdin : string option)
    ?(stdout : string option) ?(stderr : string option)
    (args : string list) : string =
  let buffer = Buffer.create 128 in
  Buffer.add_char buffer '\"';
  quote_cmd_filename buffer command;
  args |> List.iter (fun arg ->
    Buffer.add_char buffer ' ';
    quote_cmd buffer (quote arg));
  quote_redirections buffer quote_cmd_filename stdin stdout stderr;
  Buffer.add_char buffer '\"';
  Buffer.contents buffer
*)

let quote_string buffer (s : string) =
  Buffer.add_char buffer '\'';
  s |> String.iter (fun c ->
    match c with
    | '\'' ->
        Buffer.add_string buffer "'\\''"
    | _ ->
        Buffer.add_char buffer c);
  Buffer.add_char buffer '\''

let quote_command (command : string) ?(stdin : string option)
    ?(stdout : string option) ?(stderr : string option)
    (args : string list) : string =
  let buffer = Buffer.create 128 in
  quote_string buffer command;
  args |> List.iter (fun arg ->
    Buffer.add_char buffer ' ';
    quote_string buffer arg);
  quote_redirections buffer quote_string stdin stdout stderr;
  Buffer.contents buffer

*)