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
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use File::Temp 'tempdir';
use File::Spec;
use IO::Pty::Easy;
use IO::Select;
use POSIX ();
my $dir = tempdir(CLEANUP => 1);
my $readp = File::Spec->catfile($dir, 'read');
my $writep = File::Spec->catfile($dir, 'write');
POSIX::mkfifo($readp, 0700)
or die "mkfifo failed: $!";
POSIX::mkfifo($writep, 0700)
or die "mkfifo failed: $!";
my $script = <<SCRIPT;
use strict;
use warnings;
use Term::Filter::Callback;
open my \$readfh, '<', '$readp'
or die "can't open pipe (child): \$!";
open my \$writefh, '>', '$writep'
or die "can't open pipe (child): \$!";
my \$term = Term::Filter::Callback->new(
callbacks => {
setup => sub {
my (\$t) = \@_;
\$t->add_input_handle(\$readfh);
},
read => sub {
my (\$t, \$fh) = \@_;
if (\$fh == \$readfh) {
my \$buf;
sysread(\$fh, \$buf, 4096);
if (defined(\$buf) && length(\$buf)) {
print "1read from pipe: \$buf\\n";
}
else {
print "2pipe error (read)!\\n";
\$t->remove_input_handle(\$readfh);
}
}
},
read_error => sub {
my (\$t, \$fh) = \@_;
if (\$fh == \$readfh) {
print "3pipe error (exception)!\\n";
\$t->remove_input_handle(\$readfh);
}
},
munge_output => sub {
my (\$t, \$buf) = \@_;
syswrite(\$writefh, "4read from term: \$buf");
\$buf;
},
}
);
\$term->run(\$^X, '-ple', q[last if /^\$/]);
print "5done\\n";
SCRIPT
my $crlf = "\x0d\x0a";
# just in case
alarm 60;
{
my $pty = IO::Pty::Easy->new(handle_pty_size => 0);
$pty->spawn($^X, (map {; '-I', $_ } @INC), '-e', $script);
open my $readfh, '>', $readp
or die "can't open pipe (parent): $!";
open my $writefh, '<', $writep
or die "can't open pipe (parent): $!";
$pty->write("foo\n");
is(full_read($pty), "foo${crlf}foo${crlf}");
{
my $got_pipe = full_read($writefh);
like($got_pipe, qr/4read from term: /);
$got_pipe =~ s/4read from term: //g;
is($got_pipe, "foo${crlf}foo${crlf}");
}
syswrite($readfh, "bar");
{
my $got_pty = full_read($pty);
like($got_pty, qr/1read from pipe: /);
$got_pty =~ s/1read from pipe: //g;
is($got_pty, "bar\n");
}
close($readfh);
close($writefh);
is(full_read($pty), "2pipe error (read)!\n");
}
sub full_read {
my ($fh) = @_;
my $select = IO::Select->new($fh);
return if $select->has_exception(0.1);
1 while !$select->can_read(1);
my $ret;
while ($select->can_read(1)) {
my $new;
sysread($fh, $new, 4096);
last unless defined($new) && length($new);
$ret .= $new;
return $ret if $select->has_exception(0.1);
}
return $ret;
}
done_testing;
|