File Coverage

blib/lib/Color/Theme/Role.pm

Criterion	Covered	Total	%
statement	12	73	16.4
branch	0	30	0.0
condition	0	7	0.0
subroutine	4	10	40.0
pod	6	6	100.0
total	22	126	17.4

package Color::Theme::Role;

our $DATE = '2014-12-11'; # DATE
our $VERSION = '0.01'; # VERSION

use 5.010001;
use Moo::Role;

has color_theme_args  => (is => 'rw', default => sub { {} });
has _all_color_themes => (is => 'rw');

sub color_theme_module_prefix {
    my $self = shift;

    (ref($self) ? ref($self) : $self ) . '::ColorTheme';
}

sub color_theme {
    my $self = shift;

    if (!@_) { return $self->{color_theme} }
    my $ct = shift;

    my $p2 = "";
    if (!ref($ct)) {
        $p2 = " named $ct";
        $ct = $self->get_color_theme($ct);
    }

    my $err;
    if (!$ct->{no_color} && !$self->use_color) {
        $err = "color theme uses color but use_color is set to false";
    }
    die "Can't select color theme$p2: $err" if $err;

    $self->{color_theme} = $ct;
}

sub get_color_theme {
    my ($self, $ct) = @_;

    my $prefix = $self->color_theme_module_prefix;
    my $cts;
    my $pkg;
    if ($ct =~ s/(.+):://) {
        $pkg = "$prefix\::$1";
        my $pkgp = $pkg; $pkgp =~ s!::!/!g;
        require "$pkgp.pm";
        no strict 'refs';
        $cts = \%{"$pkg\::color_themes"};
    } else {
        #$cts = $self->list_color_themes(1);
        die "Please use SubPackage::name to choose color theme, ".
            "use list_color_themes() to list available themes";
    }
    $cts->{$ct} or die "Unknown color theme name '$ct'".
        ($pkg ? " in package $pkg" : "");
    ($cts->{$ct}{v} // 1.0) == 1.1 or die "Color theme '$ct' is too old ".
        "(v < 1.1)". ($pkg ? ", please upgrade $pkg" : "");
    $cts->{$ct};
}

sub get_theme_color {
    my ($self, $item_name) = @_;

    return undef if $self->{color_theme}{no_color};
    $self->{color_theme}{colors}{$item_name};
}

sub get_theme_color_as_rgb {
    my ($self, $item_name, $args) = @_;
    my $c = $self->get_theme_color($item_name);
    return undef unless defined($c);

    # resolve coderef color
    if (ref($c) eq 'CODE') {
        $args //= {};
        $c = $c->($self, %$args);
    }

    $c;
}

sub list_color_themes {
    require Module::List;
    require Module::Load;

    my ($self, $detail) = @_;

    my $prefix = $self->color_theme_module_prefix;
    my $all_ct = $self->_all_color_themes;

    if (!$all_ct) {
        my $mods = Module::List::list_modules("$prefix\::",
                                              {list_modules=>1, recurse=>1});
        no strict 'refs';
        $all_ct = {};
        for my $mod (sort keys %$mods) {
            #$log->tracef("Loading color theme module '%s' ...", $mod);
            Module::Load::load($mod);
            my $ct = \%{"$mod\::color_themes"};
            for (keys %$ct) {
                my $cutmod = $mod;
                $cutmod =~ s/^\Q$prefix\E:://;
                my $name = "$cutmod\::$_";
                $ct->{$_}{name} = $name;
                $all_ct->{$name} = $ct->{$_};
            }
        }
        $self->_all_color_themes($all_ct);
    }

    if ($detail) {
        return $all_ct;
    } else {
        return sort keys %$all_ct;
    }
}

1;
# ABSTRACT: Role for class wanting to support color themes

__END__