Color::Rgb - Simple rgb.txt parsing class

    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

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 ( <RGB> ) {
        /^(\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 ################################
###########################################################################