spam.poem.anti-art.machine v0.69.pi

#!/usr/bin/perl -w ################################## # # # spam.poem.anti-art.machine # # # # version: 00.69.pi # # author: c.eiseman # # updated: 12|17|00 # # # # (k)1900 toegristle studios # # # ################################## srand(); use strict; use CGI; use Fcntl; $main::query = new CGI; @main::data_file = qw(datawaste.dat datawaste2.dat datawaste3.dat); ### package IO contains all the input / output functions package IO; # IO::readfile accepts a path to a data file as an arg and splits up the entries, returning an array sub IO::readfile { my $all_entries = ""; open (ENTRIES, "$_[0]") or die "can't open $_[0]: $!"; flock(ENTRIES, 1) or die "can't lock $_[0]: $!"; while() { $all_entries .= $_; } close(ENTRIES) or die "can't close $_[0]: $!"; # entries divided by a vertical bar '|' my @entries = split(/\|/, $all_entries); return @entries; } # IO::readwrite accepts a path to the data file and the entry to be added as args sub IO::readwrite { my $all_entries = ""; sysopen(ENTRIES, "$_[0]", 2) or die "can't open $_[0]: $!"; flock(ENTRIES, 2) or die "can't LOCK_EX $_[0]: $!"; while() { $all_entries .= $_; } $all_entries .= $_[1]; seek(ENTRIES, 0, 0) or die "can't rewind $_[0]: $!"; truncate(ENTRIES, 0) or die "can't truncate $_[0]: $!"; print ENTRIES $all_entries or die "can't print to $_[0]: $!"; close(ENTRIES) or die "can't close $_[0]: $!"; } # IO::whichfile is a datawaste file query - checks for a user choice # and supplies one if needed. Returns the datawaste file sub IO::whichfile { my $data_query = $main::query->param('datawaste'); my @data_file = (); unless ($data_query) { $data_query = "datawaste2"; } if ($data_query eq "datawaste2") { $data_file[0] = $main::data_file[1]; } elsif ($data_query eq "datawaste3") { $data_file[0] = $main::data_file[2]; } else { $data_file[0] = $main::data_file[0]; } $data_file[1] = $data_query; return @data_file; } # IO::addwords processes the words, adds them to the data file and prints a thank you screen sub IO::addwords { # grabs the form submissions my $word1 = $main::query->param('word1'); my $word2 = $main::query->param('word2'); my $word3 = $main::query->param('word3'); # checks for blank submissions, adds punctuation if any fields are left blank unless ($word1) { $word1 = '!'; } unless ($word2) { $word2 = '?'; } unless ($word3) { $word3 = '.'; } # combines the three entries into one for processing my $words = "$word1 $word2 $word3"; # fix line-endings and lose HTML tags $words =~ s/\r\n?/\n/g; $words =~ s//>/g; $words =~ s/\"/"/g; # replace quotes with safe ASCII equivelant # replaces all white spaces with a vertical bar, to split up the different words $words =~ s/\s/\|/g; # checks for any blank entries caused by multiple spaces while ($words =~ /\|\|/) { $words =~ s/\|\|/\|/g; } $words =~ s/\|$//g; $words .= "\|"; my @data = IO::whichfile(); IO::readwrite($data[0], $words); # prints the thank you HTML page HTML::header(); print " \n \n"; print "thank you! \n"; print "dELICIOUS!
\n

$words

