+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- 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 --
--- --
--- B o d y --
--- --
--- $Revision: 1.1 $
--- --
--- Copyright (C) 2001 Ada Core Technologies, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--- --
-------------------------------------------------------------------------------
-
-with Ada.Characters.Handling;
-with Ada.Strings.Fixed;
-with Ada.Strings.Maps;
-with GNAT.OS_Lib;
-with GNAT.Regexp;
-
-package body GNAT.Directory_Operations.Iteration is
-
- use Ada;
-
- ----------
- -- Find --
- ----------
-
- procedure Find
- (Root_Directory : Dir_Name_Str;
- File_Pattern : String)
- is
- File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern);
- Index : Natural := 0;
-
- procedure Read_Directory (Directory : Dir_Name_Str);
- -- Open Directory and read all entries. This routine is called
- -- recursively for each sub-directories.
-
- function Make_Pathname (Dir, File : String) return String;
- -- Returns the pathname for File by adding Dir as prefix.
-
- -------------------
- -- Make_Pathname --
- -------------------
-
- function Make_Pathname (Dir, File : String) return String is
- begin
- if Dir (Dir'Last) = '/' or else Dir (Dir'Last) = '\' then
- return Dir & File;
- else
- return Dir & Dir_Separator & File;
- end if;
- end Make_Pathname;
-
- --------------------
- -- Read_Directory --
- --------------------
-
- procedure Read_Directory (Directory : Dir_Name_Str) is
- Dir : Dir_Type;
- Buffer : String (1 .. 2_048);
- Last : Natural;
- Quit : Boolean;
-
- begin
- Open (Dir, Directory);
-
- loop
- Read (Dir, Buffer, Last);
- exit when Last = 0;
-
- declare
- Dir_Entry : constant String := Buffer (1 .. Last);
- Pathname : constant String
- := Make_Pathname (Directory, Dir_Entry);
- begin
- if Regexp.Match (Dir_Entry, File_Regexp) then
- Quit := False;
- Index := Index + 1;
-
- begin
- Action (Pathname, Index, Quit);
- exception
- when others =>
- Close (Dir);
- raise;
- end;
-
- exit when Quit;
- end if;
-
- -- Recursively call for sub-directories, except for . and ..
-
- if not (Dir_Entry = "." or else Dir_Entry = "..")
- and then OS_Lib.Is_Directory (Pathname)
- then
- Read_Directory (Pathname);
- end if;
- end;
- end loop;
-
- Close (Dir);
- end Read_Directory;
-
- begin
- Read_Directory (Root_Directory);
- end Find;
-
- -----------------------
- -- Wildcard_Iterator --
- -----------------------
-
- procedure Wildcard_Iterator (Path : Path_Name) is
-
- Index : Natural := 0;
-
- procedure Read
- (Directory : String;
- File_Pattern : String;
- Suffix_Pattern : String);
- -- Read entries in Directory and call user's callback if the entry
- -- match File_Pattern and Suffix_Pattern is empty otherwise it will go
- -- down one more directory level by calling Next_Level routine above.
-
- procedure Next_Level
- (Current_Path : String;
- Suffix_Path : String);
- -- Extract next File_Pattern from Suffix_Path and call Read routine
- -- above.
-
- ----------------
- -- Next_Level --
- ----------------
-
- procedure Next_Level
- (Current_Path : String;
- Suffix_Path : String)
- is
- DS : Natural;
- SP : String renames Suffix_Path;
-
- begin
- if SP'Length > 2
- and then SP (SP'First) = '.'
- and then Strings.Maps.Is_In (SP (SP'First + 1), Dir_Seps)
- then
- -- Starting with "./"
-
- DS := Strings.Fixed.Index
- (SP (SP'First + 2 .. SP'Last),
- Dir_Seps);
-
- if DS = 0 then
-
- -- We have "./"
-
- Read (Current_Path & ".", "*", "");
-
- else
- -- We have "./dir"
-
- Read (Current_Path & ".",
- SP (SP'First + 2 .. DS - 1),
- SP (DS .. SP'Last));
- end if;
-
- elsif SP'Length > 3
- and then SP (SP'First .. SP'First + 1) = ".."
- and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
- then
- -- Starting with "../"
-
- DS := Strings.Fixed.Index
- (SP (SP'First + 3 .. SP'Last),
- Dir_Seps);
-
- if DS = 0 then
-
- -- We have "../"
-
- Read (Current_Path & "..", "*", "");
-
- else
- -- We have "../dir"
-
- Read (Current_Path & "..",
- SP (SP'First + 4 .. DS - 1),
- SP (DS .. SP'Last));
- end if;
-
- elsif Current_Path = ""
- and then SP'Length > 1
- and then Characters.Handling.Is_Letter (SP (SP'First))
- and then SP (SP'First + 1) = ':'
- then
- -- Starting with "<drive>:"
-
- if SP'Length > 2
- and then Strings.Maps.Is_In (SP (SP'First + 2), Dir_Seps)
- then
- -- Starting with "<drive>:\"
-
- DS := Strings.Fixed.Index
- (SP (SP'First + 3 .. SP'Last), Dir_Seps);
-
- if DS = 0 then
-
- -- Se have "<drive>:\dir"
-
- Read (SP (SP'First .. SP'First + 1),
- SP (SP'First + 3 .. SP'Last),
- "");
-
- else
- -- We have "<drive>:\dir\kkk"
-
- Read (SP (SP'First .. SP'First + 1),
- SP (SP'First + 3 .. DS - 1),
- SP (DS .. SP'Last));
- end if;
-
- else
- -- Starting with "<drive>:"
-
- DS := Strings.Fixed.Index
- (SP (SP'First + 2 .. SP'Last), Dir_Seps);
-
- if DS = 0 then
-
- -- We have "<drive>:dir"
-
- Read (SP (SP'First .. SP'First + 1),
- SP (SP'First + 2 .. SP'Last),
- "");
-
- else
- -- We have "<drive>:dir/kkk"
-
- Read (SP (SP'First .. SP'First + 1),
- SP (SP'First + 2 .. DS - 1),
- SP (DS .. SP'Last));
- end if;
-
- end if;
-
- elsif Strings.Maps.Is_In (SP (SP'First), Dir_Seps) then
-
- -- Starting with a /
-
- DS := Strings.Fixed.Index
- (SP (SP'First + 1 .. SP'Last),
- Dir_Seps);
-
- if DS = 0 then
-
- -- We have "/dir"
-
- Read (Current_Path,
- SP (SP'First + 1 .. SP'Last),
- "");
- else
- -- We have "/dir/kkk"
-
- Read (Current_Path,
- SP (SP'First + 1 .. DS - 1),
- SP (DS .. SP'Last));
- end if;
-
- else
- -- Starting with a name
-
- DS := Strings.Fixed.Index (SP, Dir_Seps);
-
- if DS = 0 then
-
- -- We have "dir"
-
- Read (Current_Path & '.',
- SP,
- "");
- else
- -- We have "dir/kkk"
-
- Read (Current_Path & '.',
- SP (SP'First .. DS - 1),
- SP (DS .. SP'Last));
- end if;
-
- end if;
- end Next_Level;
-
- ----------
- -- Read --
- ----------
-
- Quit : Boolean := False;
- -- Global state to be able to exit all recursive calls.
-
- procedure Read
- (Directory : String;
- File_Pattern : String;
- Suffix_Pattern : String)
- is
- File_Regexp : constant Regexp.Regexp :=
- Regexp.Compile (File_Pattern, Glob => True);
- Dir : Dir_Type;
- Buffer : String (1 .. 2_048);
- Last : Natural;
-
- begin
- if OS_Lib.Is_Directory (Directory) then
- Open (Dir, Directory);
-
- Dir_Iterator : loop
- Read (Dir, Buffer, Last);
- exit Dir_Iterator when Last = 0;
-
- declare
- Dir_Entry : constant String := Buffer (1 .. Last);
- Pathname : constant String :=
- Directory & Dir_Separator & Dir_Entry;
- begin
- -- Handle "." and ".." only if explicit use in the
- -- File_Pattern.
-
- if not
- ((Dir_Entry = "." and then File_Pattern /= ".")
- or else
- (Dir_Entry = ".." and then File_Pattern /= ".."))
- then
- if Regexp.Match (Dir_Entry, File_Regexp) then
-
- if Suffix_Pattern = "" then
-
- -- No more matching needed, call user's callback
-
- Index := Index + 1;
-
- begin
- Action (Pathname, Index, Quit);
-
- exception
- when others =>
- Close (Dir);
- raise;
- end;
-
- exit Dir_Iterator when Quit;
-
- else
- -- Down one level
-
- Next_Level
- (Directory & Dir_Separator & Dir_Entry,
- Suffix_Pattern);
- end if;
- end if;
- end if;
- end;
-
- exit Dir_Iterator when Quit;
-
- end loop Dir_Iterator;
-
- Close (Dir);
- end if;
- end Read;
-
- begin
- Next_Level ("", Path);
- end Wildcard_Iterator;
-
-end GNAT.Directory_Operations.Iteration;
projects / msp430-gcc.git / blobdiff