Note:

You are viewing a development version of the library. Goto the latest version.

let cp ?(follow=Skip) ?(force=Force) ?(recurse=false) fln_src_lst fln_dst = 
  let cpfile fln_src fln_dst =
    let cpfile () = 
      let buffer_len = 1024
      in
      let buffer = String.make buffer_len ' '
      in
      let read_len = ref 0
      in
      let ch_in = open_in_bin fln_src
      in
      let ch_out = open_out_bin fln_dst
      in
      while (read_len := input ch_in buffer 0 buffer_len; !read_len <> 0) do
        output ch_out buffer 0 !read_len
      done;
      close_in ch_in;
      close_out ch_out
    in
    let st = stat fln_src
    in
    match st.kind with
      File -> 
       cpfile ()
    | Dir ->
      mkdir fln_dst
    | Fifo 
    | Dev_char 
    | Dev_block
    | Socket ->
      raise (CpCannotCopy fln_src)
  in
  let cpfull dir_src dir_dst fln = 
    find (And(Custom(doit force), Is_dir)) fln (
      fun () fln_src -> cpfile fln_src (reparent dir_src dir_dst fln)
     ) ();
    find (And(Custom(doit force), Not(Is_dir))) fln (
      fun () fln_src -> cpfile fln_src (reparent dir_src dir_dst fln)
     ) ()
  in
  (* Test sur l'existence des fichiers source et création des noms de fichiers
     absolu 
   *)

  let real_fln_src_lst = 
    List.map (
      fun x -> 
        if test (Not(Exists)) x then 
          raise (CpNoSourceFile x) 
        else if test Is_dir x && not recurse then
          raise (CpCannotCopyDir x)
        else
          make_absolute (pwd ()) x
     ) 
    fln_src_lst
  in
  let real_fln_dst =
    make_absolute (pwd ()) fln_dst
  in
  if test Is_dir real_fln_dst then
    List.iter (fun x -> cpfull (dirname x) real_fln_dst x) real_fln_src_lst
  else 
    (
      if (List.length real_fln_src_lst) = 1 then
        let real_fln_src = List.nth real_fln_src_lst 0
        in
        cpfull real_fln_src real_fln_dst real_fln_src 
        (* Off course, reparent will replace the common prefix 
        * of 3rd arg and 1st arg by 2nd arg, which give 
        * fln_src -> fln_dst *)

      else
        raise (CpCannotCopyFilesToFile (real_fln_src_lst, real_fln_dst))
   )