diff options
Diffstat (limited to 'meta-networking/recipes-extended/mime-construct/files/WaitStat.pm')
| -rw-r--r-- | meta-networking/recipes-extended/mime-construct/files/WaitStat.pm | 178 |
1 files changed, 0 insertions, 178 deletions
diff --git a/meta-networking/recipes-extended/mime-construct/files/WaitStat.pm b/meta-networking/recipes-extended/mime-construct/files/WaitStat.pm deleted file mode 100644 index 337e52a705..0000000000 --- a/meta-networking/recipes-extended/mime-construct/files/WaitStat.pm +++ /dev/null @@ -1,178 +0,0 @@ -# $Id: WaitStat.pm,v 1.3 1999-10-21 12:39:43-04 roderick Exp $ -# -# Copyright (c) 1997 Roderick Schertler. All rights reserved. This -# program is free software; you can redistribute it and/or modify it -# under the same terms as Perl itself. - -=head1 NAME - -Proc::WaitStat - Interpret and act on wait() status values - -=head1 SYNOPSIS - - $description = waitstat $?; - exit waitstat_reuse $?; - waitstat_die $?, 'program-name'; - close_die COMMAND, 'program-name'; - -=head1 DESCRIPTION - -This module contains functions for interpreting and acting on wait -status values. - -Nothing is exported by default. - -=over - -=cut - -package Proc::WaitStat; - -use 5.003_98; # piped close errno resetting -use strict; -use vars qw($VERSION @ISA @EXPORT_OK); - -use Carp qw(croak); -use Exporter (); -use IPC::Signal qw(sig_name); -use POSIX qw(:sys_wait_h); - -$VERSION = '1.00'; -@ISA = qw(Exporter); -@EXPORT_OK = qw(waitstat waitstat_reuse waitstat_die close_die); - -=item B<waitstat> I<wait-status> - -Returns a string representation of wait() status value I<wait-status>. -Values returned are like C<"0"> and C<"64"> and C<"killed (SIGHUP)">. - -This function is prototyped to take a single scalar argument. - -=cut - -sub waitstat ($) { - my $status = shift; - - if (WIFEXITED $status) { - WEXITSTATUS $status - } - elsif (WIFSIGNALED $status) { - # XXX WCOREDUMP - 'killed (SIG' . sig_name(WTERMSIG $status) . ')' - } - elsif (WIFSTOPPED $status) { - 'stopped (SIG' . sig_name(WSTOPSIG $status) . ')' - } - # XXX WIFCONTINUED - else { - "invalid wait status $status" - } -} - -=item B<waitstat_reuse> I<wait-status> - -Turn I<wait-status> into a value which can be passed to B<exit>, converted -in the same manner the shell uses. If I<wait-status> indicates a normal -exit, return the exit value. If I<wait-status> instead indicates death by -signal, return 128 plus the signal number. - -This function is prototyped to take a single scalar argument. - -=cut - -sub waitstat_reuse ($) { - my $status = shift; - - if (WIFEXITED $status) { - WEXITSTATUS $status - } - elsif (WIFSIGNALED $status) { - 128 + WTERMSIG $status - } - elsif (WIFSTOPPED $status) { - 128 + WSTOPSIG $status - } - else { - croak "Invalid wait status $status"; - } -} - -=item B<waitstat_die> I<wait-status> I<program-name> - -die() if I<wait-status> is non-zero (mentioning I<program-name> as the -source of the error). - -This function is prototyped to take two scalar arguments. - -=cut - -sub waitstat_die ($$) { - my ($status, $program) = @_; - croak "Non-zero exit (" . waitstat($status) . - ") from $program" - if $status; -} - -=item B<close_die> I<filehandle> I<name> - -Close I<filehandle>, if that fails die() with an appropriate message -which refers to I<name>. This handles failed closings of both programs -and files properly. - -This function is prototyped to take a filehandle (actually, a glob ref) -and a scalar. - -=cut - -sub close_die (*$) { - my ($fh, $name) = @_; - - unless (ref $fh || ref \$fh eq 'GLOB') { - require Symbol; - $fh = Symbol::qualify_to_ref($fh, caller); - } - - unless (close $fh) { - croak "Error closing $name: ", - $!+0 ? "$!" : 'non-zero exit (' . waitstat($?) . ')'; - } -} - -1 - -__END__ - -=back - -=head1 EXAMPLES - - close SENDMAIL; - exit if $? == 0; - log "sendmail failure: ", waitstat $?; - exit EX_TEMPFAIL; - - $pid == waitpid $pid, 0 or croak "Failed to reap $pid: $!"; - exit waitstat_reuse $?; - - $output = `some-program -with args`; - waitstat_die $?, 'some-program'; - print "Output from some-process:\n", $output; - - open PROGRAM, '| post-processor' or die "Can't fork: $!"; - while (<IN>) { - print PROGRAM pre_process $_ - or die "Error writing to post-processor: $!"; - } - # This handles both flush failures at close time and a non-zero exit - # from the subprocess. - close_die PROGRAM, 'post-processor'; - -=head1 AUTHOR - -Roderick Schertler <F<roderick@argon.org>> - -=head1 SEE ALSO - -perl(1), IPC::Signal(3pm). - -=cut |