Stateless IRC nick coloring

colorize.pl

use 5.010;
use strict;
use warnings;
use Digest;


# blatantly stolen from http://www.perlmonks.org/index.pl?node_id=139486
use POSIX qw/floor/;

sub hsv2rgb {
    my ( $h, $s, $v ) = @_;

    if ( $s == 0 ) {
        return $v, $v, $v;
    }

    $h /= 60;
    my $i = floor( $h );
    my $f = $h - $i;
    my $p = $v * ( 1 - $s );
    my $q = $v * ( 1 - $s * $f );
    my $t = $v * ( 1 - $s * ( 1 - $f ) );

    if ( $i == 0 ) {
        return $v, $t, $p;
    }
    elsif ( $i == 1 ) {
        return $q, $v, $t;
    }
    elsif ( $i == 2 ) {
        return $p, $v, $t;
    }
    elsif ( $i == 3 ) {
        return $p, $q, $v;
    }
    elsif ( $i == 4 ) {
        return $t, $p, $v;
    }
    else {
        return $v, $p, $q;
    }
}

sub nick_to_color {
    my $nick = lc $_[0];
    $nick    =~ s/_+$//;
    use Digest::MD5 qw/md5/;
    use Data::Dumper; $Data::Dumper::Useqq = 1;
    my ($h, $s, $v) = unpack 'SCC', md5($nick);
    # always use full saturation to avoid readability issues
    my ($r, $g, $b) = hsv2rgb($h * 360 / 2**16, 1, $v / 255 * 0.8);
    $_ = sprintf '%02x', int(255 * $_) for $r, $g, $b;
    return "#$r$g$b";
}

for (qw(timtoady timotimo jnthn pmichaud froggs sorear pmurias [Coke]
            cognominal donaldh lixmat nwc10 dalek glitchmr Ulti)) {
    my $col = nick_to_color($_);
    say qq[<p style="color: $col">$_</p>];
}