File Coverage

lib/Devel/Trepan/DB/Colors.pm

Criterion	Covered	Total	%
statement	17	18	94.4
branch	1	2	50.0
condition	1	3	33.3
subroutine	5	5	100.0
pod	0	1	0.0
total	24	29	82.7

# Pretty much cut and paste from Syntax::Highlight::Perl's viewperl
package Devel::Trepan::DB::Colors;
=head1 NAME

Devel::Trepan::DB::Colors - Set up L<Devel::Trepan>'s formatter to do ANSI colors.

=cut

use warnings; use strict;
use Syntax::Highlight::Perl::Improved;

use vars qw(%ANSI_colors);

# See also Term::ANSIColor.
#
%ANSI_colors = (
    none      => "\e[0m",

    black     => "\e[m",
    red       => "\e[0;31m",
    green     => "\e[0;32m",
    yellow    => "\e[0;33m",
    blue      => "\e[0;34m",
    magenta   => "\e[0;35m",
    cyan      => "\e[0;36m",
    white     => "\e[0;37m",

    gray      => "\e[1;30m",
    bred      => "\e[1;31m",
    bgreen    => "\e[1;32m",
    byellow   => "\e[1;33m",
    bblue     => "\e[1;34m",
    bmagenta  => "\e[1;35m",
    bcyan     => "\e[1;36m",
    bwhite    => "\e[1;37m",

    bgred     => "\e[41m",
    bggreen   => "\e[42m",
    bgyellow  => "\e[43m",
    bgblue    => "\e[44m",
    bgmagenta => "\e[45m",
    bgcyan    => "\e[46m",
    bgwhite   => "\e[47m",
);

sub setup
{
    my $perl_formatter = new Syntax::Highlight::Perl::Improved;
    $perl_formatter->unstable(1);
    if (scalar @_ && $_[0] eq 'dark') {
	$perl_formatter->set_format(
	    'Comment_Normal'   => [$ANSI_colors{'yellow'},   $ANSI_colors{'none'}],
	    'Comment_POD'      => [$ANSI_colors{'yellow'},   $ANSI_colors{'none'}],
	    'Directive'        => [$ANSI_colors{'magenta'},  $ANSI_colors{'none'}],
	    'Label'            => [$ANSI_colors{'magenta'},  $ANSI_colors{'none'}],
	    'Quote'            => [$ANSI_colors{'black'},    $ANSI_colors{'none'}],
	    'String'           => [$ANSI_colors{'cyan'},     $ANSI_colors{'none'}],
	    'Subroutine'       => [$ANSI_colors{'yellow'},   $ANSI_colors{'none'}],
	    'Variable_Scalar'  => [$ANSI_colors{'green'},    $ANSI_colors{'none'}],
	    'Variable_Array'   => [$ANSI_colors{'magenta'},  $ANSI_colors{'none'}],
	    'Variable_Hash'    => [$ANSI_colors{'green'},    $ANSI_colors{'none'}],
	    'Variable_Typeglob'=> [$ANSI_colors{'black'},    $ANSI_colors{'none'}],
	    'Whitespace'       => ['',                       ''                  ],
	    'Character'        => [$ANSI_colors{'red'},      $ANSI_colors{'none'}],
	    'Keyword'          => [$ANSI_colors{'yellow'},   $ANSI_colors{'none'}],
	    'Builtin_Function' => [$ANSI_colors{'grey'},     $ANSI_colors{'none'}],
	    'Builtin_Operator' => [$ANSI_colors{'white'},    $ANSI_colors{'none'}],
	    'Operator'         => [$ANSI_colors{'white'},    $ANSI_colors{'none'}],
	    'Bareword'         => [$ANSI_colors{'grey'},     $ANSI_colors{'none'}],
	    'Package'          => [$ANSI_colors{'green'},    $ANSI_colors{'none'}],
	    'Number'           => [$ANSI_colors{'magenta'},  $ANSI_colors{'none'}],
	    'Symbol'           => [$ANSI_colors{'cyan'},     $ANSI_colors{'none'}],
	    'CodeTerm'         => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],
	    'DATA'             => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],

	    'Line'             => [$ANSI_colors{'byellow'},  $ANSI_colors{'none'}],
	    'File_Name'        => [$ANSI_colors{'red'} . $ANSI_colors{'bgwhite'},
				   $ANSI_colors{'none'}],);
    } else {
	$perl_formatter->set_format(
	    'Comment_Normal'   => [$ANSI_colors{'red'},      $ANSI_colors{'none'}],
	    'Comment_POD'      => [$ANSI_colors{'bblue'},    $ANSI_colors{'none'}],
	    'Directive'        => [$ANSI_colors{'magenta'},  $ANSI_colors{'none'}],
	    'Label'            => [$ANSI_colors{'bblue'},    $ANSI_colors{'none'}],
	    'Quote'            => [$ANSI_colors{'black'},    $ANSI_colors{'none'}],
	    'String'           => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],
	    'Subroutine'       => [$ANSI_colors{'blue'},     $ANSI_colors{'none'}],
	    'Variable_Scalar'  => [$ANSI_colors{'bgreen'},   $ANSI_colors{'none'}],
	    'Variable_Array'   => [$ANSI_colors{'magenta'},  $ANSI_colors{'none'}],
	    'Variable_Hash'    => [$ANSI_colors{'bgreen'},   $ANSI_colors{'none'}],
	    'Variable_Typeglob'=> [$ANSI_colors{'black'},    $ANSI_colors{'none'}],
	    'Whitespace'       => ['',                       ''                  ],
	    'Character'        => [$ANSI_colors{'bred'},     $ANSI_colors{'none'}],
	    'Keyword'          => [$ANSI_colors{'bblue'},    $ANSI_colors{'none'}],
	    'Builtin_Function' => [$ANSI_colors{'bwhite'},   $ANSI_colors{'none'}],
	    'Builtin_Operator' => [$ANSI_colors{'black'},    $ANSI_colors{'none'}],
	    'Operator'         => [$ANSI_colors{'black'},    $ANSI_colors{'none'}],
	    'Bareword'         => [$ANSI_colors{'white'},    $ANSI_colors{'none'}],
	    'Package'          => [$ANSI_colors{'green'},    $ANSI_colors{'none'}],
	    'Number'           => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],
	    'Symbol'           => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],
	    'CodeTerm'         => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],
	    'DATA'             => [$ANSI_colors{'gray'},     $ANSI_colors{'none'}],

	    'Line'             => [$ANSI_colors{'byellow'},  $ANSI_colors{'none'}],
	    'File_Name'        => [$ANSI_colors{'red'} . $ANSI_colors{'bgwhite'},
				   $ANSI_colors{'none'}],
	    );
    }
    $perl_formatter;
}

unless (caller) {
    my $perl_formatter = Devel::Trepan::DB::Colors::setup();
    my $colors_file = __FILE__;
    open my $fh, "<", __FILE__ or die "Why can't I read myself?: $!";
    local $/; # enable localized slurp mode
    my $content = <$fh>;
    close $fh;
    print $perl_formatter->format_string($content);

}