File Coverage

blib/lib/IO/Busy.pm

Criterion	Covered	Total	%
statement	18	51	35.2
branch	0	4	0.0
condition	0	3	0.0
subroutine	6	8	75.0
pod	1	1	100.0
total	25	67	37.3

package IO::Busy;

use version; $VERSION = qv('0.0.3');

use warnings;
use strict;
use Carp;

use Perl6::Export::Attrs;

sub _input_pending_on {
    my ($fh) = @_;
    my $read_bits = "";
    vec($read_bits, fileno($fh), 1) = 1;
    select $read_bits, undef, undef, 0.1;
    return $read_bits;
}

my @warning = (
    "That input was ignored. Please don't press any keys yet.\n",
    "That input was ignored. Please wait a little longer.\n",
    "That input was also ignored. You might as well just wait, you know.\n",
   # "Look, there's no point typing yet. Your input isn't going anywhere.\n",
    #"Are you learning impaired? DON'T. TYPE. YET.\n",
    #"Okay, fine. Type whatever you like. Whatever makes you happy.\n",
    #"La la la la. I can't hear you.\n",
    "",
);

sub busy (&) :Export(:MANDATORY) {
    my ($block_ref) = @_;
    my $count = 0;

    my ($read, $write);
    pipe $read, $write;
    my $child = fork;
    if (!$child) {
        close $read;
        $write->autoflush(1);
        while (1) {
            if (_input_pending_on(\*STDIN)) {
                my $res = ;
                print {$write} $res;
                print {*STDERR} "\n";
                print {*STDERR} $warning[$count++] || $warning[-1];
                print {*STDERR} "\n";
            }
        }
        exit;
    }
    close $write;
    local *ARGV;
    open *ARGV, '<', \"";
    $block_ref->();
    kill 9, $child;
    wait;
    local $/;
    return $read;
}


1; # Magic true value required at end of module
__END__