\n"; HTML::menubar(); HTML::footer(); exit 0; } ### package HTML contains functions used to store and construct html code package HTML; # initialize some common arrays used in html construction @HTML::hex = qw(FF CC 99 66 33 00); @HTML::fonts = qw(Verdana Courier Helvetica Times Arial Georgia); @HTML::alignment = qw(center left right); @HTML::open_tags= ("", "", "", "", "", "(", "{", "[", "'"); @HTML::close_tags= ("", "", "", "", "", ")", "}", "]", "'"); # subroutines to print generic header, footer and menu sub HTML::header { print "Content-type: text/html \n\n"; print " \n \nspam.poem.anti-art.machine v0.69.pi \n \n"; } sub HTML::footer { print " \n \n"; } sub HTML::menubar { print "

"; unless ($_[0]) { # checks for a "switch" to turn off the intitial form tag print "

\n"; } print " \n \n \n \n

\n"; print " \n"; print " \n"; print " \n \n"; print ""; print " \n \n \n

\n"; print " \n"; print " \n"; print " \n"; print "

"; print " "; print " \nbackground color -----	\n"; my @colors = qw(white black grey random); my @bg_query = HTML::bgcolor(); HTML::pulldown("bgcolor", $bg_query[1], @colors); print "
\n"; print " \nfont color -----	\n"; my @fontcolors = ("black", "white", "grey", "red", "light blue", "dark blue", "light green", "random"); my @fontcolor_query = HTML::font_color(); HTML::pulldown("fontcolor", $fontcolor_query[1], @fontcolors); print "
\n"; print " \nfont face -----	\n"; my @fontfaces = (@HTML::fonts, "random"); my @fontface_query = HTML::font_face(); HTML::pulldown("fontface", $fontface_query[1], @fontfaces); print "
\n"; print " \nfont size -----	\n"; my @fontsizes = (2..6, "random"); my @fontsize_query = HTML::font_size(); HTML::pulldown("fontsize", $fontsize_query[1], @fontsizes); print "
\n"; print " \ndatawaste file -----	\n"; my @files = qw(datawaste1 datawaste2 datawaste3); my @data_file = IO::whichfile(); HTML::pulldown("datawaste", $data_file[1], @files); print "

\n"; print "

"; } # HTML::bgcolor is a background color query - checks for a user choice # and supplies one if needed. Returns a hex color sub HTML::bgcolor { my $bg_query = $main::query->param('bgcolor'); my @bgcolor = (); unless ($bg_query) { $bg_query = "random"; } if ($bg_query eq "black") { $bgcolor[0] = "#000000"; } elsif ($bg_query eq "white") { $bgcolor[0] = "#FFFFFF"; } elsif ($bg_query eq "grey") { $bgcolor[0] = "#999999"; } else { $bgcolor[0] = HTML::hexcolor(); } $bgcolor[1] = $bg_query; return @bgcolor; } # HTML::pulldown creates an pulldown menu -- accepts the name of the select menu, # the index number of the selected item, then a list of elements sub HTML::pulldown { my $name = shift @_; my $selected = shift @_; my @list = @_; my $count = 0; my $thing = ""; print "

\n"; } # HTML::hexcolor generates a random hex color combination and returns it sub HTML::hexcolor { my $hexcolor = "#"; my $count = 3; my $hexnum = 0; while ($count > 0) { $hexnum = int( rand(6) ); $hexcolor .= $HTML::hex[$hexnum]; $count--; } return $hexcolor; } # HTML::enterwords prints the word entry html form to type in new words sub HTML::enterwords { HTML::header(); print " \n"; print "

\n \n"; print "

\n"; print "

feed the datawaste

\n"; print "

your words and phrases

\n"; print "

feed the machine

\n \n"; print "

\n"; print "

\n \n"; HTML::menubar("X"); # X switch turns off the form tag in the menu HTML::footer(); exit 0; } # HTML::font_tag generates a font tag and returns it sub HTML::font_tag { my @fontsize = HTML::font_size(); my @fontcolor = HTML::font_color(); my @fontface = HTML::font_face(); my $tag = ""; return $tag; } # HTML::fontcolor checks for a user choice then returns a hex color for font tag generation sub HTML::font_color { my $color = $main::query->param('fontcolor'); my @font_color = (); unless ($color) { $color = "random"; } if ($color eq "black") { $font_color[0] = "#000000"; } elsif ($color eq "white") { $font_color[0] = "#FFFFFF"; } elsif ($color eq "grey") { $font_color[0] = "#999999"; } elsif ($color eq "red") { $font_color[0] = "#FF0000"; } elsif ($color eq "light blue") { $font_color[0] = "#66CCFF"; } elsif ($color eq "dark blue") { $font_color[0] = "#0000CC"; } elsif ($color eq "light green") { $font_color[0] = "#00FF00"; } else { $font_color[0] = HTML::hexcolor(); } $font_color[1] = $color; return @font_color; } # HTML::font_face checks for a user choice then returns a font face for font tag generation sub HTML::font_face { my $ranum = int( rand($#HTML::fonts) ); my $face = $main::query->param('fontface'); my @font_face = (); unless ($face) { $face = "random"; } if ($face eq "random") { $font_face[0] = $HTML::fonts[$ranum]; } else { $font_face[0] = $face; } $font_face[1] = $face; return @font_face; } # HTML::font_size checks for a user choice then returns a font size for font tag generation sub HTML::font_size { my $size = $main::query->param('fontsize'); my @font_size = (); unless ($size) { $size = "random"; } if ($size eq "random") { $font_size[0] = ( int(rand(5)) ) + 2; } else { $font_size[0] = $size; } $font_size[1] = $size; return @font_size; } # HTML::randalign is an alignment randomization subroutine sub HTML::randalign { my $rand_align = int( rand(3) ); return $HTML::alignment[$rand_align]; } # HTML::special_tag creates and returns an array with special opening and closing tags sub HTML::special_tag { my $ranum = int( rand(20) ); my @array = (); if ( $ranum <= 8 ) { @array = ($HTML::open_tags[$ranum], $HTML::close_tags[$ranum]); return @array; } else { @array = ("", ""); return @array; } } ### package POEM contains several functions used to generate the spam poems package POEM; # POEM::randcase causes random capitalization and lowercasing of words sub POEM::randcase { my $word = ""; my $ranum = int( rand(6) ); if ($ranum == 0) { $word = uc($_[0]); } elsif ($ranum == 1) { $word = lc($_[0]); } else { $word = $_[0]; } return $word; } # POEM::printword called for each word in a line, applies font and # special tags to each word and returns the whole thing sub POEM::printword { my @words = @_; my $entry = shift @words; my $num = int( rand($#words) ); my $word = POEM::randcase($words[$num]); my @randtag = HTML::special_tag(); my $font = HTML::font_tag(); $entry .= "$font $randtag[0]$word$randtag[1] \n"; return $entry; } # POEM::alliterate returns an alliterated line sub POEM::alliterate { my $entry = $_[0]; my $wordsperline = ( int(rand(5)) ) + 1; my $num = int(rand(26)); my $thisletter = $STATS::literal_alphabet[$num]; my @letter = SORT::alpha($thisletter, @POEM::words); while ($wordsperline > 0) { $entry = POEM::printword($entry, @letter); $wordsperline--; } return $entry; } # POEM::regline returns a regular (non-alliteratd) line sub POEM::regline { my $entry = $_[0]; my $wordsperline = ( int(rand(5)) ) + 1; while ($wordsperline > 0) { $entry = POEM::printword($entry, @POEM::words); $wordsperline--; } return $entry; } # POEM::printline chooses from the line types and returns a line of the poem sub POEM::printline { my $entry = $_[0]; my $ranum = int( rand(8) ); my @randtag = HTML::special_tag(); my $font = HTML::font_tag(); if ($randtag[0]) { $entry .= "$font $randtag[0] \n"; } if ($ranum == 0) { $entry = POEM::alliterate($entry); } else { $entry = POEM::regline($entry); } if ($randtag[1]) { $entry .= "$font $randtag[1] \n"; } return $entry; } # POEM::makepoem uses other functions to generate and print a spam poem sub POEM::makepoem { # resets the cpu benchmark feature my $t0 = new Benchmark; # sets the background color and prints the beginning of the html file HTML::header(); my @bgcolor = HTML::bgcolor(); print "\n"; # use the readfile subroutine to read the datawaste into a word array my @data = IO::whichfile(); local @POEM::words = IO::readfile($data[0]); my $num = $#POEM::words; # randomly chooses the total number of lines in the poem my $linenum = ( int(rand(20)) ) + 7; # goes through the while loop to generate each line of the poem my $entry = ""; while ($linenum > 0) { my $aligntag = HTML::randalign(); $entry .= "

\n"; $entry = printline($entry); $entry .= "

\n"; $linenum--; } print $entry; # calculates and prints the cpu benchmark time use Benchmark; my $t1 = new Benchmark; my $benchmark = timestr(timediff($t1, $t0)); $benchmark =~ s/\(/
\(/; $benchmark =~ s/secs/seconds/; my $check_color = "#"; $_ = $bgcolor[0]; if (/00/) { $check_color = "#FFFFFF"; } else { $check_color = "#000000"; } print "

\n\n \n"; print "spam.poem processing time: $benchmark \n\n"; my $save_entry = SORT::strip_html($entry); print " \n"; print " \n\n"; print " \n"; HTML::menubar("X"); HTML::footer(); exit 0; } ### package STATS contains functions used to determine statistics of a datawaste file package STATS; @STATS::literal_alphabet = qw(a b c d e f g h i j k l m n o p q r s t u v w x y z); # STATS::common_count returns a hash with the words # as the keys and the values as the number of times each word occurs sub STATS::common_count { my %count = (); my $element = ""; foreach $element (@STATS::words) { $count{$element}++; } return %count; } # STATS::once_count is used for statistics and returns two values: the # number of unique entries and the number of entries that occur only once sub STATS::once_count { my @values = values %STATS::count; my $uniqcount = $#values + 1; my ($oncecount, $number) = 0; foreach $number (@values) { if ($number == 1) { $oncecount++; } } return ($oncecount, $uniqcount); } # STATS::nth_common is used within a loop for statistics to find the # first, second, third, etc. most common word in the data file sub STATS::nth_common { my $place = $_[0]; my ($word, $each, $key) = ""; my $numb = 0; foreach $key (@STATS::keys) { if ( $STATS::count{$key} > $numb ) { $word = "" $key ""; $numb = $STATS::count{$key}; $each = ""; } elsif ( $STATS::count{$key} == $numb ) { $word = "$word and " $key ""; $each = "each"; } } print "The $place most common entry is: \n"; print "

$word occurring $numb times $each

\n\n"; $word =~ s/\"\;\s\//g; $word =~ s/\<\/b\>\s\"\;//g; my @delwords = split(/\sand\s/, $word); my $entry = ""; foreach $entry (@delwords) { delete $STATS::count{$entry}; } @STATS::keys = keys %STATS::count; } # STATS::statistics is the main datawaste statistics subroutine sub STATS::statistics { HTML::header(); # reads datawaste file into a word array and counts it my @data = IO::whichfile(); local @STATS::words = IO::readfile($data[0]); my $num = $#STATS::words + 1; # prints the beginning of the statistics page print "\n \n\n"; print "

datawaste statistics

\n\n"; print "

total entries: $num

\n"; # generates a common_count hash and a once_count array local %STATS::count = STATS::common_count(); my @once = STATS::once_count(); print "

There are $once[1] unique entries.
\n"; print "There are $once[0] entries that occur only once.

\n\n"; # cycles through to find nth most common occurrences, according to how many places # are in the @place array. local @STATS::keys = keys %STATS::count; my @place = ("", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th", "10th", "11th", "12th", "13th", "14th", "15th", "16th", "17th", "18th", "19th", "20th"); my $place = ""; print "\n\n"; foreach $place (@place) { STATS::nth_common($place); } print "

\n\n"; # goes through the words and creates an array for each letter of the alphabet local @STATS::alphabet = STATS::alphabetize(); print "

breakdown by first letter \n \n\n"; print " \n"; print " \n\n"; # this loop goes through each letter array in the alphabet array and counts it my ($loop_num, $count) = 0; my @temp_array = (); my $thisletter = ""; while ($loop_num < 26) { @temp_array = @{$STATS::alphabet[$loop_num]}; $count = $#temp_array + 1; $thisletter = $STATS::literal_alphabet[$loop_num]; print " \n"; print " \n\n"; $loop_num++; } print "
starts with number of entries
$thisletter $count
\n"; HTML::menubar(); HTML::footer(); exit 0; } # STATS::alphabetize filters through the word array and sorts them into alphabetical subsets sub STATS::alphabetize { my @data = IO::whichfile(); my @words = IO::readfile($data[0]); my $item = ""; my (@A, @B, @C, @D, @E, @F, @G, @H, @I, @J, @K, @L, @M, @N, @O, @P, @Q, @R, @S, @T, @U, @V, @W, @X, @Y, @Z) = (); my(@alphabetref) = ( \@A, \@B, \@C, \@D, \@E, \@F, \@G, \@H, \@I, \@J, \@K, \@L, \@M, \@N, \@O, \@P, \@Q, \@R, \@S, \@T, \@U, \@V, \@W, \@X, \@Y, \@Z ); my $count = 0; foreach $item (@STATS::literal_alphabet) { @{$alphabetref[$count]} = SORT::alpha($STATS::literal_alphabet[$count], @words); $count++; } return @alphabetref; } ### package SORT contains various sorting functions package SORT; # SORT::alpha sorts through a word array and filters out words starting with a particular letter sub SORT::alpha { my ($lower, @words) = @_; my $upper = uc($lower); my @letter = (); my $item = ""; foreach $item (@words) { if ( $item =~ /^[$lower$upper]/ ) { push(@letter, $item); } } return @letter; } # SORT::strip_html removes all html formatting from a poem and returns a text only version sub SORT::strip_html { my $poem = $_[0]; $poem =~ s/<//g; $poem =~ s/(Arial|Helvetica|Georgia|Times|Courier|Verdana)//g; $poem =~ s/\#......//g; $poem =~ s/(\|\<\/font\>|\)//g; $poem =~ s/(\<\/b\>|\|\<\/i\>|\|\<\/u\>)//g; $poem =~ s/<\/font\>//g; $poem =~ s/\s+/ /g; $poem =~ s/\r\n?/\n/g; $poem =~ s/\//g; $poem =~ s/\/ /g; $poem =~ s/\/ /g; $poem =~ s/<\/p>/\n/g; return $poem; } ### package EMAIL contains functions related to emailing poems package EMAIL; # EMAIL::form prints the email form sub EMAIL::form { HTML::header(); print " \n

\n"; my $from = $main::query->param('from'); my $to = $main::query->param('to'); my $subject = $main::query->param('subject'); my $error = $_[0]; if ($error) { print "$error
\n"; } my $textpoem = $main::query->param('entry'); print " \n"; print " \n"; print "

from: (your name or email address)
\n"; print "

\n"; print "

to: (recipients email address)
\n"; print "

\n"; print "

subject: (optional)
\n"; print "

\n"; print "

\n \n"; print "

\n"; $textpoem =~ s/\n/\/g; $textpoem =~ s/\s/\ \;/g; print "$textpoem \n"; HTML::menubar("X"); # X switch turns off the initial form tag in the menu so it can use the one above HTML::footer(); exit 0; } # EMAIL::sendit error checks, formats and sends the mail, and prints a confirmation page sub EMAIL::sendit { my $from = $main::query->param('from'); unless ($from) { $from = "spam\@toegristle\.com" } unless ($from =~ /\@/ ) { $from .= "\@toegristle\.com" } my $to = $main::query->param('to'); my $error = "You must enter a valid email
address for the recipient!"; unless ( $to =~ /\@/ ) { email_form($error); } unless ( $to =~ /\./ ) { email_form($error); } my $subject = $main::query->param('subject'); my $poem = $main::query->param('entry'); my $sendmail = "/usr/lib/sendmail"; open (MAIL, "|$sendmail -oi -t"); print MAIL "From: $from \n"; print MAIL "To: $to \n"; print MAIL "Subject: [s.p.a.m.] $subject \n"; print MAIL "\n"; print MAIL $poem; print MAIL "\n\n"; print MAIL "::::: spam.poem.anti-art.machine :::::\n"; print MAIL "http://www.toegristle.com/netart/spam/ \n"; close MAIL; my $textpoem = $poem; $textpoem =~ s/\n/\/g; $textpoem =~ s/\s/\ \;/g; HTML::header(); print " \n"; print " \n"; print "

Thanks, your email has been sent.

\n"; print "Subject: [s.p.a.m.] $subject
\nFrom: $from
\nTo: $to

\n"; print "

$textpoem

\n \n"; HTML::menubar(); HTML::footer(); exit 0; } ### package main tells the program where to go package main; $main::action = $main::query->param('action'); unless ($main::action) { $main::action = ""; } if ($main::action eq "add.words") { HTML::enterwords(); } elsif ($main::action eq "statistics") { STATS::statistics(); } elsif ($main::action eq "Feed!") { IO::addwords(); } elsif ($main::action eq "email.this.poem") { EMAIL::form(); } elsif ($main::action eq "send") { EMAIL::sendit(); } else { POEM::makepoem(); } exit 0;