saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at adding key files

Browse Source
This commit is contained in:
dsainty
2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

131
site/slowtwitch.com/cgi-bin/articles/admin/GT/IPC/Run/Select.pm Normal file
View File

@ -0,0 +1,131 @@
# ==================================================================
# 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;