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-2010, 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-- 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
32with Ada.Characters.Handling;
33with Ada.Strings.Fixed;
34with Ada.Strings.Maps;
35with GNAT.OS_Lib;
36with GNAT.Regexp;
37
38package 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
396end GNAT.Directory_Operations.Iteration;
397