File Coverage

blib/lib/System/Explain.pm

Criterion	Covered	Total	%
statement	33	40	82.5
branch	14	32	43.7
condition	10	15	66.6
subroutine	8	8	100.0
pod	0	2	0.0
total	65	97	67.0

# Original author: Paul Johnson
# Created:         Fri 12 Mar 1999 10:25:51 am

package System::Explain;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.02";

=encoding utf-8

=head1 NAME

System::Explain - run a system command and explain the result

=head1 SYNOPSIS

  use System::Explain "command, verbose, errors";
  sys qw(ls -al);

The C function runs a system command, checks the result, and comments on
it to STDOUT.

=head1 DESCRIPTION

System::Explain is a standalone release of L, part of L
v1.20 and earlier.

=head1 FUNCTIONS

=cut

use parent 'Exporter';

our @EXPORT = qw(sys dsys);

my $Command = 0;
my $Errors  = 0;
my $Verbose = 0;

=head1 import

Say C to use this module.
The options are: C (to print the command before running it),
C (to report on the exit status), and C (to do both of those).

=cut

sub import
{
  my $class = shift;
  my $args  = "@_";
  $Command = $args =~ /\bcommand\b/i;
  $Errors  = $args =~ /\berror\b/i;
  $Verbose = $args =~ /\bverbose\b/i;
  $Command ||= $Verbose;
  $Errors  ||= $Verbose;
  $class->export_to_level(1, "sys")  if $args =~ /\bsys\b/i;
  $class->export_to_level(1, "dsys") if $args =~ /\bdsys\b/i;
}

=head1 sys

C runs C<@command> (by passing C<@command> to C) and
optionally prints human-readable information about the result (specifically,
about the return value of C).

Returns the return value of the C call.

=cut

sub sys
{
  my (@command) = @_;
  local $| = 1;
  print "@command" if $Command;
  my $rc = 0xffff & system @command;
  print "\n" if $Command && !$rc && !$Verbose;
  _print_explanation_of($rc);
}

=head1 dsys

As L, but dies if the C call fails.

=cut

sub dsys
{
  die "@_ failed" if sys @_;
}

# Print the explanation
sub _print_explanation_of
{
  my ($rc) = @_;
  printf "  returned %#04x: ", $rc if $Errors && $rc;
  if ($rc == 0)
  {
    print "ran with normal exit\n" if $Verbose;
  }
  elsif ($rc == 0xff00)
  {
    print "command failed: $!\n" if $Errors;
  }
  elsif ($rc > 0x80)
  {
    $rc >>= 8;
    print "ran with non-zero exit status $rc\n" if $Errors;
  }
  else
  {
    print "ran with " if $Errors;
    if ($rc & 0x80)
    {
      $rc &= ~0x80;
      print "coredump from " if $Errors;
    }
    print "signal $rc\n" if $Errors;
  }
  return $rc;
}

1;
__END__