From a6208d5affaa14bcafb195c0a98ec92634e3dbc1 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Fri, 30 Apr 2010 17:31:29 -0500 Subject: initial implementation --- lib/Carp/Always/Color.pm | 11 ++++++++--- lib/Carp/Always/Color/HTML.pm | 34 ++++++++++++++++++++++++++++++++++ lib/Carp/Always/Color/Term.pm | 34 ++++++++++++++++++++++++++++++++++ 3 files changed, 76 insertions(+), 3 deletions(-) create mode 100644 lib/Carp/Always/Color/HTML.pm create mode 100644 lib/Carp/Always/Color/Term.pm 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/(.*)/$1<\/span>/; + die $err; +} + +sub _warn { + my $warning; + { + local $SIG{__WARN__} = sub { $warning = $_[0] }; + Carp::Always::_warn(@_); + } + $warning =~ s/(.*)/$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; -- cgit v1.2.3-54-g00ecf