phony.pl - phonetic alphabet - now with navajo

phony.pl

#!/usr/bin/perl 
use Getopt::Std;
%alpha = (
    "A" => [ "Alpha",   "WOL-LA-CHEE",  "BE-LA-SANA",        "TSE-NILL" ],
    "B" => [ "Bravo",   "NA-HASH-CHID", "SHUSH",             "TOISH-JEH" ],
    "C" => [ "Charlie", "MOASI",        "TLA-GIN",           "BA-GOSHI" ],
    "D" => [ "Delta",   "BE",           "CHINDI",            "LHA-CHA-EH" ],
    "E" => [ "Echo",    "AH-JAH",       "DZEH",              "AH-NAH" ],
    "F" => [ "Foxtrot", "CHUO",         "TSA-E-DONIN-EE",    "MA-E" ],
    "G" => [ "Golf",    "AH-TAD",       "KLIZZIE",           "JEHA" ],
    "H" => [ "Hotel",   "TSE-GAH",      "CHA",               "LIN" ],
    "I" => [ "India",   "TKIN",         "YEH-HES",           "A-CHI" ],
    "J" => [ "Juliett", "TKELE-CHO-G",  "AH-YA-TSINNE",      "YIL-DOI" ],
    "K" => [ "Kilo",    "JAD-HO-LONI",  "BA-AH-NE-DI-TININ", "KLIZZIE-YAZZIE" ],
    "L" => [ "Lima",    "DIBEH-YAZZIE", "AH-JAD",            "NASH-DOIE-TSO" ],
    "M" => [ "Mike",    "TSIN-TLITI",   "BE-TAS-TNI",        "NA-AS-TSO-SI" ],
    "N" => [ "November", "TSAH",        "A-CHIN" ],
    "O" => [ "Oscar",    "A-KHA",       "TLO-CHIN",  "NE-AHS-JAH" ],
    "P" => [ "Papa",     "CLA-GI-AIH",  "BI-SO-DIH", "NE-ZHONI" ],
    "Q" => [ "Quebec",   "CA-YEILTH" ],
    "R" => [ "Romeo",    "GAH",    "DAH-NES-TSA", "AH-LOSZ" ],
    "S" => [ "Sierra",   "DIBEH",  "KLESH" ],
    "T" => [ "Tango",    "D-AH",   "A-WOH", "THAN-ZIE" ],
    "U" => [ "Uniform",  "SHI-DA", "NO-DA-IH" ],
    "V" => [ "Victor",   "A-KEH-DI-GLINI" ],
    "W" => [ "Whiskey",  "GLOE-IH" ],
    "X" => [ "X-Ray",    "AL-NA-AS-DZOH" ],
    "Y" => [ "Yankee",   "TSAH-AS-ZIH" ],
    "Z" => [ "Zulu",     "BESH-DO-TLIZ" ]
);
getopts('n');
srand;
while (<>) {
    my @line = split( //, $_ ), $c = 0;
    if ($opt_n) { $c++; }
    for ( $i = 0 ; $i < scalar @line ; $i++ ) {
        if ( $line[$i] =~ /[A-Z]/i ) {
            my $p = scalar @{ $alpha{ uc $line[$i] } };
            if ( $p > 1 && $c ) {
                $c = int rand( $p - 1 ) + 1;
            }
            $line[$i] = $alpha{ uc $line[$i] }[$c];
        }
    }
    print "@line";
}