# ================================================================== # 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;