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
|
#!/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 "read from pipe: \$buf\\n";
}
else {
print "pipe error (read)!\\n";
\$t->remove_input_handle(\$readfh);
}
}
},
read_error => sub {
my (\$t, \$fh) = \@_;
if (\$fh == \$readfh) {
print "pipe error (exception)!\\n";
\$t->remove_input_handle(\$readfh);
}
},
munge_output => sub {
my (\$t, \$buf) = \@_;
syswrite(\$writefh, "read from term: \$buf");
\$buf;
},
}
);
\$term->run(\$^X, '-ple', q[last if /^\$/]);
print "done\\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($pty->read(undef, 5), "foo$crlf");
is($pty->read(undef, 5), "foo$crlf");
{
my $buf;
sysread($writefh, $buf, 21);
is($buf, "read from term: foo$crlf");
sysread($writefh, $buf, 21);
# note that this could either happen as a second write, or as part
# of the first write (in which case, this read finishes reading
# the rest of the data that was sent previously)
like($buf, qr/^(?:read from term: )?foo\Q$crlf\E$/);
}
syswrite($readfh, "bar");
is($pty->read(undef, 21), "read from pipe: bar\n");
close($readfh);
close($writefh);
is($pty->read(undef, 19), "pipe error (read)!\n");
}
done_testing;
|