source: trunk/dsa_messenger/server-bus.adb

Last change on this file was 12, checked in by vadim.godunko, 12 years ago

Remove commented out code.

File size: 5.8 KB
Line 
1with Ada.Containers.Indefinite_Hashed_Maps;
2with Ada.Containers.Indefinite_Hashed_Sets;
3with Ada.Strings.Hash;
4with Ada.Text_IO;
5with System.RPC;
6
7package body Server.Bus is
8
9 package Maps is
10 new Ada.Containers.Indefinite_Hashed_Maps
11 (String,
12 Messenger.Client_Sessions.Client_Session_Access,
13 Ada.Strings.Hash,
14 "=",
15 Messenger.Client_Sessions."=");
16
17 package Sets is
18 new Ada.Containers.Indefinite_Hashed_Sets (String, Ada.Strings.Hash, "=");
19
20 protected Bus is
21
22 procedure Register
23 (Name : String;
24 Client : Messenger.Client_Sessions.Client_Session_Access);
25
26 procedure Send (From : String; To : String; Text : String);
27
28 entry Execute;
29
30 procedure Shutdown;
31
32 private
33 Users : Maps.Map;
34 Failed : Sets.Set;
35 Removed : Sets.Set;
36 Runned : Boolean := True;
37 end Bus;
38
39 protected body Bus is
40
41 -------------
42 -- Execute --
43 -------------
44
45 entry Execute when not Runned is
46 begin
47 null;
48 end Execute;
49
50 --------------------
51 -- Process_Failed --
52 --------------------
53
54 procedure Process_Failed is
55
56 procedure Remove (Position : Sets.Cursor);
57
58 procedure Notify_Disconnected (Position : Maps.Cursor);
59
60 -------------------------
61 -- Notify_Disconnected --
62 -------------------------
63
64 procedure Notify_Disconnected (Position : Maps.Cursor) is
65
66 procedure Notify_Disconnected (Position : Sets.Cursor);
67
68 CI : constant Messenger.Client_Sessions.Client_Session_Access
69 := Maps.Element (Position);
70
71 -------------------------
72 -- Notify_Disconnected --
73 -------------------------
74
75 procedure Notify_Disconnected (Position : Sets.Cursor) is
76 User : constant String := Sets.Element (Position);
77
78 begin
79 CI.User_Disconnected (User);
80 end Notify_Disconnected;
81
82 begin
83 Removed.Iterate (Notify_Disconnected'Access);
84
85 exception
86 when System.RPC.Communication_Error =>
87 Ada.Text_IO.Put_Line ("Communication failure");
88 Failed.Insert (Maps.Key (Position));
89 end Notify_Disconnected;
90
91 ------------
92 -- Remove --
93 ------------
94
95 procedure Remove (Position : Sets.Cursor) is
96 begin
97 Users.Delete (Sets.Element (Position));
98 Removed.Insert (Sets.Element (Position));
99 end Remove;
100
101 begin
102 if not Failed.Is_Empty then
103 Failed.Iterate (Remove'Access);
104 Failed.Clear;
105 Users.Iterate (Notify_Disconnected'Access);
106 Removed.Clear;
107
108 Process_Failed;
109 end if;
110 end Process_Failed;
111
112 --------------
113 -- Register --
114 --------------
115
116 procedure Register
117 (Name : String;
118 Client : Messenger.Client_Sessions.Client_Session_Access)
119 is
120 procedure Notify_Connected (Position : Maps.Cursor);
121
122 procedure Notify (Position : Maps.Cursor);
123
124 ------------
125 -- Notify --
126 ------------
127
128 procedure Notify (Position : Maps.Cursor) is
129 User : constant String := Maps.Key (Position);
130
131 begin
132 if User /= Name then
133 Client.User_Connected (User);
134 end if;
135
136 exception
137 when System.RPC.Communication_Error =>
138 Ada.Text_IO.Put_Line ("Communication failure");
139 Failed.Insert (Name);
140 end Notify;
141
142 ----------------------
143 -- Notify_Connected --
144 ----------------------
145
146 procedure Notify_Connected (Position : Maps.Cursor) is
147 begin
148 Maps.Element (Position).User_Connected (Name);
149
150 exception
151 when System.RPC.Communication_Error =>
152 Ada.Text_IO.Put_Line ("Communication failure");
153 Failed.Insert (Maps.Key (Position));
154 end Notify_Connected;
155
156 begin
157 if Users.Contains (Name) then
158 raise Messenger.Logon_Failed;
159
160 else
161 Users.Insert (Name, Client);
162 Users.Iterate (Notify'Access);
163 Users.Iterate (Notify_Connected'Access);
164 Process_Failed;
165 end if;
166 end Register;
167
168 --------------
169 -- Shutdown --
170 --------------
171
172 procedure Shutdown is
173 begin
174 Runned := False;
175 end Shutdown;
176
177 ----------
178 -- Send --
179 ----------
180
181 procedure Send (From : String; To : String; Text : String) is
182
183 procedure Send (Position : Maps.Cursor);
184
185 ----------
186 -- Send --
187 ----------
188
189 procedure Send (Position : Maps.Cursor) is
190 begin
191 Maps.Element (Position).Message_Received (From, Text);
192
193 exception
194 when System.RPC.Communication_Error =>
195 Ada.Text_IO.Put_Line ("Communication failure");
196 Failed.Insert (Maps.Key (Position));
197 end Send;
198
199 begin
200 Users.Iterate (Send'Access);
201 Process_Failed;
202 end Send;
203
204 end Bus;
205
206 -------------
207 -- Execute --
208 -------------
209
210 procedure Execute is
211 begin
212 Bus.Execute;
213 end Execute;
214
215 --------------
216 -- Register --
217 --------------
218
219 procedure Register
220 (Name : String;
221 Client : Messenger.Client_Sessions.Client_Session_Access) is
222 begin
223 Bus.Register (Name, Client);
224 end Register;
225
226 --------------
227 -- Shutdown --
228 --------------
229
230 procedure Shutdown is
231 begin
232 Bus.Shutdown;
233 end Shutdown;
234
235 ----------
236 -- Send --
237 ----------
238
239 procedure Send (From : String; To : String; Text : String) is
240 begin
241 Bus.Send (From, To, Text);
242 end Send;
243
244end Server.Bus;
Note: See TracBrowser for help on using the repository browser.