1 (***********************************************************************)
4 (* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
6 (* Copyright 2007 Institut National de Recherche en Informatique et *)
7 (* en Automatique. All rights reserved. This file is distributed *)
8 (* under the terms of the Q Public License version 1.0. *)
10 (***********************************************************************)
13 (* Original author: Nicolas Pouillard *)
16 let is_simple_filename s
=
17 let ls = String.length s
in
20 if pos
>= ls then true else
22 | 'a'
..'z'
| 'A'
..'Z'
| '
0'
..'
9'
| '
.'
| '
-'
| '
/'
| '_'
| '
:'
| '
@'
| '
+'
| '
,'
-> loop (pos
+ 1)
25 let quote_filename_if_needed s
=
26 if is_simple_filename s
then s
else Filename.quote s
28 reset_filesys_cache
();
31 reset_readdir_cache
();
32 let cmd = String.concat
" " (List.map
quote_filename_if_needed args
) in
33 if !*My_unix.is_degraded
|| Sys.os_type
= "Win32" then
35 Log.event
cmd target
Tags.empty
;
36 let st = sys_command
cmd in
38 failwith
(Printf.sprintf
"Error during command `%s'.\nExit code %d.\n" cmd st)
43 match My_unix.execute_many ~ticker
:Log.update ~display
:Log.display
[[(fun () -> cmd)]] with
46 failwith
(Printf.sprintf
"Error during command %S: %s" cmd (Printexc.to_string x
))
49 if sys_file_exists x
then rm x
51 reset_filesys_cache_for_file dir
;
52 (*Sys.mkdir dir (* MISSING in ocaml *) *)
53 run ["mkdir"; dir
] dir
54 let try_mkdir dir
= if not
(sys_file_exists dir
) then mkdir dir
56 if sys_file_exists dir
then ()
57 else (mkdir_p (Filename.dirname dir
); mkdir dir
)
60 reset_filesys_cache_for_file dest
;
61 run["cp";"-pf";src
;dest
] dest
63 (* L'Arrêté du 2007-03-07 prend en consideration
64 differement les archives. Pour les autres fichiers
65 le décret du 2007-02-01 est toujours valable :-) *)
67 if Filename.check_suffix src
".a"
68 && Filename.check_suffix dst
".a"
70 else copy_file src dst
72 let readlink = My_unix.readlink
73 let is_link = My_unix.is_link
75 reset_filesys_cache
();
78 reset_filesys_cache_for_file src
;
79 reset_filesys_cache_for_file dest
;
80 run["mv"; src
; dest
] dest
81 (*Sys.rename src dest*)