#!/usr/local/bin/perl -Tw
use strict;
use CGI qw(:standard);

my $cheese_pic = 'http://www.pilpre.com/briac/cheesering2.gif';
my $url        = url();

my $start     = param('start') || 'CheeseLord';
my $go        = param('go') || 'next';
my $referer   = referer() || 'http://www.perlmonks.org';
my $tld       = $referer =~ m[perlmonks\.([^/]+)/] ? $1 : 'org';
my $perlmonks = 'http://'.(($referer =~ m|www\.p|i)?'www.':'')."perlmo
+nks.$tld";
my $list      = 'cheese.list';

sysopen( LIST, $list, 0 ) or die "Cannot open '$list': $!\n";

# do we need flocking here?
chomp( my @ring = <LIST> );
close LIST;

my ( $start_index, $loc );
foreach ( 0 .. $#ring ) {
    if ( $ring[$_] eq $start ) { $start_index = $_; last }
}

my %dispatch = (
    'first'    => sub { $ring[0] },
    'last'     => sub { $ring[-1] },
    'next'     => sub { cycle(1) },
    'previous' => sub { cycle(-1) },
    'next5'    => sub { cycle(5) },
    'prev5'    => sub { cycle(-5) },
    'random'   => sub { $ring[ rand @ring ] },
    'list'     => sub { list() },
    'add'      => sub { add($start) },
);

$go  = 'next' unless exists $dispatch{$go};
$loc = &{ $dispatch{$go} } || $ring[0];
$loc =~ s/([\W_])/sprintf('%%%02X', $1)/eg; # [\W_] suggested by Chees
+eLord
print redirect( $perlmonks . '/index.pl?node=' . $loc );

exit(0);

#
sub list {
    my @urls =
      map {
    my $name = $_; 
        s/([\W_])/sprintf('%%%02X', $1)/eg; # [\W_] suggested by Chees
+eLord (again!)
    a( { -href => $perlmonks . '/index.pl?
    node=' . $_ }, $name )
      } @ring;

    print header(), start_html('Cheesy Ring Members'),
      h1('Cheesy Ring Members'), p( img( { -src => $cheese_pic } ) ), 
+hr(),
      ul( li( { -type => 'disc' }, \@urls ) ), end_html();
    exit(0);
}

#
sub cycle {
    my $count = shift;
    return ( $ring[ $start_index + $count ] ? $ring[ $start_index + $c
+ount ] :
      $ring[ $start_index + $count - @ring ] );
}

#
sub add {
    my $name = shift;
    my $found;

    open( LIST, "$list" ) or die "Cannot open '$list': $!\n";
    flock( LIST, 1 );
    while (<LIST>) {
        $found++ if m/^$name$/i
    }
    close(LIST);

    unless ($found){
        push ( @ring, $name );
        open( LIST, "+< $list" ) or die "Cannot open '$list': $!\n";
        flock( LIST, 2 );
        seek( LIST, 0, 0 );
        truncate( LIST, 0 );
        print LIST join ( "\n", @ring );
       close(LIST);
    }

    my $inc = div(
        { -align => 'center' },
        img({-src=> $cheese_pic}),
        h2( $found ?  "You're already a Cheese Member!" : 'Welcome to 
+the Cheesy webring!' ),
    p(small(tt(
        join(' - ', map {
        ' &#91; ' . a({-href=> "$url?start=$name&go=$_"}, $_) . ' &#93
+;'}
        ( 'previous', 'next', 'random', 'list', 'next5', 'prev5',
        'first',      'last' )
      ) ) ) ), p( small(
"don't blame me for [Cheesy WebRing|this idea], it's [ar0n]'s fault!"
          ) ) );

    $inc =~ s/&/&amp;/g;
    $inc =~ s/</&lt;/g;
    $inc =~ s/>/&gt;/g;
    print header(), start_html('Cheesy Ring Members'),
      h1('Cheesy Ring Members'),
      p('Add the following code somewhere in your homenode:'), tt($inc
+), hr(),
      end_html;
    exit;
}

__DATA__
ar0n
CheeseLord
OeufMayo
blakem
thatguy
virtualsue
tinman
htoug
rob_au
[download]

As always, since I modified bits of the code while editing the node, it's perfectly normal if everything breaks.