File Coverage

blib/lib/Color/Rgb.pm

Criterion	Covered	Total	%
statement	62	70	88.5
branch	18	28	64.2
condition	1	3	33.3
subroutine	12	12	100.0
pod	0	8	0.0
total	93	121	76.8

package Color::Rgb;

# $Id: Rgb.pm,v 1.4 2002/10/23 20:30:46 sherzodr Exp $

require 5.003;
use strict;
use Carp 'croak';
use Fcntl qw(:DEFAULT :flock);
use vars qw($RGB_TXT $VERSION);

###########################################################################
################ Color::Rgb - simple rgb.txt parser #######################
###########################################################################
#                                                                         #
#   Copyright (c) 2002 Sherzod Ruzmetov. All rights reserved              #
#   You can modify and redistribute the following library under the same   #
#   terms as Perl itself.                                                 #
#                                                                         #
#   The library is written with usefulness in mind, but  neither explicit #
#   nor implied guarantee to a particular purpose made.                   #
###########################################################################

$RGB_TXT = '/usr/X11R6/lib/X11/rgb.txt';

($VERSION) = '$Revision: 1.4 $' =~ m/Revision:\s*(\S+)/;





# new(): constructor
# Usage: CLASS->new(rgb_txt=>'/path/to/rgb.txt')
# RETURN VALUE: Color::Rgb object
sub new {
    my $class = shift;
    $class = ref($class) || $class;

    my $self = {
        rgb_txt => $RGB_TXT,
        _rgb_map=> {},
        @_,
    };

    unless (sysopen (RGB, $self->{rgb_txt}, O_RDONLY) ) {
        croak "$self->{rgb_txt}: $!";
    }

    unless ( flock(RGB, LOCK_SH) ) {
        croak "Couldn't acquire LOCK_SH on $self->{rgb_txt}: $!";
    }

    while (  ) {
        /^(\n|!|\#)/  and next;     # empty lines and comments
        chomp();
        my ($r, $g, $b, $name) = $_ =~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s+(.+)$/;
        $self->{_rgb_map}->{ lc($name) } = [$r, $g, $b];
    }

    close (RGB) or croak "$self->{rgb_txt}: $!";

    return bless $self => $class;
}









# rgb(): reruns RGB value for an name
# Usage: CLASS->rgb('red' [, ','])
# RETURN VALUE either list or string
sub rgb {
    my ($self, $name, $delim) = @_;

    unless ( $name ) {
        croak "Color::Rgb->rgb(): usage: rgb(\$name [,\$delim]";
    }

    my $rgb = $self->{_rgb_map}->{lc($name) };

    unless ( defined $rgb ) {
        croak "$name doesn't exist";
    }

    my @rgb = @{ $rgb };

    defined $delim and return join ($delim, @rgb);

    return @rgb;
}


sub name2rgb {
    my $self = shift;

    $self->rgb(@_);
}


# hex(): returns a hex value for an name
# Usage: CLASS->hex('red' [,'#'])
# RETURN VALUE: hex string
sub hex {
    my ($self, $name, $pound) = @_;

    unless ( $name ) {
        croak "Color::Rgb->hex(): usage: hex(\$name [,\$prefix]";
    }

    # Using rgb() method to get the RGB list
    my ($r, $g, $b) = $self->rgb(lc($name)) or return;

    return sprintf("$pound%02lx%02lx%02lx", $r, $g, $b);
}


sub name2hex {
    my $self= shift;

    $self->hex(@_);
}


# hex2rgb(): takes a hex string, and returns an rgb list or string
# depending if $delim was given or not
# Usage: CLASS->hex2rgb('#000000' [,',']);
# RETURN VALUE: list or string
sub hex2rgb {
    my ($self, $hex, $delim) = @_;

    unless ( $hex ) {
        croak "Color::Rgb->hex2rgb(): Usage: hex2rgb(\$hex [,\$delim]";
    }


    $hex =~ s/^(\#|Ox)//;

    $_ = $hex;
    my ($r, $g, $b) = m/(\w{2})(\w{2})(\w{2})/;

    my @rgb = ();
    $rgb[0] = CORE::hex($r);
    $rgb[1] = CORE::hex($g);
    $rgb[2] = CORE::hex($b);

    defined $delim and return join ($delim, @rgb);

    return @rgb;
}



# rgb2hex(): opposite of hex2rgb().
# Usage: CLASS->rgb2hex($r, $g, $b [,'#'])
# RETURN VALUE: hex string
sub rgb2hex {
    my ($self, $r, $g, $b, $pound) = @_;

    unless ( defined $b ) {
        croak "Color::Rgb->rgb2hex(): Usage: rgb2hex(\$red, \$green, \$blue [,\$prefix]";
    }

    return sprintf("$pound%02lx%02lx%02lx", $r, $g, $b);
}



# names(): returns a list of names
# Usage: CLASS->names(['gray'])
# RETURN VALUE: list
sub names {
    my ($self, $pat) = @_;

    my @names = ();

    while ( my ($name, $rgb) = each %{$self->{_rgb_map}} ) {
        if ( defined $pat ) {
            $name =~ m/$pat/ and push (@names, $name);
            next;
        }
        push @names, $name;
    }

    return @names;
}


1;

###########################################################################
################ Color::Rgb manual follows ################################
###########################################################################

=pod

=head1 NAME

Color::Rgb - Simple rgb.txt parsing class

=head1 REVISION

$Revision: 1.4 $

=head1 SYNOPSIS

    use Color::Rgb;
    $rgb = new Color::Rgb(rgb_txt=>'/usr/X11R6/lib/X11/rgb.txt');

    @rgb = $rgb->rgb('red');            # returns 255, 0, 0
    $red = $rgb->rgb('red', ',');       # returns the above rgb list as
                                        # comma separated string
    $red_hex=$rgb->hex('red');          # returns 'FF0000'
    $red_hex=$rgb->hex('red', '#');     # returns '#FF0000'

    $my_hex = $rgb->rgb2hex(255,0,0);   # returns 'FF0000'
    $my_rgb = $rgb->hex2rgb('#FF0000'); # returns list of 255,0,0

=head1 DESCRIPTION

Color::Rgb - simple rgb.txt parsing class.

=head1 METHODS

=over 4

=item *

C$rgb_file])> - constructor. Returns a Color::Rgb object.
Optionally accepts a path to the rgb.txt file. If you omit the file, it
will use the path in the $Color::Rgb::RGB_TXT variable, which defaults to
C<'/usr/X11R6/lib/X11/rgb.txt'>. It means, instead of using rgb_txt=>''
option, you could also set the value of the $Color::Rgb::RGB_TXT variable
to the correct path before you call the L constructor (but definitely
after you load the Color::Rgb class with C or C).

