lib/Sack/Color.pm

package Sock::Color;

use warnings;
use strict;

sub BEGIN {

        sub port2color {
                my $port = shift;
                return "\e[1m0\e[0m" if $port == 0;

                my $c = ( $port % 6 ) + 31;
                return "\e[${c}m$port\e[0m";
        }

        $SIG{__WARN__} = sub {
                return unless @_;
                my $msg = join('', @_);
                if ( $msg =~ s{ line (\d+)\.}{ +$1} ) {
                        $msg =~ s{^(.+)( at .+)}{\e[31m$1\e[0m$2} if $msg !~ m{^#};
                }
                $msg =~ s{\[(0|\d\d\d\d)\]}{ '[' . port2color($1) . ']' }eg;
                print STDERR $msg unless $msg =~ m{^#} && ! $ENV{DEBUG};
                return 1;
        };

}

1;
1	package Sock::Color;
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{\[(0\|\d\d\d\d)\]}{ '[' . port2color($1) . ']' }eg;
23	print STDERR $msg unless $msg =~ m{^#} && ! $ENV{DEBUG};
24	return 1;
25	};
26
27	}
28
29	1;