(******************************************************************************)
(* ocaml-fileutils: files and filenames common operations *)
(* *)
(* Copyright (C) 2003-2014, Sylvain Le Gall *)
(* *)
(* This library is free software; you can redistribute it and/or modify it *)
(* under the terms of the GNU Lesser General Public License as published by *)
(* the Free Software Foundation; either version 2.1 of the License, or (at *)
(* your option) any later version, with the OCaml static compilation *)
(* exception. *)
(* *)
(* This library 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 file *)
(* COPYING for more details. *)
(* *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this library; if not, write to the Free Software Foundation, *)
(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *)
(******************************************************************************)
open FileUtilTypes
open FilePath
module SetFilename = Set.Make (struct
type t = filename
let compare = FilePath.compare
end)
let doit force fln =
match force with
Force -> true
| Ask ask -> ask fln
let prevent_recursion fln_set fln =
(* TODO: use a set of dev/inode *)
if SetFilename.mem fln fln_set then
raise (RecursiveLink fln)
else
SetFilename.add fln fln_set
let solve_dirname dirname =
(* We have an ambiguity concerning "" and "." *)
if is_current dirname then
current_dir
else
reduce dirname
type exc = [ `Exc of exn ]
let handle_error_gen nm error custom =
let handle_error ~fatal e =
let str =
match e with
| `Exc (Unix.Unix_error(err, nm, arg)) ->
Printf.sprintf "%s: %s (%s, %S)" nm (Unix.error_message err) nm arg
| `Exc exc ->
Printf.sprintf "%s: %s" nm (Printexc.to_string exc)
| e -> custom e
in
if fatal then begin
try
error str e;
raise (Fatal str)
with exc ->
raise exc
end else begin
error str e
end
in
let handle_exception ~fatal exc =
handle_error ~fatal (`Exc exc)
in
handle_error, handle_exception