Note: If your system does not provide with any rgb.txt file, Color::Rgb
distribution includes one you can use instead.

=item *

C - returns list of numeric Red, Green and Blue
values for a $name delimited (optionally) by a $delimiter . $name is
name of the color in the English language (Ex., 'black', 'red', 'purple' etc.).

Examples:

    my ($r, $g, $b) = $rgb->rgb('blue');      # returns list: 00, 00, 255
    my $string      = $rgb->rgb('blue', ','); # returns string: '00,00,255'

If name does not exist in the rgb.txt file it will return undef.

=item *

C - similar to L method, but returns
hexadecimal string representing red, green and blue colors, prefixed
(optionally) with $prefix. If $name does not exist in the rgb.txt file
it will return undef.

=item *

C - alias to C

=item *

C - alias to C

=item *

C - converts rgb value to hexadecimal string.
This method has nothing to do with the rgb.txt file, so none of the arguments
need to exist in the file.

Examples:

    @rgb = (128, 128, 128);               # RGB representation of grey
    $hex_grey = $rgb->rgb2hex(@rgb);      # returns string 'C0C0C0'
    $hex_grey = $rgb->rgb2hex(@rgb, '#'); # returns string '#C0C0C0'

=item *

C - the opposite of L: takes a
hexadecimal representation of a color and returns a numeric list of Red,
Green and Blue. If optional $delim delimiter is present, it returns the
string of RGB colors delimited by the $delimiter. Characters like '#' and
'0x' in the beginning of the hexadecimal value will be ignored. Examples:

    $hex = '#00FF00';   # represents blue

    @rgb = $rgb->hex2rgb($hex);            #returns list of 0, 255, 0
    $rgb_string = $rgb->hex2rgb($hex,','); #returns string '0,255,0'

Note: L expects valid hexadecimal representation of a color in
6 character long string. If not, it might not work properly.

=item *

C - returns a list of all the names in the rgb.txt file.
If $pattern is given as the first argument, it will return only the names
matching the pattern. Example:

    @colors = $rgb->names;         # returns all the names

    @gray_colors = $rgb->names('gray'); # returns list of all the names
                                        # matching the word 'gray'
=back

=head1 CREDITS

Following people contributed to this library with their patches and/or
bug reports. (list is in chronological order)

=over 4

=item *

Marc-Olivier BERNARD  notified of the warnings that the library
produced while "warnings" pragma enabled and improper parsed rgb values
that contain single "0". This bug was fixed in 1.2

=item *

Martin Herrmann  noticed a bug in rgb2hex() method which was
failing if the blue value was a single "0". This problem is fixed in 1.3

=back

=head1 COPYRIGHT

Color::Rgb is a free software and can be modified and distributed under the same terms
as Perl itself.

=head1 AUTHOR

Color::Rgb is maintained by Sherzod B. Ruzmetov .

=head1 SEE ALSO

L

=cut