head 1.3; access; symbols; locks; strict; comment @# @; 1.3 date 2002.04.26.20.45.09; author roderick; state Exp; branches; next 1.2; 1.2 date 99.07.23.19.33.44; author roderick; state Exp; branches; next 1.1; 1.1 date 99.06.17.14.31.36; author roderick; state Exp; branches; next ; desc @@ 1.3 log @Use perl rather than perl5. @ text @#!/usr/bin/perl -w use strict; # $Id: stderr-die,v 1.2 1999-07-23 15:33:44-04 roderick Exp roderick $ # # Roderick Schertler # 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 = < 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 [B<--exit> I] I [I]... =head1 DESCRIPTION B 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 Use I 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 =cut @ 1.2 log @Correct usage typo. @ text @d1 1 a1 1 #!/usr/bin/perl5 -w d4 1 a4 1 # $Id: stderr-die,v 1.1 1999-06-17 10:31:36-04 roderick Exp roderick $ @ 1.1 log @Initial revision @ text @d4 1 a4 1 # $Id$ d34 1 a34 1 If you specify --exit num the program Me will use num rather than 1 as @