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
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use IO::Pty::Easy;
use IO::Select;
my $script = <<'SCRIPT';
use strict;
use warnings;
use Term::Filter::Callback;
my $term = Term::Filter::Callback->new(
callbacks => {
setup => sub {
my ($t, @cmd) = @_;
my $ref = ref($t);
print "SETUP: $t ($ref): @cmd\n";
},
cleanup => sub {
my ($t) = @_;
my $ref = ref($t);
print "CLEANUP: $t ($ref)\n";
},
munge_input => sub {
my ($t, $buf) = @_;
my $ref = ref($t);
print "MUNGE_INPUT: $t ($ref): $buf\n";
$buf = "\n" if $buf =~ /exit/i;
return uc($buf);
},
munge_output => sub {
my ($t, $buf) = @_;
my $ref = ref($t);
print "MUNGE_OUTPUT: $t ($ref): $buf\n";
return lc($buf);
},
}
);
print "$term\n";
$term->run($^X, '-ple', q[last if /^$/]);
print "done\n";
SCRIPT
my $crlf = qr/\x0d\x0a/;
# just in case
alarm 60;
{
my $pty = IO::Pty::Easy->new(handle_pty_size => 0);
$pty->spawn($^X, '-Ilib', '-e', $script);
my $setup_str = full_read($pty);
my ($term_str, $ref) = $setup_str =~ m{
^
((.*)=.*)
\n
SETUP: \s \1 \s \(\2\):\s
\Q$^X\E .* \Q-ple\E .* last\ if\ /\^\$/ .*
\n
$
}sx;
is($ref, 'Term::Filter::Callback', "setup callback got a Term::Filter::Callback object");
$pty->write("fOo\n");
like(
full_read($pty),
qr{
^
MUNGE_INPUT: \s \Q$term_str\E \s \($ref\): \s fOo\n
\n
MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s FOO$crlf
\n
foo$crlf
MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s FOO$crlf
\n
foo$crlf
$
}sx,
"munge_input and munge_output got the right arguments"
);
$pty->write("EXIT\n");
like(
full_read($pty),
qr{
^
MUNGE_INPUT: \s \Q$term_str\E \s \($ref\): \s EXIT\n
\n
MUNGE_OUTPUT: \s \Q$term_str\E \s \($ref\): \s $crlf
\n
$crlf
CLEANUP: \s \Q$term_str\E \s \($ref\)\n
done\n
$
}sx,
"cleanup got the right arguments"
);
}
sub full_read {
my ($pty) = @_;
my $select = IO::Select->new($pty);
return if $select->has_exception(0.1);
my $ret;
while ($select->can_read(1)) {
my $new = $pty->read;
last unless defined($new) && length($new);
$ret .= $new;
return $ret if $select->has_exception(0.1);
}
return $ret;
}
done_testing;
|
