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