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;