vcs.maemo.org Git - maemian/blob - nokia-lintian/lib/Pipeline.pm

   1 # -*- perl -*-
   2 # Pipeline -- library of process spawn functions that do not invoke a shell
   3
   4 # Copyright (C) 1998 Richard Braakman
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, you can find it on the World Wide
  18 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  19 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  20 # MA 02110-1301, USA.
  21
  22 package Pipeline;
  23 use strict;
  24
  25 use Exporter;
  26 our @ISA = qw(Exporter);
  27 our @EXPORT = qw(spawn pipeline pipeline_open pipeline_pure);
  28
  29 use Fcntl;
  30
  31
  32 # This is used to avoid END blocks and such, when exiting from
  33 # children that have not execed.
  34 use POSIX;
  35 sub immediate_exit { POSIX::_exit($_[0] + 0); }
  36
  37 # The pipeline function takes a list of coderefs, which are forked off
  38 # as processes.  The stdout of each is connected to the stdin of the
  39 # next.
  40
  41 # The coderefs will usually be 'exec' calls.  If the code does return,
  42 # the process will exit with the return value of that code.  That way
  43 # you don't have to check if the exec succeeded.
  44 #
  45 # Use an explicit exit statement if you don't want this.
  46
  47 # The first list element may be a filename instead of a coderef, in which
  48 # case it will be opened as stdin for the first process.
  49 # The last list element may also be a filename instead of a coderef, in
  50 # which case it will be opened as stdout for the last process.
  51
  52 # pipeline() returns the exit value of the last process in the pipe,
  53 # or 255 if the exec failed.
  54
  55 sub pipeline {
  56     my $i;
  57     my $pid = fork();
  58     defined $pid or return 255;
  59
  60     if (not $pid) {             # child
  61         sysopen(STDIN, shift, O_RDONLY)
  62             or fail("$$: cannot redirect input: $!")
  63                 unless ref($_[0]) eq "CODE";
  64         sysopen(STDOUT, pop, O_WRONLY|O_CREAT|O_TRUNC)
  65             or fail("$$: cannot redirect output: $!")
  66                 unless ref($_[$#_]) eq "CODE";
  67
  68         # Perhaps I should submit this to the obfuscated perl contest.
  69         $i = @_ or immediate_exit 0;
  70         $pid = open(STDIN, "-|") while $pid == 0 and --$i;
  71         defined $pid or fail("cannot fork: $!");
  72         immediate_exit int(&{$_[$i]});
  73     } else {                    # parent
  74         waitpid($pid, 0);
  75         return $?;
  76     }
  77 }
  78
  79 # pipeline_open is just like pipeline, except that it takes a filehandle
  80 # as its first argument, and cannot take both an input filename and
  81 # an output filename.  It connects the filehandle to stdout of the
  82 # last process if no output filename is given, and connects it to
  83 # stdin of the first process otherwise.  (Be sure to handle SIGPIPE
  84 # if you do the latter).
  85 # pipeline_open() returns the pid of the child process, or undef if it failed.
  86
  87 sub pipeline_open (*@) {
  88     my ($i, $pid);
  89     if (ref($_[$#_]) eq "CODE") {
  90         $pid = open(shift, "-|");
  91     } else {
  92         $pid = open(shift, "|-");
  93     }
  94     defined $pid or return undef;
  95
  96     if (not $pid) {             # child
  97         sysopen(STDIN, shift, O_RDONLY)
  98             or fail("$$: cannot redirect input: $!")
  99                 unless ref($_[0]) eq "CODE";
 100         sysopen(STDOUT, pop, O_WRONLY|O_CREAT|O_TRUNC)
 101             or fail("$$: cannot redirect output: $!")
 102                 unless ref($_[$#_]) eq "CODE";
 103
 104         $i = @_ or immediate_exit 0;
 105         $pid = open(STDIN, "-|") while $pid == 0 and --$i;
 106         defined $pid or fail("cannot fork: $!");
 107         immediate_exit int(&{$_[$i]});
 108     }
 109     # parent does nothing
 110     return $pid;
 111 }
 112
 113 # Fork off a single process that immediately execs.  It has a simpler
 114 # calling syntax than pipeline() with only one argument.
 115
 116 # It returns the exit code of the execed process, or 255 if the
 117 # fork or exec failed.
 118
 119 sub spawn {
 120     my $pid = fork();
 121     defined $pid or return 255;
 122
 123     if (not $pid) {             # child
 124         exec @_ or immediate_exit 255;
 125     } else {
 126         waitpid($pid, 0);
 127         return $?;
 128     }
 129 }
 130
 131 # This is just an experiment to see if the loop alone is useful.
 132 # It looks like it isn't.
 133 #sub pipeline_pure {
 134 #    my $pid = 0;
 135 #    my $i = @_ or return;
 136 #    $pid = open(STDIN, "-|") while $pid == 0 and --$i;
 137 #    defined $pid or fail("cannot fork: $!");
 138 #    &{$_[$i]};
 139 #    close(STDIN) or fail("child process failed: $?") if $pid;
 140 #    immediate_exit 0 unless $i == $#_;
 141 #}
 142
 143 1;