lib/WarnColor.pm

   1 package WarnColor;
   2
   3 use warnings;
   4 use strict;
   5
   6 use POSIX qw(strftime);
   7
   8 sub BEGIN {
   9
  10         sub port2color {
  11                 my $port = shift;
  12                 return "\e[1m0\e[0m" if $port == 0;
  13
  14                 my $c = ( $port % 6 ) + 31;
  15                 return "\e[${c}m$port\e[0m";
  16         }
  17
  18         sub __log {
  19                 my $log = $ENV{SLICE} ? "$ENV{SLICE}/log/" : '/tmp/';
  20
  21                 my ( $ss,$mm,$hh, $d,$m,$yyyy ) = localtime(time());
  22                 $yyyy += 1900;
  23                 $m    += 1;
  24
  25                 $log .= sprintf("%04d-%02d-%02d.", $yyyy, $m, $d );
  26
  27                 $log .= $ENV{NAME}  ? $ENV{NAME} : $1 if $0 =~ m{([^/]+)$};
  28
  29                 my $line = join(' ', @_);
  30                 if ( $line =~ s{^(?:\e\[\d+m)*(\d\d\d\d)\W(\d\d)\W(\d\d) (\d\d:\d\d:\d\d)}{$1-$2-$3 $4} ) {
  31                         # have timestamp allready
  32                 } else {
  33                         my $time = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $yyyy,$m,$d, $hh,$mm,$ss);
  34                         $line = "$time $line";
  35                 }
  36
  37                 $line =~ s/[\r\n]+$/\n/;
  38
  39                 print STDERR "creating $log\n" unless -e $log;
  40
  41                 if ( open(my $fh, '>>', $log) ) {
  42                         print $fh $line;
  43                         close $fh;
  44                 } else {
  45                         print STDERR $line;
  46                 }
  47         }
  48
  49 if ( -t STDOUT ) { # colorize only if run from terminal !
  50
  51         $SIG{__WARN__} = sub {
  52                 return unless @_;
  53                 my $msg = join('', @_);
  54                 if ( $msg =~ s{ line (\d+)\.}{ +$1} ) {
  55                         $msg =~ s{^(.+)( at .+)}{\e[31m$1\e[0m$2} if $msg !~ m{^#};
  56                 }
  57                 $msg =~ s{\[(\d+)\]}{ '[' . port2color($1) . ']' }eg;
  58                 $msg =~ s{(\||=>)}{\e[34m$1\e[0m}g; # blue
  59                 $msg =~ s{(["\{\}\#])}{\e[33m$1\e[0m}g; # yellow
  60                 __log $msg unless $msg =~ m{^#} && ! $ENV{DEBUG};
  61                 return 1;
  62         };
  63
  64 } else {
  65
  66         $SIG{__WARN__} = sub {
  67                 __log @_;
  68         };
  69
  70         $SIG{__DIE__} = sub {
  71                 if($^S) {
  72                         # We're in an eval {} and don't want log
  73                         # this message but catch it later
  74                         return;
  75                 }
  76                 __log 'DIE', @_;
  77                 die @_;
  78         };
  79
  80 }
  81
  82 } # BEGIN
  83
  84 1;