http://qs321.pair.com?node_id=112595
Category: Fun Stuff
Author/Contact Info Joe Ryan, ryan.306@osu.edu
Description:

There are a lot of monks that play Starcraft (including me), but often times we have difficulty finding people to play with. So, to organize us, I decided to write up a quick ladder. For those of you who don't know what a ladder is (or don't know what a real ladder is, unlike that pathetic bnet one), it is basically a league where one can only advance by playing higher ranked players.

In the gaming community, everyone wants a ladder. However, once a ladder is up, the ladder admin(the guy who wrote it) becomes preoccupied with other things. Without someone to maintain the ladder, it soon dies. Therefore, I wrote a ladder would be easy to setup and maintain by the non-programmer. It is EXTREMELY easy to install; it uses 2 flat text databases (for easy cross-platform support), and was designed to be inserted into pre-existing designs via ssi so the ladder maintainer doesnt have to drudge through a buncha code. All the maintainer has to do is upload the scripts and set permissions, and its ready to go.

I would really like to host this somewhere, if anyone knows somewhere I could do it, it would be really great. It wouldn't eat up much bandwidth or disk space, and I think that it would be one more thing that would enrich our community even more :)

Update
Thanks to jcwren's coolness, perlmonk.org is now hosting MonkLadder. Sign up!
5 files:
signup.pl
#!perl -wT
use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);
my $q = new CGI;
print $q->header;
my $username = $q->param("username");
my $password = $q->param("password");

if ($username)
{
    open (DATA, "data.txt");
    my @data = <DATA>;
    close (DATA);
    open (OUT, ">>data.txt");
    print OUT scalar(@data)+1, "*$username*$password\n";
    close (OUT);

    print "<p>Thank you for signing up!<br>";
    print "Your username is $username, your password is $password.";
    print "</p>";

}
else
{
    print "<form method=\"post\" action=\"/cgi-bin/signup.pl\">\n";
    print "Username:<input type=\"text\" name=\"username\"><br>\n";
    print "Password:<input type=\"password\" name=\"password\"><br>\n"
+;
    print "<input type=\"submit\">";
    print "</form>";
}
print << "END_OF_MENU";
<br>
<table border="0">
<tr>
<td><a href="/cgi-bin/signup.pl">Sign Up</a></td>
<td><a href="/cgi-bin/standings.pl">Standings</a></td>
<td><a href="/cgi-bin/loss.pl">Report Loss</a></td>
</tr>
</table>
END_OF_MENU

loss.pl
#!perl -wT
use strict;

# report a loss, and recalculate rankings.

use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $q = new CGI;
print $q->header;
my $winner = $q->param("winner");
my $description = $q->param("description");
my $username = $q->param("username");
my $password = $q->param("password");

