File Coverage

blib/lib/Convert/Color/Library.pm

Criterion	Covered	Total	%
statement	23	24	95.8
branch	4	6	66.6
condition			n/a
subroutine	5	5	100.0
pod	1	1	100.0
total	33	36	91.6

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2009,2010 -- [e-mail]

package Convert::Color::Library;

use strict;
use warnings;
use base qw( Convert::Color::RGB8 );

__PACKAGE__->register_color_space( 'lib' );

use Carp;

our $VERSION = '0.03';

=head1 NAME

C - named lookup of colors from C

=head1 SYNOPSIS

Directly:

 use Convert::Color::Library;

 my $red = Convert::Color::Library->new( 'red' );

 # Only use the SVG dictionary
 my $brown = Convert::Color::Library->new( 'svg/brown' );

 # Use either HTML or SVG dictionary
 my $pink = Convert::Color::Library->new( 'html,svg/pink' );

Via L:

 use Convert::Color;

 my $cyan = Convert::Color->new( 'lib:cyan' );

 my $darkcyan = Convert::Color->new( 'lib:windows/darkcyan' );

=head1 DESCRIPTION

This subclass of L provides lookup of color names
using Robert Krimen's L module. It therefore provides
convenient access to named colours in many dictionaries, such as SVG, X11 and
HTML.

=cut

=head1 CONSTRUCTOR

=cut

=head2 $color = Convert::Color::Library->new( $name )

Returns a new object to represent the named color.

If the name is of the form

 dicts/name

Then C is parsed as a comma-separated list of dictionary names to pass
to C.

=cut

sub new
{
   my $class = shift;

   require Color::Library;

   if( @_ == 1 ) {
      my $name = $_[0];

      my $color;

      if( $name =~ m{^(.*)/(.*)$} ) {
         ( my $dicts, $name ) = ( $1, $2 );

         $color = Color::Library->color( [ split m/,/, $dicts ], $name );
      }
      else {
         $color = Color::Library->color( $name );
      }

      defined $color or croak "No such library color named '$name'";
      return $class->SUPER::new( $color->rgb );
   }
   else {
      croak "usage: Convert::Color::Library->new( NAME )";
   }
}

# Keep perl happy; keep Britain tidy
1;

__END__