1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201 | with
POSIX.File_Status,
Ada.Unchecked_Deallocation,
Ada.IO_Exceptions;
package body Shell.Directories
is
-- Cursor
--
function Has_Element (Pos : in Cursor) return Boolean
is
begin
return Pos.Directory_Entry /= null;
end Has_Element;
-- Directory
--
function To_Directory (Path : in String;
Recurse : in Boolean := False) return Directory
is
begin
return Directory' (Path => +Path,
Recurse => Recurse);
end To_Directory;
function Path (Container : in Directory) return String
is
begin
return +Container.Path;
end Path;
function Iterate (Container : in Directory) return Directory_Iterators.Forward_Iterator'Class
is
use Ada.Directories,
Ada.Finalization;
V : constant Directory_Access := Container'Unrestricted_Access;
begin
return It : constant Iterator := (Controlled with
Container => V,
Search => new Search_Type,
State => new Iterator_State)
do
Start_Search (Search => It.Search.all,
Directory => Path (Container),
Pattern => "");
end return;
end Iterate;
function Element_Value (Container : in Directory;
Pos : in Cursor) return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Pos.Directory_Entry);
end Element_Value;
procedure Get_Next_Directory_Entry (Object : in Iterator;
Directory_Entry : in Directory_Entry_Access)
is
use Ada.Directories,
POSIX,
POSIX.File_Status;
Status : POSIX.File_Status.Status;
begin
Get_Next_Entry (Search => Object.Search.all,
Directory_Entry => Directory_Entry.all);
Status := Get_Link_Status (To_POSIX_String (Full_Name (Directory_Entry.all)));
if Object.Container.Recurse
and Kind (Directory_Entry.all) = Ada.Directories.Directory
and Simple_Name (Directory_Entry.all) /= "."
and Simple_Name (Directory_Entry.all) /= ".."
and not Is_Symbolic_Link (Status)
then
Object.State.Subdirs.Append (+Full_Name (Directory_Entry.all));
end if;
end Get_Next_Directory_Entry;
overriding
function First (Object : in Iterator) return Cursor
is
C : Cursor;
begin
C := Cursor' (Container => Object.Container,
Directory_Entry => new Directory_Entry_Type);
Get_Next_Directory_Entry (Object, C.Directory_Entry);
Object.State.Prior := C.Directory_Entry;
return C;
end First;
overriding
function Next (Object : in Iterator;
Position : in Cursor) return Cursor
is
use Ada.Directories;
procedure Free is new Ada.Unchecked_Deallocation (Directory_Entry_Type,
Directory_Entry_Access);
function new_Cursor return Cursor
is
C : constant Cursor := Cursor' (Container => Position.Container,
Directory_Entry => new Ada.Directories.Directory_Entry_Type);
begin
Get_Next_Directory_Entry (Object, C.Directory_Entry);
Free (Object.State.Prior);
Object.State.Prior := C.Directory_Entry;
return C;
end new_Cursor;
begin
if Position.Container = null
then
return No_Element;
end if;
if Position.Container /= Object.Container
then
raise Program_Error with
"Position cursor of Next designates wrong directory";
end if;
begin
if More_Entries (Object.Search.all)
then
return new_Cursor;
end if;
exception
when Ada.IO_Exceptions.Use_Error =>
null; -- The next entry cannot be accessed, so end this directories search.
end;
End_Search (Object.Search.all);
-- No more entries left, so start a new search, if any subdirs remain.
---
while not Object.State.Subdirs.Is_Empty
loop
declare
Subdir : constant String := +Object.State.Subdirs.Last_Element;
begin
Object.State.Subdirs.Delete_Last;
Start_Search (Search => Object.Search.all,
Directory => Subdir,
Pattern => "");
if More_Entries (Object.Search.all)
then
return new_Cursor;
end if;
exception
when Ada.IO_Exceptions.Use_Error =>
null; -- A forbidden directory, so ignore.
end;
end loop;
Free (Object.State.Prior);
return No_Element;
end Next;
overriding
procedure Finalize (Object : in out Iterator)
is
procedure Free is new Ada.Unchecked_Deallocation (Search_Type,
Search_Access);
procedure Free is new Ada.Unchecked_Deallocation (Iterator_State,
Iterator_State_Access);
begin
Free (Object.Search);
Free (Object.State);
end Finalize;
end Shell.Directories;
|