Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 256 lines (224 sloc) 8.391 kb
b3c9515 @mfp Added copyright and usage info, renamed git-home-history to gibak.
mfp authored
1 (* Copyright (C) 2008 Mauricio Fernandez <mfp@acm.org> http//eigenclass.org
2 * See README.txt and LICENSE for the redistribution and modification terms *)
3
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
4 open Util
5 open Unix
6
7 module type IGNORE =
8 sig
9 type t
10 val init : string -> t
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
11 val update : t -> base:string -> path:string -> t
f1a4fc9 @mfp Changed label in Folddir.IGNORE.is_ignored.
mfp authored
12 val is_ignored : ?debug:bool -> t -> string -> bool
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
13 end
14
15 let join a b = if a <> "" && b <> "" then a ^ "/" ^ b else a ^ b
16
554aaa3 @mfp New prune mechanism in Folddir.fold_directory.
mfp authored
17 type 'a fold_acc = Continue of 'a | Prune of 'a
18
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
19 module type S =
20 sig
21 type ignore_info
85a8cb0 @mfp Pass the Unix.stats to the function given to fold_directory.
mfp authored
22 val fold_directory :
cdd8a38 @mfp Added --sort, -s options to ometastore and find-git-files, find-git-repo...
mfp authored
23 ?debug:bool -> ?sorted:bool ->
24 ('a -> string -> Unix.stats -> 'a fold_acc) -> 'a ->
85a8cb0 @mfp Pass the Unix.stats to the function given to fold_directory.
mfp authored
25 string -> ?ign_info:ignore_info -> string -> 'a
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
26 end
27
28 module Make(M : IGNORE) : S with type ignore_info = M.t =
29 struct
30 type ignore_info = M.t
31
cdd8a38 @mfp Added --sort, -s options to ometastore and find-git-files, find-git-repo...
mfp authored
32 let rec fold_directory ?(debug=false) ?(sorted=false) f acc base
33 ?(ign_info = M.init base) path =
34 let readd d =
35 let l = ref [] in
36 try while true do l := readdir d :: !l done; assert false
37 with End_of_file -> !l in
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
38 let acc = ref acc in
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
39 let ign_info = M.update ign_info ~base ~path in
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
40 let dir = join base path in
41 try
42 do_finally (opendir dir) closedir
43 (fun d ->
cdd8a38 @mfp Added --sort, -s options to ometastore and find-git-files, find-git-repo...
mfp authored
44 List.iter
45 (function
46 "." | ".." -> ()
47 | n when M.is_ignored ~debug ign_info n -> ()
48 | n ->
49 let n = join path n in
50 let stat = lstat (join base n) in
51 match f !acc n stat with
52 | Continue x ->
53 acc := x;
54 if stat.st_kind = S_DIR then
55 acc := fold_directory ~debug ~sorted f ~ign_info
56 !acc base n
57 | Prune x -> acc := x)
58 (let l = readd d in if sorted then List.sort compare l else l));
3e8a398 @mfp Moved code to Folddir and Util, changed the functors.
mfp authored
59 !acc
60 with Unix.Unix_error _ -> !acc
61 end
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
62
63 module Ignore_none : IGNORE =
64 struct
65 type t = unit
66 let init _ = ()
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
67 let update () ~base ~path = ()
f1a4fc9 @mfp Changed label in Folddir.IGNORE.is_ignored.
mfp authored
68 let is_ignored ?debug () _ = false
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
69 end
70
71 module Gitignore : IGNORE =
72 struct
73 open Printf
74
75 type glob_type = Accept | Deny
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
76 (* Simple: no wildcards, no slash
77 * Simple_local: leading slash, otherwise no slashes, no wildcards
78 * Endswith: *.whatever, no slashes
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
79 * Endswith_local: *.whatever, leading slash only
80 * Startswith_local: whatever*, leading slash only
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
81 * Noslash: wildcards, no slashes
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
82 * Nowildcard: non-prefix slashes, no wildcards
83 * Complex: non-prefix slashes, wildcards
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
84 * *)
ea3108c @mfp Handle *.foo globs like git, with simple substring comparison.
mfp authored
85 type patt =
86 Simple of string | Noslash of string
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
87 | Complex of string | Simple_local of string
88 | Endswith of string | Endswith_local of string
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
89 | Startswith_local of string
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
90 | Nowildcard of string * int
11bbf42 @mfp Further glob matching optimization.
mfp authored
91 type glob = glob_type * patt
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
92 type t = (string * glob list) list
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
93
11bbf42 @mfp Further glob matching optimization.
mfp authored
94 external fnmatch : bool -> string -> string -> bool = "perform_fnmatch" "noalloc"
95
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
96 let string_of_patt = function
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
97 Simple s | Noslash s | Complex s | Nowildcard (s, _) -> s
68be4c3 @mfp Fixed pattern -> string conversion (only used in debug message).
mfp authored
98 | Simple_local s -> "/" ^ s
99 | Endswith s -> "*." ^ s
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
100 | Endswith_local s -> "/*." ^ s
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
101 | Startswith_local s -> "/" ^ s ^ "*"
11bbf42 @mfp Further glob matching optimization.
mfp authored
102
103 let has_wildcard s =
104 let rec loop s i max =
105 if i < max then
106 match String.unsafe_get s i with
107 '*' | '?' | '[' | '{' -> true
108 | _ -> loop s (i+1) max
109 else false
110 in loop s 0 (String.length s)
111
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
112 let suff1 s = String.sub s 1 (String.length s - 1)
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
113 let pref1 s = String.sub s 0 (String.length s - 1)
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
114
11bbf42 @mfp Further glob matching optimization.
mfp authored
115 let patt_of_string s =
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
116 try
117 match String.rindex s '/' with
118 0 ->
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
119 let s = suff1 s in
120 if not (has_wildcard s) then Simple_local s
121 else
122 let suff = suff1 s in
123 if s.[0] = '*' && not (has_wildcard suff) then
124 Endswith_local suff
125 else
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
126 let pref = pref1 s in
127 if s.[String.length s - 1] = '*' && not (has_wildcard pref) then
128 Startswith_local pref
129 else
130 Complex s
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
131 | _ ->
132 if not (has_wildcard s) then
133 let l = String.length s in
134 Nowildcard (s, if s.[0] = '/' then l - 1 else l)
135 else
136 Complex s
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
137 with Not_found ->
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
138 let suff = suff1 s in
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
139 if s.[0] = '*' && not (has_wildcard suff) then
140 Endswith suff
141 else if has_wildcard s then
142 Noslash s
143 else
144 Simple s
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
145
146 let glob_of_string s = match s.[0] with
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
147 '!' -> (Accept, (patt_of_string (suff1 s)))
11bbf42 @mfp Further glob matching optimization.
mfp authored
148 | _ -> (Deny, patt_of_string s)
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
149
150 let collect_globs l =
151 let rec aux acc = function
152 [] -> acc
153 | line::tl ->
154 if line = "" || line.[0] = '#' then aux acc tl
155 else aux (glob_of_string line :: acc) tl
156 in aux [] l
157
158 let read_gitignore path =
159 try
160 collect_globs
161 (do_finally (open_in (join path ".gitignore")) close_in
162 (fun is ->
163 let l = ref [] in
164 try
165 while true do
166 l := input_line is :: !l
167 done;
168 assert false
169 with End_of_file -> !l) )
170 with Sys_error _ -> []
171
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
172 let init path = []
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
173
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
174 let update t ~base ~path =
8a1ea8b @mfp Remove local globs from the ignore info of the parent in Gitignore.updat...
mfp authored
175 let rec remove_local = function
176 [] -> []
177 | ((_, (Simple _ | Noslash _ | Complex _ | Endswith _ | Nowildcard _)) as x)::tl ->
178 x :: remove_local tl
179 | (_, (Simple_local _ | Endswith_local _ | Startswith_local _))::tl ->
180 remove_local tl in
181 let t = match t with
182 (f, l)::tl -> (f, remove_local l)::tl
183 | [] -> []
184 in (Filename.basename path, read_gitignore (join base path)) :: t
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
185
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
186 type path = { basename : string; length : int; full_name : string Lazy.t }
be88e74 @mfp Some glob matching optimization in Gitignore.
mfp authored
187
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
188 let path_of_string s = { basename = s; length = String.length s; full_name = lazy s }
31bb84b @mfp Use lazy evaluation to avoid repeated full_name generation.
mfp authored
189
190 let string_of_path p = Lazy.force p.full_name
191
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
192 let path_length p = p.length
193
31bb84b @mfp Use lazy evaluation to avoid repeated full_name generation.
mfp authored
194 let push pref p =
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
195 { basename = p.basename; length = p.length + 1 + String.length pref;
31bb84b @mfp Use lazy evaluation to avoid repeated full_name generation.
mfp authored
196 full_name = lazy (String.concat "/" [pref; string_of_path p]) }
197
198 let basename p = p.basename
be88e74 @mfp Some glob matching optimization in Gitignore.
mfp authored
199
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
200 let check_ending suff path =
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
201 let fname = basename path in
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
202 let l1 = String.length suff in
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
203 let l2 = String.length fname in
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
204 if l2 < l1 then false else strneq l1 suff 0 fname (l2 - l1)
205
206 let check_start pref path =
207 let fname = basename path in
208 let l1 = String.length pref in
209 let l2 = String.length fname in
210 if l2 < l1 then false else
211 strneq l1 pref 0 fname 0
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
212
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
213 let glob_matches local patt path = match patt with
11bbf42 @mfp Further glob matching optimization.
mfp authored
214 Simple s -> s = basename path
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
215 | Simple_local s -> if local then s = basename path else false
359c139 @mfp Optimized /*.foo glob matching.
mfp authored
216 | Endswith s -> check_ending s path
217 | Endswith_local s -> if local then check_ending s path else false
c0c2a1f @mfp Optimize /whatever* glob matching (Startswith_local).
mfp authored
218 | Startswith_local s -> if local then check_start s path else false
11bbf42 @mfp Further glob matching optimization.
mfp authored
219 | Noslash s -> fnmatch false s (basename path)
220 | Complex s -> fnmatch true s (string_of_path path)
ae6332c @mfp Optimize globs with non-leading slashes (e.g., Mail/spam).
mfp authored
221 | Nowildcard (s, l) ->
222 if l = path_length path then
223 fnmatch true s (string_of_path path)
224 else false
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
225
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
226 let path_of_ign_info t = String.concat "/" (List.rev (List.map fst t))
227
f1a4fc9 @mfp Changed label in Folddir.IGNORE.is_ignored.
mfp authored
228 let is_ignored ?(debug=false) t fname =
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
229 let rec aux local path = function
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
230 | [] -> false
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
231 | (dname, globs)::tl as t ->
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
232 let ign = List.fold_left
11bbf42 @mfp Further glob matching optimization.
mfp authored
233 (fun s (ty, patt) ->
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
234 if glob_matches local patt path then
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
235 (match ty with
236 Accept ->
68f8162 @mfp Better debugging info for Gitignore.
mfp authored
237 if debug then
be88e74 @mfp Some glob matching optimization in Gitignore.
mfp authored
238 eprintf "ACCEPT %S (matched %S) at %S\n"
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
239 (string_of_path path) (string_of_patt patt)
240 (path_of_ign_info t);
44e69ff @mfp Avoid some allocation in is_ignored.
mfp authored
241 `Kept
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
242 | Deny ->
68f8162 @mfp Better debugging info for Gitignore.
mfp authored
243 if debug then
be88e74 @mfp Some glob matching optimization in Gitignore.
mfp authored
244 eprintf "DENY %S (matched %S) at %S\n"
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
245 (string_of_path path) (string_of_patt patt)
246 (path_of_ign_info t);
44e69ff @mfp Avoid some allocation in is_ignored.
mfp authored
247 `Ignored)
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
248 else s)
44e69ff @mfp Avoid some allocation in is_ignored.
mfp authored
249 `Dontknow globs
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
250 in match ign with
c126cfa @mfp Optimize glob matching for "/foo" patterns.
mfp authored
251 | `Dontknow -> aux false (push dname path) tl
44e69ff @mfp Avoid some allocation in is_ignored.
mfp authored
252 | `Ignored -> true
253 | `Kept -> false
2b4dad7 @mfp Changed IGNORE.update signature, simplified Gitignore's t type.
mfp authored
254 in fname = ".git" || aux true (path_of_string fname) t
be20c54 @mfp Move Gitignore and Ignore_none to Folddir, verbose opt for fold_director...
mfp authored
255 end
Something went wrong with that request. Please try again.