line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################# |
2
|
|
|
|
|
|
|
## Name: Wx/Perl/ProcessStream.pm |
3
|
|
|
|
|
|
|
## Purpose: capture async process STDOUT/STDERR |
4
|
|
|
|
|
|
|
## Author: Mark Dootson |
5
|
|
|
|
|
|
|
## Modified by: |
6
|
|
|
|
|
|
|
## Created: 11/05/2007 |
7
|
|
|
|
|
|
|
## Copyright: (c) 2007-2010 Mark Dootson |
8
|
|
|
|
|
|
|
## Licence: This program is free software; you can redistribute it and/or |
9
|
|
|
|
|
|
|
## modify it under the same terms as Perl itself |
10
|
|
|
|
|
|
|
############################################################################# |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Wx::Perl::ProcessStream; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.32'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Wx::Perl::ProcessStream - access IO of external processes via events |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 VERSION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Version 0.32 |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 SYNOPSYS |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use Wx::Perl::ProcessStream qw( :everything ); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_STDOUT ( $self, \&evt_process_stdout ); |
29
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_STDERR ( $self, \&evt_process_stderr ); |
30
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_EXIT ( $self, \&evt_process_exit ); |
31
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_MAXLINES ( $self, \&evt_process_maxlines ); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my $proc1 = Wx::Perl::ProcessStream::Process->new('perl -e"print qq($_\n) for(@INC);"', 'MyName1', $self); |
34
|
|
|
|
|
|
|
$proc1->Run; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $command = 'executable.exe parm1 parm2 parm3' |
37
|
|
|
|
|
|
|
my $proc2 = Wx::Perl::ProcessStream::Process->new($command, 'MyName2', $self) |
38
|
|
|
|
|
|
|
->Run; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my @args = qw( executable.exe parm1 parm2 parm3 ); |
41
|
|
|
|
|
|
|
my $proc3 = Wx::Perl::ProcessStream::Process->new(\@args, 'MyName2', $self); |
42
|
|
|
|
|
|
|
$proc3->Run; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $proc4 = Wx::Perl::ProcessStream::Process->new(\@args, 'MyName2', $self, 'readline')->Run; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $proc5 = Wx::Perl::ProcessStream::Process->new(\@args, 'MyName2', $self); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub evt_process_stdout { |
49
|
|
|
|
|
|
|
my ($self, $event) = @_; |
50
|
|
|
|
|
|
|
$event->Skip(1); |
51
|
|
|
|
|
|
|
my $process = $event->GetProcess; |
52
|
|
|
|
|
|
|
my $line = $event->GetLine; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
if($line eq 'something we are waiting for') { |
55
|
|
|
|
|
|
|
$process->WriteProcess('a message to stdin'); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$process->CloseInput() if($finishedwriting); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
............ |
60
|
|
|
|
|
|
|
# To Clear Buffer |
61
|
|
|
|
|
|
|
my @buffers = @{ $process->GetStdOutBuffer }; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub evt_process_stderr { |
66
|
|
|
|
|
|
|
my ($self, $event) = @_; |
67
|
|
|
|
|
|
|
$event->Skip(1); |
68
|
|
|
|
|
|
|
my $process = $event->GetProcess; |
69
|
|
|
|
|
|
|
my $line = $event->GetLine; |
70
|
|
|
|
|
|
|
print STDERR qq($line\n); |
71
|
|
|
|
|
|
|
# To Clear Buffer |
72
|
|
|
|
|
|
|
my @errors = @{ $process->GetStdErrBuffer }; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub evt_process_exit { |
76
|
|
|
|
|
|
|
my ($self, $event) = @_; |
77
|
|
|
|
|
|
|
$event->Skip(1); |
78
|
|
|
|
|
|
|
my $process = $event->GetProcess; |
79
|
|
|
|
|
|
|
my $line = $event->GetLine; |
80
|
|
|
|
|
|
|
my @buffers = @{ $process->GetStdOutBuffer }; |
81
|
|
|
|
|
|
|
my @errors = @{ $process->GetStdErrBuffer }; |
82
|
|
|
|
|
|
|
my $exitcode = $process->GetExitCode; |
83
|
|
|
|
|
|
|
............ |
84
|
|
|
|
|
|
|
$process->Destroy; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub evt_process_maxlines { |
88
|
|
|
|
|
|
|
my ($self, $event) = @_; |
89
|
|
|
|
|
|
|
my $process = $event->GetProcess; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
..... bad process |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$process->Kill; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 DESCRIPTION |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
This module provides the STDOUT, STDERR and exit codes of asynchronously running processes via events. |
100
|
|
|
|
|
|
|
It may be used for long running or blocking processes that provide periodic updates on state via STDOUT. Simple IPC is possible via STDIN. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
Do not use this module simply to collect the output of another process. For that, it is much simpler to do: |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
my ($status, $output) = Wx::ExecuteStdout( 'perl -e"print qq($_\n) for(@INC);"' ); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head2 Wx::Perl::ProcessStream::Process |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head3 Methods |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=over 12 |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=item new |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Create a new Wx::Perl::ProcessStream::Process object. You must then use the Run method to execute |
116
|
|
|
|
|
|
|
your command. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my $process = Wx::Perl::ProcessStream::Process->new($command, $name, $eventhandler, $readmethod); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
$command = command text (and parameters) you wish to run. You may also pass a |
121
|
|
|
|
|
|
|
reference to an array containing the command and parameters. |
122
|
|
|
|
|
|
|
$name = an arbitray name for the process. |
123
|
|
|
|
|
|
|
$eventhandler = the Wx EventHandler (Wx:Window) that will handle events for this process. |
124
|
|
|
|
|
|
|
$readmethod = 'read' or 'readline' (default = 'readline') an optional param. From Wx version |
125
|
|
|
|
|
|
|
0.75 you can specify the method you wish to use to read the output of an |
126
|
|
|
|
|
|
|
external process. |
127
|
|
|
|
|
|
|
The default depends on your Wx version ( 'getc' < 0.75,'readline' >= 0.75) |
128
|
|
|
|
|
|
|
read -- uses the Wx::InputStream->READ method to read bytes. |
129
|
|
|
|
|
|
|
readline -- uses the Wx::InputStream->READLINE method to read bytes |
130
|
|
|
|
|
|
|
getc -- alias for read (getc not actually used) |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=item SetMaxLines |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Set the maximum number of lines that will be read from a continuous stream before raising a |
135
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_MAXLINES event. The default is 1000. A continuous stream will cause |
136
|
|
|
|
|
|
|
your application to hang. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
$process->SetMaxLines(10); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item Run |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Run the process with the parameters passed to new. On success, returns the process object itself. |
143
|
|
|
|
|
|
|
This allows you to do: my $process = Wx::Perl::ProcessStream->new($command, $name, $self)->Run; |
144
|
|
|
|
|
|
|
Returns undef if the process could not be started. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $process = Wx::Perl::ProcessStream::Process->new($command, $name, $eventhandler, $readmethod); |
147
|
|
|
|
|
|
|
$process->Run; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=item CloseInput |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
Close the STDIN stream of the external process. (Some processes may not close until STDIN is closed.) |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$process->CloseInput(); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item GetAppCloseAction |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Returns the current process signal that will used on application exit. Either wxpSIGTERM or wxpSIGKILL. |
158
|
|
|
|
|
|
|
See SetAppCloseAction. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
my $action = $process->GetAppCloseAction(); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=item GetExitCode |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Returns the process exit code. It is undefined until a wxpEVT_PROCESS_STREAM_EXIT event has been received. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $exitcode = $process->GetExitCode(); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=item GetProcessName |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Returns the process name as passed to the OpenProcess constructor. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my $processname = $process->GetProcessName(); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item GetStdErrBuffer |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
This returns a reference to an array containing all the lines sent by the process to stderr. |
177
|
|
|
|
|
|
|
Calling this clears the process object internal stderr buffer. |
178
|
|
|
|
|
|
|
(This has no effect on the actual process I/O buffers.) |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
my $arryref = $process->GetStdErrBuffer(); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=item GetStdOutBuffer |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
This returns a reference to an array containing all the lines sent by the process to stdout. |
185
|
|
|
|
|
|
|
Calling this clears the process object internal stdout buffer. |
186
|
|
|
|
|
|
|
(This has no effect on the actual process I/O buffers.) |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
my $arryref = $process->GetStdOutBuffer(); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=item GetStdErrBufferLineCount |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
This returns the number of lines currently in the stderr buffer. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
my $count = $process->GetStdErrBufferLineCount(); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item GetStdOutBufferLineCount |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
This returns the number of lines currently in the stdout buffer. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my $count = $process->GetStdOutBufferLineCount(); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=item PeekStdErrBuffer |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
This returns a reference to an array containing all the lines sent by the process to stderr. |
205
|
|
|
|
|
|
|
To retrieve the buffer and clear it, call GetStdErrBuffer instead. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
my $arryref = $process->PeekStdErrBuffer(); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=item PeekStdOutBuffer |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
This returns a reference to an array containing all the lines sent by the process to stdout. |
212
|
|
|
|
|
|
|
To retrieve the buffer and clear it, call GetStdOutBuffer instead. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
my $arryref = $process->PeekStdOutBuffer(); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=item GetProcessId |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Returns the process id assigned by the system. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
my $processid = $process->GetProcessId(); |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=item GetPid |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Returns the process id assigned by the system. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
my $processid = $process->GetPid(); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item IsAlive |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Check if the process still exists in the system. |
231
|
|
|
|
|
|
|
Returns 1 if process exists, 0 if process does not exist. If the process has already |
232
|
|
|
|
|
|
|
signalled its exit, the IsAlive method will always return 0. Therefore IsAlive should |
233
|
|
|
|
|
|
|
always return 0 (false) once a EVT_WXP_PROCESS_STREAM_EXIT event has been sent. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $isalive = $process->IsAlive(); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=item KillProcess |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Send a SIGKILL signal to the external process. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$process->KillProcess(); |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=item SetAppCloseAction |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
When your application exits, any remaining Wx::Perl::ProcessStream::Process objects will be signaled to close. |
246
|
|
|
|
|
|
|
The default signal is wxpSIGTERM but you can change this to wxpSIGKILL if you are sure this is what you want. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
$process->SetAppCloseAction( $newaction ); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
$newaction = one of wxpSIGTERM, wxpSIGKILL |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=item TerminateProcess |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Send a SIGTERM signal to the external process. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
$process->TerminateProcess(); |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=item WriteProcess |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
Write to the STDIN of process. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
$process->WriteProcess( $writedata . "\n" ); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
$writedata = The data you wish to write. Remember to add any appropriate line endings your external process may expect. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=back |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 Wx::Perl::ProcessStream |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head3 Methods |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=over 12 |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=item OpenProcess |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Run an external process. DEPRECATED - use Wx::Perl::ProcessStream::Process->new()->Run; |
279
|
|
|
|
|
|
|
If the process is launched successfully, returns a Wx::Perl::ProcessStream::Process object. |
280
|
|
|
|
|
|
|
If the process could not be launched, returns undef; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $process = Wx::Perl::ProcessStream->OpenProcess($command, $name, $eventhandler, $readmethod); |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
$command = command text (and parameters) you wish to run. You may also pass a |
285
|
|
|
|
|
|
|
reference to an array containing the command and parameters. |
286
|
|
|
|
|
|
|
$name = an arbitray name for the process. |
287
|
|
|
|
|
|
|
$eventhandler = the Wx object that will handle events for this process. |
288
|
|
|
|
|
|
|
$process = Wx::Perl::ProcessStream::Process object |
289
|
|
|
|
|
|
|
$readmethod = 'getc' or 'readline' (default = 'readline') an optional param. From Wx version |
290
|
|
|
|
|
|
|
0.75 you can specifiy the method you wish to use to read the output of an |
291
|
|
|
|
|
|
|
external process. The default depends on your Wx version ( 'getc' < 0.75, |
292
|
|
|
|
|
|
|
'readline' >= 0.75) |
293
|
|
|
|
|
|
|
'getc' uses the Wx::InputStream->GetC method to read bytes. |
294
|
|
|
|
|
|
|
'readline', uses the wxPerl implementation of Wx::InputStream->READLINE. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
If the process could not be started then zero is returned. |
297
|
|
|
|
|
|
|
You should destroy each process after it has completed. You can do this after receiving the exit event. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=item GetDefaultAppCloseAction |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Returns the default on application close action that will be given to new processes. |
303
|
|
|
|
|
|
|
When your application exits, any remaining Wx::Perl::ProcessStream::Process objects will be signalled to close. |
304
|
|
|
|
|
|
|
The default signal is wxpSIGTERM but you can change this to wxpSIGKILL if you are sure this is what you want. |
305
|
|
|
|
|
|
|
Whenever a mew process is opened, it is given the application close action returned by GetDefaultAppCloseAction. |
306
|
|
|
|
|
|
|
You can also set the application close action at an individual process level. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my $def-action = Wx::Perl::ProcessStream->SetDefaultAppCloseAction(); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
$def-action will be one of wxpSIGTERM or wxpSIGKILL; (default wxpSIGTERM) |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=item SetDefaultAppCloseAction |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Sets the default on application close action that will be given to new processes. |
316
|
|
|
|
|
|
|
See GetDefaultAppCloseAction. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Wx::Perl::ProcessStream->SetDefaultAppCloseAction( $newdefaction ); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
$newdefaction = one of wxpSIGTERM or wxpSIGKILL |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=item SetDefaultMaxLines |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Sets the default maximum number of lines that will be processed continuously from |
325
|
|
|
|
|
|
|
an individual process. If a process produces a continuous stream of output, this would |
326
|
|
|
|
|
|
|
hang your application. This setting provides a maximum number of lines that will be |
327
|
|
|
|
|
|
|
read from the process streams before control is yielded and the events can be processed. |
328
|
|
|
|
|
|
|
Additionally, a EVT_WXP_PROCESS_STREAM_MAXLINES event will be sent to the eventhandler. |
329
|
|
|
|
|
|
|
The setting can also be set on an individual process basis using $process->SetMaxLines |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
Wx::Perl::ProcessStream->SetDefaultMaxLines( $maxlines ); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
the default maxlines number is 1000 |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=item GetPollInterval |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
Get the current polling interval. See SetPollInterval. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
$milliseconds = Wx::Perl::ProcessStream->GetPollInterval(); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=item SetPollInterval |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
When all buffers are empty but there are still running external process, the module will pause before polling the processes again for output. |
344
|
|
|
|
|
|
|
By default, the module waits for 500 milliseconds. You can set the value of this polling intrval with this method. |
345
|
|
|
|
|
|
|
Internally, a Wx::Timer object is used to handle polling and the value you set here is passed directly to that. |
346
|
|
|
|
|
|
|
The precision of the intervals is OS dependent. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Wx::Perl::ProcessStream->SetPollInterval( $milliseconds ); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
$milliseconds = number of milliseconds to wait when no buffer activity |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=back |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=head2 Wx::Perl::ProcessStream::ProcessEvent |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
A Wx::Perl::ProcessStream::ProcessEvent is sent whenever an external process started with OpenProcess writes to STDOUT, STDERR or when the process exits. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head3 Event Connectors |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=over 12 |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=item EVT_WXP_PROCESS_STREAM_STDOUT |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
Install an event handler for an event of type wxpEVT_PROCESS_STREAM_STDOUT exported on request by this module. |
366
|
|
|
|
|
|
|
The event subroutine will receive a Wx::Perl::ProcessStream::ProcessEvent for every line written to STDOUT by the external process. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_STDOUT( $eventhandler, $codref ); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=item EVT_WXP_PROCESS_STREAM_STDERR |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Install an event handler for an event of type wxpEVT_PROCESS_STREAM_STDERR exported on request by this module. |
373
|
|
|
|
|
|
|
The event subroutine will receive a Wx::Perl::ProcessStream::ProcessEvent for every line written to STDERR by the external process. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_STDERR( $eventhandler, $codref ); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=item EVT_WXP_PROCESS_STREAM_EXIT |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Install an event handler for an event of type wxpEVT_PROCESS_STREAM_EXIT exported on request by this module. |
380
|
|
|
|
|
|
|
The event subroutine will receive a Wx::Perl::ProcessStream::ProcessEvent when the external process exits. |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_EXIT( $eventhandler, $codref ); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=item EVT_WXP_PROCESS_STREAM_MAXLINES |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
Install an event handler for an event of type wxpEVT_PROCESS_STREAM_MAXLINES exported on request by this module. |
387
|
|
|
|
|
|
|
The event subroutine will receive a Wx::Perl::ProcessStream::ProcessEvent when the external process produces |
388
|
|
|
|
|
|
|
a continuous stream of lines on stderr and stdout that exceed the max lines set via $process->SetMaxLines or |
389
|
|
|
|
|
|
|
Wx::Perl::ProcessStream->SetDefaultMaxLines. |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_MAXLINES( $eventhandler, $codref ); |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=back |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head3 Methods |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=over 12 |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=item GetLine |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
For events of type wxpEVT_PROCESS_STREAM_STDOUT and wxpEVT_PROCESS_STREAM_STDERR this will return the line written by the process. |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=item GetProcess |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
This returns the process that raised the event. If this is a wxpEVT_PROCESS_STREAM_EXIT event you should destroy the process with $process->Destroy; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=back |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Copyright (C) 2007-2010 Mark Dootson, all rights reserved. |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
414
|
|
|
|
|
|
|
under the same terms as Perl itself. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
Thanks to Johan Vromans for testing and suggesting a better interface. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=head1 AUTHOR |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
Mark Dootson, C<< >> |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head1 SEE ALSO |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
The distribution includes examples in the 'example' folder. |
427
|
|
|
|
|
|
|
From the source root, run |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
perl -Ilib example/psexample.pl |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
You can enter commands, execute them and view results. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
You may also wish to consult the wxWidgets manuals for: |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Wx::Process |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Wx::Execute |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
Wx::ExecuteArgs |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Wx::ExecuteCommand |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
Wx::ExecuteStdout |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
Wx::ExecuteStdoutStderr |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=cut |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
#----------------------------------------------------- |
450
|
|
|
|
|
|
|
# PACKAGE Wx::Perl::ProcessStream |
451
|
|
|
|
|
|
|
#----------------------------------------------------- |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
package Wx::Perl::ProcessStream; |
454
|
1
|
|
|
1
|
|
25798
|
use strict; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
55
|
|
455
|
1
|
|
|
1
|
|
508
|
use Wx 0.50 qw( wxEXEC_ASYNC wxSIGTERM wxSIGKILL); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
require Exporter; |
457
|
|
|
|
|
|
|
use base qw(Exporter); |
458
|
|
|
|
|
|
|
use Wx::Perl::Carp; |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
#----------------------------------------------------- |
461
|
|
|
|
|
|
|
# check wxWidgets version |
462
|
|
|
|
|
|
|
#----------------------------------------------------- |
463
|
|
|
|
|
|
|
if( Wx::wxVERSION() < 2.0060025) { |
464
|
|
|
|
|
|
|
croak qq(Wx $Wx::VERSION compiled with $Wx::wxVERSION_STRING.\n\nMinimum wxWidgets version 2.6.3 required for Wx::Perl::ProcessStream $VERSION); |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
#----------------------------------------------------- |
468
|
|
|
|
|
|
|
# initialise |
469
|
|
|
|
|
|
|
#----------------------------------------------------- |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
our ($ID_CMD_EXIT, $ID_CMD_STDOUT, $ID_CMD_STDERR, $ID_CMD_MAXLINES, |
472
|
|
|
|
|
|
|
$WXP_DEFAULT_CLOSE_ACTION, $WXP_DEFAULT_MAX_LINES, $WXPDEBUG); |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
$ID_CMD_EXIT = Wx::NewEventType(); |
475
|
|
|
|
|
|
|
$ID_CMD_STDOUT = Wx::NewEventType(); |
476
|
|
|
|
|
|
|
$ID_CMD_STDERR = Wx::NewEventType(); |
477
|
|
|
|
|
|
|
$ID_CMD_MAXLINES = Wx::NewEventType(); |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
$WXP_DEFAULT_CLOSE_ACTION = wxSIGTERM; |
480
|
|
|
|
|
|
|
$WXP_DEFAULT_MAX_LINES = 1000; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
our @EXPORT_OK = qw( wxpEVT_PROCESS_STREAM_EXIT |
483
|
|
|
|
|
|
|
wxpEVT_PROCESS_STREAM_STDERR |
484
|
|
|
|
|
|
|
wxpEVT_PROCESS_STREAM_STDOUT |
485
|
|
|
|
|
|
|
wxpEVT_PROCESS_STREAM_MAXLINES |
486
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_STDOUT |
487
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_STDERR |
488
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_EXIT |
489
|
|
|
|
|
|
|
EVT_WXP_PROCESS_STREAM_MAXLINES |
490
|
|
|
|
|
|
|
wxpSIGTERM |
491
|
|
|
|
|
|
|
wxpSIGKILL |
492
|
|
|
|
|
|
|
); |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
our %EXPORT_TAGS = (); |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
$EXPORT_TAGS{'everything'} = \@EXPORT_OK; |
497
|
|
|
|
|
|
|
$EXPORT_TAGS{'all'} = \@EXPORT_OK; |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
our $ProcHandler = Wx::Perl::ProcessStream::ProcessHandler->new(); |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
sub wxpEVT_PROCESS_STREAM_EXIT () { $ID_CMD_EXIT } |
502
|
|
|
|
|
|
|
sub wxpEVT_PROCESS_STREAM_STDERR () { $ID_CMD_STDERR } |
503
|
|
|
|
|
|
|
sub wxpEVT_PROCESS_STREAM_STDOUT () { $ID_CMD_STDOUT } |
504
|
|
|
|
|
|
|
sub wxpEVT_PROCESS_STREAM_MAXLINES () { $ID_CMD_MAXLINES } |
505
|
|
|
|
|
|
|
sub wxpSIGTERM () { wxSIGTERM } |
506
|
|
|
|
|
|
|
sub wxpSIGKILL () { wxSIGKILL } |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
sub EVT_WXP_PROCESS_STREAM_STDOUT ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_STDOUT, $_[1] ) }; |
509
|
|
|
|
|
|
|
sub EVT_WXP_PROCESS_STREAM_STDERR ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_STDERR, $_[1] ) }; |
510
|
|
|
|
|
|
|
sub EVT_WXP_PROCESS_STREAM_EXIT ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_EXIT, $_[1] ) }; |
511
|
|
|
|
|
|
|
sub EVT_WXP_PROCESS_STREAM_MAXLINES ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_MAXLINES, $_[1] ) }; |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
sub Yield { Wx::YieldIfNeeded; } |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
# Old interface - call Wx::Perl::ProcessStream::new |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub OpenProcess { |
518
|
|
|
|
|
|
|
my $class = shift; |
519
|
|
|
|
|
|
|
my( $command, $procname, $handler, $readmethod ) = @_; |
520
|
|
|
|
|
|
|
my $process = Wx::Perl::ProcessStream::Process->new( $command, $procname, $handler, $readmethod ); |
521
|
|
|
|
|
|
|
return ( $process->Run ) ? $process : undef; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
sub SetDefaultAppCloseAction { |
525
|
|
|
|
|
|
|
my $class = shift; |
526
|
|
|
|
|
|
|
my $newaction = shift; |
527
|
|
|
|
|
|
|
$WXP_DEFAULT_CLOSE_ACTION = ($newaction == wxSIGTERM||wxSIGKILL) ? $newaction : $WXP_DEFAULT_CLOSE_ACTION; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub GetDefaultAppCloseAction { $WXP_DEFAULT_CLOSE_ACTION; } |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub SetDefaultMaxLines { |
533
|
|
|
|
|
|
|
my $class = shift; |
534
|
|
|
|
|
|
|
$WXP_DEFAULT_MAX_LINES = shift || 1; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub GetDefaultMaxLines { $WXP_DEFAULT_MAX_LINES; } |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub GetPollInterval { |
540
|
|
|
|
|
|
|
$ProcHandler->GetInterval(); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub SetPollInterval { |
544
|
|
|
|
|
|
|
my ($class, $interval) = @_; |
545
|
|
|
|
|
|
|
$ProcHandler->_set_poll_interval($interval); |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
sub ProcessCount { $ProcHandler->ProcessCount; } |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
#----------------------------------------------------- |
552
|
|
|
|
|
|
|
# PACKAGE Wx::Perl::ProcessStream::ProcessHandler; |
553
|
|
|
|
|
|
|
# |
554
|
|
|
|
|
|
|
# Inherits from timer and cycles througn running |
555
|
|
|
|
|
|
|
# processes raising events for STDOUT/STDERR/EXIT |
556
|
|
|
|
|
|
|
#----------------------------------------------------- |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
package Wx::Perl::ProcessStream::ProcessHandler; |
559
|
|
|
|
|
|
|
use strict; |
560
|
|
|
|
|
|
|
use Wx qw( wxSIGTERM wxSIGKILL); |
561
|
|
|
|
|
|
|
use base qw( Wx::Timer ); |
562
|
|
|
|
|
|
|
use Wx::Perl::Carp; |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub DESTROY { |
565
|
|
|
|
|
|
|
my $self = shift; |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
## clear any live procs |
568
|
|
|
|
|
|
|
for my $process (@{ $self->{_procs} }) { |
569
|
|
|
|
|
|
|
my $procid = $process->GetProcessId() if($process->IsAlive()); |
570
|
|
|
|
|
|
|
$process->Detach; |
571
|
|
|
|
|
|
|
Wx::Process::Kill($procid, $process->GetAppCloseAction()); |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
$self->SUPER::DESTROY if $self->can("SUPER::DESTROY"); |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub new { |
578
|
|
|
|
|
|
|
my $self = shift->SUPER::new(@_); |
579
|
|
|
|
|
|
|
$self->{_procs} = []; |
580
|
|
|
|
|
|
|
$self->{_pollinterval} = 500; |
581
|
|
|
|
|
|
|
return $self; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub _set_poll_interval { |
585
|
|
|
|
|
|
|
my $self = shift; |
586
|
|
|
|
|
|
|
$self->{_pollinterval} = shift; |
587
|
|
|
|
|
|
|
if($self->IsRunning()) { |
588
|
|
|
|
|
|
|
$self->Stop(); |
589
|
|
|
|
|
|
|
$self->Start( $self->{_pollinterval} ); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub Notify { |
594
|
|
|
|
|
|
|
my ($self ) = @_; |
595
|
|
|
|
|
|
|
return 1 if($self->{_notify_in_progress}); # do not re-enter notify proc |
596
|
|
|
|
|
|
|
$self->{_notify_in_progress} = 1; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
my $continueprocessloop = 1; |
599
|
|
|
|
|
|
|
my $eventscreated = 0; |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
while( $continueprocessloop ) { |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
$continueprocessloop = 0; |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
my @checkprocs = @{ $self->{_procs} }; |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
for my $process (@checkprocs) { |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
# process inout actions |
610
|
|
|
|
|
|
|
while( my $action = shift( @{ $process->{_await_actions} }) ) { |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
$continueprocessloop ++; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
if( $action->{action} eq 'terminate' ) { |
615
|
|
|
|
|
|
|
$process->CloseOutput() if( defined(my $handle = $process->GetOutputStream() ) ); |
616
|
|
|
|
|
|
|
Wx::Process::Kill($process->GetProcessId(), wxSIGTERM); |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
}elsif( $action->{action} eq 'kill' ) { |
619
|
|
|
|
|
|
|
$process->CloseOutput() if( defined(my $handle = $process->GetOutputStream() ) ); |
620
|
|
|
|
|
|
|
Wx::Process::Kill($process->GetProcessId(), wxSIGKILL); |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
}elsif( $action->{action} eq 'closeinput') { |
623
|
|
|
|
|
|
|
$process->CloseOutput() if( defined(my $handle = $process->GetOutputStream() ) ); |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
} elsif( $action->{action} eq 'write') { |
626
|
|
|
|
|
|
|
if(defined( my $fh = $process->GetOutputStream() )) { |
627
|
|
|
|
|
|
|
print $fh $action->{writedata}; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
my $procexitcode = $process->GetExitCode; |
633
|
|
|
|
|
|
|
my $linedataread = 0; |
634
|
|
|
|
|
|
|
my $maxlinecount = $process->GetMaxLines; |
635
|
|
|
|
|
|
|
$maxlinecount = 1 if $maxlinecount < 1; |
636
|
|
|
|
|
|
|
if(!$process->_exit_event_posted) { |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# STDERR |
639
|
|
|
|
|
|
|
while( ( my $linebuffer = $process->__read_error_line ) ){ |
640
|
|
|
|
|
|
|
$continueprocessloop ++; |
641
|
|
|
|
|
|
|
$linedataread ++; |
642
|
|
|
|
|
|
|
$linebuffer =~ s/(\r\n|\n)$//; |
643
|
|
|
|
|
|
|
my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_STDERR, -1 ); |
644
|
|
|
|
|
|
|
push(@{ $process->{_stderr_buffer} }, $linebuffer); |
645
|
|
|
|
|
|
|
$event->SetLine( $linebuffer ); |
646
|
|
|
|
|
|
|
$event->SetProcess( $process ); |
647
|
|
|
|
|
|
|
$process->__get_handler()->AddPendingEvent($event); |
648
|
|
|
|
|
|
|
$eventscreated ++; |
649
|
|
|
|
|
|
|
last if $linedataread == $maxlinecount; |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
# STDOUT |
654
|
|
|
|
|
|
|
if( $linedataread < $maxlinecount ) { |
655
|
|
|
|
|
|
|
while( ( my $linebuffer = $process->__read_input_line ) ){ |
656
|
|
|
|
|
|
|
$continueprocessloop ++; |
657
|
|
|
|
|
|
|
$linedataread ++; |
658
|
|
|
|
|
|
|
$linebuffer =~ s/(\r\n|\n)$//; |
659
|
|
|
|
|
|
|
my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_STDOUT, -1 ); |
660
|
|
|
|
|
|
|
push(@{ $process->{_stdout_buffer} }, $linebuffer); |
661
|
|
|
|
|
|
|
$event->SetLine( $linebuffer ); |
662
|
|
|
|
|
|
|
$event->SetProcess( $process ); |
663
|
|
|
|
|
|
|
$process->__get_handler()->AddPendingEvent($event); |
664
|
|
|
|
|
|
|
$eventscreated ++; |
665
|
|
|
|
|
|
|
last if $linedataread == $maxlinecount; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
if(defined($procexitcode) && !$linedataread) { |
671
|
|
|
|
|
|
|
# defer exit event until we think all IO buffers are empty |
672
|
|
|
|
|
|
|
# post no more events once we post exit event; |
673
|
|
|
|
|
|
|
$process->_set_exit_event_posted(1); |
674
|
|
|
|
|
|
|
my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_EXIT, -1); |
675
|
|
|
|
|
|
|
$event->SetLine( undef ); |
676
|
|
|
|
|
|
|
$event->SetProcess( $process ); |
677
|
|
|
|
|
|
|
$process->__get_handler()->AddPendingEvent($event); |
678
|
|
|
|
|
|
|
$eventscreated ++; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
# raise the maxline event if required |
682
|
|
|
|
|
|
|
# this will be actioned during outer loop yield |
683
|
|
|
|
|
|
|
if($linedataread == $maxlinecount) { |
684
|
|
|
|
|
|
|
my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_MAXLINES, -1 ); |
685
|
|
|
|
|
|
|
$event->SetLine( undef ); |
686
|
|
|
|
|
|
|
$event->SetProcess( $process ); |
687
|
|
|
|
|
|
|
$process->__get_handler()->AddPendingEvent($event); |
688
|
|
|
|
|
|
|
$eventscreated ++; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
} # for my $process (@checkprocs) { |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
#----------------------------------------------------------------- |
694
|
|
|
|
|
|
|
# yield to allow changes to $self->{_procs} |
695
|
|
|
|
|
|
|
# we will not exit this outer loop until $continueprocessloop == 0 |
696
|
|
|
|
|
|
|
# events we have raised may not get processed in this Yield |
697
|
|
|
|
|
|
|
# Taht may not happen until the outer ->ProcessPendingEvents |
698
|
|
|
|
|
|
|
#----------------------------------------------------------------- |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Wx::Perl::ProcessStream::Yield(); |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
} # while( $continueprocessloop ) { |
703
|
|
|
|
|
|
|
# ProcessPendingEvents happens once per eventloop |
704
|
|
|
|
|
|
|
# Below seems to improve response AND is necessary |
705
|
|
|
|
|
|
|
# in some cases |
706
|
|
|
|
|
|
|
Wx::wxTheApp->ProcessPendingEvents if $eventscreated; |
707
|
|
|
|
|
|
|
$self->{_notify_in_progress} = 0; |
708
|
|
|
|
|
|
|
$self->Stop() unless( $self->ProcessCount ); |
709
|
|
|
|
|
|
|
return 1; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
sub Start { |
713
|
|
|
|
|
|
|
my $self = shift; |
714
|
|
|
|
|
|
|
my @args = @_; |
715
|
|
|
|
|
|
|
$self->SUPER::Start(@args); |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
sub Stop { |
719
|
|
|
|
|
|
|
my $self = shift; |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
$self->SUPER::Stop(); |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
sub AddProc { |
725
|
|
|
|
|
|
|
my $self = shift; |
726
|
|
|
|
|
|
|
my $newproc = shift; |
727
|
|
|
|
|
|
|
push(@{ $self->{_procs} }, $newproc ); |
728
|
|
|
|
|
|
|
$self->Start($self->{_pollinterval}) if(!$self->IsRunning()); |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
sub RemoveProc { |
732
|
|
|
|
|
|
|
my($self, $proc) = @_; |
733
|
|
|
|
|
|
|
my $checkpid = $proc->GetPid; |
734
|
|
|
|
|
|
|
my @oldprocs = @{ $self->{_procs} }; |
735
|
|
|
|
|
|
|
my @newprocs = (); |
736
|
|
|
|
|
|
|
for ( @oldprocs ) { |
737
|
|
|
|
|
|
|
push(@newprocs, $_) if $_->GetPid != $checkpid; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
$self->{_procs} = \@newprocs; |
740
|
|
|
|
|
|
|
delete $Wx::Perl::ProcessStream::Process::_runningpids->{$checkpid}; |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
sub FindProc { |
744
|
|
|
|
|
|
|
my($self, $pid) = @_; |
745
|
|
|
|
|
|
|
my $foundproc = undef; |
746
|
|
|
|
|
|
|
for ( @{ $self->{_procs} } ) { |
747
|
|
|
|
|
|
|
if ($pid == $_->GetPid) { |
748
|
|
|
|
|
|
|
$foundproc = $_; |
749
|
|
|
|
|
|
|
last; |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
return $foundproc; |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
sub ProcessCount { |
756
|
|
|
|
|
|
|
my $self = shift; |
757
|
|
|
|
|
|
|
return scalar @{ $self->{_procs} }; |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
#----------------------------------------------------- |
761
|
|
|
|
|
|
|
# PACKAGE Wx::Perl::ProcessStream::Process |
762
|
|
|
|
|
|
|
# |
763
|
|
|
|
|
|
|
# Adds some extra methods to Wx::Process |
764
|
|
|
|
|
|
|
#----------------------------------------------------- |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
package Wx::Perl::ProcessStream::Process; |
767
|
|
|
|
|
|
|
use strict; |
768
|
|
|
|
|
|
|
use Wx 0.50 qw( |
769
|
|
|
|
|
|
|
wxSIGTERM |
770
|
|
|
|
|
|
|
wxSIGKILL |
771
|
|
|
|
|
|
|
wxSIGNONE |
772
|
|
|
|
|
|
|
wxKILL_OK |
773
|
|
|
|
|
|
|
wxKILL_BAD_SIGNAL |
774
|
|
|
|
|
|
|
wxKILL_ACCESS_DENIED |
775
|
|
|
|
|
|
|
wxKILL_NO_PROCESS |
776
|
|
|
|
|
|
|
wxKILL_ERROR |
777
|
|
|
|
|
|
|
wxEXEC_ASYNC |
778
|
|
|
|
|
|
|
wxID_ANY |
779
|
|
|
|
|
|
|
wxTheApp |
780
|
|
|
|
|
|
|
); |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
use base qw( Wx::Process ); |
783
|
|
|
|
|
|
|
use Wx::Perl::Carp; |
784
|
|
|
|
|
|
|
use Time::HiRes qw( sleep ); |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
our $_runningpids = {}; |
787
|
|
|
|
|
|
|
our $_eventhandler = Wx::Perl::ProcessStream::ProcEvtHandler->new(); |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
sub new { |
790
|
|
|
|
|
|
|
my ($class, $command, $procname, $handler, $readmethod) = @_; |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
$procname ||= 'any'; |
793
|
|
|
|
|
|
|
$readmethod ||= ($Wx::VERSION > 0.74) ? 'readline' : 'read'; |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
my $self = $class->SUPER::new($_eventhandler); |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
$self->Redirect(); |
798
|
|
|
|
|
|
|
$self->SetAppCloseAction(Wx::Perl::ProcessStream->GetDefaultAppCloseAction()); |
799
|
|
|
|
|
|
|
$self->SetMaxLines(Wx::Perl::ProcessStream->GetDefaultMaxLines()); |
800
|
|
|
|
|
|
|
$self->{_readlineon} = ( lc($readmethod) eq 'readline' ) ? 1 : 0; |
801
|
|
|
|
|
|
|
if($self->{_readlineon} && ($Wx::VERSION < 0.75)) { |
802
|
|
|
|
|
|
|
carp('A read method of "readline" cannot be used with Wx versions < 0.75. Reverting to default "read" method'); |
803
|
|
|
|
|
|
|
$readmethod = 'read'; |
804
|
|
|
|
|
|
|
$self->{_readlineon} = 0; |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
print qq(read method is $readmethod\n) if($Wx::Perl::ProcessStream::WXPDEBUG); |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
$self->__set_process_name($procname); |
810
|
|
|
|
|
|
|
$self->__set_handler($handler); |
811
|
|
|
|
|
|
|
$self->{_await_actions} = []; |
812
|
|
|
|
|
|
|
$self->{_stderr_buffer} = []; |
813
|
|
|
|
|
|
|
$self->{_stdout_buffer} = []; |
814
|
|
|
|
|
|
|
$self->{_arg_command} = $command; |
815
|
|
|
|
|
|
|
return $self; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub Run { |
819
|
|
|
|
|
|
|
my $self = shift; |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
my $command = $self->{_arg_command}; |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
my $procid = (ref $command eq 'ARRAY') |
824
|
|
|
|
|
|
|
? Wx::ExecuteArgs ( $command, wxEXEC_ASYNC, $self ) |
825
|
|
|
|
|
|
|
: Wx::ExecuteCommand( $command, wxEXEC_ASYNC, $self ); |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
if($procid) { |
828
|
|
|
|
|
|
|
$self->__set_process_id( $procid ); |
829
|
|
|
|
|
|
|
$Wx::Perl::ProcessStream::ProcHandler->AddProc( $self ); |
830
|
|
|
|
|
|
|
return $self; |
831
|
|
|
|
|
|
|
} else { |
832
|
|
|
|
|
|
|
$self->Destroy; |
833
|
|
|
|
|
|
|
return undef; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
sub SetMaxLines { $_[0]->{_max_read_lines} = $_[1]; } |
838
|
|
|
|
|
|
|
sub GetMaxLines { $_[0]->{_max_read_lines} } |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
sub __read_input_line { |
841
|
|
|
|
|
|
|
my $self = shift; |
842
|
|
|
|
|
|
|
my $linebuffer; |
843
|
|
|
|
|
|
|
my $charbuffer = '0'; |
844
|
|
|
|
|
|
|
use bytes; |
845
|
|
|
|
|
|
|
if($self->{_readlineon}) { |
846
|
|
|
|
|
|
|
print qq(readline method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG); |
847
|
|
|
|
|
|
|
if( $self->IsInputAvailable() && defined( my $tempbuffer = readline( $self->GetInputStream() ) ) ){ |
848
|
|
|
|
|
|
|
$linebuffer = $tempbuffer; |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
} else { |
851
|
|
|
|
|
|
|
print qq(read method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG); |
852
|
|
|
|
|
|
|
while( $self->IsInputAvailable() && ( my $chars = read($self->GetInputStream(),$charbuffer,1 ) ) ) { |
853
|
|
|
|
|
|
|
last if(!$chars); |
854
|
|
|
|
|
|
|
$linebuffer .= $charbuffer; |
855
|
|
|
|
|
|
|
last if($charbuffer eq "\n"); |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
no bytes; |
859
|
|
|
|
|
|
|
return $linebuffer; |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub __read_error_line { |
863
|
|
|
|
|
|
|
my $self = shift; |
864
|
|
|
|
|
|
|
my $linebuffer; |
865
|
|
|
|
|
|
|
my $charbuffer = '0'; |
866
|
|
|
|
|
|
|
use bytes; |
867
|
|
|
|
|
|
|
if($self->{_readlineon}) { |
868
|
|
|
|
|
|
|
print qq(readline method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG); |
869
|
|
|
|
|
|
|
if( $self->IsErrorAvailable() && defined( my $tempbuffer = readline( $self->GetErrorStream() ) ) ){ |
870
|
|
|
|
|
|
|
$linebuffer = $tempbuffer; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
} else { |
873
|
|
|
|
|
|
|
print qq(read method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG); |
874
|
|
|
|
|
|
|
while($self->IsErrorAvailable() && ( my $chars = read($self->GetErrorStream(),$charbuffer,1 ) ) ) { |
875
|
|
|
|
|
|
|
last if(!$chars); |
876
|
|
|
|
|
|
|
$linebuffer .= $charbuffer; |
877
|
|
|
|
|
|
|
last if($charbuffer eq "\n"); |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
no bytes; |
881
|
|
|
|
|
|
|
return $linebuffer; |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
sub __get_handler { |
885
|
|
|
|
|
|
|
my $self = shift; |
886
|
|
|
|
|
|
|
return $self->{_handler}; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
sub __set_handler { |
890
|
|
|
|
|
|
|
my $self = shift; |
891
|
|
|
|
|
|
|
$self->{_handler} = shift; |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
sub GetAppCloseAction { |
895
|
|
|
|
|
|
|
my $self = shift; |
896
|
|
|
|
|
|
|
return $self->{_closeaction}; |
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
sub SetAppCloseAction { |
900
|
|
|
|
|
|
|
my $self = shift; |
901
|
|
|
|
|
|
|
my $newaction = shift; |
902
|
|
|
|
|
|
|
$self->{_closeaction} = ($newaction == wxSIGTERM||wxSIGKILL) ? $newaction : $self->{_closeaction}; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub GetProcessName { |
906
|
|
|
|
|
|
|
my $self = shift; |
907
|
|
|
|
|
|
|
return $self->{_procname}; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
sub __set_process_name { |
911
|
|
|
|
|
|
|
my $self = shift; |
912
|
|
|
|
|
|
|
$self->{_procname} = shift; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
sub GetExitCode { |
916
|
|
|
|
|
|
|
my $self = shift; |
917
|
|
|
|
|
|
|
if(!defined($self->{_stored_event_exit_code})) { |
918
|
|
|
|
|
|
|
my $pid = $self->GetPid; |
919
|
|
|
|
|
|
|
$self->{_stored_event_exit_code} = $_runningpids->{$pid}; |
920
|
|
|
|
|
|
|
} |
921
|
|
|
|
|
|
|
return $self->{_stored_event_exit_code}; |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
sub GetStdOutBuffer { |
925
|
|
|
|
|
|
|
my $self = shift; |
926
|
|
|
|
|
|
|
my @buffers = @{ $self->{_stdout_buffer} }; |
927
|
|
|
|
|
|
|
$self->{_stdout_buffer} = []; |
928
|
|
|
|
|
|
|
return \@buffers; |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
sub GetStdErrBuffer { |
932
|
|
|
|
|
|
|
my $self = shift; |
933
|
|
|
|
|
|
|
my @buffers = @{ $self->{_stderr_buffer} }; |
934
|
|
|
|
|
|
|
$self->{_stderr_buffer} = []; |
935
|
|
|
|
|
|
|
return \@buffers; |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
sub GetStdOutBufferLineCount { |
939
|
|
|
|
|
|
|
my $self = shift; |
940
|
|
|
|
|
|
|
return scalar @{ $self->{_stdout_buffer} }; |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
sub GetStdErrBufferLineCount { |
944
|
|
|
|
|
|
|
my $self = shift; |
945
|
|
|
|
|
|
|
return scalar @{ $self->{_stderr_buffer} }; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
sub PeekStdOutBuffer { |
949
|
|
|
|
|
|
|
my $self = shift; |
950
|
|
|
|
|
|
|
my @buffers = @{ $self->{_stdout_buffer} }; |
951
|
|
|
|
|
|
|
return \@buffers; |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
sub PeekStdErrBuffer { |
955
|
|
|
|
|
|
|
my $self = shift; |
956
|
|
|
|
|
|
|
my @buffers = @{ $self->{_stderr_buffer} }; |
957
|
|
|
|
|
|
|
return \@buffers; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
sub GetProcessId { |
961
|
|
|
|
|
|
|
my $self = shift; |
962
|
|
|
|
|
|
|
return $self->{_processpid}; |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
sub GetPid { shift->GetProcessId; } |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
sub __set_process_id { |
968
|
|
|
|
|
|
|
my $self = shift; |
969
|
|
|
|
|
|
|
$self->{_processpid} = shift; |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
sub TerminateProcess { |
973
|
|
|
|
|
|
|
my $self = shift; |
974
|
|
|
|
|
|
|
push(@{ $self->{_await_actions} }, { action => 'terminate', } ); |
975
|
|
|
|
|
|
|
} |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
sub KillProcess { |
978
|
|
|
|
|
|
|
my $self = shift; |
979
|
|
|
|
|
|
|
push(@{ $self->{_await_actions} }, { action => 'kill', } ); |
980
|
|
|
|
|
|
|
} |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
sub WriteProcess { |
983
|
|
|
|
|
|
|
my ($self, $writedata) = @_; |
984
|
|
|
|
|
|
|
push(@{ $self->{_await_actions} }, { action => 'write', writedata => $writedata } ); |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
sub CloseInput { |
988
|
|
|
|
|
|
|
my $self = shift; |
989
|
|
|
|
|
|
|
push(@{ $self->{_await_actions} }, { action => 'closeinput', } ); |
990
|
|
|
|
|
|
|
} |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
sub _exit_event_posted { $_[0]->{_exit_event_posted} } |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
sub _set_exit_event_posted { $_[0]->{_exit_event_posted} = $_[1]; } |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
sub IsAlive { |
997
|
|
|
|
|
|
|
my $self = shift; |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
# if we already have the exitcode from the system |
1000
|
|
|
|
|
|
|
# we should return 0 - regardless if system tells |
1001
|
|
|
|
|
|
|
# us process is still hanging around - as it will |
1002
|
|
|
|
|
|
|
# sometimes |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
return 0 if defined( $self->GetExitCode ); |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
# otherwise, return the system result |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
return ( Wx::Process::Exists( $self->GetProcessId() ) ) ? 1 : 0; |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
sub Destroy { |
1013
|
|
|
|
|
|
|
my $self = shift; |
1014
|
|
|
|
|
|
|
Wx::Process::Kill($self->GetPid(), wxSIGKILL) if $self->IsAlive; |
1015
|
|
|
|
|
|
|
$Wx::Perl::ProcessStream::ProcHandler->RemoveProc( $self ); |
1016
|
|
|
|
|
|
|
$self->SUPER::Destroy; |
1017
|
|
|
|
|
|
|
$self = undef; |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
sub DESTROY { |
1021
|
|
|
|
|
|
|
my $self = shift; |
1022
|
|
|
|
|
|
|
print qq(DESTROY method for ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG); |
1023
|
|
|
|
|
|
|
$self->SUPER::DESTROY if $self->can('SUPER::DESTROY'); |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
#----------------------------------------------------- |
1027
|
|
|
|
|
|
|
# PACKAGE Wx::Perl::ProcessStream::ProcessEvent |
1028
|
|
|
|
|
|
|
# |
1029
|
|
|
|
|
|
|
# STDOUT, STDERR, EXIT events |
1030
|
|
|
|
|
|
|
#----------------------------------------------------- |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
package Wx::Perl::ProcessStream::ProcessEvent; |
1033
|
|
|
|
|
|
|
use strict; |
1034
|
|
|
|
|
|
|
use Wx; |
1035
|
|
|
|
|
|
|
use base qw( Wx::PlCommandEvent ); |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
sub new { |
1038
|
|
|
|
|
|
|
my( $class, $type, $id ) = @_; |
1039
|
|
|
|
|
|
|
my $self = $class->SUPER::new( $type, $id ); |
1040
|
|
|
|
|
|
|
return $self; |
1041
|
|
|
|
|
|
|
} |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
sub GetLine { |
1044
|
|
|
|
|
|
|
my $self = shift; |
1045
|
|
|
|
|
|
|
return $self->{_outputline}; |
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
sub SetLine { |
1049
|
|
|
|
|
|
|
my $self = shift; |
1050
|
|
|
|
|
|
|
$self->{_outputline} = shift; |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
sub GetProcess { |
1054
|
|
|
|
|
|
|
my $self = shift; |
1055
|
|
|
|
|
|
|
return $Wx::Perl::ProcessStream::ProcHandler->FindProc( $self->_get_pid ); |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
} |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
sub SetProcess { |
1060
|
|
|
|
|
|
|
my ($self, $process) = @_; |
1061
|
|
|
|
|
|
|
$self->_set_pid( $process->GetPid ); |
1062
|
|
|
|
|
|
|
} |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
sub _get_pid { $_[0]->{_pid}; } |
1065
|
|
|
|
|
|
|
sub _set_pid { $_[0]->{_pid} = $_[1]; } |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
sub Clone { |
1068
|
|
|
|
|
|
|
my $self = shift; |
1069
|
|
|
|
|
|
|
my $class = ref $self; |
1070
|
|
|
|
|
|
|
my $clone = $class->new( $self->GetEventType(), $self->GetId() ); |
1071
|
|
|
|
|
|
|
$clone->SetLine( $self->GetLine ); |
1072
|
|
|
|
|
|
|
$clone->_set_pid( $self->_get_pid ); |
1073
|
|
|
|
|
|
|
return $clone; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
package Wx::Perl::ProcessStream::ProcEvtHandler; |
1077
|
|
|
|
|
|
|
use strict; |
1078
|
|
|
|
|
|
|
use Wx 0.50 qw( wxID_ANY ); |
1079
|
|
|
|
|
|
|
use base qw( Wx::Process ); |
1080
|
|
|
|
|
|
|
use Wx::Event qw(EVT_END_PROCESS); |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
sub new { |
1083
|
|
|
|
|
|
|
my ($class, @args) = @_; |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
my $self = $class->SUPER::new(@args); |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
EVT_END_PROCESS($self, wxID_ANY, sub { shift->OnEventEndProcess(@_); }); |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
return $self; |
1090
|
|
|
|
|
|
|
} |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
sub OnEventEndProcess { |
1093
|
|
|
|
|
|
|
my ($self, $event) = @_; |
1094
|
|
|
|
|
|
|
$event->Skip(0); |
1095
|
|
|
|
|
|
|
my $pid = $event->GetPid; |
1096
|
|
|
|
|
|
|
my $exitcode = $event->GetExitCode; |
1097
|
|
|
|
|
|
|
$Wx::Perl::ProcessStream::Process::_runningpids->{$pid} = $exitcode; |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
1; |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
__END__ |