Blob Blame History Raw
(******************************************************************************)
(*  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
open FileUtilMisc
open FileUtilPWD
open FileUtilRM
open FileUtilCP
open FileUtilTEST


exception MvError of string

type mv_error =
  [ `Exc of exn
  | `MvCp of filename * filename * string * cp_error
  | `MvRm of  filename * string * rm_error
  | `NoSourceFile ]


let rec mv
      ?(error=fun str _ -> raise (MvError str))
      ?(force=Force)
      fln_src fln_dst =
  let handle_error, _ =
    handle_error_gen "mv" error
      (function
         | `NoSourceFile ->
             "Cannot move an empty list of files."
         | `MvCp (fn_src, fn_dst, str, _) ->
             Printf.sprintf
               "Recursive error in 'mv %s %s' for 'cp %s %s': %s"
               fn_src fn_dst fn_src fn_dst str
         | `MvRm (fn, str, _) ->
             Printf.sprintf "Recursive error in 'mv %s ..' for 'rm %s': %s"
               fn fn str
         | #exc -> "")
  in
  let fln_src_abs =  make_absolute (pwd ()) fln_src in
  let fln_dst_abs =  make_absolute (pwd ()) fln_dst in
  if compare fln_src_abs fln_dst_abs <> 0 then begin
    if test_exists fln_dst_abs && doit force fln_dst then begin
        rm [fln_dst_abs];
        mv fln_src_abs fln_dst_abs
    end else if test Is_dir fln_dst_abs then begin
      mv ~force ~error
        fln_src_abs
        (make_absolute
           fln_dst_abs
           (basename fln_src_abs))
    end else if test_exists fln_src_abs then begin
      try
        Sys.rename fln_src_abs fln_dst_abs
      with Sys_error _ ->
        cp ~force
          ~error:(fun str e ->
                    handle_error ~fatal:true
                      (`MvCp (fln_src_abs, fln_dst_abs, str, e)))
          ~recurse:true [fln_src_abs] fln_dst_abs;
        rm ~force
          ~error:(fun str e ->
                    handle_error ~fatal:true
                      (`MvRm (fln_src_abs, str, e)))
          ~recurse:true [fln_src_abs]
    end else
      handle_error ~fatal:true `NoSourceFile
  end