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-2005 Adacore, Inc.                   --
  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
  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          Dir    : Dir_Type;
  81          Buffer : String (1 .. 2_048);
  82          Last   : Natural;
  83          Quit   : Boolean;
  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                   Quit  := False;
 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                then
 118                   Read_Directory (Pathname);
 119                end if;
 120             end;
 121          end loop;
 122
 123          Close (Dir);
 124       end Read_Directory;
 125
 126    begin
 127       Read_Directory (Root_Directory);
 128    end Find;
 129
 130    -----------------------
 131    -- Wildcard_Iterator --
 132    -----------------------
 133
 134    procedure Wildcard_Iterator (Path : Path_Name) is
 135
 136       Index : Natural := 0;
 137
 138       procedure Read
 139         (Directory      : String;
 140          File_Pattern   : String;
 141          Suffix_Pattern : String);
 142       --  Read entries in Directory and call user's callback if the entry
 143       --  match File_Pattern and Suffix_Pattern is empty otherwise it will go
 144       --  down one more directory level by calling Next_Level routine above.
 145
 146       procedure Next_Level
 147         (Current_Path : String;
 148          Suffix_Path  : String);
 149       --  Extract next File_Pattern from Suffix_Path and call Read routine
 150       --  above.
 151
 152       ----------------
 153       -- Next_Level --
 154       ----------------
 155
 156       procedure Next_Level
 157         (Current_Path : String;
 158          Suffix_Path  : String)
 159       is
 160          DS : Natural;
 161          SP : String renames Suffix_Path;
 162
 163       begin
 164          if SP'Length > 2
 165            and then SP (SP'First) = '.'
 166            and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
 167          then
 168             --  Starting with "./"
 169
 170             DS := Strings.Fixed.Index
 171               (SP (SP'First + 2 .. SP'Last),
 172                Dir_Seps);
 173
 174             if DS = 0 then
 175
 176                --  We have "./"
 177
 178                Read (Current_Path & ".", "*", "");
 179
 180             else
 181                --  We have "./dir"
 182
 183                Read (Current_Path & ".",
 184                      SP (SP'First + 2 .. DS - 1),
 185                      SP (DS .. SP'Last));
 186             end if;
 187
 188          elsif SP'Length > 3
 189            and then SP (SP'First .. SP'First + 1) = ".."
 190            and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 191          then
 192             --  Starting with "../"
 193
 194             DS := Strings.Fixed.Index
 195                     (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 196
 197             if DS = 0 then
 198
 199                --  We have "../"
 200
 201                Read (Current_Path & "..", "*", "");
 202
 203             else
 204                --  We have "../dir"
 205
 206                Read (Current_Path & "..",
 207                      SP (SP'First + 3 .. DS - 1),
 208                      SP (DS .. SP'Last));
 209             end if;
 210
 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) = ':'
 215          then
 216             --  Starting with "<drive>:"
 217
 218             if SP'Length > 2
 219               and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 220             then
 221                --  Starting with "<drive>:\"
 222
 223                DS :=  Strings.Fixed.Index
 224                         (SP (SP'First + 3 .. SP'Last), Dir_Seps);
 225
 226                if DS = 0 then
 227
 228                   --  We have "<drive>:\dir"
 229
 230                   Read (SP (SP'First .. SP'First + 2),
 231                         SP (SP'First + 3 .. SP'Last),
 232                         "");
 233
 234                else
 235                   --  We have "<drive>:\dir\kkk"
 236
 237                   Read (SP (SP'First .. SP'First + 2),
 238                         SP (SP'First + 3 .. DS - 1),
 239                         SP (DS .. SP'Last));
 240                end if;
 241
 242             else
 243                --  Starting with "<drive>:" and the drive letter not followed
 244                --  by a directory separator. The proper semantic on Windows is
 245                --  to read the content of the current selected directory on
 246                --  this drive. For example, if drive C current selected
 247                --  directory is c:\temp the suffix pattern "c:m*" is
 248                --  equivalent to c:\temp\m*.
 249
 250                DS :=  Strings.Fixed.Index
 251                         (SP (SP'First + 2 .. SP'Last), Dir_Seps);
 252
 253                if DS = 0 then
 254
 255                   --  We have "<drive>:dir"
 256
 257                   Read (SP, "", "");
 258
 259                else
 260                   --  We have "<drive>:dir/kkk"
 261
 262                   Read (SP (SP'First .. DS - 1), "", SP (DS .. SP'Last));
 263                end if;
 264             end if;
 265
 266          elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
 267
 268             --  Starting with a /
 269
 270             DS := Strings.Fixed.Index
 271                     (SP (SP'First + 1 .. SP'Last), Dir_Seps);
 272
 273             if DS = 0 then
 274
 275                --  We have "/dir"
 276
 277                Read (Current_Path, SP (SP'First + 1 .. SP'Last), "");
 278             else
 279                --  We have "/dir/kkk"
 280
 281                Read (Current_Path,
 282                      SP (SP'First + 1 .. DS - 1),
 283                      SP (DS .. SP'Last));
 284             end if;
 285
 286          else
 287             --  Starting with a name
 288
 289             DS := Strings.Fixed.Index (SP, Dir_Seps);
 290
 291             if DS = 0 then
 292
 293                --  We have "dir"
 294
 295                Read (Current_Path & '.', SP, "");
 296             else
 297                --  We have "dir/kkk"
 298
 299                Read (Current_Path & '.',
 300                      SP (SP'First .. DS - 1),
 301                      SP (DS .. SP'Last));
 302             end if;
 303
 304          end if;
 305       end Next_Level;
 306
 307       ----------
 308       -- Read --
 309       ----------
 310
 311       Quit : Boolean := False;
 312       --  Global state to be able to exit all recursive calls
 313
 314       procedure Read
 315         (Directory      : String;
 316          File_Pattern   : String;
 317          Suffix_Pattern : String)
 318       is
 319          File_Regexp : constant Regexp.Regexp :=
 320                          Regexp.Compile (File_Pattern, Glob => True);
 321          Dir    : Dir_Type;
 322          Buffer : String (1 .. 2_048);
 323          Last   : Natural;
 324
 325       begin
 326          if OS_Lib.Is_Directory (Directory & Dir_Separator) then
 327             Open (Dir, Directory & Dir_Separator);
 328
 329             Dir_Iterator : loop
 330                Read (Dir, Buffer, Last);
 331                exit Dir_Iterator when Last = 0;
 332
 333                declare
 334                   Dir_Entry : constant String := Buffer (1 .. Last);
 335                   Pathname  : constant String :=
 336                                 Directory & Dir_Separator & Dir_Entry;
 337                begin
 338                   --  Handle "." and ".." only if explicit use in the
 339                   --  File_Pattern.
 340
 341                   if not
 342                     ((Dir_Entry = "." and then File_Pattern /= ".")
 343                        or else
 344                      (Dir_Entry = ".." and then File_Pattern /= ".."))
 345                   then
 346                      if Regexp.Match (Dir_Entry, File_Regexp) then
 347                         if Suffix_Pattern = "" then
 348
 349                            --  No more matching needed, call user's callback
 350
 351                            Index := Index + 1;
 352
 353                            begin
 354                               Action (Pathname, Index, Quit);
 355                            exception
 356                               when others =>
 357                                  Close (Dir);
 358                                  raise;
 359                            end;
 360
 361                         else
 362                            --  Down one level
 363
 364                            Next_Level
 365                              (Directory & Dir_Separator & Dir_Entry,
 366                               Suffix_Pattern);
 367                         end if;
 368                      end if;
 369                   end if;
 370                end;
 371
 372                --  Exit if Quit set by call to Action, either at this level
 373                --  or at at some lower recursive call to Next_Level.
 374
 375                exit Dir_Iterator when Quit;
 376             end loop Dir_Iterator;
 377
 378             Close (Dir);
 379          end if;
 380       end Read;
 381
 382    begin
 383       if Path = "" then
 384          return;
 385       end if;
 386
 387       Next_Level ("", Path);
 388    end Wildcard_Iterator;
 389
 390 end GNAT.Directory_Operations.Iteration;