Commit | Line | Data |
b3f8c6ea |
1 | # |
2 | # $Id: piconv.t,v 0.2 2009/07/13 00:50:52 dankogai Exp $ |
3 | # |
4 | |
b3f8c6ea |
5 | use strict; |
6 | use FindBin; |
7 | use File::Spec; |
8 | use IPC::Open3 qw(open3); |
9 | use IO::Select; |
10 | use Test::More; |
11 | |
12 | my $WIN = $^O eq 'MSWin32'; |
13 | |
14 | if ($WIN) { |
15 | eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or |
16 | plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test'; |
17 | } |
18 | |
19 | sub run_cmd (;$$); |
20 | |
21 | my $blib = |
22 | File::Spec->rel2abs( |
23 | File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) ); |
24 | my $script = File::Spec->catdir($blib, 'script', 'piconv'); |
0aeed650 |
25 | my @base_cmd = ( $^X, ($ENV{PERL_CORE} ? () : "-Mblib=$blib"), $script ); |
b3f8c6ea |
26 | |
27 | plan tests => 5; |
28 | |
29 | { |
30 | my ( $st, $out, $err ) = run_cmd; |
31 | is( $st, 0, 'status for usage call' ); |
32 | is( $out, $WIN ? undef : '' ); |
33 | like( $err, qr{^piconv}, 'usage' ); |
34 | } |
35 | |
36 | { |
37 | my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script]; |
38 | like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme'); |
39 | } |
40 | |
41 | { |
42 | my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)]; |
43 | like( $err, qr{can't open}i ); |
44 | } |
45 | |
46 | sub run_cmd (;$$) { |
47 | my ( $args, $in ) = @_; |
48 | |
49 | my $out = "x" x 10_000; |
50 | $out = ""; |
51 | my $err = "x" x 10_000; |
52 | $err = ""; |
53 | |
54 | if ($WIN) { |
55 | IPC::Run->import(qw(run timeout)); |
56 | my @cmd; |
57 | if (defined $args) { |
58 | @cmd = (@base_cmd, @$args); |
59 | } else { |
60 | @cmd = @base_cmd; |
61 | } |
62 | run(\@cmd, \$in, \$out, \$err, timeout(10)); |
63 | my $st = $?; |
64 | $out = undef if ($out eq ''); |
65 | ( $st, $out, $err ); |
66 | } else { |
67 | $in ||= ''; |
68 | my ( $in_fh, $out_fh, $err_fh ); |
69 | use Symbol 'gensym'; |
70 | $err_fh = |
71 | gensym; # sigh... otherwise stderr gets just to $out_fh, not to $err_fh |
72 | my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args ) |
73 | or die "Can't run @base_cmd @$args: $!"; |
74 | print $in_fh $in; |
75 | my $sel = IO::Select->new( $out_fh, $err_fh ); |
76 | |
77 | while ( my @ready = $sel->can_read ) { |
78 | for my $fh (@ready) { |
79 | if ( eof($fh) ) { |
80 | $sel->remove($fh); |
81 | last if !$sel->handles; |
82 | } |
83 | elsif ( $out_fh == $fh ) { |
84 | my $line = <$fh>; |
85 | $out .= $line; |
86 | } |
87 | elsif ( $err_fh == $fh ) { |
88 | my $line = <$fh>; |
89 | $err .= $line; |
90 | } |
91 | } |
92 | } |
93 | my $st = $?; |
94 | ( $st, $out, $err ); |
95 | } |
96 | } |