Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Cheesy Webring

by OeufMayo (Curate)
on Aug 20, 2001 at 20:26 UTC ( #106258=sourcecode: print w/ replies, xml ) Need Help??

Category: Cheesy Web Stuff
Author/Contact Info Briac 'Cheesy' Pilpré - briac (at cheese) pilpre (dot cheese) com
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.

Comment on Cheesy Webring
Download Code
Re: Cheesy Webring
by virtualsue (Vicar) on Aug 23, 2001 at 12:47 UTC

    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) Re: Cheesy Webring
by crazyinsomniac (Prior) on Aug 26, 2001 at 17:27 UTC
    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;"

      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

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://106258]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (3)
As of 2014-09-18 05:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (108 votes), past polls