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