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 | ------------------------------------------------------------------------------
-- --
-- GPR2 PROJECT MANAGER --
-- --
-- Copyright (C) 2019-2024, AdaCore --
-- --
-- This 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 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY 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, --
-- see <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Directories;
with Ada.Strings.Hash;
with GNATCOLL.OS.Dir;
package body GPRinstall is
use GNATCOLL.OS.Dir;
use GNAT.OS_Lib;
Delete_Dir : Boolean := True;
package P_Directory_Map is
new Ada.Containers.Indefinite_Hashed_Maps
(String, Boolean, Ada.Strings.Hash, "=");
Directory_Map : P_Directory_Map.Map;
procedure Delete_Directory (Root_Dir, Dir : String);
-- Deletes Dir if it is empty
-- If so, recursively calls Delete_Directory on containing directories
-- until it cannot delete (not empty) or it reaches Root_Dir.
function Process_Dir (Dir : Dir_Handle; Element : Dir_Entry)
return Boolean;
-- Used by GNATCOLL.OS.Dir.Walk. It detects Dir contains a directory and
-- tags it not to be deleted.
procedure Process_File (Dir : Dir_Handle; Element : Dir_Entry);
-- Used by GNATCOLL.OS.Dir.Walk. It detects Dir contains a file and
-- tags it not to be deleted.
----------------------
-- Delete_Directory --
----------------------
procedure Delete_Directory (Root_Dir, Dir : String)
is
begin
Delete_Dir := True;
-- Walk in the directory so detect if it is empty
Walk
(Path => Dir,
File_Handler => Process_File'Access,
Dir_Handler => Process_Dir'Access,
Max_Depth => 1);
if Delete_Dir then
Ada.Directories.Delete_Directory (Directory => Dir);
-- if the Map contained the element, tag it "deleted" so we won't
-- try to delete it again.
if Directory_Map.Contains (Dir) then
Directory_Map.Replace
(Key => Dir,
New_Item => True);
end if;
-- Recursively call Delete_Directory until we can't delete the dir
-- (not empty) or we reach Root_Dir.
if Dir /= Root_Dir then
Delete_Directory
(Root_Dir => Root_Dir,
Dir => Ada.Directories.Containing_Directory (Dir));
end if;
end if;
end Delete_Directory;
---------------------------------
-- Delete_Registered_Directory --
---------------------------------
procedure Delete_Registered_Directory (Root_Dir : String)
is
N_Root_Dir : constant String := Normalize_Pathname (Root_Dir);
procedure Delete (Position : P_Directory_Map.Cursor);
procedure Delete (Position : P_Directory_Map.Cursor) is
Dir : constant String :=
P_Directory_Map.Key (Position => Position);
Deleted : constant Boolean :=
P_Directory_Map.Element (Position => Position);
begin
-- Only call Delete_Directory if the element was not already
-- deleted by a previous Delete_Directory recursive call.
if not Deleted then
Delete_Directory (Root_Dir => N_Root_Dir, Dir => Dir);
end if;
end Delete;
begin
-- Iteratively delete all registered directories
Directory_Map.Iterate (Process => Delete'Access);
end Delete_Registered_Directory;
-----------------
-- Process_Dir --
-----------------
function Process_Dir
(Dir : Dir_Handle; Element : Dir_Entry) return Boolean
is
pragma Unreferenced (Dir, Element);
begin
Delete_Dir := False;
return False;
end Process_Dir;
------------------
-- Process_File --
------------------
procedure Process_File (Dir : Dir_Handle; Element : Dir_Entry) is
pragma Unreferenced (Dir, Element);
begin
Delete_Dir := False;
end Process_File;
------------------------
-- Register_Directory --
------------------------
procedure Register_Directory (Dir : String) is
N_Dir : constant String := Normalize_Pathname (Dir);
begin
-- Only cache the directory if the map does not already contains the
-- element and if the directory actually exists.
if not Directory_Map.Contains (N_Dir)
and then Is_Directory (N_Dir)
then
Directory_Map.Insert
(Key => N_Dir,
New_Item => False);
end if;
end Register_Directory;
end GPRinstall;
|