diff options
-rw-r--r-- | lib/Carp/Always/Color.pm | 11 | ||||
-rw-r--r-- | lib/Carp/Always/Color/HTML.pm | 34 | ||||
-rw-r--r-- | lib/Carp/Always/Color/Term.pm | 34 |
3 files changed, 76 insertions, 3 deletions
diff --git a/lib/Carp/Always/Color.pm b/lib/Carp/Always/Color.pm index 26b5e11..9c58978 100644 --- a/lib/Carp/Always/Color.pm +++ b/lib/Carp/Always/Color.pm @@ -1,5 +1,4 @@ package Carp::Always::Color; -use Moose; =head1 NAME @@ -13,8 +12,14 @@ Carp::Always::Color - =cut -__PACKAGE__->meta->make_immutable; -no Moose; +BEGIN { + if (-t *STDERR) { + require Carp::Always::Color::Term; + } + else { + require Carp::Always::Color::HTML; + } +} =head1 BUGS diff --git a/lib/Carp/Always/Color/HTML.pm b/lib/Carp/Always/Color/HTML.pm new file mode 100644 index 0000000..04846ca --- /dev/null +++ b/lib/Carp/Always/Color/HTML.pm @@ -0,0 +1,34 @@ +package Carp::Always::Color::HTML; +use Carp::Always; + +BEGIN { $Carp::Internal{(__PACKAGE__)}++ } + +sub _die { + eval { Carp::Always::_die(@_) }; + my $err = $@; + $err =~ s/(.*)/<span style="color:#800">$1<\/span>/; + die $err; +} + +sub _warn { + my $warning; + { + local $SIG{__WARN__} = sub { $warning = $_[0] }; + Carp::Always::_warn(@_); + } + $warning =~ s/(.*)/<span style="color:#880">$1<\/span>/; + warn $warning; +} + +my %OLD_SIG; +BEGIN { + @OLD_SIG{qw(__DIE__ __WARN__)} = @SIG{qw(__DIE__ __WARN__)}; + $SIG{__DIE__} = \&_die; + $SIG{__WARN__} = \&_warn; +} + +END { + @SIG{qw(__DIE__ __WARN__)} = @OLD_SIG{qw(__DIE__ __WARN__)}; +} + +1; diff --git a/lib/Carp/Always/Color/Term.pm b/lib/Carp/Always/Color/Term.pm new file mode 100644 index 0000000..5b6b538 --- /dev/null +++ b/lib/Carp/Always/Color/Term.pm @@ -0,0 +1,34 @@ +package Carp::Always::Color::Term; +use Carp::Always; + +BEGIN { $Carp::Internal{(__PACKAGE__)}++ } + +sub _die { + eval { Carp::Always::_die(@_) }; + my $err = $@; + $err =~ s/(.*)/\e[31m$1\e[m/; + die $err; +} + +sub _warn { + my $warning; + { + local $SIG{__WARN__} = sub { $warning = $_[0] }; + Carp::Always::_warn(@_); + } + $warning =~ s/(.*)/\e[33m$1\e[m/; + warn $warning; +} + +my %OLD_SIG; +BEGIN { + @OLD_SIG{qw(__DIE__ __WARN__)} = @SIG{qw(__DIE__ __WARN__)}; + $SIG{__DIE__} = \&_die; + $SIG{__WARN__} = \&_warn; +} + +END { + @SIG{qw(__DIE__ __WARN__)} = @OLD_SIG{qw(__DIE__ __WARN__)}; +} + +1; |