# Pipeline.pm
# Author: Noah Friedman <friedman@splode.com>
# Created: 1996-06-17
# Public domain.

# $Id: Pipeline.pm,v 1.5 2000/03/01 09:51:08 friedman Exp $

# Commentary:

# Usage:
#
#       pipeline ("foo", "-x", "-y", ..., "|", "bar", "-m", "-n", ...);
#
# which produces the obvious pipeline of commands.

# Optional anonymous hash
#
#       {  STDIN => infh,
#         STDOUT => outfh,
#         STDERR => errfh }
#
# can be specified anywhere in the command list.  If filehandles infh or
# outfh are given, they provide the input to the beginning of the pipeline
# and the output of the end of the pipeline respectively.  Otherwise, a
# pair of input and output filehandles are returned as described below.
#
# If an errfh filehandle is provided, each process in the pipeline will
# write its stderr to that file handle.  By default stderr is inherited
# from whatever perl itself is currently using.

# This function does not use an `sh' subprocess to do parsing, which means
# 1) less process overhead, 2) no multi-level argument rescanning to screw
# up quoting, and 3) avoiding the signal-handling problems usually
# associated with the system function (to wit: during execution of the
# system function, SIGCHLD is blocked, and SIGINT and SIGQUIT are ignored).
#
# Returns an anonymous hash with the following elements:
#
#   cmdlist     -  array of commands (processes)
#   pidlist     -  array of associated pids
#   exitlist    -  array of exit status for each pid (initially empty)
#   inhandle    -  writable input handle to first process (goes to stdin)
#   outhandle   -  readable output handle of last process (comes from stdout)

# Code:

package NF::Pipeline;

use Symbol;
use POSIX qw(:sys_wait_h);

use Exporter ();
use vars qw($VERSION @ISA @EXPORT);
$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = qw(pipeline pipeline_exitlist);

use strict;


sub pipeline (@)
{
  return undef unless (scalar @_ > 0);

  my @cmdlist;
  my @pidlist;
  my %cmdstruct;
  my $fds;

  while (scalar @_ > 0)
    {
      my @cmd;
      while (defined $_[0] && $_[0] ne '|')
        {
          if (ref ($_[0]) eq 'HASH')
            {
              $fds = shift @_;
              next;
            }
          push (@cmd, shift @_);
        }
      push @cmdlist, \@cmd;
      shift @_;
    }

  my $prh = gensym;
  my $pwh = gensym;
  pipe ($prh, $pwh);

  my $bwh = $pwh;
  my $erh = $prh;
  my $i = 0;
  while (defined $cmdlist[$i])
    {
      my $cmd = $cmdlist[$i];

      my $nrh = gensym;
      my $nwh = gensym;
      $erh = $nrh;
      pipe ($nrh, $nwh);

      my $pid = fork;
      die "Can't fork: $!\n" unless (defined $pid);

      my $fh;
      if ($pid == 0)
        {
          # child
          $fh = exists $fds->{STDIN} && $i == 0 ? $fds->{STDIN} : $prh;
          open (STDIN,  "<&=" . fileno ($fh));
          $fh = (exists $fds->{STDOUT} && $i == $#cmdlist
                 ? $fds->{STDOUT} : $nwh);
          open (STDOUT, ">&=" . fileno ($fh));
          open (STDERR, ">&=" . fileno ($fds->{STDERR}))
            if (exists $fds->{STDERR});

          close ($prh);
          close ($pwh);
          close ($nrh);
          close ($nwh);
          exec (@$cmd);
        }
      # parent
      $pidlist[$i] = $pid;
      $i++;
      close ($prh);
      close ($pwh) unless ($pwh == $bwh);
      $prh = $nrh;
      $pwh = $nwh;
    }
  $cmdstruct{cmdlist}   = \@cmdlist;
  $cmdstruct{pidlist}   = \@pidlist;

  # caller can write input to inhandle
  # caller can read output from outhandle
  $cmdstruct{inhandle}  = $bwh unless (exists $fds->{STDIN});
  $cmdstruct{outhandle} = $erh unless (exists $fds->{STDOUT});
  return \%cmdstruct;
}

sub pipeline_exitlist ($;$)
{
  my $cmdstruct = shift;
  my $waitp = shift || 0;
  my $i = -1;
  my $len = scalar @{$cmdstruct->{pidlist}};

  while (++$i < $len)
    {
      my $pid = waitpid ($cmdstruct->{pidlist}->[$i], $waitp? 0 : WNOHANG);
      next if ($pid == -1);
      my $exitstat = (WIFEXITED ($?)
                      ? WEXITSTATUS ($?)
                      : (WIFSIGNALED ($?)
                         ? WTERMSIG ($?)
                         : (WIFSTOPPED ($?)
                            ? WSTOPSIG ($?)
                            : undef)));
      next unless (defined $exitstat);
      $cmdstruct->{exitlist}->[$i] = $exitstat;
    }
}

1;