#!/usr/bin/perl
# Mnemonic Generator
###################################################################
# What this program does: You enter a word or short phrase and
# it returns a short term by taking out all unnecessary letters.
# This method was originally design for geology to assign
# standardized codes to geographic strata (i.e. "Mississippian"
# becomes "MSPN"). Similar in use as acronyms but more descriptive.
# I also used it to create shortened variable names for programming
# applications.
###################################################################
# Get input from HTML form and parse into name/value pairs.
# This form uses the POST method, so read from standard input.
###################################################################
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name/value pairs on '&'
@pairs = split(/&/, $buffer);
# Go through the pairs and determine the name
# and value for each input form variable (i_varname).
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
@char=qw(a e i o u w h y t n s r l d c m f g p k s v x j q z);
$_=$FORM{i_term};
$wordlen= $FORM{i_maxword};
$option= $FORM{i_option} ;
$out = $_ . "
";
#printf "\t\t%s\n",$_;
if ($option eq "first") {
tr/[A-Z]/[a-z]/; # translate all char to lower-case
}
s/\d//g; # remove all numbers
s/\W/ /g; # remove all non-word chars
s/(\s)\1+/$1/g; # remove multiple spaces
#printf "[^alpha]\t\t%s\n",$_;
$out .= $_ . "
";
s/\b\w{0,$wordlen}\b//g; # remove small words
s/(\s)\1+/$1/g; # remove multiple spaces
#printf "[word]\t\t%s\n",$_;
$out .= $_ . "
";
if ($option eq "first") {
s/\b([a-z])/\U$1/g; # 1st char of word to uppercase
}
foreach $c (@char) { # Loop for all chars $c
do { # Loop for all occurences of $c in string
$count= tr/[a-zA-Z]\w//; # count number of chars in string
$cnt= $count ;
#printf "%i,\t%i\n",$cnt,$count;
if ( $count <= $FORM{i_minlen} ) {
last ;
} else {
if ($c eq "t") {
s/(\w)\1+/$1/g; # remove multiple chars
#printf "[double]\t%s\n",$_;
$out .= $_ . "
";
}
$count= tr/[a-zA-Z]\w//; # count number of chars in string
if ( $count <= $FORM{i_minlen} ) {
last ;
} else {
s/$c//; # remove character
#printf "[%s]\t\t%s\n",$c,$_;
$out .= $_ . "
";
}
}
$count= tr/[a-zA-Z]\w//; # count number of chars in string
} until $cnt == $count ; # until there are no more changes in string length
if ( $count <= $FORM{i_minlen} ) {
last ;
}
}
s/\s//g; # remove the rest of the spaces
tr/[a-z]/[A-Z]/; # translate all char to up-case
#printf "\t\t%s\n",$_;
$mnemonic = $_;
$out .= $_ . "
";
print "Content-type: text/html", "\n\n" ;
print <
Mnemonic Generator Output
Mnemonic Generator
EOF
print $out if $FORM{i_verbose};
print "
Form Variables";
print "
Radio Options:\t", $option if $FORM{i_verbose}; ;
print "
Min mnemonic chars:\t", $FORM{i_minlen};
print "
Max Small Word length:\t",$wordlen;
print "
Word or Term:\t\"", $FORM{i_term},"\"";
print "
Mnemonic:\t", $mnemonic,"
";
print "