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 @@ | |||
| 1 | # $Id: WaitStat.pm,v 1.3 1999-10-21 12:39:43-04 roderick Exp $ | ||
| 2 | # | ||
| 3 | # Copyright (c) 1997 Roderick Schertler. All rights reserved. This | ||
| 4 | # program is free software; you can redistribute it and/or modify it | ||
| 5 | # under the same terms as Perl itself. | ||
| 6 | |||
| 7 | =head1 NAME | ||
| 8 | |||
| 9 | Proc::WaitStat - Interpret and act on wait() status values | ||
| 10 | |||
| 11 | =head1 SYNOPSIS | ||
| 12 | |||
| 13 | $description = waitstat $?; | ||
| 14 | exit waitstat_reuse $?; | ||
| 15 | waitstat_die $?, 'program-name'; | ||
| 16 | close_die COMMAND, 'program-name'; | ||
| 17 | |||
| 18 | =head1 DESCRIPTION | ||
| 19 | |||
| 20 | This module contains functions for interpreting and acting on wait | ||
| 21 | status values. | ||
| 22 | |||
| 23 | Nothing is exported by default. | ||
| 24 | |||
| 25 | =over | ||
| 26 | |||
| 27 | =cut | ||
| 28 | |||
| 29 | package Proc::WaitStat; | ||
| 30 | |||
| 31 | use 5.003_98; # piped close errno resetting | ||
| 32 | use strict; | ||
| 33 | use vars qw($VERSION @ISA @EXPORT_OK); | ||
| 34 | |||
| 35 | use Carp qw(croak); | ||
| 36 | use Exporter (); | ||
| 37 | use IPC::Signal qw(sig_name); | ||
| 38 | use POSIX qw(:sys_wait_h); | ||
| 39 | |||
| 40 | $VERSION = '1.00'; | ||
| 41 | @ISA = qw(Exporter); | ||
| 42 | @EXPORT_OK = qw(waitstat waitstat_reuse waitstat_die close_die); | ||
| 43 | |||
| 44 | =item B<waitstat> I<wait-status> | ||
| 45 | |||
| 46 | Returns a string representation of wait() status value I<wait-status>. | ||
| 47 | Values returned are like C<"0"> and C<"64"> and C<"killed (SIGHUP)">. | ||
| 48 | |||
| 49 | This function is prototyped to take a single scalar argument. | ||
| 50 | |||
| 51 | =cut | ||
| 52 | |||
| 53 | sub waitstat ($) { | ||
| 54 | my $status = shift; | ||
| 55 | |||
| 56 | if (WIFEXITED $status) { | ||
| 57 | WEXITSTATUS $status | ||
| 58 | } | ||
| 59 | elsif (WIFSIGNALED $status) { | ||
| 60 | # XXX WCOREDUMP | ||
| 61 | 'killed (SIG' . sig_name(WTERMSIG $status) . ')' | ||
| 62 | } | ||
| 63 | elsif (WIFSTOPPED $status) { | ||
| 64 | 'stopped (SIG' . sig_name(WSTOPSIG $status) . ')' | ||
| 65 | } | ||
| 66 | # XXX WIFCONTINUED | ||
| 67 | else { | ||
| 68 | "invalid wait status $status" | ||
| 69 | } | ||
| 70 | } | ||
| 71 | |||
| 72 | =item B<waitstat_reuse> I<wait-status> | ||
| 73 | |||
| 74 | Turn I<wait-status> into a value which can be passed to B<exit>, converted | ||
| 75 | in the same manner the shell uses. If I<wait-status> indicates a normal | ||
| 76 | exit, return the exit value. If I<wait-status> instead indicates death by | ||
| 77 | signal, return 128 plus the signal number. | ||
| 78 | |||
| 79 | This function is prototyped to take a single scalar argument. | ||
| 80 | |||
| 81 | =cut | ||
| 82 | |||
| 83 | sub waitstat_reuse ($) { | ||
| 84 | my $status = shift; | ||
| 85 | |||
| 86 | if (WIFEXITED $status) { | ||
| 87 | WEXITSTATUS $status | ||
| 88 | } | ||
| 89 | elsif (WIFSIGNALED $status) { | ||
| 90 | 128 + WTERMSIG $status | ||
| 91 | } | ||
| 92 | elsif (WIFSTOPPED $status) { | ||
| 93 | 128 + WSTOPSIG $status | ||
| 94 | } | ||
| 95 | else { | ||
| 96 | croak "Invalid wait status $status"; | ||
| 97 | } | ||
| 98 | } | ||
| 99 | |||
| 100 | =item B<waitstat_die> I<wait-status> I<program-name> | ||
| 101 | |||
| 102 | die() if I<wait-status> is non-zero (mentioning I<program-name> as the | ||
| 103 | source of the error). | ||
| 104 | |||
| 105 | This function is prototyped to take two scalar arguments. | ||
| 106 | |||
| 107 | =cut | ||
| 108 | |||
| 109 | sub waitstat_die ($$) { | ||
| 110 | my ($status, $program) = @_; | ||
| 111 | croak "Non-zero exit (" . waitstat($status) . | ||
| 112 | ") from $program" | ||
| 113 | if $status; | ||
| 114 | } | ||
| 115 | |||
| 116 | =item B<close_die> I<filehandle> I<name> | ||
| 117 | |||
| 118 | Close I<filehandle>, if that fails die() with an appropriate message | ||
| 119 | which refers to I<name>. This handles failed closings of both programs | ||
| 120 | and files properly. | ||
| 121 | |||
| 122 | This function is prototyped to take a filehandle (actually, a glob ref) | ||
| 123 | and a scalar. | ||
| 124 | |||
| 125 | =cut | ||
| 126 | |||
| 127 | sub close_die (*$) { | ||
| 128 | my ($fh, $name) = @_; | ||
| 129 | |||
| 130 | unless (ref $fh || ref \$fh eq 'GLOB') { | ||
| 131 | require Symbol; | ||
| 132 | $fh = Symbol::qualify_to_ref($fh, caller); | ||
| 133 | } | ||
| 134 | |||
| 135 | unless (close $fh) { | ||
| 136 | croak "Error closing $name: ", | ||
| 137 | $!+0 ? "$!" : 'non-zero exit (' . waitstat($?) . ')'; | ||
| 138 | } | ||
| 139 | } | ||
| 140 | |||
| 141 | 1 | ||
| 142 | |||
| 143 | __END__ | ||
| 144 | |||
| 145 | =back | ||
| 146 | |||
| 147 | =head1 EXAMPLES | ||
| 148 | |||
| 149 | close SENDMAIL; | ||
| 150 | exit if $? == 0; | ||
| 151 | log "sendmail failure: ", waitstat $?; | ||
| 152 | exit EX_TEMPFAIL; | ||
| 153 | |||
| 154 | $pid == waitpid $pid, 0 or croak "Failed to reap $pid: $!"; | ||
| 155 | exit waitstat_reuse $?; | ||
| 156 | |||
| 157 | $output = `some-program -with args`; | ||
| 158 | waitstat_die $?, 'some-program'; | ||
| 159 | print "Output from some-process:\n", $output; | ||
| 160 | |||
| 161 | open PROGRAM, '| post-processor' or die "Can't fork: $!"; | ||
| 162 | while (<IN>) { | ||
| 163 | print PROGRAM pre_process $_ | ||
| 164 | or die "Error writing to post-processor: $!"; | ||
| 165 | } | ||
| 166 | # This handles both flush failures at close time and a non-zero exit | ||
| 167 | # from the subprocess. | ||
| 168 | close_die PROGRAM, 'post-processor'; | ||
| 169 | |||
| 170 | =head1 AUTHOR | ||
| 171 | |||
| 172 | Roderick Schertler <F<roderick@argon.org>> | ||
| 173 | |||
| 174 | =head1 SEE ALSO | ||
| 175 | |||
| 176 | perl(1), IPC::Signal(3pm). | ||
| 177 | |||
| 178 | =cut | ||
