view release on metacpan or  search on metacpan

t/run.t  view on Meta::CPAN

sub _unlink {
    my ($f) = @_;
    my $tries;
    while () {
        return if unlink $f;
        if ( $^O =~ /Win32/ && ++$tries <= 10 ) {
            print STDOUT "# Waiting for Win32 to allow $f to be unlinked ($!)\n";
            select undef, undef, undef, 0.1;
            next;
        }
        die "$! unlinking $f at ", join( ", line ", (caller)[ 1, 2 ] ), "\n";
    }
}

my $text           = "Hello World\n";
my @perl           = ($perl);
my $emitter_script = qq{print '$text'; print STDERR uc( '$text' ) unless \@ARGV };
my @emitter        = ( @perl, '-e', $emitter_script );

my $in;
my $out;