Travesty -- done properly

This program is a re-written CGI version of Travesty, which is featured in Programming Perl and was first published in Byte in 1984 or 1985 (a Pascal version). The Programming Perl version never seemed to work right... this version rules and produces hysterically garbled output in the style of the input, regardless of what language it's written in.

#!/usr/bin/perl

$debug = 0;
use CGI qw/:standard :netscape :html3/;
use CGI::Carp 'fatalsToBrowser';

$text = param('text');
$order = param('order');
$textlen = substr(length($text),0,64000);

srand(time||$$);
randomize;

$absmaxsent = 4;
$maxsent = int(rand()*$absmaxsent+2);

$text =~ s/[^A-z\.\,\;\-\n\'\ \?\"0-9\$\:]//g;
$text =~ s/\n/ /g;
while ($text =~ s/\s\s/ /g) {};

for ($i=0; $i<(length($text)-$order); $i++) {
   $key = substr($text, $i, $order);
   $key =~ s/ /}/g;
   push(@{$options{$key}},substr($text,$i+$order,1));
}


print header(-expires=>'now');
print "<BODY BGCOLOR=FFFFFF>";

if ($debug) {
   print "<hr>Key options defined:<p><table width=600>";


   foreach (sort keys %options) {
      @keyoptions = @{$options{$_}};
      $maxoption = $#keyoptions + 1;
      $newchar = @keyoptions[int(rand()*$maxoption)];
      print "<tr><td><b>$_</b>&nbsp;[$maxoption, $newchar]</td><td>@ke
+yoptions</td></tr>\n";
   }
   print "</table><p><hr>";
}

$window = substr($text,0,$order);
$output = $window;
$srcwindow = $window;

while(1) {
   $window =~ s/ /}/g;
   if (!exists($options{$window})) {
      $output .= ". $srcwindow";
      $window = $srcwindow;
      next;
   } else {
      @keyoptions = @{$options{$window}};
      $maxoption = $#keyoptions + 1;
      $newchar = @keyoptions[int(rand()*$maxoption)];
      $output .= $newchar;
   }
   $scount++ if (substr($output,length($output)-2) eq ". ");
   if ($scount>=$maxsent) {
      $output .= "<p>\n";
      $maxsent = int((rand()*$absmaxsent)+1);
      $scount = 0;
      last if (length($output)>$textlen);
   }

   $window = substr($window,1) . $newchar;
   last if $iterations++>32000;
}

$outlen = length($output);

print qq{
<table width=580><tr><td>
$output
<hr>
<i>$iterations iterations, $outlen output length, $textlen input lengt
+h. © 2000 David C. Troy, dave@toad.net</i>
</td></tr></table>
};
[download]

Comment on Travesty -- done properly Download Code

Replies are listed 'Best First'.
Re: Travesty -- done properly by extremely (Priest) on Jan 28, 2001 at 13:26 UTC
These three lines bug me: `$text =~ s/[^A-z\.\,\;\-\n\'\ \?\"0-9\$\:]//g; $text =~ s/\n/ /g; while ($text =~ s/\s\s/ /g) {};` [download] I would likely do those as: `$text =~ tr/A-z0-9.,;'?!":$\n\t\r -//dc; $text =~ s/\s+/ /g;` [download] I also added in "!" and "\t\r" since it seems unfair to rip tabs and Mac/PC returns out. The while thing is really evil and smells of removed code. =) Update: fixed where I had $test rather than $text. Lysdexics of the world, Untie! -- $you = new YOU; honk() if $you->love(perl)	[reply] [d/l] [select]
Re: Travesty -- done properly by flocto (Pilgrim) on Jan 28, 2001 at 20:42 UTC
Be nice to all browsers and use "`©`" to get the copy-right sign. Thanks :) -- GED/CC d-- s:- a--- C++(+++) UL+++ P++++$ L++>++++ E--- W+++@ N o? K? w-- O- M-(+) V? !PS !PE !Y PGP+(++) t-- 5 X+ R+(+++) tv+(++) b++@ DI+() D+ G++ e->+++ h!++ r+(++) y+	[reply] [d/l]