File Coverage

blib/lib/Proc/WaitStat.pm

Criterion	Covered	Total	%
statement	37	41	90.2
branch	13	20	65.0
condition	2	3	66.6
subroutine	11	11	100.0
pod	4	4	100.0
total	67	79	84.8

# $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 I

Returns a string representation of wait() status value I.
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 I

Turn I into a value which can be passed to B, converted
in the same manner the shell uses.  If I indicates a normal
exit, return the exit value.  If I 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 I I

die() if I is non-zero (mentioning I 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 I I

Close I, if that fails die() with an appropriate message
which refers to I.  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__