blob: 2275acd1b15449f3291c77b16b8d4e4d655fbe8c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
(* $Id$ *)
open Unix
type unix_path = string (* path in unix-style, with '/' separator *)
type file_kind =
| FileDir of unix_path * (* basename of path: *) string
| FileRegular of string (* basename of file *)
(* Copy of Filename.concat but assuming paths to always be POSIX *)
let (//) dirname filename =
let l = String.length dirname in
if l = 0 || dirname.[l-1] = '/'
then dirname ^ filename
else dirname ^ "/" ^ filename
(* Excluding directories; We avoid directories starting with . as well
as CVS and _darcs and any subdirs given via -exclude-dir *)
let skipped_dirnames = ref ["CVS"; "_darcs"]
let exclude_directory f = skipped_dirnames := f :: !skipped_dirnames
let ok_dirname f =
not (f = "") && f.[0] != '.' &&
not (List.mem f !skipped_dirnames) (*&&
(match Unicode.ident_refutation f with None -> true | _ -> false)*)
(* Check directory can be opened *)
let exists_dir dir =
try let _ = closedir (opendir dir) in true with Unix_error _ -> false
let check_unix_dir warn dir =
if (Sys.os_type = "Win32" || Sys.os_type = "Cygwin") &&
(String.length dir > 2 && dir.[1] = ':' ||
String.contains dir '\\' ||
String.contains dir ';')
then warn ("assuming " ^ dir ^
" to be a Unix path even if looking like a Win32 path.")
let apply_subdir f path name =
(* we avoid all files and subdirs starting by '.' (e.g. .svn) *)
(* as well as skipped files like CVS, ... *)
if name.[0] <> '.' && ok_dirname name then
let path = if path = "." then name else path//name in
match try (stat path).st_kind with Unix_error _ -> S_BLK with
| S_DIR -> f (FileDir (path,name))
| S_REG -> f (FileRegular name)
| _ -> ()
let process_directory f path =
let dirh = opendir path in
try while true do apply_subdir f path (readdir dirh) done
with End_of_file -> closedir dirh
let process_subdirectories f path =
let f = function FileDir (path,base) -> f path base | FileRegular _ -> () in
process_directory f path
|
