view release on metacpan or  search on metacpan

lib/Color/Library/Dictionary.pm  view on Meta::CPAN

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