Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
Aliases.t	5.68 KB	-r--r--r--	2014-12-27 11:48
CJKT.t	3.01 KB	-r--r--r--	2014-12-27 11:48
Encode.t	5.03 KB	-r--r--r--	2014-12-27 11:48
Encoder.t	1006 B	-r--r--r--	2014-12-27 11:48
Mod_EUCJP.pm	442 B	-r--r--r--	2014-12-27 11:48
Unicode.t	5.83 KB	-r--r--r--	2014-12-27 11:48
at-cn.t	3.99 KB	-r--r--r--	2014-12-27 11:48
at-tw.t	2.54 KB	-r--r--r--	2014-12-27 11:48
big5-eten.enc	31.35 KB	-r--r--r--	2014-12-27 11:48
big5-eten.utf	44.79 KB	-r--r--r--	2014-12-27 11:48
big5-hkscs.enc	41.53 KB	-r--r--r--	2014-12-27 11:48
big5-hkscs.utf	59.27 KB	-r--r--r--	2014-12-27 11:48
cow.t	385 B	-r--r--r--	2014-12-27 11:48
decode.t	514 B	-r--r--r--	2014-12-27 11:48
enc_data.t	1020 B	-r--r--r--	2014-12-27 11:48
enc_eucjp.t	2.08 KB	-r--r--r--	2014-12-27 11:48
enc_module.enc	24 B	-r--r--r--	2014-12-27 11:48
enc_module.t	1.73 KB	-r--r--r--	2014-12-27 11:48
enc_utf8.t	1.9 KB	-r--r--r--	2014-12-27 11:48
encoding.t	5.14 KB	-r--r--r--	2014-12-27 11:48
fallback.t	5.08 KB	-r--r--r--	2014-12-27 11:48
from_to.t	357 B	-r--r--r--	2014-12-27 11:48
gb2312.enc	16.96 KB	-r--r--r--	2014-12-27 11:48
gb2312.utf	24.08 KB	-r--r--r--	2014-12-27 11:48
grow.t	820 B	-r--r--r--	2014-12-27 11:48
gsm0338.t	3.55 KB	-r--r--r--	2014-12-27 11:48
guess.t	3.68 KB	-r--r--r--	2014-12-27 11:48
jis7-fallback.t	337 B	-r--r--r--	2014-12-27 11:48
jisx0201.enc	145 B	-r--r--r--	2014-12-27 11:48
jisx0201.utf	208 B	-r--r--r--	2014-12-27 11:48
jisx0208.enc	15.77 KB	-r--r--r--	2014-12-27 11:48
jisx0208.utf	22.36 KB	-r--r--r--	2014-12-27 11:48
jisx0212.enc	19.86 KB	-r--r--r--	2014-12-27 11:48
jisx0212.utf	19.6 KB	-r--r--r--	2014-12-27 11:48
jperl.t	2.63 KB	-r--r--r--	2014-12-27 11:48
ksc5601.enc	18.72 KB	-r--r--r--	2014-12-27 11:48
ksc5601.utf	26.59 KB	-r--r--r--	2014-12-27 11:48
mime-header.t	4.54 KB	-r--r--r--	2014-12-27 11:48
mime-name.t	836 B	-r--r--r--	2014-12-27 11:48
mime_header_iso2022jp.t	1.02 KB	-r--r--r--	2014-12-27 11:48
perlio.t	4.83 KB	-r--r--r--	2014-12-27 11:48
piconv.t	2.55 KB	-r--r--r--	2014-12-27 11:48
rt.pl	1.69 KB	-r--r--r--	2014-12-27 11:48
taint.t	393 B	-r--r--r--	2014-12-27 11:49
unibench.pl	1.81 KB	-r--r--r--	2014-12-27 11:48
utf8ref.t	368 B	-r--r--r--	2014-12-27 11:48
utf8strict.t	2.54 KB	-r--r--r--	2014-12-27 11:48

Rename

#
# $Id: piconv.t,v 0.4 2013/02/18 02:23:56 dankogai Exp $
#

BEGIN {
    if ( $ENV{'PERL_CORE'} && $] >= 5.011) {
        print "1..0 # Skip: Don't know how to test this within perl's core\n";
        exit 0;
    }
}

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 ) );
my $script = File::Spec->catdir($blib, 'bin', 'piconv');
my @base_cmd = ( $^X, "-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 );
    }
}