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.

[virtualsue]

To think this all started when CheeseLord said he had the ambition of being mentioned on every home node and someone else pointed out that as he was only mentioned on 10 of them, he really had his work cut out for him. :)
ar0n suggested a webring, and ~10 seconds later, OeufMayo had one ready.*

(Oops: My memory is failing. It was CheeseLord himself who pointed out that he had his work cut out for himself, and it was only 4 nodes then. )

The code above is up on my site, so anyone can join the Cheesy Webring. You can see who is a citizen of the Free Cheese Nation via the member list. Show your support and add yourself to the ring while you're there. The program provides sample code that you can use in your home node.**

I've added a delete option, so if you develop an allergy to Wensleydale /msg me and I'll give you the URL.

---

*Some may find it ironic that CheeseLord is not directly mentioned in the Cheesy Webring.

**If your level is not high enough, the Cheesy Webring image won't appear, but don't worry, you're still in the club. The image will show up once you reach level 5.

[crazyinsomniac]

You check to see which top level domain it is, but you forget the server. Here, you go fix: my $perlmonks = 'http://'.(($referer =~ m|www\.p|i)?'www.':'')."perlmonks.$tld";

 
___crazyinsomniac_______________________________________
Disclaimer: Don't blame. It came from inside the void
perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

[blakem]

Here is how I did it in Random NonHome Nodes.

my ($www,$tld) = $referer =~ /(www\.)?perlmonks\.(\w+)/i;
[snip]
my $redirurl = "http://${www}perlmonks.$tld/index.pl?node_id=$node";

-Blake