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 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
  30 --                                                                          --
  31 ------------------------------------------------------------------------------
  32
  33 with Ada.Characters.Handling;
  34 with Ada.Strings.Fixed;
  35 with Ada.Strings.Maps;
  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
  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          Dir    : Dir_Type;
  80          Buffer : String (1 .. 2_048);
  81          Last   : Natural;
  82          Quit   : Boolean;
  83
  84       begin
  85          Open (Dir, Directory);
  86
  87          loop
  88             Read (Dir, Buffer, Last);
  89             exit when Last = 0;
  90
  91             declare
  92                Dir_Entry : constant String := Buffer (1 .. Last);
  93                Pathname  : constant String
  94                  := Make_Pathname (Directory, Dir_Entry);
  95             begin
  96                if Regexp.Match (Dir_Entry, File_Regexp) then
  97                   Quit  := False;
  98                   Index := Index + 1;
  99
 100                   begin
 101                      Action (Pathname, Index, Quit);
 102                   exception
 103                      when others =>
 104                         Close (Dir);
 105                         raise;
 106                   end;
 107
 108                   exit when Quit;
 109                end if;
 110
 111                --  Recursively call for sub-directories, except for . and ..
 112
 113                if not (Dir_Entry = "." or else Dir_Entry = "..")
 114                  and then OS_Lib.Is_Directory (Pathname)
 115                then
 116                   Read_Directory (Pathname);
 117                end if;
 118             end;
 119          end loop;
 120
 121          Close (Dir);
 122       end Read_Directory;
 123
 124    begin
 125       Read_Directory (Root_Directory);
 126    end Find;
 127
 128    -----------------------
 129    -- Wildcard_Iterator --
 130    -----------------------
 131
 132    procedure Wildcard_Iterator (Path : Path_Name) is
 133
 134       Index : Natural := 0;
 135
 136       procedure Read
 137         (Directory      : String;
 138          File_Pattern   : String;
 139          Suffix_Pattern : String);
 140       --  Read entries in Directory and call user's callback if the entry
 141       --  match File_Pattern and Suffix_Pattern is empty otherwise it will go
 142       --  down one more directory level by calling Next_Level routine above.
 143
 144       procedure Next_Level
 145         (Current_Path : String;
 146          Suffix_Path  : String);
 147       --  Extract next File_Pattern from Suffix_Path and call Read routine
 148       --  above.
 149
 150       ----------------
 151       -- Next_Level --
 152       ----------------
 153
 154       procedure Next_Level
 155         (Current_Path : String;
 156          Suffix_Path  : String)
 157       is
 158          DS : Natural;
 159          SP : String renames Suffix_Path;
 160
 161       begin
 162          if SP'Length > 2
 163            and then SP (SP'First) = '.'
 164            and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
 165          then
 166             --  Starting with "./"
 167
 168             DS := Strings.Fixed.Index
 169               (SP (SP'First + 2 .. SP'Last),
 170                Dir_Seps);
 171
 172             if DS = 0 then
 173
 174                --  We have "./"
 175
 176                Read (Current_Path & ".", "*", "");
 177
 178             else
 179                --  We have "./dir"
 180
 181                Read (Current_Path & ".",
 182                      SP (SP'First + 2 .. DS - 1),
 183                      SP (DS .. SP'Last));
 184             end if;
 185
 186          elsif SP'Length > 3
 187            and then SP (SP'First .. SP'First + 1) = ".."
 188            and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
 189          then
 190             --  Starting with "../"
 191
 192             DS := Strings.Fixed.Index
 193               (SP (SP'First + 3 .. SP'Last),
 194                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                   --  Se have "<drive>:\dir"
 228
 229                   Read (SP (SP'First .. SP'First + 1),
 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 + 1),
 237                         SP (SP'First + 3 .. DS - 1),
 238                         SP (DS .. SP'Last));
 239                end if;
 240
 241             else
 242                --  Starting with "<drive>:"
 243
 244                DS :=  Strings.Fixed.Index
 245                         (SP (SP'First + 2 .. SP'Last), Dir_Seps);
 246
 247                if DS = 0 then
 248
 249                   --  We have "<drive>:dir"
 250
 251                   Read (SP (SP'First .. SP'First + 1),
 252                         SP (SP'First + 2 .. SP'Last),
 253                         "");
 254
 255                else
 256                   --  We have "<drive>:dir/kkk"
 257
 258                   Read (SP (SP'First .. SP'First + 1),
 259                         SP (SP'First + 2 .. DS - 1),
 260                         SP (DS .. SP'Last));
 261                end if;
 262
 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),
 271                Dir_Seps);
 272
 273             if DS = 0 then
 274
 275                --  We have "/dir"
 276
 277                Read (Current_Path,
 278                      SP (SP'First + 1 .. SP'Last),
 279                      "");
 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 & '.',
 298                      SP,
 299                      "");
 300             else
 301                --  We have "dir/kkk"
 302
 303                Read (Current_Path & '.',
 304                      SP (SP'First .. DS - 1),
 305                      SP (DS .. SP'Last));
 306             end if;
 307
 308          end if;
 309       end Next_Level;
 310
 311       ----------
 312       -- Read --
 313       ----------
 314
 315       Quit : Boolean := False;
 316       --  Global state to be able to exit all recursive calls.
 317
 318       procedure Read
 319         (Directory      : String;
 320          File_Pattern   : String;
 321          Suffix_Pattern : String)
 322       is
 323          File_Regexp : constant Regexp.Regexp :=
 324                          Regexp.Compile (File_Pattern, Glob => True);
 325          Dir    : Dir_Type;
 326          Buffer : String (1 .. 2_048);
 327          Last   : Natural;
 328
 329       begin
 330          if OS_Lib.Is_Directory (Directory) then
 331             Open (Dir, Directory);
 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
 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
 361                            exception
 362                               when others =>
 363                                  Close (Dir);
 364                                  raise;
 365                            end;
 366
 367                            exit Dir_Iterator when Quit;
 368
 369                         else
 370                            --  Down one level
 371
 372                            Next_Level
 373                              (Directory & Dir_Separator & Dir_Entry,
 374                               Suffix_Pattern);
 375                         end if;
 376                      end if;
 377                   end if;
 378                end;
 379
 380                exit Dir_Iterator when Quit;
 381
 382             end loop Dir_Iterator;
 383
 384             Close (Dir);
 385          end if;
 386       end Read;
 387
 388    begin
 389       Next_Level ("", Path);
 390    end Wildcard_Iterator;
 391
 392 end GNAT.Directory_Operations.Iteration;