1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
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 --
10 -- Copyright (C) 2001 Ada Core Technologies, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
32 ------------------------------------------------------------------------------
34 with Ada
.Characters
.Handling
;
35 with Ada
.Strings
.Fixed
;
36 with Ada
.Strings
.Maps
;
40 package body GNAT
.Directory_Operations
.Iteration
is
49 (Root_Directory
: Dir_Name_Str
;
50 File_Pattern
: String)
52 File_Regexp
: constant Regexp
.Regexp
:= Regexp
.Compile
(File_Pattern
);
55 procedure Read_Directory
(Directory
: Dir_Name_Str
);
56 -- Open Directory and read all entries. This routine is called
57 -- recursively for each sub-directories.
59 function Make_Pathname
(Dir
, File
: String) return String;
60 -- Returns the pathname for File by adding Dir as prefix.
66 function Make_Pathname
(Dir
, File
: String) return String is
68 if Dir
(Dir
'Last) = '/' or else Dir
(Dir
'Last) = '\' then
71 return Dir
& Dir_Separator
& File
;
79 procedure Read_Directory
(Directory
: Dir_Name_Str
) is
81 Buffer
: String (1 .. 2_048
);
86 Open
(Dir
, Directory
);
89 Read
(Dir
, Buffer
, Last
);
93 Dir_Entry
: constant String := Buffer
(1 .. Last
);
94 Pathname
: constant String
95 := Make_Pathname
(Directory
, Dir_Entry
);
97 if Regexp
.Match
(Dir_Entry
, File_Regexp
) then
102 Action
(Pathname
, Index
, Quit
);
112 -- Recursively call for sub-directories, except for . and ..
114 if not (Dir_Entry
= "." or else Dir_Entry
= "..")
115 and then OS_Lib
.Is_Directory
(Pathname
)
117 Read_Directory
(Pathname
);
126 Read_Directory
(Root_Directory
);
129 -----------------------
130 -- Wildcard_Iterator --
131 -----------------------
133 procedure Wildcard_Iterator
(Path
: Path_Name
) is
135 Index
: Natural := 0;
139 File_Pattern
: String;
140 Suffix_Pattern
: String);
141 -- Read entries in Directory and call user's callback if the entry
142 -- match File_Pattern and Suffix_Pattern is empty otherwise it will go
143 -- down one more directory level by calling Next_Level routine above.
146 (Current_Path
: String;
147 Suffix_Path
: String);
148 -- Extract next File_Pattern from Suffix_Path and call Read routine
156 (Current_Path
: String;
157 Suffix_Path
: String)
160 SP
: String renames Suffix_Path
;
164 and then SP
(SP
'First) = '.'
165 and then Strings
.Maps
.Is_In
(SP
(SP
'First + 1), Dir_Seps
)
167 -- Starting with "./"
169 DS
:= Strings
.Fixed
.Index
170 (SP
(SP
'First + 2 .. SP
'Last),
177 Read
(Current_Path
& ".", "*", "");
182 Read
(Current_Path
& ".",
183 SP
(SP
'First + 2 .. DS
- 1),
188 and then SP
(SP
'First .. SP
'First + 1) = ".."
189 and then Strings
.Maps
.Is_In
(SP
(SP
'First + 2), Dir_Seps
)
191 -- Starting with "../"
193 DS
:= Strings
.Fixed
.Index
194 (SP
(SP
'First + 3 .. SP
'Last),
201 Read
(Current_Path
& "..", "*", "");
206 Read
(Current_Path
& "..",
207 SP
(SP
'First + 4 .. DS
- 1),
211 elsif Current_Path
= ""
212 and then SP
'Length > 1
213 and then Characters
.Handling
.Is_Letter
(SP
(SP
'First))
214 and then SP
(SP
'First + 1) = ':'
216 -- Starting with "<drive>:"
219 and then Strings
.Maps
.Is_In
(SP
(SP
'First + 2), Dir_Seps
)
221 -- Starting with "<drive>:\"
223 DS
:= Strings
.Fixed
.Index
224 (SP
(SP
'First + 3 .. SP
'Last), Dir_Seps
);
228 -- Se have "<drive>:\dir"
230 Read
(SP
(SP
'First .. SP
'First + 1),
231 SP
(SP
'First + 3 .. SP
'Last),
235 -- We have "<drive>:\dir\kkk"
237 Read
(SP
(SP
'First .. SP
'First + 1),
238 SP
(SP
'First + 3 .. DS
- 1),
243 -- Starting with "<drive>:"
245 DS
:= Strings
.Fixed
.Index
246 (SP
(SP
'First + 2 .. SP
'Last), Dir_Seps
);
250 -- We have "<drive>:dir"
252 Read
(SP
(SP
'First .. SP
'First + 1),
253 SP
(SP
'First + 2 .. SP
'Last),
257 -- We have "<drive>:dir/kkk"
259 Read
(SP
(SP
'First .. SP
'First + 1),
260 SP
(SP
'First + 2 .. DS
- 1),
266 elsif Strings
.Maps
.Is_In
(SP
(SP
'First), Dir_Seps
) then
270 DS
:= Strings
.Fixed
.Index
271 (SP
(SP
'First + 1 .. SP
'Last),
279 SP
(SP
'First + 1 .. SP
'Last),
282 -- We have "/dir/kkk"
285 SP
(SP
'First + 1 .. DS
- 1),
290 -- Starting with a name
292 DS
:= Strings
.Fixed
.Index
(SP
, Dir_Seps
);
298 Read
(Current_Path
& '.',
304 Read
(Current_Path
& '.',
305 SP
(SP
'First .. DS
- 1),
316 Quit
: Boolean := False;
317 -- Global state to be able to exit all recursive calls.
321 File_Pattern
: String;
322 Suffix_Pattern
: String)
324 File_Regexp
: constant Regexp
.Regexp
:=
325 Regexp
.Compile
(File_Pattern
, Glob
=> True);
327 Buffer
: String (1 .. 2_048
);
331 if OS_Lib
.Is_Directory
(Directory
) then
332 Open
(Dir
, Directory
);
335 Read
(Dir
, Buffer
, Last
);
336 exit Dir_Iterator
when Last
= 0;
339 Dir_Entry
: constant String := Buffer
(1 .. Last
);
340 Pathname
: constant String :=
341 Directory
& Dir_Separator
& Dir_Entry
;
343 -- Handle "." and ".." only if explicit use in the
347 ((Dir_Entry
= "." and then File_Pattern
/= ".")
349 (Dir_Entry
= ".." and then File_Pattern
/= ".."))
351 if Regexp
.Match
(Dir_Entry
, File_Regexp
) then
353 if Suffix_Pattern
= "" then
355 -- No more matching needed, call user's callback
360 Action
(Pathname
, Index
, Quit
);
368 exit Dir_Iterator
when Quit
;
374 (Directory
& Dir_Separator
& Dir_Entry
,
381 exit Dir_Iterator
when Quit
;
383 end loop Dir_Iterator
;
390 Next_Level
("", Path
);
391 end Wildcard_Iterator
;
393 end GNAT
.Directory_Operations
.Iteration
;