132 lines
3.7 KiB
Perl
132 lines
3.7 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::IPC::Run::Select
|
|
# Author : Scott Beck
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: Select.pm,v 1.6 2004/01/13 01:35:17 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description: Select IO for children handles
|
|
#
|
|
|
|
package GT::IPC::Run::Select;
|
|
# ==================================================================
|
|
|
|
use strict;
|
|
|
|
use POSIX qw(errno_h);
|
|
use constants
|
|
STDOUT_FN => 0,
|
|
STDERR_FN => 1;
|
|
|
|
sub new {
|
|
# ------------------------------------------------------------------------
|
|
my ($class) = @_;
|
|
return bless {}, $class;
|
|
}
|
|
|
|
sub add_stdout {
|
|
# ------------------------------------------------------------------------
|
|
my ($self, $pid, $stdout) = @_;
|
|
my $bits = delete $self->{vec_bits};
|
|
$bits = '' unless defined $bits;
|
|
|
|
if (defined $stdout) {
|
|
my $stdout_fn = fileno($stdout);
|
|
vec($bits, $stdout_fn, 1) = 1;
|
|
$self->{$pid}[STDOUT_FN] = $stdout_fn;
|
|
}
|
|
$self->{vec_bits} = $bits;
|
|
}
|
|
|
|
sub add_stderr {
|
|
# ------------------------------------------------------------------------
|
|
my ($self, $pid, $stderr) = @_;
|
|
my $bits = delete $self->{vec_bits};
|
|
$bits = '' unless defined $bits;
|
|
|
|
if (defined $stderr) {
|
|
my $stderr_fn = fileno($stderr);
|
|
vec($bits, $stderr_fn, 1) = 1;
|
|
$self->{$pid}[STDERR_FN] = $stderr_fn;
|
|
}
|
|
$self->{vec_bits} = $bits;
|
|
}
|
|
|
|
sub remove_stdout {
|
|
# ------------------------------------------------------------------------
|
|
my ($self, $pid) = @_;
|
|
my $bits = delete $self->{vec_bits};
|
|
$bits = '' unless defined $bits;
|
|
|
|
my $fn = $self->{$pid}[STDOUT_FN];
|
|
if (defined $fn) {
|
|
vec($bits, $fn, 1) = 0;
|
|
undef $self->{$pid}[STDOUT_FN];
|
|
}
|
|
$self->{vec_bits} = $bits;
|
|
}
|
|
|
|
sub remove_stderr {
|
|
# ------------------------------------------------------------------------
|
|
my ($self, $pid) = @_;
|
|
my $bits = delete $self->{vec_bits};
|
|
$bits = '' unless defined $bits;
|
|
|
|
my $fn = $self->{$pid}[STDERR_FN];
|
|
if (defined $fn) {
|
|
vec($bits, $fn, 1) = 0;
|
|
undef $self->{$pid}[STDERR_FN];
|
|
}
|
|
$self->{vec_bits} = $bits;
|
|
}
|
|
|
|
sub can_read {
|
|
# ------------------------------------------------------------------------
|
|
my ($self, $timeout) = @_;
|
|
my $bits = delete $self->{vec_bits};
|
|
my $sbits = $bits;
|
|
|
|
local $!;
|
|
my $nfound;
|
|
do {
|
|
$! = 0;
|
|
$nfound = select($sbits, undef, undef, $timeout);
|
|
} while $! == EINTR;
|
|
if (defined $sbits and $nfound > 0) {
|
|
my (@stdout_waiting, @stderr_waiting);
|
|
for my $pid (keys %$self ) {
|
|
my $child = $self->{$pid};
|
|
if (!defined $self->{$pid}[STDOUT_FN] and !defined $self->{$pid}[STDERR_FN]) {
|
|
delete $self->{$pid};
|
|
next;
|
|
}
|
|
if (defined $child->[STDOUT_FN] and (!defined $sbits or vec($sbits, $child->[STDOUT_FN], 1))) {
|
|
push @stdout_waiting, $pid;
|
|
}
|
|
if (defined $child->[STDERR_FN] and (!defined $sbits or vec($sbits, $child->[STDERR_FN], 1))) {
|
|
push @stderr_waiting, $pid;
|
|
}
|
|
}
|
|
if (!@stdout_waiting and !@stderr_waiting) {
|
|
$self->debug(
|
|
"Select said we have nfound, but did not find anything pending!"
|
|
) if $self->{_debug};
|
|
}
|
|
$self->{vec_bits} = $bits;
|
|
return(\@stdout_waiting, \@stderr_waiting);
|
|
}
|
|
elsif ($nfound < 0) {
|
|
$self->debug("Socket error: $!") if $self->{_debug};
|
|
}
|
|
$self->{vec_bits} = $bits;
|
|
return [], [];
|
|
}
|
|
|
|
1;
|
|
|
|
|