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