Proc-WaitStat-1.00/004075500005500000162000000000000700364132200145415ustar00roderickmis00000000000000Proc-WaitStat-1.00/Makefile.PL010044400005500000162000000010140634045542300165120ustar00roderickmis00000000000000# $Id: Makefile.PL,v 1.1 1997-05-20 22:14:23-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. use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Proc::WaitStat', PREREQ_PM => { 'IPC::Signal' => 0 }, VERSION_FROM => 'WaitStat.pm', dist => { COMPRESS => 'gzip --best', DIST_CP => 'ln', PREOP => '$(MAKE) ci', SUFFIX => 'gz', }, ); Proc-WaitStat-1.00/Changes010044400005500000162000000004710700364062700160400ustar00roderickmis00000000000000Revision history for Perl extension Proc::WaitStat. 1.00 Thu Oct 21 12:38:28 EDT 1999 - Handle a string passed as filehandle to close_die(). I think this changed behavior in 5.005. 0.01 Thu May 15 00:00:00 EDT 1997 - Initial version. $Id: Changes,v 1.2 1999-10-21 12:38:48-04 roderick Exp $ Proc-WaitStat-1.00/WaitStat.pm010044400005500000162000000075620700364071700166530ustar00roderickmis00000000000000# $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__ =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 () { 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 > =head1 SEE ALSO perl(1), IPC::Signal(3pm). =cut Proc-WaitStat-1.00/MANIFEST.SKIP010044400005500000162000000001240634045542300164370ustar00roderickmis00000000000000# $Id: MANIFEST.SKIP,v 1.1 1997-05-20 22:14:23-04 roderick Exp $ ,v$ ~$ ^Makefile$ Proc-WaitStat-1.00/t/004075500005500000162000000000000700364132200150045ustar00roderickmis00000000000000Proc-WaitStat-1.00/t/waitstat.t010044400005500000162000000031720700364131500170310ustar00roderickmis00000000000000#!perl -w use strict; # $Id: waitstat.t,v 1.3 1999-10-21 12:43:58-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. BEGIN { $| = 1; print "1..20\n"; } use Proc::WaitStat qw(waitstat waitstat_reuse waitstat_die close_die); use IPC::Signal qw(sig_num); sub ok { my ($n, $result, @info) = @_; if ($result) { print "ok $n\n"; } else { print "not ok $n\n"; print "# ", @info, "\n" if @info; } } my $test_func; sub test { my ($n, $expect, @args) = @_; my $result = $test_func->(@args); ok $n, $expect eq $result, "$expect != $result, args @args"; } $test_func = \&waitstat; ok 1, prototype($test_func) eq '$'; #'; test 2, '0', 0; test 3, 'killed (SIGHUP)', sig_num 'HUP'; test 4, '1', 1 << 8; test 5, '23', 23 << 8; test 6, '255', 255 << 8; $test_func = \&waitstat_reuse; ok 7, prototype($test_func) eq '$'; #'; test 8, 0, 0; test 9, 129, 1; test 10, 1, 1 << 8; test 11, 23, 23 << 8; test 12, 255, 255 << 8; ok 13, prototype('waitstat_die') eq '$$'; eval { waitstat_die 0, 'program' }; ok 14, $@ eq '', $@; eval { waitstat_die 1, 'program' }; ok 15, $@ =~ /^Non-zero/, $@; # This also tests some of the different forms a filehandle can take when # passed to close_die(). use vars qw(*TRUE); # squelch warning ok 16, prototype('close_die') eq '*$'; #'; ok 17, open(TRUE, '|true'); eval { close_die TRUE, 'true' }; ok 18, $@ eq '', $@; ok 19, open(FALSE, '|false'); eval { close_die *FALSE, 'false' }; ok 20, $@ =~ /^Error closing false:/, $@; Proc-WaitStat-1.00/README010044400005500000162000000011360634045542200154240ustar00roderickmis00000000000000This distribution contains the Proc::WaitStat module. This module requires IPC::Signal module so install it before building this one. To build this module run perl Makefile.PL make make test make install The documentation is embeded in the module, use perldoc WaitStat.pm to read it before installation. Roderick Schertler 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. $Id: README,v 1.1 1997-05-20 22:14:23-04 roderick Exp $ Proc-WaitStat-1.00/MANIFEST010044400005500000162000000002070634045542200156730ustar00roderickmis00000000000000 $Id: MANIFEST,v 1.1 1997-05-20 22:14:23-04 roderick Exp $ Changes MANIFEST MANIFEST.SKIP Makefile.PL README WaitStat.pm t/waitstat.t