# non-blocking pipe using select
use Tk;

{   my $in;
    sub stop { undef $in }

    # modified by bliako
    # non-blocking way to check if $fh has output ready

    sub has_output_ready {
      my ($fh, $nbytes) = @_;
      my $timeout = 0;
      my $rin = '';
      vec($rin, fileno($fh), 1) = 1;
      if( select($rin, undef, undef, $timeout) ){
        my ($buffer);
        read ($fh, $buffer, $nbytes);
        # fh has data and we are returning nbytes max
        # make $nbytes arbitrarily large or next time (if buffer holds)
        return $buffer;
      }
      return; # no output at this time, return undef
    }

    sub run {
        my ($type, $entry) = @_;
        my $command = $entry->cget('-text');
        if (1 == $type) {
            my $out = $_[2];
            open $in, '-|', $command or die $!;
            my $repeat;
            $repeat = ($entry->repeat(1, sub {
                return $entry->afterCancel($repeat)
                    if $repeat && ! defined $in;

		# modified by bliako: read blocks,
		# use has_output_ready() instead
                #read $in, my $buff, 100;
		my $buff = has_output_ready($in, 100, 0);
                if ($buff && length $buff) { # undef means no data yet
                    $out->insert(end => $buff);
                    $out->yview('end');
                }
            }));
        } elsif (2 == $type) {
            system "$command&";
        }
    }
}

...

##</code><code>##

# non-blocking pipe using O_NONBLOCK file flag, unsafe(?)

  ...
  open $in, '-|', $command or die $!;
# modified by bliako to set the filehandle to non-block IO
use Fcntl;
# EDIT: commented below is not supported and outputs warning about ORing non-numerical flags
#my $flags = "";
#fcntl($in, F_GETFL, $flags) or die "failed to get flags, $!";
# use this instead:
my $flags = fcntl($in, F_GETFL, 0);
# reporting weird flags (linux)!
print "FLAGS: '$flags'\n";
$flags |= O_NONBLOCK;
fcntl($in, F_SETFL, $flags) or die "Couldn't set file flags: $!\n";
...
# and now read is non-block,
# undef will be returned if no output ready
read $in, my $buff, 100;
if ($buff && length $buff) { # check if undef
  ...
}
...