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
|
#
# $Id: piconv.t,v 0.2 2009/07/13 00:50:52 dankogai Exp $
#
use strict;
use FindBin;
use File::Spec;
use IPC::Open3 qw(open3);
use IO::Select;
use Test::More;
my $WIN = $^O eq 'MSWin32';
if ($WIN) {
eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or
plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test';
}
sub run_cmd (;$$);
my $blib =
File::Spec->rel2abs(
File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) );
my $script = File::Spec->catdir($blib, 'script', 'piconv');
my @base_cmd = ( $^X, ($ENV{PERL_CORE} ? () : "-Mblib=$blib"), $script );
plan tests => 5;
{
my ( $st, $out, $err ) = run_cmd;
is( $st, 0, 'status for usage call' );
is( $out, $WIN ? undef : '' );
like( $err, qr{^piconv}, 'usage' );
}
{
my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script];
like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme');
}
{
my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)];
like( $err, qr{can't open}i );
}
sub run_cmd (;$$) {
my ( $args, $in ) = @_;
my $out = "x" x 10_000;
$out = "";
my $err = "x" x 10_000;
$err = "";
if ($WIN) {
IPC::Run->import(qw(run timeout));
my @cmd;
if (defined $args) {
@cmd = (@base_cmd, @$args);
} else {
@cmd = @base_cmd;
}
run(\@cmd, \$in, \$out, \$err, timeout(10));
my $st = $?;
$out = undef if ($out eq '');
( $st, $out, $err );
} else {
$in ||= '';
my ( $in_fh, $out_fh, $err_fh );
use Symbol 'gensym';
$err_fh =
gensym; # sigh... otherwise stderr gets just to $out_fh, not to $err_fh
my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args )
or die "Can't run @base_cmd @$args: $!";
print $in_fh $in;
my $sel = IO::Select->new( $out_fh, $err_fh );
while ( my @ready = $sel->can_read ) {
for my $fh (@ready) {
if ( eof($fh) ) {
$sel->remove($fh);
last if !$sel->handles;
}
elsif ( $out_fh == $fh ) {
my $line = <$fh>;
$out .= $line;
}
elsif ( $err_fh == $fh ) {
my $line = <$fh>;
$err .= $line;
}
}
}
my $st = $?;
( $st, $out, $err );
}
}
|
