Cheesy Webring

[OeufMayo]

Category:

Cheesy Web Stuff

Description:

Don't blame me, ar0n had the idea first.

But nonetheless, it's a fully functional webring.
You too can make your own and impress your friends, by showing them how many people share you love of Cheesy things.

Big thanks to virtualsue for hosting the Cheese Ring! (see node below)

update: Eradicated a couple of bugs that prevented the code to compile. oops.

update - Thu Aug 23 07:47:26 2001 GMT: The truncate filehandle was not right, but virtualsue spotted it!

update - Sun Aug 26 13:32:41 2001 GMT: Fixed the check for http://perlmonks.org, thanks crazyinsomniac!

Sat Sep 22 21:35:45 UTC 2001: Fixed the encoding of characters other than 0-9a-zA-Z.

#!/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

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