initial implementation

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;