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 | -- SPDX-FileCopyrightText: 2020 Max Reznik <reznikmm@gmail.com>
--
-- SPDX-License-Identifier: MIT
----------------------------------------------------------------
with Ada.Streams;
with Ada.Exceptions;
with League.Stream_Element_Vectors;
with League.Text_Codecs;
with Spawn.Processes.Monitor_Loop;
with Spawn.Processes;
with Spawn.String_Vectors;
package body Processes is
function "+" (Text : Wide_Wide_String)
return League.Strings.Universal_String
renames League.Strings.To_Universal_String;
---------
-- Run --
---------
procedure Run
(Program : League.Strings.Universal_String;
Arguments : League.String_Vectors.Universal_String_Vector;
Directory : League.Strings.Universal_String;
Output : out League.Strings.Universal_String;
Errors : out League.Strings.Universal_String;
Status : out Integer)
is
type Listener is new Spawn.Processes.Process_Listener with record
Output : League.Stream_Element_Vectors.Stream_Element_Vector;
Errors : League.Stream_Element_Vectors.Stream_Element_Vector;
Status : Integer := 0;
Done : Boolean := False;
end record;
procedure Standard_Output_Available (Self : in out Listener);
procedure Standard_Error_Available (Self : in out Listener);
procedure Finished
(Self : in out Listener;
Exit_Code : Integer);
procedure Error_Occurred
(Self : in out Listener;
Process_Error : Integer);
procedure Exception_Occurred
(Self : in out Listener;
Occurrence : Ada.Exceptions.Exception_Occurrence);
Process : Spawn.Processes.Process;
-------------------------------
-- Standard_Output_Available --
-------------------------------
procedure Standard_Output_Available (Self : in out Listener) is
use type Ada.Streams.Stream_Element_Count;
Data : Ada.Streams.Stream_Element_Array (1 .. 512);
Last : Ada.Streams.Stream_Element_Count;
begin
loop
Process.Read_Standard_Output (Data, Last);
exit when Last < Data'First;
Self.Output.Append (Data (1 .. Last));
end loop;
end Standard_Output_Available;
------------------------------
-- Standard_Error_Available --
------------------------------
procedure Standard_Error_Available (Self : in out Listener) is
use type Ada.Streams.Stream_Element_Count;
Data : Ada.Streams.Stream_Element_Array (1 .. 512);
Last : Ada.Streams.Stream_Element_Count;
begin
loop
Process.Read_Standard_Error (Data, Last);
exit when Last < Data'First;
Self.Errors.Append (Data (1 .. Last));
end loop;
end Standard_Error_Available;
--------------
-- Finished --
--------------
procedure Finished
(Self : in out Listener;
Exit_Code : Integer) is
begin
Self.Status := Exit_Code;
Self.Done := True;
end Finished;
--------------------
-- Error_Occurred --
--------------------
procedure Error_Occurred
(Self : in out Listener;
Process_Error : Integer) is
pragma Unreferenced (Self);
begin
Errors.Append (+"Error_Occurred");
Self.Status := Process_Error;
Self.Done := True;
end Error_Occurred;
procedure Exception_Occurred
(Self : in out Listener;
Occurrence : Ada.Exceptions.Exception_Occurrence) is
begin
Errors.Append
(League.Strings.From_UTF_8_String
(Ada.Exceptions.Exception_Information (Occurrence)));
Self.Status := -1;
Self.Done := True;
end Exception_Occurred;
Codec : constant League.Text_Codecs.Text_Codec :=
League.Text_Codecs.Codec_For_Application_Locale;
Args : Spawn.String_Vectors.UTF_8_String_Vector;
Feedback : aliased Listener;
begin
Process.Set_Program (Program.To_UTF_8_String);
for J in 1 .. Arguments.Length loop
Args.Append (Arguments (J).To_UTF_8_String);
end loop;
Process.Set_Arguments (Args);
Process.Set_Working_Directory (Directory.To_UTF_8_String);
Process.Set_Listener (Feedback'Unchecked_Access);
Process.Start;
while not Feedback.Done loop
Spawn.Processes.Monitor_Loop (Timeout => 50);
end loop;
Output := Codec.Decode (Feedback.Output);
Errors.Append (Codec.Decode (Feedback.Errors));
Status := Feedback.Status;
end Run;
end Processes;
|