|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T . D I R E C T O R Y _ O P E R A T I O N S . I T E R A T I O N --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2001-2018, AdaCore --
|
|
111
|
10 -- --
|
|
|
11 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
12 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 with Ada.Characters.Handling;
|
|
|
33 with Ada.Strings.Fixed;
|
|
|
34 with Ada.Strings.Maps;
|
|
|
35 with GNAT.OS_Lib;
|
|
|
36 with GNAT.Regexp;
|
|
|
37
|
|
|
38 package body GNAT.Directory_Operations.Iteration is
|
|
|
39
|
|
|
40 use Ada;
|
|
|
41
|
|
|
42 ----------
|
|
|
43 -- Find --
|
|
|
44 ----------
|
|
|
45
|
|
|
46 procedure Find
|
|
|
47 (Root_Directory : Dir_Name_Str;
|
|
|
48 File_Pattern : String)
|
|
|
49 is
|
|
|
50 File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
|
|
|
51 Index : Natural := 0;
|
|
|
52 Quit : Boolean;
|
|
|
53
|
|
|
54 procedure Read_Directory (Directory : Dir_Name_Str);
|
|
|
55 -- Open Directory and read all entries. This routine is called
|
|
|
56 -- recursively for each sub-directories.
|
|
|
57
|
|
|
58 function Make_Pathname (Dir, File : String) return String;
|
|
|
59 -- Returns the pathname for File by adding Dir as prefix
|
|
|
60
|
|
|
61 -------------------
|
|
|
62 -- Make_Pathname --
|
|
|
63 -------------------
|
|
|
64
|
|
|
65 function Make_Pathname (Dir, File : String) return String is
|
|
|
66 begin
|
|
|
67 if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
|
|
|
68 return Dir & File;
|
|
|
69 else
|
|
|
70 return Dir & Dir_Separator & File;
|
|
|
71 end if;
|
|
|
72 end Make_Pathname;
|
|
|
73
|
|
|
74 --------------------
|
|
|
75 -- Read_Directory --
|
|
|
76 --------------------
|
|
|
77
|
|
|
78 procedure Read_Directory (Directory : Dir_Name_Str) is
|
|
|
79 Buffer : String (1 .. 2_048);
|
|
|
80 Last : Natural;
|
|
|
81
|
|
|
82 Dir : Dir_Type;
|
|
|
83 pragma Warnings (Off, Dir);
|
|
|
84
|
|
|
85 begin
|
|
|
86 Open (Dir, Directory);
|
|
|
87
|
|
|
88 loop
|
|
|
89 Read (Dir, Buffer, Last);
|
|
|
90 exit when Last = 0;
|
|
|
91
|
|
|
92 declare
|
|
|
93 Dir_Entry : constant String := Buffer (1 .. Last);
|
|
|
94 Pathname : constant String :=
|
|
|
95 Make_Pathname (Directory, Dir_Entry);
|
|
|
96
|
|
|
97 begin
|
|
|
98 if Regexp.Match (Dir_Entry, File_Regexp) then
|
|
|
99 Index := Index + 1;
|
|
|
100
|
|
|
101 begin
|
|
|
102 Action (Pathname, Index, Quit);
|
|
|
103 exception
|
|
|
104 when others =>
|
|
|
105 Close (Dir);
|
|
|
106 raise;
|
|
|
107 end;
|
|
|
108
|
|
|
109 exit when Quit;
|
|
|
110 end if;
|
|
|
111
|
|
|
112 -- Recursively call for sub-directories, except for . and ..
|
|
|
113
|
|
|
114 if not (Dir_Entry = "." or else Dir_Entry = "..")
|
|
|
115 and then OS_Lib.Is_Directory (Pathname)
|
|
|
116 then
|
|
|
117 Read_Directory (Pathname);
|
|
|
118 exit when Quit;
|
|
|
119 end if;
|
|
|
120 end;
|
|
|
121 end loop;
|
|
|
122
|
|
|
123 Close (Dir);
|
|
|
124 end Read_Directory;
|
|
|
125
|
|
|
126 begin
|
|
|
127 Quit := False;
|
|
|
128 Read_Directory (Root_Directory);
|
|
|
129 end Find;
|
|
|
130
|
|
|
131 -----------------------
|
|
|
132 -- Wildcard_Iterator --
|
|
|
133 -----------------------
|
|
|
134
|
|
|
135 procedure Wildcard_Iterator (Path : Path_Name) is
|
|
|
136
|
|
|
137 Index : Natural := 0;
|
|
|
138
|
|
|
139 procedure Read
|
|
|
140 (Directory : String;
|
|
|
141 File_Pattern : String;
|
|
|
142 Suffix_Pattern : String);
|
|
|
143 -- Read entries in Directory and call user's callback if the entry match
|
|
|
144 -- File_Pattern and Suffix_Pattern is empty; otherwise go down one more
|
|
|
145 -- directory level by calling Next_Level routine below.
|
|
|
146
|
|
|
147 procedure Next_Level
|
|
|
148 (Current_Path : String;
|
|
|
149 Suffix_Path : String);
|
|
|
150 -- Extract next File_Pattern from Suffix_Path and call Read routine
|
|
|
151 -- above.
|
|
|
152
|
|
|
153 ----------------
|
|
|
154 -- Next_Level --
|
|
|
155 ----------------
|
|
|
156
|
|
|
157 procedure Next_Level
|
|
|
158 (Current_Path : String;
|
|
|
159 Suffix_Path : String)
|
|
|
160 is
|
|
|
161 DS : Natural;
|
|
|
162 SP : String renames Suffix_Path;
|
|
|
163
|
|
|
164 begin
|
|
|
165 if SP'Length > 2
|
|
|
166 and then SP (SP'First) = '.'
|
|
|
167 and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
|
|
|
168 then
|
|
|
169 -- Starting with "./"
|
|
|
170
|
|
|
171 DS := Strings.Fixed.Index
|
|
|
172 (SP (SP'First + 2 .. SP'Last),
|
|
|
173 Dir_Seps);
|
|
|
174
|
|
|
175 if DS = 0 then
|
|
|
176
|
|
|
177 -- We have "./"
|
|
|
178
|
|
|
179 Read (Current_Path & ".", "*", "");
|
|
|
180
|
|
|
181 else
|
|
|
182 -- We have "./dir"
|
|
|
183
|
|
|
184 Read (Current_Path & ".",
|
|
|
185 SP (SP'First + 2 .. DS - 1),
|
|
|
186 SP (DS .. SP'Last));
|
|
|
187 end if;
|
|
|
188
|
|
|
189 elsif SP'Length > 3
|
|
|
190 and then SP (SP'First .. SP'First + 1) = ".."
|
|
|
191 and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
|
|
|
192 then
|
|
|
193 -- Starting with "../"
|
|
|
194
|
|
|
195 DS := Strings.Fixed.Index
|
|
|
196 (SP (SP'First + 3 .. SP'Last), Dir_Seps);
|
|
|
197
|
|
|
198 if DS = 0 then
|
|
|
199
|
|
|
200 -- We have "../"
|
|
|
201
|
|
|
202 Read (Current_Path & "..", "*", "");
|
|
|
203
|
|
|
204 else
|
|
|
205 -- We have "../dir"
|
|
|
206
|
|
|
207 Read (Current_Path & "..",
|
|
|
208 SP (SP'First + 3 .. DS - 1),
|
|
|
209 SP (DS .. SP'Last));
|
|
|
210 end if;
|
|
|
211
|
|
|
212 elsif Current_Path = ""
|
|
|
213 and then SP'Length > 1
|
|
|
214 and then Characters.Handling.Is_Letter (SP (SP'First))
|
|
|
215 and then SP (SP'First + 1) = ':'
|
|
|
216 then
|
|
|
217 -- Starting with "<drive>:"
|
|
|
218
|
|
|
219 if SP'Length > 2
|
|
|
220 and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
|
|
|
221 then
|
|
|
222 -- Starting with "<drive>:\"
|
|
|
223
|
|
|
224 DS := Strings.Fixed.Index
|
|
|
225 (SP (SP'First + 3 .. SP'Last), Dir_Seps);
|
|
|
226
|
|
|
227 if DS = 0 then
|
|
|
228
|
|
|
229 -- We have "<drive>:\dir"
|
|
|
230
|
|
|
231 Read (SP (SP'First .. SP'First + 2),
|
|
|
232 SP (SP'First + 3 .. SP'Last),
|
|
|
233 "");
|
|
|
234
|
|
|
235 else
|
|
|
236 -- We have "<drive>:\dir\kkk"
|
|
|
237
|
|
|
238 Read (SP (SP'First .. SP'First + 2),
|
|
|
239 SP (SP'First + 3 .. DS - 1),
|
|
|
240 SP (DS .. SP'Last));
|
|
|
241 end if;
|
|
|
242
|
|
|
243 else
|
|
|
244 -- Starting with "<drive>:" and the drive letter not followed
|
|
|
245 -- by a directory separator. The proper semantic on Windows is
|
|
|
246 -- to read the content of the current selected directory on
|
|
|
247 -- this drive. For example, if drive C current selected
|
|
|
248 -- directory is c:\temp the suffix pattern "c:m*" is
|
|
|
249 -- equivalent to c:\temp\m*.
|
|
|
250
|
|
|
251 DS := Strings.Fixed.Index
|
|
|
252 (SP (SP'First + 2 .. SP'Last), Dir_Seps);
|
|
|
253
|
|
|
254 if DS = 0 then
|
|
|
255
|
|
|
256 -- We have "<drive>:dir"
|
|
|
257
|
|
|
258 Read (SP, "", "");
|
|
|
259
|
|
|
260 else
|
|
|
261 -- We have "<drive>:dir/kkk"
|
|
|
262
|
|
|
263 Read (SP (SP'First .. DS - 1), "", SP (DS .. SP'Last));
|
|
|
264 end if;
|
|
|
265 end if;
|
|
|
266
|
|
|
267 elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
|
|
|
268
|
|
|
269 -- Starting with a /
|
|
|
270
|
|
|
271 DS := Strings.Fixed.Index
|
|
|
272 (SP (SP'First + 1 .. SP'Last), Dir_Seps);
|
|
|
273
|
|
|
274 if DS = 0 then
|
|
|
275
|
|
|
276 -- We have "/dir"
|
|
|
277
|
|
|
278 Read (Current_Path, SP (SP'First + 1 .. SP'Last), "");
|
|
|
279 else
|
|
|
280 -- We have "/dir/kkk"
|
|
|
281
|
|
|
282 Read (Current_Path,
|
|
|
283 SP (SP'First + 1 .. DS - 1),
|
|
|
284 SP (DS .. SP'Last));
|
|
|
285 end if;
|
|
|
286
|
|
|
287 else
|
|
|
288 -- Starting with a name
|
|
|
289
|
|
|
290 DS := Strings.Fixed.Index (SP, Dir_Seps);
|
|
|
291
|
|
|
292 if DS = 0 then
|
|
|
293
|
|
|
294 -- We have "dir"
|
|
|
295
|
|
|
296 Read (Current_Path & '.', SP, "");
|
|
|
297 else
|
|
|
298 -- We have "dir/kkk"
|
|
|
299
|
|
|
300 Read (Current_Path & '.',
|
|
|
301 SP (SP'First .. DS - 1),
|
|
|
302 SP (DS .. SP'Last));
|
|
|
303 end if;
|
|
|
304
|
|
|
305 end if;
|
|
|
306 end Next_Level;
|
|
|
307
|
|
|
308 ----------
|
|
|
309 -- Read --
|
|
|
310 ----------
|
|
|
311
|
|
|
312 Quit : Boolean := False;
|
|
|
313 -- Global state to be able to exit all recursive calls
|
|
|
314
|
|
|
315 procedure Read
|
|
|
316 (Directory : String;
|
|
|
317 File_Pattern : String;
|
|
|
318 Suffix_Pattern : String)
|
|
|
319 is
|
|
|
320 File_Regexp : constant Regexp.Regexp :=
|
|
|
321 Regexp.Compile (File_Pattern, Glob => True);
|
|
|
322
|
|
|
323 Dir : Dir_Type;
|
|
|
324 pragma Warnings (Off, Dir);
|
|
|
325
|
|
|
326 Buffer : String (1 .. 2_048);
|
|
|
327 Last : Natural;
|
|
|
328
|
|
|
329 begin
|
|
|
330 if OS_Lib.Is_Directory (Directory & Dir_Separator) then
|
|
|
331 Open (Dir, Directory & Dir_Separator);
|
|
|
332
|
|
|
333 Dir_Iterator : loop
|
|
|
334 Read (Dir, Buffer, Last);
|
|
|
335 exit Dir_Iterator when Last = 0;
|
|
|
336
|
|
|
337 declare
|
|
|
338 Dir_Entry : constant String := Buffer (1 .. Last);
|
|
|
339 Pathname : constant String :=
|
|
|
340 Directory & Dir_Separator & Dir_Entry;
|
|
|
341 begin
|
|
|
342 -- Handle "." and ".." only if explicit use in the
|
|
|
343 -- File_Pattern.
|
|
|
344
|
|
|
345 if not
|
|
|
346 ((Dir_Entry = "." and then File_Pattern /= ".")
|
|
|
347 or else
|
|
|
348 (Dir_Entry = ".." and then File_Pattern /= ".."))
|
|
|
349 then
|
|
|
350 if Regexp.Match (Dir_Entry, File_Regexp) then
|
|
|
351 if Suffix_Pattern = "" then
|
|
|
352
|
|
|
353 -- No more matching needed, call user's callback
|
|
|
354
|
|
|
355 Index := Index + 1;
|
|
|
356
|
|
|
357 begin
|
|
|
358 Action (Pathname, Index, Quit);
|
|
|
359 exception
|
|
|
360 when others =>
|
|
|
361 Close (Dir);
|
|
|
362 raise;
|
|
|
363 end;
|
|
|
364
|
|
|
365 else
|
|
|
366 -- Down one level
|
|
|
367
|
|
|
368 Next_Level
|
|
|
369 (Directory & Dir_Separator & Dir_Entry,
|
|
|
370 Suffix_Pattern);
|
|
|
371 end if;
|
|
|
372 end if;
|
|
|
373 end if;
|
|
|
374 end;
|
|
|
375
|
|
|
376 -- Exit if Quit set by call to Action, either at this level
|
|
|
377 -- or at some lower recursive call to Next_Level.
|
|
|
378
|
|
|
379 exit Dir_Iterator when Quit;
|
|
|
380 end loop Dir_Iterator;
|
|
|
381
|
|
|
382 Close (Dir);
|
|
|
383 end if;
|
|
|
384 end Read;
|
|
|
385
|
|
|
386 -- Start of processing for Wildcard_Iterator
|
|
|
387
|
|
|
388 begin
|
|
|
389 if Path = "" then
|
|
|
390 return;
|
|
|
391 end if;
|
|
|
392
|
|
|
393 Next_Level ("", Path);
|
|
|
394 end Wildcard_Iterator;
|
|
|
395
|
|
|
396 end GNAT.Directory_Operations.Iteration;
|
