File Coverage

blib/lib/Term/SimpleColor.pm

Criterion	Covered	Total	%
statement	93	98	94.9
branch	9	12	75.0
condition	3	9	33.3
subroutine	30	30	100.0
pod	22	22	100.0
total	157	171	91.8

package Term::SimpleColor;

use strict;
use warnings;
use utf8;
use Carp;
use base 'Exporter';

our $VERSION = '0.0.3';

our @EXPORT = qw/ black red green yellow blue magenta cyan gray white default /;
our @EXPORT_OK =
  qw/ bg_default bg_black bg_red bg_green bg_yellow bg_blue bg_magenta bg_cyan bg_gray underscore bold invert dc_default /;

our %EXPORT_TAGS = (
    all        => \@EXPORT_OK,
    background => [
        qw(bg_default bg_black bg_red bg_green bg_yellow bg_blue bg_magenta bg_cyan bg_gray)
    ],
    decoration => [qw(underscore bold invert dc_default)],
);


# TRIVIA: \x1b is escape code
my %COLOR = (
    black   => "\x1b[30m",
    red     => "\x1b[31m",
    green   => "\x1b[32m",
    yellow  => "\x1b[33m",
    blue    => "\x1b[34m",
    magenta => "\x1b[35m",
    cyan    => "\x1b[36m",
    white   => "\x1b[37m",
    default => "\x1b[39m",
);

my %BG_COLOR = (
    bg_black   => "\x1b[40m",
    bg_red     => "\x1b[41m",
    bg_green   => "\x1b[42m",
    bg_yellow  => "\x1b[43m",
    bg_blue    => "\x1b[44m",
    bg_magenta => "\x1b[45m",
    bg_cyan    => "\x1b[46m",
    bg_gray    => "\x1b[47m",
    bg_default => "\x1b[49m",
);

my %DECORATE = (
    underscore => "\x1b[4m",
    bold       => "\x1b[1m",
    invert     => "\x1b[7m",
    dc_default => "\x1b[0m",
);


sub _code {
    my ( $color_key, $string ) = @_;

    if ( !defined($color_key) || !defined( $COLOR{$color_key} ) ) {
        croak 'The color is NOT defined';
    }

    return $COLOR{$color_key}  unless defined($string);
    return $COLOR{$color_key} . $string . default();
}


sub default {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}


sub black {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}



sub red {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}

sub green {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}

sub yellow {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}

sub blue {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}

sub magenta {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}

sub cyan {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}


sub white {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _code($me, $string);
}


sub _bg_code {
    my ( $color_key, $string ) = @_;

    if ( !defined($color_key) || !defined( $BG_COLOR{$color_key} ) ) {
        croak 'The color is NOT defined';
    }

    return $BG_COLOR{$color_key}  unless defined($string);
    return $BG_COLOR{$color_key} . $string . bg_default();

    return '';
}


sub bg_default {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_black {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}


sub bg_red {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_green {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_yellow {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_blue {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_magenta {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_cyan {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}

sub bg_gray {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _bg_code($me, $string);
}



sub _dc_code {
    my ( $color_key, $string ) = @_;

    if ( !defined($color_key) || !defined( $DECORATE{$color_key} ) ) {
        croak 'The color is NOT defined.', " $color_key" ;
    }

    return $DECORATE{$color_key}  unless defined($string);
    return $DECORATE{$color_key} . $string . dc_default();

    return '';
}

sub dc_default {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _dc_code($me, $string);
}

sub underscore {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _dc_code($me, $string);
}

sub bold {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _dc_code($me, $string);
}

sub invert {
    my ($string) = @_;
    my $me = (split('::', (caller(0))[3]))[-1];
    return _dc_code($me, $string);
}

1;
__END__