#!/usr/bin/perl

my $hex, $content_length;


#### Get parameters ####

# The query is included in the pathname, eg /foo/gif.pl/bl-ff00cc.gif
# where this script is /foo/gif.pl.

$ENV{REQUEST_URI} =~ m:.*/(..?)-([0-9a-f]{6})\.gif$:;
my ($type, $rgb) = ($1, $2);


#### Make GIF ####

if ($type eq 'bl') {

    # Bottom Left corner
    $hex = "47494638396117001700800000".$rgb
          ."ffffff21f90401000001002c00000000"
          ."170017000002348c8fa9cb6de06280b2"
          ."d1ba2e4e7a1fd079a0c78de4639e602a"
          ."aee7b48652cc56741dddb8a5cb59bf2b"
          ."0183a8a1eb67d47d92c002003b";

} elsif ($type eq 'br') {

    # Bottom Right corner
    $hex = "47494638396117001700f00000".$rgb
          ."00000021f90401000001002c00000000"
          ."170017000002358c8fa901ebdb9e6471"
          ."3a50adc2fae67e7020827d603986684a"
          ."8963e99e700ac7566d4b78eeeddabe7a"
          ."0067bd21cf883320974c6001003b";

} elsif ($type eq 'tr') {

    # Top Right corner
    $hex = "47494638396117001700800000".$rgb
          ."ffffff21f90401000001002c00000000"
          ."170017000002328c8fa908ed0fe38ad4"
          ."2d53e5c5b96d967d20258e50695ae8a1"
          ."ad9cea0667fc02747dbfb9eced7dfebb"
          ."0569c358d1b8c31400003b";

} elsif ($type eq 'tl') {

    # Top Left corner
    $hex = "47494638396117001700800000".$rgb
          ."ffffff21f90401000001002c00000000"
          ."170017000002308c8fa907ed0f218b14"
          ."ac50e5c5d96e937d48258e51693e68da"
          ."acacfbc2602bcf5e4dd79c0ef2bd7fd3"
          ."0571bea2315000003b";

} elsif ($type eq 'l') {

    # Left line end
    $hex = "47494638396113002500f00000".$rgb
          ."00000021f90401000001002c00000000"
          ."13002500000247848f09c1ea0c834331"
          ."ce55edcb3af1aa7c2025765809916863"
          ."ac9d9b9e700bb37573e3b93ce792cf73"
          ."0557b45a71362c1d6e4b6353f824aa50"
          ."21a987ba115d94976437cafa3e0b003b";

} elsif ($type eq 'r') {

    # Right line end
    $hex = "47494638396113002500f00000".$rgb
          ."00000021f90401000001002c00000000"
          ."130025000002498c81a90be6c1e27b51"
          ."cd59dba572f3e56160f821a4689e8ea5"
          ."ae690bbdb0dcd2aa7dc394bef2870f01"
          ."6a78c359b176bc25490922cec3423e2f"
          ."a31343598576b45b54859a691ec28b02"
          ."003b";

} elsif ($type eq 'rc') {

    # Right Corner (tabs)
    $hex = "47494638396106000600800000ffffff"
          .$rgb. "21f90401000000002c00000000"
          ."0600060000020a447ea0a81bbda091a0"
          ."00003b";

} elsif ($type eq 'lc') {

    # Left Corner (tabs)
    $hex = "47494638396106000600800000".$rgb
          ."ffffff21f90401000001002c00000000"
          ."06000600000209841d178b9bcea05c05"
          ."003b";

} elsif ($type eq 'ra') {

    # Right Arrow
    $hex = "4749463839610c000b00800000".$rgb
          ."ffffff21f904010a0001002c00000000"
          ."0c000b000002168c0fa70ab9dc509bd4"
          ."d01bb1de993f1b7d41283a4701003b";

} else {

    exit 0;

}

$content_length = length($hex)/2;

#### HTTP headers ####

# Generate expires header 1 day from now. Borrowed from CGI/Util.pm.
my(@MON)  = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time() + 24*3600);
$year += 1900;
$expires = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);

print "Expires: $expires\n";
print "Cache-Control: public\n";
print "Content-Type: image/gif\n";
print "Content-Length: $content_length\n";
print "Last-Modified: Mon, 28 Oct 2002 12:00:00 GMT\n";
print "\n";

#### Output GIF ####

print pack('H*', $hex);