1 files changed, 178 insertions, 0 deletions
diff --git a/meta-networking/recipes-extended/mime-construct/files/WaitStat.pm b/meta-networking/recipes-extended/mime-construct/files/WaitStat.pm
new file mode 100644
index 0000000000..337e52a705
--- /dev/null
+++ b/meta-networking/recipes-extended/mime-construct/files/WaitStat.pm
@@ -0,0 +1,178 @@
+# $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