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-- 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