Blame src/FileUtilMV.ml

Packit 9ff65e
(******************************************************************************)
Packit 9ff65e
(*  ocaml-fileutils: files and filenames common operations                    *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  Copyright (C) 2003-2014, Sylvain Le Gall                                  *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  This library is free software; you can redistribute it and/or modify it   *)
Packit 9ff65e
(*  under the terms of the GNU Lesser General Public License as published by  *)
Packit 9ff65e
(*  the Free Software Foundation; either version 2.1 of the License, or (at   *)
Packit 9ff65e
(*  your option) any later version, with the OCaml static compilation         *)
Packit 9ff65e
(*  exception.                                                                *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  This library is distributed in the hope that it will be useful, but       *)
Packit 9ff65e
(*  WITHOUT ANY WARRANTY; without even the implied warranty of                *)
Packit 9ff65e
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file         *)
Packit 9ff65e
(*  COPYING for more details.                                                 *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  You should have received a copy of the GNU Lesser General Public License  *)
Packit 9ff65e
(*  along with this library; if not, write to the Free Software Foundation,   *)
Packit 9ff65e
(*  Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA             *)
Packit 9ff65e
(******************************************************************************)
Packit 9ff65e
Packit 9ff65e
open FileUtilTypes
Packit 9ff65e
open FilePath
Packit 9ff65e
open FileUtilMisc
Packit 9ff65e
open FileUtilPWD
Packit 9ff65e
open FileUtilRM
Packit 9ff65e
open FileUtilCP
Packit 9ff65e
open FileUtilTEST
Packit 9ff65e
Packit 9ff65e
Packit 9ff65e
exception MvError of string
Packit 9ff65e
Packit 9ff65e
type mv_error =
Packit 9ff65e
  [ `Exc of exn
Packit 9ff65e
  | `MvCp of filename * filename * string * cp_error
Packit 9ff65e
  | `MvRm of  filename * string * rm_error
Packit 9ff65e
  | `NoSourceFile ]
Packit 9ff65e
Packit 9ff65e
Packit 9ff65e
let rec mv
Packit 9ff65e
      ?(error=fun str _ -> raise (MvError str))
Packit 9ff65e
      ?(force=Force)
Packit 9ff65e
      fln_src fln_dst =
Packit 9ff65e
  let handle_error, _ =
Packit 9ff65e
    handle_error_gen "mv" error
Packit 9ff65e
      (function
Packit 9ff65e
         | `NoSourceFile ->
Packit 9ff65e
             "Cannot move an empty list of files."
Packit 9ff65e
         | `MvCp (fn_src, fn_dst, str, _) ->
Packit 9ff65e
             Printf.sprintf
Packit 9ff65e
               "Recursive error in 'mv %s %s' for 'cp %s %s': %s"
Packit 9ff65e
               fn_src fn_dst fn_src fn_dst str
Packit 9ff65e
         | `MvRm (fn, str, _) ->
Packit 9ff65e
             Printf.sprintf "Recursive error in 'mv %s ..' for 'rm %s': %s"
Packit 9ff65e
               fn fn str
Packit 9ff65e
         | #exc -> "")
Packit 9ff65e
  in
Packit 9ff65e
  let fln_src_abs =  make_absolute (pwd ()) fln_src in
Packit 9ff65e
  let fln_dst_abs =  make_absolute (pwd ()) fln_dst in
Packit 9ff65e
  if compare fln_src_abs fln_dst_abs <> 0 then begin
Packit 9ff65e
    if test_exists fln_dst_abs && doit force fln_dst then begin
Packit 9ff65e
        rm [fln_dst_abs];
Packit 9ff65e
        mv fln_src_abs fln_dst_abs
Packit 9ff65e
    end else if test Is_dir fln_dst_abs then begin
Packit 9ff65e
      mv ~force ~error
Packit 9ff65e
        fln_src_abs
Packit 9ff65e
        (make_absolute
Packit 9ff65e
           fln_dst_abs
Packit 9ff65e
           (basename fln_src_abs))
Packit 9ff65e
    end else if test_exists fln_src_abs then begin
Packit 9ff65e
      try
Packit 9ff65e
        Sys.rename fln_src_abs fln_dst_abs
Packit 9ff65e
      with Sys_error _ ->
Packit 9ff65e
        cp ~force
Packit 9ff65e
          ~error:(fun str e ->
Packit 9ff65e
                    handle_error ~fatal:true
Packit 9ff65e
                      (`MvCp (fln_src_abs, fln_dst_abs, str, e)))
Packit 9ff65e
          ~recurse:true [fln_src_abs] fln_dst_abs;
Packit 9ff65e
        rm ~force
Packit 9ff65e
          ~error:(fun str e ->
Packit 9ff65e
                    handle_error ~fatal:true
Packit 9ff65e
                      (`MvRm (fln_src_abs, str, e)))
Packit 9ff65e
          ~recurse:true [fln_src_abs]
Packit 9ff65e
    end else
Packit 9ff65e
      handle_error ~fatal:true `NoSourceFile
Packit 9ff65e
  end
Packit 9ff65e