[Scripts/package_log.pl] refactor guts of package_log.pl

1 files changed, 41 insertions, 16 deletions

diff --git a/scripts/lib/colorcarp.pm b/scripts/lib/colorcarp.pm
index f06d6c3dc..bc878eb28 100644
--- a/scripts/lib/colorcarp.pm
+++ b/scripts/lib/colorcarp.pm
@@ -1,30 +1,55 @@
 use strict;
 use warnings;
+
 package colorcarp;
+
 # FILENAME: colorcarp.pm
 # CREATED: 02/08/11 16:11:38 by Kent Fredric (kentnl) <kentfredric@gmail.com>
 # ABSTRACT: Easy currier for making coloured carp functions.
 
+=head1 SYNOPSIS
+
+  use colorcarp
+    defaults => { attributes => [qw( on_white )], method => 'confess' },
+    carper => { -as => 'redcarp' , attributes => [qw( red )] },
+    carper => { -as => 'bluecarp' , attributes => [qw( blue )] };
 
-sub import {
-  my $inject = [ caller ]->[0];
-  my $params = $_[1] ;
-  for my $method ( keys %{$params} ){
-    my ( $foreground, $background, $realcall ) = @{ $params->{$method} };
-    eval "{ package $inject ; sub $method {
-      my \$value = shift;
-      color: {
-        last color if \$ENV{NO_COLOR};
-        \$value =~ s/^(.*)\$/\e[${foreground};${background}m \$1 \e[0m\n/mg;
-      }
-      \@_ = ( \$value );
-      require Carp;
-      goto \&Carp::${realcall}
-    }}"
+=cut
+
+use Sub::Exporter -setup => { 
+    exports => [ carper => \&build_carper, ],
+    collectors => [ defaults => \&defaults_collector ],
+};
+sub defaults_collector {
+  my ( $collection, $config ) = @_;
+  $collection->{attributes} ||= [];
+  if( @{ $collection->{attributes} } ){ 
+    require Term::ANSIColor;
+    return if not Term::ANSIColor::colorvalid(@{ $collection->{attributes} });
+  }
+  $collection->{method} ||= 'confess'
+  if( not grep { $_ eq $collection->{method} } qw( confess carp cluck croak ) ){
+    return;
   }
+  return 1;
 }
 
+sub build_carper {
+  my ( $class, $name, $args , $col ) = @_;
+  my $attributes = ( $args->{attributes} || [] );
+  unshift @$attributes, @{ $col->{defaults}->{attributes} };
+  
+  require Carp;
+  my $call = Carp->can( $args->{method} || $col->{defaults}->{method} );
 
-1;
+  return sub {
+    require Term::ANSIColor;
+    my $value = shift;
+    @_ = ( Term::ANSIColor::colored( $attributes, $value ) );
+    goto $call;
+  };
+
+}
 
+1;