#!/usr/bin/perl # Rob's Amazing Poem Generator # v0.000000001 # Last modified 5/1/98 rm # *** THIS CODE HAS NO WARRANTY OF ANY SORTS. # *** IF IT BREAKS, YOU GET TO KEEP BOTH PIECES! # Return a big string with the contents of a URL, or a 0. # PROBLEM:Locks the script pretty regularly. Needs to be # Fixed! sub geturl { return 0; # busted use LWP::UserAgent; use HTTP::Request; use URI::Escape; my $ua = new LWP::UserAgent; my $request = new HTTP::Request('GET', $_[0]); my $result = $ua->request($request); if ($result->is_success) { return $result->content; } else { return 0; } } # Prints a file sub dumpfile { my($fname)=@_; open HEADER, $fname; while(
) { print $_; } close HEADER; } use CGI; my $query=new CGI; my @names = $query->param; my $FORM; foreach (@names) { $$FORM{$_}=$query->param($_) }; print "Content-type: text/html \n\n\n Rob's Amazing Poem Generator "; dumpfile("./cthead.inc"); print "

Sorry, we're shutdown now. Hugs and Kisses.

"; dumpfile("./ctfoot.inc"); return; $_=geturl($$FORM{url}) || "Tempararily/Permaently Unavailable"; unless($$FORM{url}) { while($x++ < 20) { $s=$s." ".`/usr/games/fortune `."\n"; } $_=$s; } # These should really be condensed intelligently: # They just strip out stuff that doesn't work nicely. # Yank hypenated and apostrophed words s/(\w*)['-](\w*)//g; # Nuke Whitespace tr/\n\"\(\)\t/ /; # double dashes occur a lot in s|--| |g; s/ +/ /g; # Yank All HTML s|\<.*?\>||gs; s| +| |gs; s|&(\w*?);||gi; /\b(\w*)\b/; # The first word is the one I'm gonna seed the poem with $seed=$1; # Generate a Poem $output="$seed "; while($sentances < 5 and length($seed) > 0) { if(not defined $library{$seed}) { while(/\b$seed\b([^\w]*)\b([\w]*)\b([^\w]*)\b/ig) { if(length $2 > 0) { push @{ $library{$seed} },$2,$3; } } } $x=int(rand (@{$library{$seed}})/2); $x=$x*2; ($word,$punc)=($library{$seed}[$x], $library{$seed}[$x+1]); $output.="$word$punc"; $seed=$word; if($punc=~/\./) { $sentances++; } # Likelihood of a carriage return. # This section needs some work- its far to random. $odds++; $x=int(rand(15)); if($x < $odds) { $output.="
\n"; $odds=0; } } print "

Rob's Amazing Poem Generator

"; print "

Once again, as an escape from productive labor, I have resorted to programming. This one generates poetry. This poem was generated from "; if($$FORM{url}) { print "$$FORM{url}"; } else { print "fortune."; } print "

"; if(length($output) > 10 ) { print "

$output
"; } else { print "One of any number of things have just gone wrong.

"; } $$FORM{url}||="http://"; print "

Entertained by this?

Enter a URL and have it generate a poem based on the contents!

(This will probably take a bit longer)

You can snag the source code to this here.

"; # Don't Worry about this stuff... it handles my footer dumpfile("./ctfoot.inc");