File Coverage

blib/lib/Color/Library/Dictionary.pm

Criterion	Covered	Total	%
statement	83	96	86.4
branch	21	32	65.6
condition	3	6	50.0
subroutine	15	18	83.3
pod	7	7	100.0
total	129	159	81.1

package Color::Library::Dictionary;

use strict;
use warnings;

use Color::Library;
use Color::Library::Color;

use base qw/Class::Data::Inheritable/;

__PACKAGE__->mk_classdata($_) for qw/_self _compiled _color_list _index/;

=head1 NAME

Color::Library::Dictionary - Color dictionary for Color::Library

=cut

sub _register_dictionary {
    my $module = my $class = shift;
    my @module = split m/::/, $module;

    my @parent_module = @module;
    my $name = pop @parent_module;
    @parent_module = qw/Color Library/ if @parent_module == 3; # Color::Library::Dictionary
    my $parent_module = join "::", @parent_module;
    {
        no strict 'refs';
        *{"$parent_module\::$name"} = sub {
            return $module->_singleton;
        };
    }
    Color::Library->_register_dictionary($module);
}

sub _parse_id($) {
    my $id = shift;
    $id =~ s/::|_|\s+|\//-/g;
    $id = lc $id;
    $id =~ s/^color-library-dictionary-//g;
    return $id;
}

sub _singleton {
    my $class = shift;
    my $self;
    return $self if $self = $class->_self;
    $class->_self($self = bless {}, $class);
    return $self;
}

sub _compile {
    my $self = shift;
    my $class = ref $self || $self;

    return if $self->_compiled;

    my $color_list = $self->_load_color_list;

    my $index = {};
    my @color_list;
    my $indice = 0;
    for my $color (@$color_list) {
        push @color_list, $color = Color::Library::Color->new($color, $self);
        $index->{id}->{$color->id} = $color;
        $index->{name}->{$color->name} = $color;
        $index->{title}->{$color->title} = $color;
        $index->{hex}->{$color->hex} = $color;
        $index->{value}->{$color->value} = $color;
    }
    $self->_index($index);
    $self->_color_list(\@color_list);
    $self->_compiled(1);
}

=head1 METHODS

=over 4

=item @colors = $dictionary->colors

Returns the list of Color::Library::Color objects contained by $dictionary

Will return a list in list context, and a list reference in scalar context

=cut

sub colors {
    my $self = shift;
    $self->_compile unless $self->_compiled;
    my @colors = @{ $self->_color_list };
    return wantarray ? @colors : \@colors;
}

=item @names = $dictionary->names

=item @names = $dictionary->color_names

Returns the list of color names contained by $dictionary

Will return a list in list context, and a list reference in scalar context

=cut

sub names {
    my $self = shift;
    my @names = map { $_->name } $self->colors;
    return wantarray ? @names : \@names;
}
*color_names = \&names;

=item $color = $dictionary->color(  )

Returns a Color::Library::Color object of $dictionary found via

A query can be any of the following:

=over 4

=item color name

A color name is like C or C

=item color title

A color title is like C

=item color id

A color id is in the form of :, for example: C

=back

=cut

sub color {
    my $self = shift;
    my $query = shift;

    return unless defined $query;

    unless (ref $query) {
        $query =~ s/^\s*//;
        $query =~ s/\s*$//;
    }

    $self->_compile unless $self->_compiled;

    my $color;

    if (ref $query eq "ARRAY") {
        $query = Color::Library::Color::rgb2hex $query;
        return $color = $self->_index->{hex}->{$query};
    }
    elsif ($query =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
        return (hex($1), hex($2), hex($3), 255);
        $query = lc($1 . $2 . $3);
        return $color = $self->_index->{hex}->{$query};
    }
    elsif ($query =~ /^\#([\da-f])([\da-f])([\da-f])$/i) {
        $query = lc($1 . $1 . $2 . $2 . $3 . $3);
        return $color = $self->_index->{hex}->{$query};
    }

    return $color if $color = $self->_index->{title}->{$query};

    $query = lc $query;

    return $color if $color = $self->_index->{id}->{$query};

    $query =~ s/[^\w]//g;

    return $color if $color = $self->_index->{name}->{$query};

    return $color if $color = $self->_index->{value}->{$query};

    return;
}

=item $id = $dictionary->id

=item $name = $dictionary->name

Returns the id (name) of $dictionary, e.g.

    svg
    x11
    vaccc
    nbs-iscc-f

=cut

sub id {
    my $self = shift;
    return _parse_id(ref $self || $self);
}
*name = \&id;

=item $title = $dictionary->title

Returns the title of $dictionary, e.g.

    SVG
    X11
    VACCC
    NBS/ISCC F

=cut

sub title {
    my $self = shift;
    return $self->_description->{title};
}

=item $subtitle = $dictionary->subtitle

Returns the subtitle of $dictionary, if any

=cut

sub subtitle {
    my $self = shift;
    return $self->_description->{subtitle};
}

=item $description = $dictionary->description

Returns the description of $dictionary, if any

=cut

sub description {
    my $self = shift;
    return $self->_description->{description};
}


1;