--- /dev/null
+# -*- perl -*-
+# Pipeline -- library of process spawn functions that do not invoke a shell
+
+# Copyright (C) 1998 Richard Braakman
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+package Pipeline;
+use strict;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(spawn pipeline pipeline_open pipeline_pure);
+
+use Fcntl;
+
+
+# This is used to avoid END blocks and such, when exiting from
+# children that have not execed.
+use POSIX;
+sub immediate_exit { POSIX::_exit($_[0] + 0); }
+
+# The pipeline function takes a list of coderefs, which are forked off
+# as processes. The stdout of each is connected to the stdin of the
+# next.
+
+# The coderefs will usually be 'exec' calls. If the code does return,
+# the process will exit with the return value of that code. That way
+# you don't have to check if the exec succeeded.
+#
+# Use an explicit exit statement if you don't want this.
+
+# The first list element may be a filename instead of a coderef, in which
+# case it will be opened as stdin for the first process.
+# The last list element may also be a filename instead of a coderef, in
+# which case it will be opened as stdout for the last process.
+
+# pipeline() returns the exit value of the last process in the pipe,
+# or 255 if the exec failed.
+
+sub pipeline {
+ my $i;
+ my $pid = fork();
+ defined $pid or return 255;
+
+ if (not $pid) { # child
+ sysopen(STDIN, shift, O_RDONLY)
+ or fail("$$: cannot redirect input: $!")
+ unless ref($_[0]) eq "CODE";
+ sysopen(STDOUT, pop, O_WRONLY|O_CREAT|O_TRUNC)
+ or fail("$$: cannot redirect output: $!")
+ unless ref($_[$#_]) eq "CODE";
+
+ # Perhaps I should submit this to the obfuscated perl contest.
+ $i = @_ or immediate_exit 0;
+ $pid = open(STDIN, "-|") while $pid == 0 and --$i;
+ defined $pid or fail("cannot fork: $!");
+ immediate_exit int(&{$_[$i]});
+ } else { # parent
+ waitpid($pid, 0);
+ return $?;
+ }
+}
+
+# pipeline_open is just like pipeline, except that it takes a filehandle
+# as its first argument, and cannot take both an input filename and
+# an output filename. It connects the filehandle to stdout of the
+# last process if no output filename is given, and connects it to
+# stdin of the first process otherwise. (Be sure to handle SIGPIPE
+# if you do the latter).
+# pipeline_open() returns the pid of the child process, or undef if it failed.
+
+sub pipeline_open (*@) {
+ my ($i, $pid);
+ if (ref($_[$#_]) eq "CODE") {
+ $pid = open(shift, "-|");
+ } else {
+ $pid = open(shift, "|-");
+ }
+ defined $pid or return undef;
+
+ if (not $pid) { # child
+ sysopen(STDIN, shift, O_RDONLY)
+ or fail("$$: cannot redirect input: $!")
+ unless ref($_[0]) eq "CODE";
+ sysopen(STDOUT, pop, O_WRONLY|O_CREAT|O_TRUNC)
+ or fail("$$: cannot redirect output: $!")
+ unless ref($_[$#_]) eq "CODE";
+
+ $i = @_ or immediate_exit 0;
+ $pid = open(STDIN, "-|") while $pid == 0 and --$i;
+ defined $pid or fail("cannot fork: $!");
+ immediate_exit int(&{$_[$i]});
+ }
+ # parent does nothing
+ return $pid;
+}
+
+# Fork off a single process that immediately execs. It has a simpler
+# calling syntax than pipeline() with only one argument.
+
+# It returns the exit code of the execed process, or 255 if the
+# fork or exec failed.
+
+sub spawn {
+ my $pid = fork();
+ defined $pid or return 255;
+
+ if (not $pid) { # child
+ exec @_ or immediate_exit 255;
+ } else {
+ waitpid($pid, 0);
+ return $?;
+ }
+}
+
+# This is just an experiment to see if the loop alone is useful.
+# It looks like it isn't.
+#sub pipeline_pure {
+# my $pid = 0;
+# my $i = @_ or return;
+# $pid = open(STDIN, "-|") while $pid == 0 and --$i;
+# defined $pid or fail("cannot fork: $!");
+# &{$_[$i]};
+# close(STDIN) or fail("child process failed: $?") if $pid;
+# immediate_exit 0 unless $i == $#_;
+#}
+
+1;
projects / maemian / blobdiff