lib/WarnColor.pm

   1 package WarnColor;
   2
   3 use warnings;
   4 use strict;
   5
   6 sub BEGIN {
   7
   8         sub port2color {
   9                 my $port = shift;
  10                 return "\e[1m0\e[0m" if $port == 0;
  11
  12                 my $c = ( $port % 6 ) + 31;
  13                 return "\e[${c}m$port\e[0m";
  14         }
  15
  16         $SIG{__WARN__} = sub {
  17                 return unless @_;
  18                 my $msg = join('', @_);
  19                 if ( $msg =~ s{ line (\d+)\.}{ +$1} ) {
  20                         $msg =~ s{^(.+)( at .+)}{\e[31m$1\e[0m$2} if $msg !~ m{^#};
  21                 }
  22                 $msg =~ s{\[(\d+)\]}{ '[' . port2color($1) . ']' }eg;
  23                 $msg =~ s{(\||=>)}{\e[34m$1\e[0m}g; # blue
  24                 $msg =~ s{(["\{\}\#])}{\e[33m$1\e[0m}g; # yellow
  25                 print STDERR $msg unless $msg =~ m{^#} && ! $ENV{DEBUG};
  26                 return 1;
  27         };
  28
  29 }
  30
  31 1;