if ($username)
{
    open (DATA, "data.txt");
    my @data = <DATA>;
    close (DATA);

    my (@rank, @player, @player_password, $the_winner, $the_loser, $wi
+nner_rank, $loser_rank);

    for (my $i=0; $i<@data; $i++)
    {
        my @entry = split /\*/, $data[$i];
        $rank[@rank] = $entry[0];
        $player[@player] = $entry[1];
        chomp($entry[2]);
        $player_password[@player_password] = $entry[2];

        if ($winner eq $entry[1])
        {
            $the_winner=$i;
            $winner_rank=$entry[0];
        }
        if ($username eq $entry[1])
        {
            $the_loser=$i;
            $loser_rank=$entry[0];
        }
    }

    $rank[$the_winner] += (int(($loser_rank - $winner_rank)/2)-1) if (
+$winner_rank>$loser_rank);
    $loser_rank = $rank[$the_winner];
    if ($username eq $player[$the_loser] && $password eq $player_passw
+ord[$the_loser])
    {
        for (my $i=0; $i<@player; $i++)
        {
            $rank[$i]++ if ($rank[$i] >= $loser_rank && $rank[$i] < $w
+inner_rank && $i != $the_winner);
        }

        my @indices = (0 .. $#rank);
        my @sorted_indices = sort {$rank[$a] <=> $rank[$b]} @indices;
        @rank = @rank[@sorted_indices];
        @player= @player[@sorted_indices];
        @player_password = @player_password[@sorted_indices];

        open (OUT, ">data.txt");
        for (my $i=0; $i < @rank; $i++)
        {
            print OUT "$rank[$i]*$player[$i]*$player_password[$i]\n";
        }
        close (OUT);

        my $thetime = localtime;
        my @entry = split(' ', $thetime);
        $thetime = "$entry[1]/$entry[2]/$entry[4]";

        open (OUT, ">>matches.txt");
        print OUT "$winner*$username*$description*$thetime\n";
        close (OUT);

        print "Thank you.  You submitted:<br>\n";
        print "Winner: $winner<br>\n";
        print "Loser: $username<br>\n";
        print "Description: $description<br>\n";
        print "Time: $thetime\n";
    }
    else
    {
        print "I hope you die, cheating scum.";
    }
}
else
{
    print << "END_OF_FORM";
    <form method="post" action="/cgi-bin/loss.pl">
        Username: <input type="text" name="username"><br>
        Password: <input type="password" name="password"><br>
        Winner: <input type="text" name="winner"><br>
        Description: <input type="text" name="description"><br>
        <input type="submit">
    </form>
END_OF_FORM
}
print << "END_OF_MENU";
<br>
<table border="0">
<tr>
<td><a href="/cgi-bin/signup.pl">Sign Up</a></td>
<td><a href="/cgi-bin/standings.pl">Standings</a></td>
<td><a href="/cgi-bin/loss.pl">Report Loss</a></td>
</tr>
</table>
END_OF_MENU

standings.pl
#!perl -wT
use strict;

use CGI::Carp qw(fatalsToBrowser);

print "Content-type: text/html\n\n";
open (DATA, "data.txt");
my @data = <DATA>;
close (DATA);

my (@rank, @player, @player_password);

for (my $i=0; $i<@data; $i++)
{
    my @entry = split /\*/, $data[$i];
    $rank[@rank] = $entry[0];
    $player[@player] = $entry[1];
    chomp($entry[2]);
    $player_password[@player_password] = $entry[2];
}

open (MATCHES, "matches.txt");
my @matches = <MATCHES>;
close (MATCHES);

my %wins;
my %losses;

foreach my $player (@player)
{
    $wins{$player} = 0;
    $losses{$player} = 0;
    foreach my $match (@matches)
    {
        my @entry = split /\*/, $match;
        if ($player eq $entry[0])
        {
            $wins{$player}++;
        }
        if ($player eq $entry[1])
        {
            $losses{$player}++;
        }
    }
    
}

print "<table border=\"1\">\n";
print "<tr><td>Rank</td><td>Player</td><td>Wins</td><td>Losses</td><td
+>Win Percentage</td></tr>\n";
for (my $i=0; $i < @rank; $i++)
{
    my $win_percentage = substr(($wins{$player[$i]}/($wins{$player[$i]
+}+$losses{$player[$i]})),0,6) unless (($wins{$player[$i]}+$losses{$pl
+ayer[$i]}) < 1);
    $win_percentage = 0 if (($wins{$player[$i]}+$losses{$player[$i]}) 
+< 1);
    print "<tr><td>$rank[$i]</td><td><a href=\"/cgi-bin/users.pl?user=
+$player[$i]\">$player[$i]</a></td><td>$wins{$player[$i]}</td><td>$los
+ses{$player[$i]}</td><td>$win_percentage</td></tr>\n";
}
print "</table>\n";
print << "END_OF_MENU";
<br>
<table border="0">
<tr>
<td><a href="/cgi-bin/signup.pl">Sign Up</a></td>
<td><a href="/cgi-bin/standings.pl">Standings</a></td>
<td><a href="/cgi-bin/loss.pl">Report Loss</a></td>
</tr>
</table>
END_OF_MENU

admin.pl
#!perl -wT
use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $q = new CGI;
print $q->header;
my $username = $q->param("username");
my $password = $q->param("password");
my $delete   = $q->param("delete");
my $deluser  = $q->param("deluser");
if ($username)
{    

    if ($username eq "admin" && $password eq "monksofperl")
    {

        if ($delete)
        {
            open (MATCHES, "matches.txt");
            my @matches = <MATCHES>;
            close (MATCHES);
            open (OUT, ">matches.txt");
            for (my $i=0; $i<@matches; $i++)
            {
                print OUT "$matches[$i]" if ($i != $delete);
            }
            close (OUT);
        }
        if ($deluser)
        {
            open (DATA, "data.txt");
            my @data = <DATA>;
            close (DATA);
            open (OUT, ">data.txt");
            for (my $i=0; $i<@data; $i++)
            {
                print OUT "$data[$i]" if ($i != $deluser);
            }
            close (OUT);
        }
        open (MATCHES, "matches.txt");
        my @matches = <MATCHES>;
        close (MATCHES);
        open (DATA, "data.txt");
        my @data = <DATA>;
        close (DATA);

        print "<h1>Matches</h1>\n";
        print "<table border=\"1\">";
        print "<tr><td>&nbsp;</td><td>Winner</td><td>Loser</td><td>Des
+cription</td><td>Date</td></tr>\n";
        for (my $i=0; $i<@matches; $i++)
        {
            my @entry = split /\*/, $matches[$i];
            print "<tr><td><a href=\"/cgi-bin/admin.pl?delete=$i&usern
+ame=$username&password=$password\">Reap</a></td><td>$entry[0]</td><td
+>$entry[1]</td><td>$entry[2]</td><td>$entry[3]</td></tr>\n";
        }
        print "</table>\n";
        print "<p><b>Report a loss</b><br>\n";
        print "<form method=\"post\" action=\"/cgi-bin/loss.pl\">\n";
        print "<table border=\"0\">\n";
        print "<tr><td>Winner:</td><td><input type=\"text\" name=\"win
+ner\"></td></tr>\n";
        print "<tr><td>Loser:</td><td><input type=\"text\" name=\"user
+name\"></td></tr>\n";
        print "<tr><td>Description:</td><td><input type=\"text\" name=
+\"description\"></td></tr>\n";
        print "<tr><td>Loser's pw:</td><td><input type=\"text\" name=\
+"password\"></td></tr>\n";        
        print "</table>\n";
        print "<input type=\"submit\">";
        print "</form>";
        print "<h1>Users</h1>\n";
        print "<table border=\"1\">";
        print "<tr><td>&nbsp;</td><td>Rank</td><td>Username</td><td>Pa
+ssword</td></tr>\n";
        for (my $i=0; $i<@data; $i++)
        {
            my @entry = split /\*/, $data[$i];
            print "<tr><td><a href=\"/cgi-bin/admin.pl?deluser=$i&user
+name=$username&password=$password\">Reap</a></td><td>$entry[0]</td><t
+d>$entry[1]</td><td>$entry[2]</td></tr>\n";
        }
        print "</table>\n";
    }
    else
    {
        print "<h1><font color=\"red\">UNAUTHORIZED</font></h1>";
    }
}
else
{
    print "<form method=\"post\" action=\"/cgi-bin/admin.pl\">\n";
    print "Username:<input type=\"text\" name=\"username\"><br>\n";
    print "Password:<input type=\"password\" name=\"password\"><br>\n"
+;
    print "<input type=\"submit\">";
    print "</form>";
}
print << "END_OF_MENU";
<br>
<table border="0">
<tr>
<td><a href="/cgi-bin/signup.pl">Sign Up</a></td>
<td><a href="/cgi-bin/standings.pl">Standings</a></td>
<td><a href="/cgi-bin/loss.pl">Report Loss</a></td>
</tr>
</table>
END_OF_MENU

users.pl
#!perl -wT
use strict;

use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $q = new CGI;
print $q->header;
my $user = $q->param("user");

open (MATCHES, "matches.txt");
my @matches = <MATCHES>;
close (MATCHES);

open (DATA, "data.txt");
my @data = <DATA>;
close (DATA);

my %rankings;
foreach my $line (@data)
{
    my @entry = split /\*/, $line;
    $rankings{$entry[1]} = $entry[0];
}
my ($x, $wins, $losses, @winners, @losers, @descriptions, @dates);
$wins = $losses = 0;
if (exists($rankings{$user}))
{
    foreach my $match (@matches)
    {
        my @entry = split /\*/, $match;
        $wins++ if ($entry[0] eq $user);
        $losses++ if ($entry[1] eq $user);
        if ($entry[0] eq $user || $entry[1] eq $user && $x<10)
        {
            $winners[@winners] = $entry[0];
            $losers[@losers] = $entry[1];
            $descriptions[@descriptions] = $entry[2];
            $dates[@dates] = $entry[3];
            $x++;
        }
    }
}

print "<center><h1>$user</h1>\n";
print "<p><b>Wins:</b> $wins &nbsp;&nbsp; <b>Losses:</b> $losses</p><p
+>Last 10 Matches<br>";
print "<table border=\"1\">";
print "<tr><td>Date</td><td>Winner</td><td>Loser</td><td>Description</
+td></tr>";
for (my $i=0; $i<@winners; $i++)
{
    print "<tr><td>$dates[$i]</td><td>$winners[$i]</td><td>$losers[$i]
+</td><td>$descriptions[$i]</td></tr>\n";
}
print "</table>\n";
print << "END_OF_MENU";
<br>
<table border="0">
<tr>
<td><a href="/cgi-bin/signup.pl">Sign Up</a></td>
<td><a href="/cgi-bin/standings.pl">Standings</a></td>
<td><a href="/cgi-bin/loss.pl">Report Loss</a></td>
</tr>
</table>
END_OF_MENU
Replies are listed 'Best First'.
Re: Monk Ladder
by grinder (Bishop) on Sep 15, 2001 at 17:13 UTC

    This code looks pretty good, at least at a first glance. You use heredocs in some places, but not in others. It would be good to use them everywhere.

    The biggest thing that jumps out is that you are not testing whether open succeeds or fails. Also, the data files appear to be in the same directory as the CGI script. This is definitely not a clever idea. Put them under your home directory, or something, but get them out from under the web document tree.

    Finally, if you want to try this out on a webserver, if you ask jcwren nicely he'll give you an account on perlmonk.org.

    --
    g r i n d e r
[reply]
Re: Monk Ladder
by George_Sherston (Vicar) on Sep 15, 2001 at 17:22 UTC
    Smart! Your clear statement of design aims (and the K.I.S.S. attitude to implementing them) are something to copy.

    HTML::Template is a bit of an obsession with me at present, because I just learnt to use it and it's saved me a lot of hassle. Maybe I over-rate it, but if you haven't looked at it, I'd recommend it as an easily learnt way to mass-produce chunks like 
    print << "END_OF_MENU";
<br>
<table border="0">
<tr>
<td><a href="/cgi-bin/signup.pl">Sign Up</a></td>
<td><a href="/cgi-bin/standings.pl">Standings</a></td>
<td><a href="/cgi-bin/loss.pl">Report Loss</a></td>
</tr>
</table>
END_OF_MENU

    [download]
    Wd also let you make centralised edits of, e.g. file path.

    § George Sherston
[reply]
[d/l]

Back to Code Catacombs