File: getstatus

package info (click to toggle)
libdbix-class-perl 0.082843-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 5,320 kB
  • sloc: perl: 27,215; sql: 322; sh: 29; makefile: 16
file content (52 lines) | stat: -rwxr-xr-x 967 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
#!/usr/bin/perl

use warnings;
use strict;

use Config;
use Term::ANSIColor ':constants';
my $CRST = RESET;
my $CCODE = BOLD;
my $CSTAT = BOLD . GREEN;
my $CCORE = BOLD . CYAN;
my $CSIG = CYAN;

if (@ARGV) {
  my $code = system (@ARGV);

  if ($code < 0) {
    exit 127;
  }
  elsif ($code > 0) {

    my $status = $code >> 8;
    my $signum = $code & 127;
    my $core = $code & 128;

    my %sig_idx;
    @sig_idx{split /\s+/, $Config{sig_num}} = split /\s/, $Config{sig_name};

    printf STDERR (
<<EOF

Results of execution: `%s`
----------------------
System exit code:$CCODE %d $CRST$CSIG %s $CRST
 ($CSTAT%08b$CRST$CCORE%b$CRST$CSIG%07b$CRST)

Status: %3s ($CSTAT%08b$CRST)
Signal: %3s ($CSIG%08b$CRST)
Core:   %3s
----------------------
EOF
    , (join ' ', @ARGV),
      $code, ($signum ? "(SIG-$sig_idx{$signum})" : ''),
      $status, $core, $signum,
      ($status) x 2,
      ($signum) x 2,
      ($core ? 'Yes': 'No')
    );

    exit ($status);
  }
}