gcc/ada/libgnat/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-2024, 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
  32 with Ada.Characters.Handling;
  33 with Ada.Strings.Fixed;
  34 with Ada.Strings.Maps;
  35
  36 with GNAT.OS_Lib;
  37 with GNAT.Regexp;
  38
  39 package body GNAT.Directory_Operations.Iteration is
  40
  41    use Ada;
  42
  43    ----------
  44    -- Find --
  45    ----------
  46
  47    procedure Find
  48      (Root_Directory : Dir_Name_Str;
  49       File_Pattern   : String)
  50    is
  51       File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
  52       Index       : Natural := 0;
  53       Quit        : Boolean := False;
  54
  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.
  58
  59       function Make_Pathname (Dir, File : String) return String;
  60       --  Returns the pathname for File by adding Dir as prefix
  61
  62       -------------------
  63       -- Make_Pathname --
  64       -------------------
  65
  66       function Make_Pathname (Dir, File : String) return String is
  67       begin
  68          if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
  69             return Dir & File;
  70          else
  71             return Dir & Dir_Separator & File;
  72          end if;
  73       end Make_Pathname;
  74
  75       --------------------
  76       -- Read_Directory --
  77       --------------------
  78
  79       procedure Read_Directory (Directory : Dir_Name_Str) is
  80          Buffer : String (1 .. 2_048);
  81          Last   : Natural;
  82
  83          Dir : Dir_Type;
  84          pragma Warnings (Off, Dir);
  85
  86       begin
  87          Open (Dir, Directory);
  88
  89          loop
  90             Read (Dir, Buffer, Last);
  91             exit when Last = 0;
  92
  93             declare
  94                Dir_Entry : constant String := Buffer (1 .. Last);
  95                Pathname  : constant String :=
  96                              Make_Pathname (Directory, Dir_Entry);
  97
  98             begin
  99                if Regexp.Match (Dir_Entry, File_Regexp) then
 100                   Index := Index + 1;
 101
 102                   begin
 103                      Action (Pathname, Index, Quit);
 104                   exception
 105                      when others =>
 106                         Close (Dir);
 107                         raise;
 108                   end;
 109
 110                   exit when Quit;
 111                end if;
 112
 113                --  Recursively call for sub-directories, except for . and ..
 114
 115                if not (Dir_Entry = "." or else Dir_Entry = "..")
 116                  and then OS_Lib.Is_Directory (Pathname)
 117                  and then not OS_Lib.Is_Symbolic_Link (Pathname)
 118                then
 119                   Read_Directory (Pathname);
 120                   exit when Quit;
 121                end if;
 122             end;
 123          end loop;
 124
 125          Close (Dir);
 126       end Read_Directory;
 127
 128    begin
 129       Read_Directory (Root_Directory);
 130    end Find;
 131
 132    -----------------------
 133    -- Wildcard_Iterator --
 134    -----------------------
 135
 136    procedure Wildcard_Iterator (Path : Path_Name) is
 137
 138       Index : Natural := 0;
 139
 140       procedure Read
 141         (Directory      : String;
 142          File_Pattern   : String;
 143          Suffix_Pattern : String);
 144       --  Read entries in Directory and call user's callback if the entry match
 145       --  File_Pattern and Suffix_Pattern is empty; otherwise go down one more
 146       --  directory level by calling Next_Level routine below.
 147
 148       procedure Next_Level
 149         (Current_Path : String;
 150          Suffix_Path  : String);
 151       --  Extract next File_Pattern from Suffix_Path and call Read routine
 152       --  above.
 153
 154       ----------------
 155       -- Next_Level --
 156       ----------------
 157
 158       procedure Next_Level
 159         (Current_Path : String;
 160          Suffix_Path  : String)
 161       is
 162          DS : Natural;
 163          SP : String renames Suffix_Path;
 164
 165       begin
 166          if SP'Length > 2
 167            and then SP (SP'First) = '.'
 168            and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
 169          then
 170             --  Starting with "./"
 171
 172             DS := Strings.Fixed.Index
 173               (SP (SP'First + 2 .. SP'Last),
 174                Dir_Seps);
 175
 176             if DS = 0 then
 177
 178                --  We have "./"
 179
 180                Read (Current_Path & ".", "*", "");
 181
 182             else
 183                --  We have "./dir"
 184
 185                Read (Current_Path & ".",
 186                      SP (SP'First + 2 .. DS - 1),
 187                      SP (DS .. SP'Last));
 188             end if;
 189
 190          elsif SP'Length > 3
 191            and then SP (SP'First .. SP'First + 1) = ".."
 192            and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 193          then
 194             --  Starting with "../"
 195
 196             DS := Strings.Fixed.Index
 197                     (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 198
 199             if DS = 0 then
 200
 201                --  We have "../"
 202
 203                Read (Current_Path & "..", "*", "");
 204
 205             else
 206                --  We have "../dir"
 207
 208                Read (Current_Path & "..",
 209                      SP (SP'First + 3 .. DS - 1),
 210                      SP (DS .. SP'Last));
 211             end if;
 212
 213          elsif Current_Path = ""
 214            and then SP'Length > 1
 215            and then Characters.Handling.Is_Letter (SP (SP'First))
 216            and then SP (SP'First + 1) = ':'
 217          then
 218             --  Starting with "<drive>:"
 219
 220             if SP'Length > 2
 221               and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 222             then
 223                --  Starting with "<drive>:\"
 224
 225                DS := Strings.Fixed.Index
 226                        (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 227
 228                if DS = 0 then
 229
 230                   --  We have "<drive>:\dir"
 231
 232                   Read (SP (SP'First .. SP'First + 2),
 233                         SP (SP'First + 3 .. SP'Last),
 234                         "");
 235
 236                else
 237                   --  We have "<drive>:\dir\kkk"
 238
 239                   Read (SP (SP'First .. SP'First + 2),
 240                         SP (SP'First + 3 .. DS - 1),
 241                         SP (DS .. SP'Last));
 242                end if;
 243
 244             else
 245                --  Starting with "<drive>:" and the drive letter not followed
 246                --  by a directory separator. The proper semantic on Windows is
 247                --  to read the content of the current selected directory on
 248                --  this drive. For example, if drive C current selected
 249                --  directory is c:\temp the suffix pattern "c:m*" is
 250                --  equivalent to c:\temp\m*.
 251
 252                DS :=  Strings.Fixed.Index
 253                         (SP (SP'First + 2 .. SP'Last), Dir_Seps);
 254
 255                if DS = 0 then
 256
 257                   --  We have "<drive>:dir"
 258
 259                   Read (SP, "", "");
 260
 261                else
 262                   --  We have "<drive>:dir/kkk"
 263
 264                   Read (SP (SP'First .. DS - 1), "", SP (DS .. SP'Last));
 265                end if;
 266             end if;
 267
 268          elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
 269
 270             --  Starting with a /
 271
 272             DS := Strings.Fixed.Index
 273                     (SP (SP'First + 1 .. SP'Last), Dir_Seps);
 274
 275             if DS = 0 then
 276
 277                --  We have "/dir"
 278
 279                Read (Current_Path, SP (SP'First + 1 .. SP'Last), "");
 280             else
 281                --  We have "/dir/kkk"
 282
 283                Read (Current_Path,
 284                      SP (SP'First + 1 .. DS - 1),
 285                      SP (DS .. SP'Last));
 286             end if;
 287
 288          else
 289             --  Starting with a name
 290
 291             DS := Strings.Fixed.Index (SP, Dir_Seps);
 292
 293             if DS = 0 then
 294
 295                --  We have "dir"
 296
 297                Read (Current_Path & '.', SP, "");
 298             else
 299                --  We have "dir/kkk"
 300
 301                Read (Current_Path & '.',
 302                      SP (SP'First .. DS - 1),
 303                      SP (DS .. SP'Last));
 304             end if;
 305
 306          end if;
 307       end Next_Level;
 308
 309       ----------
 310       -- Read --
 311       ----------
 312
 313       Quit : Boolean := False;
 314       --  Global state to be able to exit all recursive calls
 315
 316       procedure Read
 317         (Directory      : String;
 318          File_Pattern   : String;
 319          Suffix_Pattern : String)
 320       is
 321          File_Regexp : constant Regexp.Regexp :=
 322                          Regexp.Compile (File_Pattern, Glob => True);
 323
 324          Dir : Dir_Type;
 325          pragma Warnings (Off, Dir);
 326
 327          Buffer : String (1 .. 2_048);
 328          Last   : Natural;
 329
 330       begin
 331          if OS_Lib.Is_Directory (Directory & Dir_Separator) then
 332             Open (Dir, Directory & Dir_Separator);
 333
 334             Dir_Iterator : loop
 335                Read (Dir, Buffer, Last);
 336                exit Dir_Iterator when Last = 0;
 337
 338                declare
 339                   Dir_Entry : constant String := Buffer (1 .. Last);
 340                   Pathname  : constant String :=
 341                                 Directory & Dir_Separator & Dir_Entry;
 342                begin
 343                   --  Handle "." and ".." only if explicit use in the
 344                   --  File_Pattern.
 345
 346                   if not
 347                     ((Dir_Entry = "." and then File_Pattern /= ".")
 348                        or else
 349                      (Dir_Entry = ".." and then File_Pattern /= ".."))
 350                   then
 351                      if Regexp.Match (Dir_Entry, File_Regexp) then
 352                         if Suffix_Pattern = "" then
 353
 354                            --  No more matching needed, call user's callback
 355
 356                            Index := Index + 1;
 357
 358                            begin
 359                               Action (Pathname, Index, Quit);
 360                            exception
 361                               when others =>
 362                                  Close (Dir);
 363                                  raise;
 364                            end;
 365
 366                         else
 367                            --  Down one level
 368
 369                            Next_Level
 370                              (Directory & Dir_Separator & Dir_Entry,
 371                               Suffix_Pattern);
 372                         end if;
 373                      end if;
 374                   end if;
 375                end;
 376
 377                --  Exit if Quit set by call to Action, either at this level
 378                --  or at some lower recursive call to Next_Level.
 379
 380                exit Dir_Iterator when Quit;
 381             end loop Dir_Iterator;
 382
 383             Close (Dir);
 384          end if;
 385       end Read;
 386
 387    --  Start of processing for Wildcard_Iterator
 388
 389    begin
 390       if Path = "" then
 391          return;
 392       end if;
 393
 394       Next_Level ("", Path);
 395    end Wildcard_Iterator;
 396
 397 end GNAT.Directory_Operations.Iteration;