File Coverage

blib/lib/Data/Printer/Theme.pm

Criterion	Covered	Total	%
statement	102	104	98.0
branch	39	44	88.6
condition	13	16	81.2
subroutine	16	16	100.0
pod	0	6	0.0
total	170	186	91.4

package Data::Printer::Theme;
use strict;
use warnings;
use Data::Printer::Common;

# the theme name
sub name {
    my ($self) = @_;
    return $self->{name};
}

# true if the theme has at least one color override
sub customized {
    my ($self) = @_;
    return exists $self->{is_custom} ? 1 : 0;
}

# displays the color as-is
sub color_for {
    my ($self, $color_type) = @_;
    return $self->{colors}{$color_type} || '';
}

# prints the SGR (terminal) color modifier
sub sgr_color_for {
    my ($self, $color_type) = @_;
    return unless exists $self->{sgr_colors}{$color_type};
    return $self->{sgr_colors}{$color_type} || ''
}

# prints the SGR (terminal) color reset modifier
sub color_reset { return "\e[m" }

sub new {
    my ($class, %params) = @_;

    my $color_level        = $params{color_level};
    my $colors_to_override = $params{color_overrides};
    my $theme_name         = $params{name};

    # before we put user info on string eval, make sure
    # it's just a module name:
    $theme_name =~ s/[^a-zA-Z0-9:]+//gsm;

    my $theme = bless {
        name        => $theme_name,
        color_level => $color_level,
        colors      => {},
        sgr_colors  => {},
    }, $class;
    $theme->_load_theme($params{ddp}) or delete $theme->{name};
    $theme->_maybe_override_theme_colors($colors_to_override, $params{ddp});
    return $theme;
}

sub _maybe_override_theme_colors {
    my ($self, $colors_to_override, $ddp) = @_;

    return unless $colors_to_override
               && ref $colors_to_override eq 'HASH'
               && keys %$colors_to_override;

    my $error = Data::Printer::Common::_tryme(sub {
        foreach my $kind (keys %$colors_to_override ) {
            my $override = $colors_to_override->{$kind};
            die "invalid color for '$kind': must be scalar not ref" if ref $override;
            my $parsed = $self->_parse_color($override, $ddp);
            if (defined $parsed) {
                $self->{colors}{$kind}     = $override;
                $self->{sgr_colors}{$kind} = $parsed;
                $self->{is_custom}{$kind}  = 1;
            }
        }
    });
    if ($error) {
        Data::Printer::Common::_warn($ddp, "error overriding color: $error. Skipping!");
    }
    return;
}

sub _load_theme {
    my ($self, $ddp) = @_;
    my $theme_name = $self->{name};

    my $class = 'Data::Printer::Theme::' . $theme_name;
    my $error = Data::Printer::Common::_tryme("use $class; 1;");
    if ($error) {
        Data::Printer::Common::_warn($ddp, "error loading theme '$theme_name': $error.");
        return;
    }
    my $loaded_colors     = {};
    my $loaded_colors_sgr = {};
    $error = Data::Printer::Common::_tryme(sub {
        my $class_colors;
        { no strict 'refs'; $class_colors = &{ $class . '::colors'}(); }
        die "${class}::colors() did not return a hash reference"
            unless ref $class_colors eq 'HASH';

        foreach my $kind (keys %$class_colors) {
            my $loaded_color = $class_colors->{$kind};
            die "color for '$kind' must be a scalar in theme '$theme_name'"
                if ref $loaded_color;
            my $parsed_color = $self->_parse_color($loaded_color, $ddp);
            if (defined $parsed_color) {
                $loaded_colors->{$kind}     = $loaded_color;
                $loaded_colors_sgr->{$kind} = $parsed_color;
            }
        }
    });
    if ($error) {
        Data::Printer::Common::_warn($ddp, "error loading theme '$theme_name': $error. Output will have no colors");
        return;
    }
    $self->{colors}     = $loaded_colors;
    $self->{sgr_colors} = $loaded_colors_sgr;
    return 1;
}

sub _parse_color {
    my ($self, $color_label, $ddp) = @_;
    return unless defined $color_label;
    return '' unless $color_label;

    my $color_code;
    if ($color_label =~ /\Argb\((\d+),(\d+),(\d+)\)\z/) {
        my ($r, $g, $b) = ($1, $2, $3);
        if ($r < 256 && $g < 256 && $b < 256) {
            if ($self->{color_level} == 3) {
                $color_code = "\e[0;38;2;$r;$g;${b}m";
            }
            else {
                my $reduced = _rgb2short($r,$g,$b);
                $color_code = "\e[0;38;5;${reduced}m";
            }
        }
        else {
            Data::Printer::Common::_warn($ddp, "invalid color '$color_label': all colors must be between 0 and 255");
        }
    }
    elsif ($color_label =~ /\A#([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})\z/i) {
        my ($r, $g, $b) = map hex($_), ($1, $2, $3);
        if ($self->{color_level} == 3) {
            $color_code = "\e[0;38;2;$r;$g;${b}m";
        }
        else {
            my $reduced = _rgb2short($r,$g,$b);
            $color_code = "\e[0;38;5;${reduced}m";
        }
    }
    elsif ($color_label =~ /\A\e\[\d+(:?;\d+)*m\z/) {
        $color_code = $color_label;
    }
    elsif ($color_label =~ /\A
        (?:
         \s*
          (?:on_)?
          (?:bright_)?
          (?:black|red|green|yellow|blue|magenta|cyan|white)
        )+
        \s*\z/x
    ) {
        my %ansi_colors = (
            'black'          => 30,   'on_black'          => 40,
            'red'            => 31,   'on_red'            => 41,
            'green'          => 32,   'on_green'          => 42,
            'yellow'         => 33,   'on_yellow'         => 43,
            'blue'           => 34,   'on_blue'           => 44,
            'magenta'        => 35,   'on_magenta'        => 45,
            'cyan'           => 36,   'on_cyan'           => 46,
            'white'          => 37,   'on_white'          => 47,
            'bright_black'   => 90,   'on_bright_black'   => 100,
            'bright_red'     => 91,   'on_bright_red'     => 101,
            'bright_green'   => 92,   'on_bright_green'   => 102,
            'bright_yellow'  => 93,   'on_bright_yellow'  => 103,
            'bright_blue'    => 94,   'on_bright_blue'    => 104,
            'bright_magenta' => 95,   'on_bright_magenta' => 105,
            'bright_cyan'    => 96,   'on_bright_cyan'    => 106,
            'bright_white'   => 97,   'on_bright_white'   => 107,
        );
        $color_code = "\e["
                    . join(';' => map $ansi_colors{$_}, split(/\s+/, $color_label))
                    . 'm'
                    ;
    }
    else {
        Data::Printer::Common::_warn($ddp, "invalid color '$color_label'");
    }
    return $color_code;
}

sub _rgb2short {
    my ($r,$g,$b) = @_;
    my @snaps = (47, 115, 155, 195, 235);
    my @new;
    foreach my $color ($r,$g,$b) {
        my $big = 0;
        foreach my $s (@snaps) {
            $big++ if $s < $color;
        }
        push @new, $big
    }
    return $new[0]*36 + $new[1]*6 + $new[2] + 16
}

1;
__END__