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
|
#!/usr/bin/perl -w
# vim: ts=2 sw=2 filetype=perl expandtab
use strict;
use POE;
use Test::More;
BEGIN {
if ($^O ne "MSWin32") {
plan skip_all => "This test examines ActiveState Perl behavior.";
}
eval 'use Win32::Console';
if ($@) {
plan skip_all => "Win32::Console is required on $^O - try ActivePerl";
}
}
plan tests => 2;
my $obj = new MyDebug;
POE::Session->create(
object_states => [ $obj => [ '_start', 'next', 'reaper', 'output' ] ]
);
POE::Kernel->run;
exit(0);
# ------------------------------------------------
# Now define our class which does all of the work.
# ------------------------------------------------
package MyDebug;
use strict;
use POE;
use POE::Wheel::Run;
use Test::More;
# Just adding POE::Wheel::SocketFactory breaks the program, the child
# will die prematurely
use POE::Wheel::SocketFactory;
use IO::Handle;
use File::Spec;
use POSIX qw(dup);
sub new {
my $class = shift;
return bless {};
}
sub _start {
my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
$kernel->sig(CHLD => 'reaper');
$self->{subprocess} = POE::Wheel::Run->new(
Program => sub {
my $buffer = "";
my $input_stream = IO::Handle::->new_from_fd(dup(fileno(STDIN)), "r");
my $output_stream = IO::Handle::->new_from_fd(dup(fileno(STDOUT)), "w");
my $devnull = File::Spec->devnull();
open(STDIN, "$devnull");
open(STDOUT, ">$devnull");
open(STDERR, ">$devnull");
while (sysread($input_stream, $buffer, 1024 * 32)) {
last if $buffer =~ /kill/;
my $l = "child [$$] read: $buffer";
syswrite($output_stream,$l,length($l));
}
},
StdoutEvent => 'output'
);
ok($self->{subprocess}, "we have a subprocess");
$heap->{counter} = 3;
$kernel->delay_set('next', 1);
}
sub output {
my ($self, $output) = @_[OBJECT, ARG0];
chomp $output;
diag "received data from subprocess: [$output]\n";
}
sub reaper {
my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
ok(!$heap->{counter}, "child has exited when the counter ran out");
$self->{subprocess} = undef;
$kernel->sig_handled;
$kernel->sig(CHLD => undef);
}
sub next {
my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
diag "next [$heap->{counter}]\n";
if ($self->{subprocess}) {
$self->{subprocess}->put("Can you hear me $heap->{counter}");
}
if (--$heap->{counter}) {
$kernel->delay_set('next', 1)
}
elsif ($self->{subprocess}) {
diag "Trying to kill [" . $self->{subprocess}->PID . "]\n";
$self->{subprocess}->put("kill");
}
}
|
