maint/getstatus

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Config;
   7 use Term::ANSIColor ':constants';
   8 my $CRST = RESET;
   9 my $CCODE = BOLD;
  10 my $CSTAT = BOLD . GREEN;
  11 my $CCORE = BOLD . CYAN;
  12 my $CSIG = CYAN;
  13
  14 if (@ARGV) {
  15   my $code = system (@ARGV);
  16
  17   if ($code < 0) {
  18     exit 127;
  19   }
  20   elsif ($code > 0) {
  21
  22     my $status = $code >> 8;
  23     my $signum = $code & 127;
  24     my $core = $code & 128;
  25
  26     my %sig_idx;
  27     @sig_idx{split /\s+/, $Config{sig_num}} = split /\s/, $Config{sig_name};
  28
  29     printf STDERR (
  30 <<EOF
  31
  32 Results of execution: `%s`
  33 ----------------------
  34 System exit code:$CCODE %d $CRST$CSIG %s $CRST
  35  ($CSTAT%08b$CRST$CCORE%b$CRST$CSIG%07b$CRST)
  36
  37 Status: %3s ($CSTAT%08b$CRST)
  38 Signal: %3s ($CSIG%08b$CRST)
  39 Core:   %3s
  40 ----------------------
  41 EOF
  42     , (join ' ', @ARGV),
  43       $code, ($signum ? "(SIG-$sig_idx{$signum})" : ''),
  44       $status, $core, $signum,
  45       ($status) x 2,
  46       ($signum) x 2,
  47       ($core ? 'Yes': 'No')
  48     );
  49
  50     exit ($status);
  51   }
  52 }