Blame t/piconv.t

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
}