Automated word messer

The code for this web toy:

#!/usr/bin/perl -w

use strict;
use CGI qw(:param);

# Mark words

print "Content-type:text/html\n\n";

print "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html lang=\"en\">\n<head>\n<title>Automated Word Messer</title>\n<style>\n\@import url(/stylesheet.css);\n</style>\n</head>\n<body>\n";

print "<h1>Automated Word Messer</h1>\n";

my $text = param("text");

if ($text) {
    print "<h2>Results</h2>\n";
    print "<table width=\"100%\">\n";
    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt\;/g;
    $text =~ s/>/&gt\;/g;
    print "<tr>\n<td width=\"50%\">\n<h3>Original</h3>\n<p>$text</p>\n</td>\n";

    my $d="<>";
    $text =~ s/(\w)(\W)/$1$d$2/g;
    $text =~ s/(\W)(\w)/$1$d$2/g;
    my @textlist = (split /$d/, $text);

    my $shuffledtext = "";
    foreach my $word (@textlist) {
        if ($word =~ /\w/) {
            my @wordlist = (split //, $word);
            if (scalar @wordlist > 3) {
                my $first = shift @wordlist;
                my $last = pop @wordlist;
                my @shuffled = sort {rand cmp rand} @wordlist;
                $word = $first.(join "", @shuffled).$last;
            }
        }
        $shuffledtext .= $word;
    }

    print "<td width=\"50%\"><h3>Shuffled</h3>\n<p>$shuffledtext</p></td></tr>\n";
    print "</table>\n";
    print "<hr />\n";
}

print "<form><p><textarea name=\"text\" rows=\"5\" cols=\"60\">Enter some text here</textarea></p><p><input type=\"submit\" value=\"Mess it up\" /></p></form>";

print "<p>by <strong><a href=\"/\">fridgemagnet</a></strong> 2003/09/16</p>\n";
print "<ul>\n<li><a href=\"http://www.fridgemagnet.org.uk/2003/09/16/jumbling-letters-automated/\">blog entry about this</a> where you can leave comments</li>\n";
print '<li><a href="/code/wordmess.php">See the full code for this page</a></li></ul>';
print "</body>\n</html>\n";

Site links

Blogging

Utility

Site things

latest del.icio.us

&; NATIONAL DEBT TO REACH CHRIST ON A BIKE - The Daily Mash

&; Monbiot.com » The Paranoia Squad

&; fuck the pope

&; BBC NEWS | Politics | Row over state loan charge 'plan'

&; Stanley Kubrick’s Notebooks - a set on Flickr

&; Bailiffs get power to use force on debtors - Times Online

» more...