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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380 | -- --------------------------------------------------------------------
-- util-files-walk -- Walk directory trees
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
-- SPDX-License-Identifier: Apache-2.0
-----------------------------------------------------------------------
with Ada.Exceptions;
with Ada.Directories.Hierarchical_File_Names;
with Util.Log.Loggers;
with GNAT.Regexp;
package body Util.Files.Walk is
package AD renames Ada.Directories;
Log : constant Util.Log.Loggers.Logger :=
Util.Log.Loggers.Create ("Util.Files.Walk");
-- ------------------------------
-- Add a new pattern to include files or directories in the walk.
-- ------------------------------
procedure Include (Filter : in out Filter_Type;
Pattern : in String) is
begin
if Pattern (Pattern'First) = '/' then
Filter.Insert (Pattern => Pattern (Pattern'First + 1 .. Pattern'Last),
Recursive => False,
Value => Included);
else
Filter.Insert (Pattern => Pattern,
Recursive => True,
Value => Included);
end if;
end Include;
-- ------------------------------
-- Add a new pattern to exclude (ignore) files or directories in the walk.
-- ------------------------------
procedure Exclude (Filter : in out Filter_Type;
Pattern : in String) is
begin
if Pattern (Pattern'First) = '/' then
Filter.Insert (Pattern => Pattern (Pattern'First + 1 .. Pattern'Last),
Recursive => False,
Value => Excluded);
else
Filter.Insert (Pattern => Pattern,
Recursive => True,
Value => Excluded);
end if;
end Exclude;
-- ------------------------------
-- Check if a path matches the included or excluded patterns.
-- ------------------------------
function Match (Filter : in Filter_Type;
Path : in String) return Filter_Mode is
Result : constant Path_Filter.Filter_Result := Filter.Match (Path);
begin
if Result.Match = Path_Filter.Not_Found then
return Not_Found;
elsif Result.Match = Path_Filter.No_Value then
return Not_Found;
else
return Path_Filter.Get_Value (Result);
end if;
end Match;
-- ------------------------------
-- Get the path of a file that can be read to get a list of files to ignore
-- in the given directory (ie, .gitignore).
-- ------------------------------
function Get_Ignore_Path (Walker : Walker_Type;
Path : String) return String is
pragma Unreferenced (Walker, Path);
begin
return "";
end Get_Ignore_Path;
-- ------------------------------
-- Returns true if the path corresponds to a root path for a project:
-- The default returns True.
-- ------------------------------
function Is_Root (Walker : in Walker_Type;
Path : in String) return Boolean is
begin
return True;
end Is_Root;
-- ------------------------------
-- Find the root directory of a project knowing a path of a file or
-- directory of that project. Move up to parent directories until
-- a path returns true when `Is_Root` is called.
-- ------------------------------
function Find_Root (Walker : in Walker_Type;
Path : in String) return String is
function Is_Root_Directory_Name (Path : in String) return Boolean
renames AD.Hierarchical_File_Names.Is_Root_Directory_Name;
Real_Path : constant String := Util.Files.Realpath (Path);
Pos : Natural := Real_Path'Last;
begin
while not Walker_Type'Class (Walker).Is_Root (Real_Path (Real_Path'First .. Pos)) loop
if Is_Root_Directory_Name (Real_Path (Real_Path'First .. Pos)) then
return Real_Path;
end if;
declare
Parent : constant String :=
AD.Containing_Directory (Real_Path (Real_Path'First .. Pos));
begin
if Parent'Length = 0 then
return Real_Path;
end if;
Pos := Real_Path'First + Parent'Length - 1;
end;
end loop;
return Real_Path (Real_Path'First .. Pos);
end Find_Root;
-- ------------------------------
-- Scan the directory tree given by the path for files and sub-directories
-- matching the filters:
-- * it calls `Get_Ignore_Path` to get an optional path of files to read
-- for patterns to ignore,
-- * if that file exist, it calls `Load_Ignore` in a local filter and
-- loads the patterns in the filter.
-- * it scans the directory for files and sub-directories matching the
-- filters (either defined by the loaded ignored files) or by the main
-- filter.
-- * when files are found and are not excluded, it calls `Scan_File`,
-- * when sub-directories are found and are not excluded, it calls
-- `Scan_Directory`.
-- ------------------------------
procedure Scan (Walker : in out Walker_Type;
Path : in String;
Filter : in Filter_Type'Class) is
Dir : constant String := Util.Files.Realpath (Path);
Root : constant String := Walker_Type'Class (Walker).Find_Root (Dir);
Rel_Path : constant String := Util.Files.Get_Relative_Path (Root, Dir);
Dir_Context : constant Filter_Context_Type := Filter.Create;
begin
Log.Debug ("Scanning {0}", Path);
Walker_Type'Class (Walker).Scan_Subdir_For_Ignore
(Root, Path, (if Rel_Path = "." then "" else Rel_Path), 0, Dir_Context);
end Scan;
procedure Scan_Subdir_For_Ignore (Walker : in out Walker_Type;
Path : in String;
Scan_Path : in String;
Rel_Path : in String;
Level : in Natural;
Filter : in Filter_Context_Type) is
Sep : constant Natural := Path_Component_Position (Rel_Path);
Child_Dir : constant String := Compose (Path, Rel_Path (Rel_Path'First .. Sep));
Ignore_File : constant String := Walker_Type'Class (Walker).Get_Ignore_Path (Path);
Local_Filter : Filter_Type;
begin
if Ignore_File'Length > 0 and then Ada.Directories.Exists (Ignore_File) then
Walker_Type'Class (Walker).Load_Ignore (Ignore_File, Local_Filter);
declare
Dir_Context : constant Filter_Context_Type
:= Local_Filter.Create (Filter);
begin
if Sep < Rel_Path'Last then
Walker_Type'Class (Walker).Scan_Subdir_For_Ignore
(Child_Dir, Scan_Path,
Rel_Path (Sep + 1 .. Rel_Path'Last),
Level + 1,
Dir_Context);
else
-- Reached end of relative path to load ignore files, scan from the Scan_Path now.
Walker_Type'Class (Walker).Scan_Directory (Scan_Path, Dir_Context);
end if;
end;
else
declare
Dir_Context : constant Filter_Context_Type
:= Path_Filter.Create (Filter);
begin
if Sep < Rel_Path'Last then
Walker_Type'Class (Walker).Scan_Subdir_For_Ignore
(Child_Dir, Scan_Path,
Rel_Path (Sep + 1 .. Rel_Path'Last),
Level + 1,
Dir_Context);
else
-- Reached end of relative path to load ignore files, scan from the Scan_Path now.
Walker_Type'Class (Walker).Scan_Directory (Scan_Path, Dir_Context);
end if;
end;
end if;
end Scan_Subdir_For_Ignore;
procedure Scan_Subdir (Walker : in out Walker_Type;
Path : in String;
Filter : in Filter_Context_Type;
Match : in Filter_Result) is
Ignore_File : constant String
:= Walker_Type'Class (Walker).Get_Ignore_Path (Path);
begin
Log.Debug ("Scanning {0}", Path);
if Ignore_File'Length > 0
and then Ada.Directories.Exists (Ignore_File)
then
declare
Local_Filter : Filter_Type;
begin
Walker_Type'Class (Walker).Load_Ignore (Ignore_File, Local_Filter);
declare
Dir_Context : constant Filter_Context_Type
:= Local_Filter.Create (Filter);
begin
Walker_Type'Class (Walker).Scan_Directory (Path,
Dir_Context);
end;
end;
elsif Match.Match /= Not_Found then
declare
Dir_Context : constant Filter_Context_Type
:= Path_Filter.Create (Filter, Match);
begin
Walker_Type'Class (Walker).Scan_Directory (Path,
Dir_Context);
end;
else
declare
Dir_Context : constant Filter_Context_Type
:= Path_Filter.Create (Filter);
begin
Walker_Type'Class (Walker).Scan_Directory (Path,
Dir_Context);
end;
end if;
end Scan_Subdir;
-- ------------------------------
-- Load a series of lines that contains a list of files to ignore.
-- The `Reader` procedure is called with a `Process` procedure that is
-- expected to be called for each line which comes from the ignore
-- file (such as the .gitignore file). The `Process` procedure handles
-- the interpretation of ignore patterns as defined by `.gitignore`
-- and it updates the `Filter` accordingly.
-- ------------------------------
procedure Load_Ignore (Filter : in out Filter_Type'Class;
Label : in String;
Reader : not null access
procedure (Process : not null access
procedure (Line : in String))) is
procedure Process (Line : String);
Line_Number : Natural := 0;
procedure Process (Line : String) is
Last : Natural;
Negative : Boolean;
begin
Line_Number := Line_Number + 1;
if Line'Length > 0 and then Line (Line'First) /= '#' then
Last := Line'Last;
while Last >= Line'First loop
exit when Line (Last) /= ' ';
exit when Last - 1 >= Line'First and then Line (Last - 1) = '\';
Last := Last - 1;
end loop;
if Last >= Line'First then
Negative := Line (Line'First) = '!';
begin
if Negative then
Filter.Include (Line (Line'First + 1 .. Last));
else
Filter.Exclude (Line (Line'First .. Last));
end if;
exception
when E : GNAT.Regexp.Error_In_Regexp =>
Log.Error ("{0}:{1}: Invalid regular expression: {2}",
Label,
Util.Strings.Image (Line_Number),
Ada.Exceptions.Exception_Message (E));
end;
end if;
end if;
end Process;
begin
Reader (Process'Access);
end Load_Ignore;
-- ------------------------------
-- Load the file that contains a list of files to ignore. The default
-- implementation reads patterns as defined in `.gitignore` files.
-- ------------------------------
procedure Load_Ignore (Filter : in out Filter_Type'Class;
Path : String) is
procedure Reader (Process : not null access procedure (Line : in String));
procedure Reader (Process : not null access procedure (Line : in String)) is
begin
Util.Files.Read_File (Path, Process);
end Reader;
begin
Log.Debug ("Loading ignore file {0}", Path);
Filter.Load_Ignore (Path, Reader'Access);
end Load_Ignore;
-- ------------------------------
-- Load the file that contains a list of files to ignore. The default
-- implementation reads patterns as defined in `.gitignore` files.
-- ------------------------------
procedure Load_Ignore (Walker : in out Walker_Type;
Path : String;
Filter : in out Filter_Type'Class) is
pragma Unreferenced (Walker);
begin
Load_Ignore (Filter, Path);
end Load_Ignore;
function Is_File_Excluded (Result : Filter_Result) return Boolean
is (Result.Match = Found and then Get_Value (Result) = Excluded
and then not Is_Only_Directory (Result));
function Is_Directory_Excluded (Result : Filter_Result) return Boolean
is ((Result.Match = Found and then Get_Value (Result) = Excluded)
or else (Result.Match = Found and then Is_Only_Directory (Result)));
-- ------------------------------
-- Called when a directory is found during a directory tree walk.
-- The default implementation scans the directory for files and directories
-- matching the filter. It can be overriden to implement specific
-- behaviors.
-- ------------------------------
procedure Scan_Directory (Walker : in out Walker_Type;
Path : in String;
Filter : in Filter_Context_Type) is
package AD renames Ada.Directories;
use type AD.File_Kind;
Dir_Filter : constant AD.Filter_Type := (AD.Ordinary_File => True,
AD.Directory => True,
others => False);
Ent : AD.Directory_Entry_Type;
Search : AD.Search_Type;
begin
Log.Debug ("Scanning {0}", Path);
AD.Start_Search (Search, Directory => Path,
Pattern => "*", Filter => Dir_Filter);
while AD.More_Entries (Search) loop
AD.Get_Next_Entry (Search, Ent);
declare
Name : constant String := AD.Simple_Name (Ent);
begin
if Name /= "." and then Name /= ".." then
declare
Full_Path : constant String := Util.Files.Compose (Path, Name);
Kind : constant AD.File_Kind := AD.Kind (Full_Path);
Result : constant Filter_Result := Match (Filter, Name);
begin
-- Log.Debug ("{0} => {1}",
-- AD.Full_Name (Ent), Result.Match'Image);
case Kind is
when AD.Ordinary_File =>
if not Is_File_Excluded (Result) then
Walker_Type'Class (Walker).Scan_File (Full_Path);
end if;
when AD.Directory =>
if not Is_Directory_Excluded (Result) then
Walker_Type'Class (Walker).Scan_Subdir (Full_Path, Filter, Result);
end if;
when others =>
null;
end case;
end;
end if;
end;
end loop;
end Scan_Directory;
end Util.Files.Walk;
|