File Coverage

blib/lib/System/Explain.pm

Criterion	Covered	Total	%
statement	31	40	77.5
branch	8	32	25.0
condition	7	15	46.6
subroutine	7	8	87.5
pod	0	3	0.0
total	53	98	54.0

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

our $VERSION = "0.01";

# Copyright 1999-2012 by Paul Johnson ([e-mail])

# documentation at __END__

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

use parent 'Exporter';

our @EXPORT = qw(sys dsys);

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

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;
}

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

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

sub ret
{
  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;
  }
  $rc;
}

1;
__END__