File : g-diopit.adb
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 -- --
9 -- Copyright (C) 2001-2015, AdaCore --
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 -- --
19 -- --
20 -- --
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
144 -- match File_Pattern and Suffix_Pattern is empty otherwise it will go
145 -- down one more directory level by calling Next_Level routine above.
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;