gcc/ada/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 -- 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 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;