Re: ITP: diskless for NFS-ROOT tree structures.

[Roderick Schertler <roderick@argon.org>]

On Wed, 16 Jun 1999 10:32:29 +1000, Brian May <bam@snoopy.apana.org.au> said:
>
> However, if m4 returns with any output written to STDERR, the perl
> function should return with a non-succesful status (eg 0).

This program will do that.  There's an embedded man page (perldoc
stderr-die) but for your purpose just do

    stderr-die m4 $file_list > $tmp_output

#!/usr/bin/perl -w
use strict;

# $Id: stderr-die,v 1.1 1999-06-17 10:31:36-04 roderick Exp $
#
# Roderick Schertler <roderick@argon.org>

# Copyright (C) 1999 Roderick Schertler
#
# 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.
#
# For a copy of the GNU General Public License write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use Proc::WaitStat qw(waitstat_reuse);

(my $Me = $0) =~ s-.*/--;
my $Usage = <<EOF;
usage: $Me [--exit num] command [arg]...

This program runs the given command and mostly stays out of the way.
The exit status is normally the exit status of the command.  If the
command outputs anything on stderr but exits with a 0 status, though,
the exit status will be 1 instead.

If you specify --exit num the program Me will use num rather than 1 as
the fallback exit status.
EOF

sub main {
    my $error_exit = 1;
    my $exit = 0;

    if (@ARGV && $ARGV[0] eq '--exit') {
	@ARGV > 1		or die "$Me: need an argument for $ARGV[0]\n";
	shift @ARGV;
	$error_exit = shift @ARGV;
	$error_exit =~ /^\d+$/	or die "$Me: invalid --exit `$error_exit'\n";
    }
    @ARGV			or die $Usage;

    # Set up a pipe for the child's stderr, fork the child.
    pipe READ, WRITE		or die "$Me: can't pipe: $!\n";
    my $pid = fork;
    defined $pid		or die "$Me: can't fork: $!\n";
    if (!$pid) {
    	close READ		or die "$Me: error closing read pipe: $!\n";
	open STDERR, '>&WRITE'	or die "$Me: can't dup: $!\n";
	close WRITE		or die "$Me: error closing write pipe: $!\n";
	$^W = 0;		# I'll check my own errors, thankyouverymuch.
	exec @ARGV		or die "$Me: error execing $ARGV[0]: $!\n";
    }
    close WRITE			or die "$Me: error closing write pipe: $!\n";

    # Pass the child's stderr through.
    $SIG{PIPE} = 'IGNORE';	# I'll check my own errors, thankyouverymuch.
    select STDERR; $| = 1; select STDOUT;
    my $nread;
    my $buf = ''; # -w bug
    while ($nread = sysread READ, $buf, 8192) {
	$exit = $error_exit;
	print STDERR $buf
	    # This write will presumably fail too, alas.
	    or die "$Me: error writing to stderr: $!\n";
    }
    defined $nread
	or die "$Me: error reading command's stderr: $!\n";

    # Shut everything down, set up a reuse of the child's exit status.
    close READ			or die "$Me: error closing read pipe: $!\n";
    waitpid($pid, 0) == $pid	or die "$Me: error reaping $pid: $!\n";
    $exit = waitstat_reuse $? if $?;

    exit $exit;
}
main;

__END__

=head1 NAME

stderr-die - run the given command and die if it outputs to stderr

=head1 SYNOPSIS

B<stderr-die> [B<--exit> I<num>] I<command> [I<arg>]...

=head1 DESCRIPTION

B<stderr-die> runs the command given as its args and mostly stays out of
the way.  The exit status is normally the exit status of the command.
If the command outputs anything on stderr but exits with a 0 status,
though, the exit status will be 1 instead.

=head1 OPTIONS

=over 4

=item B<--exit> I<num>

Use I<num> rather than 1 as the exit status if the command exits with a
0 status but outputs something to stderr.

=back

=head1 AUTHOR

Roderick Schertler <roderick@argon.org>

=cut

-- 
Roderick Schertler
roderick@argon.org